Negate integral expressions

2024-10-02 22:56:15 +02:00
parent cafae5c830
commit fdf56ce9d0
18 changed files with 169 additions and 138 deletions
--- a/lib/Language/Elna/Frontend/Parser.hs
+++ b/lib/Language/Elna/Frontend/Parser.hs
@@ -0,0 +1,223 @@
+module Language.Elna.Frontend.Parser
+    ( Parser
+    , programP
+    ) where
+
+import Control.Monad (void)
+import Control.Monad.Combinators.Expr (Operator(..), makeExprParser)
+import Data.Text (Text)
+import qualified Data.Text as Text
+import Data.Void (Void)
+import Language.Elna.Frontend.AST
+    ( Declaration(..)
+    , Identifier(..)
+    , Parameter(..)
+    , Program(..)
+    , Statement(..)
+    , TypeExpression(..)
+    , VariableDeclaration(..)
+    {-, VariableAccess(..)
+    , Condition(..)-}
+    , Expression(..)
+    , Literal(..)
+    )
+import Text.Megaparsec
+    ( Parsec
+    , (<?>)
+    , MonadParsec(..)
+    , eof
+    , optional
+    , between
+    , sepBy
+    , choice
+    )
+import qualified Text.Megaparsec.Char.Lexer as Lexer
+import Text.Megaparsec.Char
+    ( alphaNumChar
+--    , char
+    , letterChar
+    , space1
+--    , string
+    )
+import Control.Applicative (Alternative(..))
+import Data.Maybe (isJust)
+-- import Data.Functor (($>))
+
+type Parser = Parsec Void Text
+
+literalP :: Parser Literal
+literalP
+    = {- HexadecimalLiteral <$> (string "0x" *> lexeme Lexer.hexadecimal)
+    <|> -} IntegerLiteral <$> Lexer.signed space integerP
+    {- <|> CharacterLiteral <$> lexeme charP
+    <|> BooleanLiteral <$> (symbol "true" $> True)
+    <|> BooleanLiteral <$> (symbol "false" $> False)
+  where
+    charP = fromIntegral . fromEnum
+        <$> between (char '\'') (char '\'') Lexer.charLiteral -}
+{-
+typeDefinitionP :: Parser Declaration
+typeDefinitionP = TypeDefinition
+    <$> (symbol "type" *> identifierP)
+    <*> (symbol "=" *> typeExpressionP)
+    <* semicolonP
+    <?> "type definition"
+-}
+termP :: Parser Expression
+termP = choice
+    [ parensP expressionP
+    , LiteralExpression <$> literalP
+    -- , VariableExpression <$> variableAccessP
+    ]
+
+operatorTable :: [[Operator Parser Expression]]
+operatorTable =
+    [ unaryOperator
+    -- , factorOperator
+    , termOperator
+    ]
+  where
+    unaryOperator =
+        [ prefix "-" NegationExpression
+        , prefix "+" id
+        ]
+    {- factorOperator =
+        [ binary "*" ProductExpression
+        , binary "/" DivisionExpression
+        ] -}
+    termOperator =
+        [ binary "+" SumExpression
+        , binary "-" SubtractionExpression
+        ]
+    prefix name f = Prefix (f <$ symbol name)
+    binary name f = InfixL (f <$ symbol name)
+
+expressionP :: Parser Expression
+expressionP = makeExprParser termP operatorTable
+{-
+variableAccessP :: Parser VariableAccess
+variableAccessP = do
+    identifier <- identifierP
+    indices <- many $ bracketsP expressionP
+    pure $ foldr (flip ArrayAccess) (VariableAccess identifier) indices
+
+conditionP :: Parser Condition
+conditionP = do
+    lhs <- expressionP
+    conditionCons <- choice comparisonOperator
+    conditionCons lhs <$> expressionP
+  where
+    comparisonOperator =
+        [ symbol "<" >> pure LessCondition
+        , symbol "<=" >> pure LessOrEqualCondition
+        , symbol ">" >> pure GreaterCondition
+        , symbol ">=" >> pure GreaterOrEqualCondition
+        , symbol "=" >> pure EqualCondition
+        , symbol "#" >> pure NonEqualCondition
+        ]
+-}
+symbol :: Text -> Parser Text
+symbol = Lexer.symbol space
+
+space :: Parser ()
+space = Lexer.space space1 (Lexer.skipLineComment "//")
+    $ Lexer.skipBlockComment "/*" "*/"
+
+lexeme :: forall a. Parser a -> Parser a
+lexeme = Lexer.lexeme space
+
+blockP :: forall a. Parser a -> Parser a
+blockP = between (symbol "{") (symbol "}")
+
+parensP :: forall a. Parser a -> Parser a
+parensP = between (symbol "(")  (symbol ")")
+
+bracketsP :: forall a. Parser a -> Parser a
+bracketsP = between (symbol "[") (symbol "]")
+
+colonP :: Parser ()
+colonP = void $ symbol ":"
+
+commaP :: Parser ()
+commaP = void $ symbol ","
+
+semicolonP :: Parser ()
+semicolonP = void $ symbol ";"
+
+integerP :: Integral a => Parser a
+integerP = lexeme Lexer.decimal
+
+identifierP :: Parser Identifier
+identifierP =
+    let wordParser = (:) <$> letterChar <*> many alphaNumChar <?> "identifier"
+     in fmap Identifier $ lexeme $ Text.pack <$> wordParser
+
+procedureP :: Parser ()
+procedureP = void $ symbol "proc"
+
+parameterP :: Parser Parameter
+parameterP = paramCons
+    <$> optional (symbol "ref")
+    <*> identifierP
+    <*> (colonP *> typeExpressionP)
+  where
+    paramCons ref name typeName = Parameter name typeName (isJust ref)
+
+typeExpressionP :: Parser TypeExpression
+typeExpressionP = arrayTypeExpression
+    <|> NamedType <$> identifierP
+    <?> "type expression"
+  where
+    arrayTypeExpression = ArrayType
+        <$> (symbol "array" *> bracketsP integerP)
+        <*> (symbol "of" *> typeExpressionP)
+
+procedureDeclarationP :: Parser Declaration
+procedureDeclarationP = procedureCons
+    <$> (procedureP *> identifierP)
+    <*> parensP (sepBy parameterP commaP)
+    <*> blockP ((,) <$> many variableDeclarationP <*> many statementP)
+    <?> "procedure definition"
+  where
+    procedureCons procedureName parameters (variables, body) =
+        ProcedureDeclaration procedureName parameters variables body
+
+statementP :: Parser Statement
+statementP
+    = EmptyStatement <$ semicolonP
+    {-<|> CompoundStatement <$> blockP (many statementP)
+    <|> try assignmentP
+    <|> try ifElseP
+    <|> try whileP -}
+    <|> try callP
+    <?> "statement"
+  where
+    callP = CallStatement
+        <$> identifierP
+        <*> parensP (sepBy expressionP commaP)
+        <* semicolonP
+    {-ifElseP = IfStatement
+        <$> (symbol "if" *> parensP conditionP)
+        <*> statementP
+        <*> optional (symbol "else" *> statementP)
+    whileP = WhileStatement
+        <$> (symbol "while" *> parensP conditionP)
+        <*> statementP
+    assignmentP = AssignmentStatement
+        <$> variableAccessP
+        <* symbol ":="
+        <*> expressionP
+        <* semicolonP -}
+
+variableDeclarationP :: Parser VariableDeclaration
+variableDeclarationP = VariableDeclaration
+    <$> (symbol "var" *> identifierP)
+    <*> (colonP *> typeExpressionP)
+    <* semicolonP
+    <?> "variable declaration"
+
+declarationP :: Parser Declaration
+declarationP = procedureDeclarationP -- <|> typeDefinitionP
+
+programP :: Parser Program
+programP = Program <$> many declarationP <* eof