Parse all statements

2 files changed, 69 insertions, 33 deletions

diff --git a/lib/Language/Elna/AST.hs b/lib/Language/Elna/AST.hs
index 0add1d2..3189469 100644
--- a/lib/Language/Elna/AST.hs
+++ b/lib/Language/Elna/AST.hs
@@ -12,11 +12,12 @@ module Language.Elna.AST
 
 import Data.Int (Int32)
 import Data.List (intercalate)
-import Data.Word (Word8)
+import Data.Word (Word16)
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Data.Char (chr)
 import Data.String (IsString(..))
+import Numeric (showHex)
 
 newtype Identifier = Identifier { unIdentifier :: Text }
     deriving Eq
@@ -43,14 +44,14 @@ instance Show TypeExpression
 data Literal
     = IntegerLiteral Int32
     | HexadecimalLiteral Int32
-    | CharacterLiteral Word8
+    | CharacterLiteral Word16
     | BooleanLiteral Bool
     deriving Eq
 
 instance Show Literal
   where
     show (IntegerLiteral integer) = show integer
-    show (HexadecimalLiteral integer) = show integer
+    show (HexadecimalLiteral integer) = '0' : 'x' : showHex integer ""
     show (CharacterLiteral character) =
         '\'' : chr (fromEnum character) : ['\'']
     show (BooleanLiteral boolean)
@@ -84,7 +85,7 @@ instance Show Expression
     show (ProductExpression lhs rhs) = concat [show lhs, " * ", show rhs]
     show (DivisionExpression lhs rhs) = concat [show lhs, " / ", show rhs]
     show (EqualExpression lhs rhs) = concat [show lhs, " = ", show rhs]
-    show (NonEqualExpression lhs rhs) = concat [show lhs, " /= ", show rhs]
+    show (NonEqualExpression lhs rhs) = concat [show lhs, " # ", show rhs]
     show (LessExpression lhs rhs) = concat [show lhs, " < ", show rhs]
     show (GreaterExpression lhs rhs) = concat [show lhs, " > ", show rhs]
     show (LessOrEqualExpression lhs rhs) = concat [show lhs, " <= ", show rhs]
@@ -105,17 +106,16 @@ instance Show Statement
   where
     show EmptyStatement = ";"
     show (AssignmentStatement lhs rhs) =
-        concat [show lhs, " := ", show rhs, show rhs, ";"]
+        concat [show lhs, " := ", show rhs, ";"]
     show (IfStatement condition if' else') = concat
         [ "if (", show condition, ") "
         , show if'
         , maybe "" ((<> " else ") . show) else'
-        , ";"
         ]
     show (WhileStatement expression statement) =
-        concat [ "while (", show expression, ") ", show statement, ";"]
-    show (CompoundStatement statements) = "begin "
-        <> intercalate "; " (show <$> statements) <> " end"
+        concat ["while (", show expression, ") ", show statement, ";"]
+    show (CompoundStatement statements) =
+        concat ["{\n", unlines (show <$> statements), " }"]
     show (CallStatement name parameters) = show name <> "("
         <> intercalate ", " (show <$> parameters) <> ")"
 
@@ -136,7 +136,7 @@ data VariableDeclaration =
 instance Show VariableDeclaration
   where
     show (VariableDeclaration identifier typeExpression) =
-        concat [" var ", show identifier, ": " <> show typeExpression, ";"]
+        concat ["var ", show identifier, ": " <> show typeExpression, ";"]
 
 data Declaration
     = TypeDefinition Identifier TypeExpression
@@ -146,11 +146,12 @@ data Declaration
 instance Show Declaration
   where
     show (TypeDefinition identifier typeExpression) =
-        concat ["type ", show identifier, " = ", show typeExpression]
+        concat ["type ", show identifier, " = ", show typeExpression, ";"]
     show (ProcedureDefinition procedureName parameters variables body)
-        = "proc " <> show procedureName <> showParameters parameters <> ";"
-        <> unlines (show <$> variables)
-        <> unlines (show <$> body) <> ";"
+        = "proc " <> show procedureName <> showParameters parameters <> " {\n"
+        <> unlines (("  " <>) . show <$> variables)
+        <> unlines (("  " <>) . show <$> body)
+        <> "}"
 
 newtype Program = Program [Declaration]
     deriving Eq
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