Parse expressions

2 files changed, 74 insertions, 17 deletions

diff --git a/lib/Language/Elna/AST.hs b/lib/Language/Elna/AST.hs
index fc4b264..0add1d2 100644
--- a/lib/Language/Elna/AST.hs
+++ b/lib/Language/Elna/AST.hs
@@ -61,9 +61,6 @@ data Expression
     = VariableExpression Identifier
     | LiteralExpression Literal
     | NegationExpression Expression
-    | NotExpression Expression
-    | ReferenceExpression Expression
-    | DereferenceExpression Expression
     | SumExpression Expression Expression
     | SubtractionExpression Expression Expression
     | ProductExpression Expression Expression
@@ -74,7 +71,7 @@ data Expression
     | GreaterExpression Expression Expression
     | LessOrEqualExpression Expression Expression
     | GreaterOrEqualExpression Expression Expression
-    | FieldExpression Expression Identifier
+    | ArrayExpression Expression Expression
     deriving Eq
 
 instance Show Expression
@@ -82,9 +79,6 @@ instance Show Expression
     show (VariableExpression variable) = show variable
     show (LiteralExpression literal) = show literal
     show (NegationExpression negation) = '-' : show negation
-    show (NotExpression negation) = "not " <> show negation
-    show (ReferenceExpression reference) = '@' : show reference
-    show (DereferenceExpression dereference) = show dereference <> "^"
     show (SumExpression lhs rhs) = concat [show lhs, " + ", show rhs]
     show (SubtractionExpression lhs rhs) = concat [show lhs, " - ", show rhs]
     show (ProductExpression lhs rhs) = concat [show lhs, " * ", show rhs]
@@ -95,8 +89,8 @@ instance Show Expression
     show (GreaterExpression lhs rhs) = concat [show lhs, " > ", show rhs]
     show (LessOrEqualExpression lhs rhs) = concat [show lhs, " <= ", show rhs]
     show (GreaterOrEqualExpression lhs rhs) = concat [show lhs, " >= ", show rhs]
-    show (FieldExpression fieldExpression identifier) =
-        show fieldExpression <> "." <> show identifier
+    show (ArrayExpression arrayExpression indexExpression) =
+        concat [show arrayExpression, "[", show indexExpression, "]"]
 
 data Statement
     = EmptyStatement
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)