module Ast.Parser.Utils where

import qualified Ast.Parser.State as PS
import qualified Ast.Types as AT
import qualified Control.Monad.Combinators.Expr as CE
import qualified Control.Monad.State as S
import qualified Data.Char as C
import qualified Text.Megaparsec as M
import qualified Text.Megaparsec.Char as MC
import qualified Text.Megaparsec.Char.Lexer as ML
import qualified Text.Megaparsec.Pos as MP

-- | A type alias for the parser, based on `Parsec` with `Void` error type and `String` input.
type Parser = M.ParsecT ParseErrorCustom String (S.StateT PS.ParserState IO)

-- | Custom error types for the parser.
data ParseErrorCustom
  = UnknownType String
  | InvalidFunctionType String AT.Type
  | InvalidDefer AT.Expr
  deriving (Int -> ParseErrorCustom -> ShowS
[ParseErrorCustom] -> ShowS
ParseErrorCustom -> [Char]
(Int -> ParseErrorCustom -> ShowS)
-> (ParseErrorCustom -> [Char])
-> ([ParseErrorCustom] -> ShowS)
-> Show ParseErrorCustom
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseErrorCustom -> ShowS
showsPrec :: Int -> ParseErrorCustom -> ShowS
$cshow :: ParseErrorCustom -> [Char]
show :: ParseErrorCustom -> [Char]
$cshowList :: [ParseErrorCustom] -> ShowS
showList :: [ParseErrorCustom] -> ShowS
Show, Eq ParseErrorCustom
Eq ParseErrorCustom
-> (ParseErrorCustom -> ParseErrorCustom -> Ordering)
-> (ParseErrorCustom -> ParseErrorCustom -> Bool)
-> (ParseErrorCustom -> ParseErrorCustom -> Bool)
-> (ParseErrorCustom -> ParseErrorCustom -> Bool)
-> (ParseErrorCustom -> ParseErrorCustom -> Bool)
-> (ParseErrorCustom -> ParseErrorCustom -> ParseErrorCustom)
-> (ParseErrorCustom -> ParseErrorCustom -> ParseErrorCustom)
-> Ord ParseErrorCustom
ParseErrorCustom -> ParseErrorCustom -> Bool
ParseErrorCustom -> ParseErrorCustom -> Ordering
ParseErrorCustom -> ParseErrorCustom -> ParseErrorCustom
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ParseErrorCustom -> ParseErrorCustom -> Ordering
compare :: ParseErrorCustom -> ParseErrorCustom -> Ordering
$c< :: ParseErrorCustom -> ParseErrorCustom -> Bool
< :: ParseErrorCustom -> ParseErrorCustom -> Bool
$c<= :: ParseErrorCustom -> ParseErrorCustom -> Bool
<= :: ParseErrorCustom -> ParseErrorCustom -> Bool
$c> :: ParseErrorCustom -> ParseErrorCustom -> Bool
> :: ParseErrorCustom -> ParseErrorCustom -> Bool
$c>= :: ParseErrorCustom -> ParseErrorCustom -> Bool
>= :: ParseErrorCustom -> ParseErrorCustom -> Bool
$cmax :: ParseErrorCustom -> ParseErrorCustom -> ParseErrorCustom
max :: ParseErrorCustom -> ParseErrorCustom -> ParseErrorCustom
$cmin :: ParseErrorCustom -> ParseErrorCustom -> ParseErrorCustom
min :: ParseErrorCustom -> ParseErrorCustom -> ParseErrorCustom
Ord, ParseErrorCustom -> ParseErrorCustom -> Bool
(ParseErrorCustom -> ParseErrorCustom -> Bool)
-> (ParseErrorCustom -> ParseErrorCustom -> Bool)
-> Eq ParseErrorCustom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseErrorCustom -> ParseErrorCustom -> Bool
== :: ParseErrorCustom -> ParseErrorCustom -> Bool
$c/= :: ParseErrorCustom -> ParseErrorCustom -> Bool
/= :: ParseErrorCustom -> ParseErrorCustom -> Bool
Eq)

instance M.ShowErrorComponent ParseErrorCustom where
  showErrorComponent :: ParseErrorCustom -> [Char]
showErrorComponent (UnknownType [Char]
n) =
    [Char]
"Unknown type: type \"" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\" does not exist"
  showErrorComponent (InvalidFunctionType [Char]
n Type
t) =
    [Char]
"Invalid Function Type: function \"" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\" with type \"" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> [Char]
forall a. Show a => a -> [Char]
show Type
t [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\" is not valid"
  showErrorComponent (InvalidDefer Expr
e) =
    [Char]
"Invalid Defer: defer \"" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Expr -> [Char]
forall a. Show a => a -> [Char]
show Expr
e [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\" is not valid "

-- | Skips whitespace and comments (starting with `%`). Ensures proper handling of spacing in parsers.
sc :: Parser ()
sc :: Parser ()
sc = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
ML.space Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MC.space1 (Tokens [Char] -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
ML.skipLineComment [Char]
Tokens [Char]
"%") (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens [Char] -> Tokens [Char] -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> Tokens s -> m ()
ML.skipBlockComment [Char]
Tokens [Char]
"%%" [Char]
Tokens [Char]
"%%"

-- | Wraps a parser to consume trailing whitespace, returning the result of the inner parser.
lexeme :: Parser a -> Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme = Parser ()
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
ML.lexeme Parser ()
sc

-- | Parses a specific symbol (e.g., "+", "-") while skipping trailing whitespace.
symbol :: String -> Parser String
symbol :: [Char] -> Parser [Char]
symbol = Parser ()
-> Tokens [Char]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
ML.symbol Parser ()
sc

-- | Tries each parser in the list sequentially, allowing backtracking for all but the last parser.
triedChoice :: [Parser a] -> Parser a
triedChoice :: forall a. [Parser a] -> Parser a
triedChoice [Parser a]
ps =
  let triedPs :: [Parser a]
triedPs = (Parser a -> Parser a) -> [Parser a] -> [Parser a]
forall a b. (a -> b) -> [a] -> [b]
map Parser a -> Parser a
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try ([Parser a] -> [Parser a]
forall a. HasCallStack => [a] -> [a]
init [Parser a]
ps) [Parser a] -> [Parser a] -> [Parser a]
forall a. [a] -> [a] -> [a]
++ [[Parser a] -> Parser a
forall a. HasCallStack => [a] -> a
last [Parser a]
ps]
   in [Parser a] -> Parser a
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
M.choice [Parser a]
triedPs

-- | An identifier in our language syntax
identifier :: Parser String
identifier :: Parser [Char]
identifier = Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a
lexeme ((:) (Char -> ShowS)
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
ParsecT
  ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
MC.letterChar ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a.
ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
M.<|> [Token [Char]]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
M.oneOf [Char]
[Token [Char]]
"$_") ParsecT ParseErrorCustom [Char] (StateT ParserState IO) ShowS
-> Parser [Char] -> Parser [Char]
forall a b.
ParsecT ParseErrorCustom [Char] (StateT ParserState IO) (a -> b)
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> Parser [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many (ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
ParsecT
  ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
MC.alphaNumChar ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a.
ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
M.<|> [Token [Char]]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
M.oneOf [Char]
[Token [Char]]
"$_"))

-- | Gets the SrcLoc
parseSrcLoc :: Parser AT.SrcLoc
parseSrcLoc :: Parser SrcLoc
parseSrcLoc = do
  (MP.SourcePos {sourceName :: SourcePos -> [Char]
MP.sourceName = [Char]
_sourceName, sourceLine :: SourcePos -> Pos
MP.sourceLine = Pos
_sourceLine, sourceColumn :: SourcePos -> Pos
MP.sourceColumn = Pos
_sourceColumn}) <- ParsecT ParseErrorCustom [Char] (StateT ParserState IO) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
M.getSourcePos
  SrcLoc -> Parser SrcLoc
forall a.
a -> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcLoc -> Parser SrcLoc) -> SrcLoc -> Parser SrcLoc
forall a b. (a -> b) -> a -> b
$ AT.SrcLoc {srcFile :: [Char]
AT.srcFile = [Char]
_sourceName, srcLine :: Int
AT.srcLine = Pos -> Int
MP.unPos Pos
_sourceLine, srcCol :: Int
AT.srcCol = Pos -> Int
MP.unPos Pos
_sourceColumn}

-- | Creates a prefix operator parser.
prefix :: String -> (AT.SrcLoc -> AT.Expr -> AT.Expr) -> CE.Operator Parser AT.Expr
prefix :: [Char]
-> (SrcLoc -> Expr -> Expr)
-> Operator
     (ParsecT ParseErrorCustom [Char] (StateT ParserState IO)) Expr
prefix [Char]
name SrcLoc -> Expr -> Expr
f = Parser (Expr -> Expr)
-> Operator
     (ParsecT ParseErrorCustom [Char] (StateT ParserState IO)) Expr
forall (m :: * -> *) a. m (a -> a) -> Operator m a
CE.Prefix (SrcLoc -> Expr -> Expr
f (SrcLoc -> Expr -> Expr) -> Parser SrcLoc -> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser SrcLoc
parseSrcLoc Parser SrcLoc -> Parser [Char] -> Parser SrcLoc
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> Parser [Char]
symbol [Char]
name))

-- | Creates a postfix operator parser.
postfix :: String -> (AT.SrcLoc -> AT.Expr -> AT.Expr) -> CE.Operator Parser AT.Expr
postfix :: [Char]
-> (SrcLoc -> Expr -> Expr)
-> Operator
     (ParsecT ParseErrorCustom [Char] (StateT ParserState IO)) Expr
postfix [Char]
name SrcLoc -> Expr -> Expr
f = Parser (Expr -> Expr)
-> Operator
     (ParsecT ParseErrorCustom [Char] (StateT ParserState IO)) Expr
forall (m :: * -> *) a. m (a -> a) -> Operator m a
CE.Postfix (SrcLoc -> Expr -> Expr
f (SrcLoc -> Expr -> Expr) -> Parser SrcLoc -> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser SrcLoc
parseSrcLoc Parser SrcLoc -> Parser [Char] -> Parser SrcLoc
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> Parser [Char]
symbol [Char]
name))

-- | Helper functions to define operators
binary :: String -> (AT.SrcLoc -> AT.Expr -> AT.Expr -> AT.Expr) -> CE.Operator Parser AT.Expr
binary :: [Char]
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
     (ParsecT ParseErrorCustom [Char] (StateT ParserState IO)) Expr
binary [Char]
name SrcLoc -> Expr -> Expr -> Expr
f = Parser (Expr -> Expr -> Expr)
-> Operator
     (ParsecT ParseErrorCustom [Char] (StateT ParserState IO)) Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
CE.InfixL (SrcLoc -> Expr -> Expr -> Expr
f (SrcLoc -> Expr -> Expr -> Expr)
-> Parser SrcLoc -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser SrcLoc
parseSrcLoc Parser SrcLoc -> Parser [Char] -> Parser SrcLoc
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> Parser [Char]
symbol [Char]
name))

-- | Parses a boolean value (`true` or `false`).
-- Returns a `Bool`.
parseBool :: Parser Bool
parseBool :: Parser Bool
parseBool = Bool
True Bool
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Tokens [Char])
-> Parser Bool
forall a b.
a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) b
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens [Char]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string [Char]
Tokens [Char]
"true" Parser Bool -> Parser Bool -> Parser Bool
forall a.
ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
M.<|> Bool
False Bool
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Tokens [Char])
-> Parser Bool
forall a b.
a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) b
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens [Char]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string [Char]
Tokens [Char]
"false"

-- | Parses a character in a string literal, supporting escape sequences.
parseStringChar :: Parser Char
parseStringChar :: ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
parseStringChar =
  [ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char]
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
M.choice
    [ ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
parseEscapeSequence,
      [Token [Char]]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
M.noneOf [Char
'"', Char
'\\']
    ]

-- | Parses an escape sequence in a string literal (e.g., `\n`, `\t`, `\xFF`).
parseEscapeSequence :: Parser Char
parseEscapeSequence :: ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
parseEscapeSequence =
  Token [Char]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token [Char]
'\\'
    ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a b.
ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) b
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char]
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
M.choice
      [ Char
'\a' Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a b.
a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) b
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token [Char]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token [Char]
'a',
        Char
'\b' Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a b.
a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) b
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token [Char]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token [Char]
'b',
        Char
'\f' Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a b.
a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) b
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token [Char]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token [Char]
'f',
        Char
'\n' Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a b.
a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) b
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token [Char]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token [Char]
'n',
        Char
'\r' Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a b.
a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) b
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token [Char]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token [Char]
'r',
        Char
'\t' Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a b.
a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) b
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token [Char]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token [Char]
't',
        Char
'\v' Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a b.
a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) b
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token [Char]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token [Char]
'v',
        Char
'\\' Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a b.
a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) b
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token [Char]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token [Char]
'\\',
        Char
'\"' Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a b.
a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) b
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token [Char]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token [Char]
'"',
        Char
'\'' Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a b.
a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) b
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token [Char]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token [Char]
'\'',
        Char
'\0' Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a b.
a
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) b
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token [Char]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token [Char]
'0',
        ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
parseHexEscape,
        ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
parseOctalEscape
      ]

-- | Parses a hexadecimal escape sequence (e.g., `\xFF`).
parseHexEscape :: Parser Char
parseHexEscape :: ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
parseHexEscape = do
  Char
_ <- Token [Char]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token [Char]
'x'
  [Char]
digits <- Int
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> Parser [Char]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
M.count Int
2 ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
hexDigit
  Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a.
a -> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
 -> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char)
-> Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
C.chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall a. Read a => [Char] -> a
read ([Char]
"0x" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
digits)

-- | Parses an octal escape sequence (e.g., `\077`).
parseOctalEscape :: Parser Char
parseOctalEscape :: ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
parseOctalEscape = do
  [Char]
digits <- Int
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
-> Parser [Char]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
M.count Int
3 ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
octalDigit
  Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a.
a -> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
 -> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char)
-> Char
-> ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
C.chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall a. Read a => [Char] -> a
read ([Char]
"0o" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
digits)

-- | Parses a hexadecimal digit (`0-9`, `a-f`, `A-F`).
hexDigit :: Parser Char
hexDigit :: ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
hexDigit = [Token [Char]]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
M.oneOf ([Token [Char]]
 -> ParsecT
      ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char]))
-> [Token [Char]]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall a b. (a -> b) -> a -> b
$ [Char
'0' .. Char
'9'] [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'a' .. Char
'f'] [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A' .. Char
'F']

-- | Parses an octal digit (`0-7`).
octalDigit :: Parser Char
octalDigit :: ParsecT ParseErrorCustom [Char] (StateT ParserState IO) Char
octalDigit = [Token [Char]]
-> ParsecT
     ParseErrorCustom [Char] (StateT ParserState IO) (Token [Char])
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
M.oneOf [Char
'0' .. Char
'7']

-- | A default `SrcLoc` for normalization.
normalizeLoc :: AT.SrcLoc
normalizeLoc :: SrcLoc
normalizeLoc = [Char] -> Int -> Int -> SrcLoc
AT.SrcLoc [Char]
"" Int
0 Int
0

-- | Normalizes expressions by resetting their source locations.
-- Ensures consistent formatting and comparison of expressions.
normalizeExpr :: AT.Expr -> AT.Expr
normalizeExpr :: Expr -> Expr
normalizeExpr (AT.Lit SrcLoc
_ Literal
lit) = SrcLoc -> Literal -> Expr
AT.Lit SrcLoc
normalizeLoc Literal
lit
normalizeExpr (AT.Var SrcLoc
_ [Char]
name Type
t) = SrcLoc -> [Char] -> Type -> Expr
AT.Var SrcLoc
normalizeLoc [Char]
name Type
t
normalizeExpr (AT.Function SrcLoc
_ [Char]
name Type
t [[Char]]
params Expr
body) = SrcLoc -> [Char] -> Type -> [[Char]] -> Expr -> Expr
AT.Function SrcLoc
normalizeLoc [Char]
name Type
t [[Char]]
params (Expr -> Expr
normalizeExpr Expr
body)
normalizeExpr (AT.Declaration SrcLoc
_ [Char]
name Type
t Maybe Expr
initVal) = SrcLoc -> [Char] -> Type -> Maybe Expr -> Expr
AT.Declaration SrcLoc
normalizeLoc [Char]
name Type
t ((Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr -> Expr
normalizeExpr Maybe Expr
initVal)
normalizeExpr (AT.Assignment SrcLoc
_ Expr
target Expr
value) = SrcLoc -> Expr -> Expr -> Expr
AT.Assignment SrcLoc
normalizeLoc (Expr -> Expr
normalizeExpr Expr
target) (Expr -> Expr
normalizeExpr Expr
value)
normalizeExpr (AT.Call SrcLoc
_ Expr
func [Expr]
args) = SrcLoc -> Expr -> [Expr] -> Expr
AT.Call SrcLoc
normalizeLoc (Expr -> Expr
normalizeExpr Expr
func) ((Expr -> Expr) -> [Expr] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
normalizeExpr [Expr]
args)
normalizeExpr (AT.If SrcLoc
_ Expr
cond Expr
thenBranch Maybe Expr
elseBranch) = SrcLoc -> Expr -> Expr -> Maybe Expr -> Expr
AT.If SrcLoc
normalizeLoc (Expr -> Expr
normalizeExpr Expr
cond) (Expr -> Expr
normalizeExpr Expr
thenBranch) ((Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr -> Expr
normalizeExpr Maybe Expr
elseBranch)
normalizeExpr (AT.Block [Expr]
exprs) = [Expr] -> Expr
AT.Block ((Expr -> Expr) -> [Expr] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
normalizeExpr [Expr]
exprs)
normalizeExpr (AT.Return SrcLoc
_ Maybe Expr
value) = SrcLoc -> Maybe Expr -> Expr
AT.Return SrcLoc
normalizeLoc ((Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr -> Expr
normalizeExpr Maybe Expr
value)
normalizeExpr (AT.Op SrcLoc
_ Operation
op Expr
e1 Expr
e2) = SrcLoc -> Operation -> Expr -> Expr -> Expr
AT.Op SrcLoc
normalizeLoc Operation
op (Expr -> Expr
normalizeExpr Expr
e1) (Expr -> Expr
normalizeExpr Expr
e2)
normalizeExpr (AT.UnaryOp SrcLoc
_ UnaryOperation
op Expr
e) = SrcLoc -> UnaryOperation -> Expr -> Expr
AT.UnaryOp SrcLoc
normalizeLoc UnaryOperation
op (Expr -> Expr
normalizeExpr Expr
e)
normalizeExpr (AT.From SrcLoc
_ Expr
s Expr
e Expr
r Expr
v Expr
b) = SrcLoc -> Expr -> Expr -> Expr -> Expr -> Expr -> Expr
AT.From SrcLoc
normalizeLoc (Expr -> Expr
normalizeExpr Expr
s) (Expr -> Expr
normalizeExpr Expr
e) (Expr -> Expr
normalizeExpr Expr
r) (Expr -> Expr
normalizeExpr Expr
v) (Expr -> Expr
normalizeExpr Expr
b)
normalizeExpr (AT.While SrcLoc
_ Expr
c Expr
b) = SrcLoc -> Expr -> Expr -> Expr
AT.While SrcLoc
normalizeLoc (Expr -> Expr
normalizeExpr Expr
c) (Expr -> Expr
normalizeExpr Expr
b)
normalizeExpr (AT.Continue SrcLoc
_) = SrcLoc -> Expr
AT.Continue SrcLoc
normalizeLoc
normalizeExpr (AT.Break SrcLoc
_) = SrcLoc -> Expr
AT.Break SrcLoc
normalizeLoc
normalizeExpr (AT.StructAccess SrcLoc
_ Expr
e1 Expr
e2) = SrcLoc -> Expr -> Expr -> Expr
AT.StructAccess SrcLoc
normalizeLoc (Expr -> Expr
normalizeExpr Expr
e1) (Expr -> Expr
normalizeExpr Expr
e2)
normalizeExpr (AT.ArrayAccess SrcLoc
_ Expr
e1 Expr
e2) = SrcLoc -> Expr -> Expr -> Expr
AT.ArrayAccess SrcLoc
normalizeLoc (Expr -> Expr
normalizeExpr Expr
e1) (Expr -> Expr
normalizeExpr Expr
e2)
normalizeExpr (AT.Cast SrcLoc
_ Type
t Expr
e) = SrcLoc -> Type -> Expr -> Expr
AT.Cast SrcLoc
normalizeLoc Type
t (Expr -> Expr
normalizeExpr Expr
e)
normalizeExpr (AT.ForeignFunction SrcLoc
_ [Char]
n Type
t) = SrcLoc -> [Char] -> Type -> Expr
AT.ForeignFunction SrcLoc
normalizeLoc [Char]
n Type
t
normalizeExpr (AT.Assembly SrcLoc
_ AsmExpr
a) = SrcLoc -> AsmExpr -> Expr
AT.Assembly SrcLoc
normalizeLoc AsmExpr
a