Improve AST to ANF transformation

lib/Parser/Ast.hs

@@ -1,8 +1,12 @@
--- | Contains all AST elements, all of these produced by the [Parser]("Parser.Parser") module.
+-- |
+-- Module      : Ast
+-- Description : Contains all AST elements.
+--
+-- Contains all AST elements, all of these produced by the [Parser]("Parser.Parser") module.
 module Parser.Ast where
 
 import Data.List.NonEmpty (NonEmpty)
-import Data.Text (Text)
+import Trees.Common
 
 --------------------------------------------------------Program---------------------------------------------------------
 
@@ -16,8 +20,8 @@ newtype Program = Program [Statement]
 
 -- | Statement.
 data Statement
-  = -- | User declaration statement, see 'UserDeclaration'.
-    StmtUserDecl UserDeclaration
+  = -- | Declaration statement, see 'Declaration'.
+    StmtDecl Declaration
   | -- | Expression statement, see 'Expression'.
     StmtExpr Expression
   deriving (Show, Eq)
@@ -26,32 +30,18 @@ data Statement
 
 -- * Declarations
 
--- | User declaration.
-data UserDeclaration
-  = -- | Variable declaration (e.g., @let x = 5@).
+-- | Declaration.
+data Declaration
+  = -- | Variable declaration.
+    --
+    -- > let x = 5
     DeclVar (Identifier, Maybe Type) Expression
-  | -- | Function declaration (e.g., @let f x y = x + y@).
-    DeclFun Identifier Fun
-  | -- | Recursive function declaration (e.g., @let rec f x y = f x 1 + f 1 y@).
-    DeclRecFun Identifier Fun
-  deriving (Show, Eq)
-
----------------------------------------------------------Types----------------------------------------------------------
-
--- * Types
-
--- | All existing types.
-data Type
-  = -- | Unit type
-    TUnit
-  | -- | Boolean type.
-    TBool
-  | -- | Integer type.
-    TInt
-  | -- | Function type.
+  | -- | Function declaration.
+    --
+    -- > let f x y = x + y
     --
-    -- It contains the type of the first parameter and the result of the function (e.g., @int -> (int -> bool -> bool)@).
-    TFun Type Type
+    -- > let rec f x y = f x 1 + f 1 y
+    DeclFun Identifier IsRec Fun
   deriving (Show, Eq)
 
 ------------------------------------------------------Expressions-------------------------------------------------------
@@ -61,15 +51,15 @@ data Type
 -- | Expression.
 data Expression
   = -- | Identifier expression, see 'Identifier'.
-    ExprIdentifier Identifier
+    ExprId Identifier
   | -- | Value expression, see 'Value'.
-    ExprValue Value
+    ExprVal Value
   | -- | Binary operation, see 'BinaryOperator'.
-    ExprBinaryOperation BinaryOperator Expression Expression
+    ExprBinOp BinaryOperator Expression Expression
   | -- | Unary operation, see 'UnaryOperator'.
-    ExprUnaryOperation UnaryOperator Expression
+    ExprUnOp UnaryOperator Expression
   | -- | Function application expression (e.g., @f 6@, @(fun x y = x + y) 5@).
-    ExprApplication Expression Expression
+    ExprApp Expression Expression
   | -- | If-then-else expression (e.g., @if x > 4 then x * 8 else x / 15@).
     ExprIte Expression Expression Expression
   | -- | Let expression.
@@ -79,21 +69,9 @@ data Expression
     -- > let f x y = x + y in f 4 8
     --
     -- > let rec f x y = f x 1 + f 1 y in f 4 8
-    ExprLetIn UserDeclaration Expression
-  deriving (Show, Eq)
-
--- ** Values
-
--- | Literal or anonymous function.
-data Value
-  = -- | Unit literal (@()@).
-    ValUnit
-  | -- | Boolean literal (@true@, @false@).
-    ValBool Bool
-  | -- | Int literal (e.g., @0@, @4@, @15@, @23@).
-    ValInt Integer
+    ExprLetIn Declaration Expression
   | -- | Anonymous function, see 'Fun'.
-    ValFun Fun
+    ExprFun Fun
   deriving (Show, Eq)
 
 -- | Function representation without the name.
@@ -105,62 +83,3 @@ data Value
 -- > fun x y -> x + y
 data Fun = Fun (NonEmpty (Identifier, Maybe Type)) (Maybe Type) Expression
   deriving (Show, Eq)
-
--- ** Operators
-
--- | Binary operator.
-data BinaryOperator
-  = -- | Boolean operator, see 'BooleanOperator'.
-    BooleanOp BooleanOperator
-  | -- | Arithmetic operator, see 'ArithmeticOperator'.
-    ArithmeticOp ArithmeticOperator
-  | -- | Comparison operator, see 'ComparisonOperator'.
-    ComparisonOp ComparisonOperator
-  deriving (Show, Eq)
-
--- | Unary operator.
-data UnaryOperator
-  = -- | Unary minus operator (@-a@), works only for @int@.
-    UnaryMinusOp
-  deriving (Show, Eq, Enum, Bounded)
-
--- | Boolean operator.
-data BooleanOperator
-  = -- | And operator (@a && b@).
-    AndOp
-  | -- | Or operator (@a || b@).
-    OrOp
-  deriving (Show, Eq, Enum, Bounded)
-
--- | Arithmetic operator.
-data ArithmeticOperator
-  = -- | Addition operator (@a + b@).
-    PlusOp
-  | -- | Subtraction operator (@a - b@).
-    MinusOp
-  | -- | Multiplication operator (@a * b@).
-    MulOp
-  | -- | Division operator (@a / b@).
-    DivOp
-  deriving (Show, Eq, Enum, Bounded)
-
--- | Comparison operator.
-data ComparisonOperator
-  = -- | Equality operator (@a = b@).
-    EqOp
-  | -- | Non-equality operator (@a <> b@).
-    NeOp
-  | -- | Less than operator (@a < b@).
-    LtOp
-  | -- | Less than or equal operator (@a <= b@).
-    LeOp
-  | -- | Greater than operator (@a > b@).
-    GtOp
-  | -- | Greater than or equal operator (@a >= b@).
-    GeOp
-  deriving (Show, Eq, Enum, Bounded)
-
--- ** Identifier
-
--- | Any valid identifier (e.g., @he42llo@, @_42@).
-type Identifier = Text

lib/Parser/Lexer.hs

@@ -28,12 +28,14 @@ module Parser.Lexer
   )
 where
 
+import Control.Monad (when)
+import Data.Int (Int64)
 import Data.Text (Text, pack)
 import Data.Void (Void)
-import Parser.Ast (Identifier)
 import Text.Megaparsec (MonadParsec (..), Parsec, choice, many, (<|>))
 import Text.Megaparsec.Char (char, digitChar, letterChar, space1, string)
 import qualified Text.Megaparsec.Char.Lexer as L
+import Trees.Common (Identifier)
 
 -- * Basic lexer parts
 
@@ -89,8 +91,11 @@ boolLitP :: Parser Bool
 boolLitP = True <$ kwTrue <|> False <$ kwFalse
 
 -- | Decimal integer literal parser.
-intLitP :: Parser Integer
-intLitP = lexeme L.decimal
+intLitP :: Parser Int64
+intLitP = do
+  int <- lexeme L.decimal
+  when (int > 9223372036854775808) $ fail "Error: Integer literal exceeds the range of representable integers of type int64"
+  return $ fromInteger int
 
 -- * Identifiers and keywords
 

lib/Parser/Parser.hs

@@ -10,6 +10,7 @@ import Parser.Ast
 import Parser.Lexer
 import Parser.Utils
 import Text.Megaparsec (MonadParsec (..), many, parseMaybe)
+import Trees.Common
 
 -- * Program Parser
 
@@ -18,19 +19,19 @@ parseProgram :: Text -> Maybe Program
 parseProgram = parseMaybe $ sc *> programP <* eof
 
 programP :: Parser Program
-programP = Program <$> (many semicolon2 *> many (statementP <* many semicolon2))
+programP = Program <$> (many semicolon2 *> many (stmtP <* many semicolon2))
 
-statementP :: Parser Statement
-statementP = choice' [StmtExpr <$> exprP, StmtUserDecl <$> userDeclP]
+stmtP :: Parser Statement
+stmtP = choice' [StmtExpr <$> exprP, StmtDecl <$> declP]
 
 -- ** User Declaration Parsers
 
-userDeclP :: Parser UserDeclaration
-userDeclP = choice' [recFunDeclP, funDeclP, varDeclP]
+declP :: Parser Declaration
+declP = choice' [recFunDeclP, funDeclP, varDeclP]
   where
     varDeclP = DeclVar <$ kwLet <*> varSigP <* eq <*> exprP
-    funDeclP = DeclFun <$ kwLet <*> identifierP <*> funP eq
-    recFunDeclP = DeclRecFun <$ kwLet <* kwRec <*> identifierP <*> funP eq
+    funDeclP = flip DeclFun False <$ kwLet <*> identifierP <*> funP eq
+    recFunDeclP = flip DeclFun True <$ kwLet <* kwRec <*> identifierP <*> funP eq
 
     varSigP = manyParens $ (,) <$> manyParens identifierP <*> optionalTypeAnnotationP
 
@@ -43,48 +44,48 @@ exprTerm :: Parser Expression
 exprTerm =
   choice'
     [ parens exprP,
-      ExprLetIn <$> userDeclP <* kwIn <*> exprP,
-      ExprValue <$> valueP,
+      ExprLetIn <$> declP <* kwIn <*> exprP,
+      valueExprP,
       ExprIte <$ kwIf <*> exprP <* kwThen <*> exprP <* kwElse <*> exprP,
-      ExprIdentifier <$> identifierP
+      ExprId <$> identifierP
     ]
 
 -- ** Operation Parsers
 
 opsTable :: [[Operator Parser Expression]]
 opsTable =
-  [ [applicationOp],
-    [unaryOp "-" UnaryMinusOp],
-    [arithmeticOp "*" MulOp, arithmeticOp "/" DivOp],
-    [arithmeticOp "+" PlusOp, arithmeticOp "-" MinusOp],
-    [ comparisonOp "=" EqOp,
-      comparisonOp "<>" NeOp,
-      comparisonOp "<=" LeOp,
-      comparisonOp "<" LtOp,
-      comparisonOp ">=" GeOp,
-      comparisonOp ">" GtOp
+  [ [appOp],
+    [unOp "-" UnaryMinusOp],
+    [arithOp "*" MulOp, arithOp "/" DivOp],
+    [arithOp "+" PlusOp, arithOp "-" MinusOp],
+    [ compOp "=" EqOp,
+      compOp "<>" NeOp,
+      compOp "<=" LeOp,
+      compOp "<" LtOp,
+      compOp ">=" GeOp,
+      compOp ">" GtOp
     ],
-    [booleanOp "&&" AndOp],
-    [booleanOp "||" OrOp]
+    [boolOp "&&" AndOp],
+    [boolOp "||" OrOp]
   ]
 
-applicationOp :: Operator Parser Expression
-applicationOp = InfixL $ return ExprApplication
+appOp :: Operator Parser Expression
+appOp = InfixL $ return ExprApp
 
-binaryLeftOp :: Text -> BinaryOperator -> Operator Parser Expression
-binaryLeftOp name op = InfixL $ ExprBinaryOperation op <$ symbol name
+binLeftOp :: Text -> BinaryOperator -> Operator Parser Expression
+binLeftOp name op = InfixL $ ExprBinOp op <$ symbol name
 
-booleanOp :: Text -> BooleanOperator -> Operator Parser Expression
-booleanOp name op = binaryLeftOp name $ BooleanOp op
+boolOp :: Text -> BooleanOperator -> Operator Parser Expression
+boolOp name op = binLeftOp name $ BooleanOp op
 
-arithmeticOp :: Text -> ArithmeticOperator -> Operator Parser Expression
-arithmeticOp name op = binaryLeftOp name $ ArithmeticOp op
+arithOp :: Text -> ArithmeticOperator -> Operator Parser Expression
+arithOp name op = binLeftOp name $ ArithmeticOp op
 
-comparisonOp :: Text -> ComparisonOperator -> Operator Parser Expression
-comparisonOp name op = binaryLeftOp name $ ComparisonOp op
+compOp :: Text -> ComparisonOperator -> Operator Parser Expression
+compOp name op = binLeftOp name $ ComparisonOp op
 
-unaryOp :: Text -> UnaryOperator -> Operator Parser Expression
-unaryOp name op = Prefix $ ExprUnaryOperation op <$ symbol name
+unOp :: Text -> UnaryOperator -> Operator Parser Expression
+unOp name op = Prefix $ ExprUnOp op <$ symbol name
 
 -- ** Type Parsers
 
@@ -105,13 +106,13 @@ typeP =
 
 -- ** Value Parsers
 
-valueP :: Parser Value
-valueP =
+valueExprP :: Parser Expression
+valueExprP =
   choice'
-    [ ValUnit <$ unitLitP,
-      ValBool <$> boolLitP,
-      ValInt <$> intLitP,
-      ValFun <$ kwFun <*> funP arrow
+    [ ExprVal ValUnit <$ unitLitP,
+      ExprVal . ValBool <$> boolLitP,
+      ExprVal . ValInt <$> intLitP,
+      ExprFun <$ kwFun <*> funP arrow
     ]
 
 -- ** Function Parser