Parse all statements

1 files changed, 54 insertions, 19 deletions

diff --git a/lib/Language/Elna/Parser.hs b/lib/Language/Elna/Parser.hs
index f387f60..109f1ba 100644
--- a/lib/Language/Elna/Parser.hs
+++ b/lib/Language/Elna/Parser.hs
@@ -19,8 +19,22 @@ import Language.Elna.AST
     , TypeExpression(..)
     , VariableDeclaration(..)
     )
-import Text.Megaparsec (Parsec, (<?>), optional, between, sepBy, choice)
-import Text.Megaparsec.Char (alphaNumChar, char, letterChar, space1, asciiChar)
+import Text.Megaparsec
+    ( Parsec
+    , (<?>)
+    , optional
+    , between
+    , sepBy
+    , choice
+    , MonadParsec(..)
+    )
+import Text.Megaparsec.Char
+    ( alphaNumChar
+    , char
+    , letterChar
+    , space1
+    , string
+    )
 import qualified Text.Megaparsec.Char.Lexer as Lexer
 import Control.Applicative (Alternative(..))
 import Data.Maybe (isJust)
@@ -91,33 +105,32 @@ parameterP = paramCons
   where
     paramCons ref name typeName = Parameter name typeName (isJust ref)
 
-parametersP :: Parser [Parameter]
-parametersP = parensP $ sepBy parameterP (symbol ",")
+commaP :: Parser ()
+commaP = void $ symbol ","
 
 literalP :: Parser Literal
 literalP
-    = HexadecimalLiteral <$> Lexer.hexadecimal
-    <|> IntegerLiteral <$> Lexer.decimal
-    <|> CharacterLiteral <$> charP
+    = HexadecimalLiteral <$> (string "0x" *> lexeme Lexer.hexadecimal)
+    <|> IntegerLiteral <$> lexeme Lexer.decimal
+    <|> CharacterLiteral <$> lexeme charP
     <|> BooleanLiteral <$> (symbol "true" $> True)
     <|> BooleanLiteral <$> (symbol "false" $> False)
   where
-    -- TODO: Escape characters.
     charP = fromIntegral . fromEnum
-        <$> between (char '\'') (char '\'') asciiChar
+        <$> between (char '\'') (char '\'') Lexer.charLiteral
 
 termP :: Parser Expression
 termP = choice
     [ parensP expressionP
-    , VariableExpression <$> identifierP
     , LiteralExpression <$> literalP
+    , VariableExpression <$> identifierP
     ]
 
 operatorTable :: [[Operator Parser Expression]]
 operatorTable =
-    [ [Postfix (ArrayExpression <$> bracketsP expressionP)]
+    [ [Postfix (flip ArrayExpression <$> bracketsP expressionP)]
     , unaryOperator
-    , factoryOperator
+    , factorOperator
     , termOperator
     , comparisonOperator
     ]
@@ -126,7 +139,7 @@ operatorTable =
         [ prefix "-" NegationExpression
         , prefix "+" id
         ]
-    factoryOperator =
+    factorOperator =
         [ binary "*" ProductExpression
         , binary "/" DivisionExpression
         ]
@@ -151,17 +164,39 @@ expressionP = makeExprParser termP operatorTable
 statementP :: Parser Statement
 statementP
     = EmptyStatement <$ semicolonP
-    <|> AssignmentStatement <$> expressionP <* symbol ":=" <*> expressionP
     <|> CompoundStatement <$> blockP (many statementP)
-    <?> "statement" -- TODO: further statements
+    <|> try assignmentP
+    <|> try ifElseP
+    <|> try whileP
+    <|> try callP
+    <?> "statement"
+  where
+    ifElseP = IfStatement
+        <$> (symbol "if" *> parensP expressionP)
+        <*> statementP
+        <*> optional (symbol "else" *> statementP)
+    whileP = WhileStatement
+        <$> (symbol "while" *> parensP expressionP)
+        <*> statementP
+    callP = CallStatement
+        <$> identifierP
+        <*> parensP (sepBy expressionP commaP)
+        <* semicolonP
+    assignmentP = AssignmentStatement
+        <$> expressionP
+        <* symbol ":="
+        <*> expressionP
+        <* semicolonP
 
 procedureDefinitionP :: Parser Declaration
-procedureDefinitionP = ProcedureDefinition
+procedureDefinitionP = procedureCons
     <$> (procedureP *> identifierP)
-    <*> parametersP
-    <*> blockP (many variableDeclarationP)
-    <*> pure mempty -- TODO
+    <*> parensP (sepBy parameterP commaP)
+    <*> blockP ((,) <$> many variableDeclarationP <*> many statementP)
     <?> "procedure definition"
+  where
+    procedureCons procedureName parameters (variables, body) =
+        ProcedureDefinition procedureName parameters variables body
 
 declarationP :: Parser Declaration
 declarationP = typeDefinitionP <|> procedureDefinitionP