-- Copyright (C) 2018-2024 Jun Zhang <zhangjunphy[at]gmail[dot]com>
--
-- This file is a part of decafc.
--
-- decafc is free software: you can redistribute it and/or modify it under the
-- terms of the MIT (X11) License as described in the LICENSE file.
--
-- decafc is distributed in the hope that it will be useful, but WITHOUT ANY
-- WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE.  See the X11 license for more details.

module Parser.Helper where

import Data.Text (Text)
import Lexer (Alex (..), Token (..), alexMonadScan, alexError, addError)
import Util.SourceLoc as SL
import Text.Printf (printf)
import Types (CompileError(CompileError))
import Formatting (sformat, shown, (%))

getID :: Token -> Text
getID :: Token -> Text
getID (Identifier Text
id) = Text
id

getLiteral :: Token -> Text
getLiteral :: Token -> Text
getLiteral (IntLiteral Text
i) = Text
i
getLiteral (BooleanLiteral Text
b) = Text
b
getLiteral (CharLiteral Text
c) = Text
c
getLiteral (StringLiteral Text
s) = Text
s

getOp :: Token -> Text
getOp :: Token -> Text
getOp (IncrementOp Text
op) = Text
op
getOp (CompoundAssignOp Text
op) = Text
op

unionOf :: SL.Located a -> SL.Located b -> Range
unionOf :: forall a b. Located a -> Located b -> Range
unionOf (SL.LocatedAt Range
loc1 a
_) (SL.LocatedAt Range
loc2 b
_) = Range -> Range -> Range
combineRanges Range
loc1 Range
loc2
  where
    combineRanges :: Range -> Range -> Range
combineRanges (SL.Range Posn
start1 Posn
stop1) (SL.Range Posn
start2 Posn
stop2) =
      let start :: Posn
start = if (Posn -> Int
SL.offset Posn
start1) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Posn -> Int
SL.offset Posn
start2) then Posn
start1 else Posn
start2
          stop :: Posn
stop = if (Posn -> Int
SL.offset Posn
stop1) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Posn -> Int
SL.offset Posn
stop2) then Posn
stop1 else Posn
stop2
       in Posn -> Posn -> Range
SL.Range Posn
start Posn
stop

lexerwrap :: (SL.Located Token -> Alex a) -> Alex a
lexerwrap :: forall a. (Located Token -> Alex a) -> Alex a
lexerwrap Located Token -> Alex a
s = do
  Located Token
token <- Alex (Located Token)
alexMonadScan
  Located Token -> Alex a
s Located Token
token

parseError :: Located a -> Alex b
parseError (SL.LocatedAt sl :: Range
sl@(SL.Range (SL.Posn Int
_ Int
row Int
col) Posn
_) a
tok) = do
  CompileError -> Alex ()
addError (CompileError -> Alex ()) -> CompileError -> Alex ()
forall a b. (a -> b) -> a -> b
$ Maybe Range -> Text -> CompileError
CompileError (Range -> Maybe Range
forall a. a -> Maybe a
Just Range
sl) (Text -> CompileError) -> Text -> CompileError
forall a b. (a -> b) -> a -> b
$ Format Text (a -> Text) -> a -> Text
forall a. Format Text a -> a
sformat (Format (a -> Text) (a -> Text)
"Error handling token '" Format (a -> Text) (a -> Text)
-> Format Text (a -> Text) -> Format Text (a -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (a -> Text)
forall a r. Show a => Format r (a -> r)
shown Format Text (a -> Text)
-> Format Text Text -> Format Text (a -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text Text
"'") a
tok
  String -> Alex b
forall a. String -> Alex a
alexError String
"Parser failed."