Parse expressions

1 files changed, 71 insertions, 8 deletions

diff --git a/lib/Language/Elna/Parser.hs b/lib/Language/Elna/Parser.hs
index cd8f927..f387f60 100644
--- a/lib/Language/Elna/Parser.hs
+++ b/lib/Language/Elna/Parser.hs
@@ -4,22 +4,27 @@ module Language.Elna.Parser
     ) 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.AST
     ( Declaration(..)
+    , Expression(..)
     , Identifier(..)
+    , Literal(..)
     , Parameter(..)
     , Program(..)
+    , Statement(..)
     , TypeExpression(..)
     , VariableDeclaration(..)
     )
-import Text.Megaparsec (Parsec, (<?>), optional, between, sepBy)
-import Text.Megaparsec.Char (alphaNumChar, letterChar, space1)
+import Text.Megaparsec (Parsec, (<?>), optional, between, sepBy, choice)
+import Text.Megaparsec.Char (alphaNumChar, char, letterChar, space1, asciiChar)
 import qualified Text.Megaparsec.Char.Lexer as Lexer
 import Control.Applicative (Alternative(..))
 import Data.Maybe (isJust)
+import Data.Functor (($>))
 
 type Parser = Parsec Void Text
 
@@ -42,11 +47,8 @@ procedureP = void $ symbol "proc"
 parensP :: forall a. Parser a -> Parser a
 parensP = between (symbol "(")  (symbol ")")
 
-openBracketP :: Parser ()
-openBracketP = void $ symbol "["
-
-closingBracketP :: Parser ()
-closingBracketP = void $ symbol "]"
+bracketsP :: forall a. Parser a -> Parser a
+bracketsP = between (symbol "[") (symbol "]")
 
 colonP :: Parser ()
 colonP = void $ symbol ":"
@@ -65,7 +67,7 @@ typeExpressionP = arrayTypeExpression
     <?> "type expression"
   where
     arrayTypeExpression = flip ArrayType
-        <$> (symbol "array" *> openBracketP *> lexeme Lexer.decimal <* closingBracketP)
+        <$> (symbol "array" *> bracketsP (lexeme Lexer.decimal))
         <*> (symbol "of" *> typeExpressionP)
 
 typeDefinitionP :: Parser Declaration
@@ -92,6 +94,67 @@ parameterP = paramCons
 parametersP :: Parser [Parameter]
 parametersP = parensP $ sepBy parameterP (symbol ",")
 
+literalP :: Parser Literal
+literalP
+    = HexadecimalLiteral <$> Lexer.hexadecimal
+    <|> IntegerLiteral <$> Lexer.decimal
+    <|> CharacterLiteral <$> charP
+    <|> BooleanLiteral <$> (symbol "true" $> True)
+    <|> BooleanLiteral <$> (symbol "false" $> False)
+  where
+    -- TODO: Escape characters.
+    charP = fromIntegral . fromEnum
+        <$> between (char '\'') (char '\'') asciiChar
+
+termP :: Parser Expression
+termP = choice
+    [ parensP expressionP
+    , VariableExpression <$> identifierP
+    , LiteralExpression <$> literalP
+    ]
+
+operatorTable :: [[Operator Parser Expression]]
+operatorTable =
+    [ [Postfix (ArrayExpression <$> bracketsP expressionP)]
+    , unaryOperator
+    , factoryOperator
+    , termOperator
+    , comparisonOperator
+    ]
+  where
+    unaryOperator = 
+        [ prefix "-" NegationExpression
+        , prefix "+" id
+        ]
+    factoryOperator =
+        [ binary "*" ProductExpression
+        , binary "/" DivisionExpression
+        ]
+    termOperator =
+        [ binary "+" SumExpression
+        , binary "-" SubtractionExpression
+        ]
+    comparisonOperator =
+        [ binary "<" LessExpression
+        , binary "<=" LessOrEqualExpression
+        , binary ">" GreaterExpression
+        , binary ">=" GreaterOrEqualExpression
+        , binary "=" EqualExpression
+        , binary "#" NonEqualExpression
+        ]
+    prefix name f = Prefix (f <$ symbol name)
+    binary name f = InfixL (f <$ symbol name)
+
+expressionP :: Parser Expression
+expressionP = makeExprParser termP operatorTable
+
+statementP :: Parser Statement
+statementP
+    = EmptyStatement <$ semicolonP
+    <|> AssignmentStatement <$> expressionP <* symbol ":=" <*> expressionP
+    <|> CompoundStatement <$> blockP (many statementP)
+    <?> "statement" -- TODO: further statements
+
 procedureDefinitionP :: Parser Declaration
 procedureDefinitionP = ProcedureDefinition
     <$> (procedureP *> identifierP)