2 files changed, 277 insertions, 0 deletions
diff --git a/lib/Language/Elna/AST.hs b/lib/Language/Elna/AST.hs
new file mode 100644
index 0000000..fc4b264
--- /dev/null
+++ b/lib/Language/Elna/AST.hs
@@ -0,0 +1,170 @@
+module Language.Elna.AST
+    ( Declaration(..)
+    , Expression(..)
+    , Identifier(..)
+    , Literal(..)
+    , Parameter(..)
+    , Program(..)
+    , Statement(..)
+    , VariableDeclaration(..)
+    , TypeExpression(..)
+    ) where
+
+import Data.Int (Int32)
+import Data.List (intercalate)
+import Data.Word (Word8)
+import Data.Text (Text)
+import qualified Data.Text as Text
+import Data.Char (chr)
+import Data.String (IsString(..))
+
+newtype Identifier = Identifier { unIdentifier :: Text }
+    deriving Eq
+
+instance Show Identifier
+  where
+    show (Identifier identifier) = Text.unpack identifier
+
+instance IsString Identifier
+  where
+    fromString = Identifier . Text.pack
+
+data TypeExpression
+    = NamedType Identifier
+    | ArrayType TypeExpression Int32
+    deriving Eq
+
+instance Show TypeExpression
+  where
+    show (NamedType typeName) = show typeName
+    show (ArrayType typeName elementCount) = concat
+        [show typeName, "[", show elementCount, "]"]
+
+data Literal
+    = IntegerLiteral Int32
+    | HexadecimalLiteral Int32
+    | CharacterLiteral Word8
+    | BooleanLiteral Bool
+    deriving Eq
+
+instance Show Literal
+  where
+    show (IntegerLiteral integer) = show integer
+    show (HexadecimalLiteral integer) = show integer
+    show (CharacterLiteral character) =
+        '\'' : chr (fromEnum character) : ['\'']
+    show (BooleanLiteral boolean)
+        | boolean = "true"
+        | otherwise = "false"
+
+data Expression
+    = VariableExpression Identifier
+    | LiteralExpression Literal
+    | NegationExpression Expression
+    | NotExpression Expression
+    | ReferenceExpression Expression
+    | DereferenceExpression Expression
+    | SumExpression Expression Expression
+    | SubtractionExpression Expression Expression
+    | ProductExpression Expression Expression
+    | DivisionExpression Expression Expression
+    | EqualExpression Expression Expression
+    | NonEqualExpression Expression Expression
+    | LessExpression Expression Expression
+    | GreaterExpression Expression Expression
+    | LessOrEqualExpression Expression Expression
+    | GreaterOrEqualExpression Expression Expression
+    | FieldExpression Expression Identifier
+    deriving Eq
+
+instance Show Expression
+  where
+    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]
+    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 (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]
+    show (GreaterOrEqualExpression lhs rhs) = concat [show lhs, " >= ", show rhs]
+    show (FieldExpression fieldExpression identifier) =
+        show fieldExpression <> "." <> show identifier
+
+data Statement
+    = EmptyStatement
+    | AssignmentStatement Expression Expression
+    | IfStatement Expression Statement (Maybe Statement)
+    | WhileStatement Expression Statement
+    | CompoundStatement [Statement]
+    | CallStatement Identifier [Expression]
+    deriving Eq
+
+instance Show Statement
+  where
+    show EmptyStatement = ";"
+    show (AssignmentStatement lhs rhs) =
+        concat [show lhs, " := ", show rhs, 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"
+    show (CallStatement name parameters) = show name <> "("
+        <> intercalate ", " (show <$> parameters) <> ")"
+
+data Parameter = Parameter Identifier TypeExpression Bool
+    deriving Eq
+
+instance Show Parameter
+  where
+    show (Parameter identifier typeName ref) = concat
+        [ if ref then "ref " else ""
+        , show identifier, ": ", show typeName
+        ]
+
+data VariableDeclaration =
+    VariableDeclaration Identifier TypeExpression
+    deriving Eq
+
+instance Show VariableDeclaration
+  where
+    show (VariableDeclaration identifier typeExpression) =
+        concat [" var ", show identifier, ": " <> show typeExpression, ";"]
+
+data Declaration
+    = TypeDefinition Identifier TypeExpression
+    | ProcedureDefinition Identifier [Parameter] [VariableDeclaration] [Statement]
+    deriving Eq
+
+instance Show Declaration
+  where
+    show (TypeDefinition identifier typeExpression) =
+        concat ["type ", show identifier, " = ", show typeExpression]
+    show (ProcedureDefinition procedureName parameters variables body)
+        = "proc " <> show procedureName <> showParameters parameters <> ";"
+        <> unlines (show <$> variables)
+        <> unlines (show <$> body) <> ";"
+
+newtype Program = Program [Declaration]
+    deriving Eq
+
+instance Show Program
+  where
+    show (Program declarations) = unlines (show <$> declarations)
+
+showParameters :: [Parameter] -> String
+showParameters parameters =
+    "(" <> intercalate ", " (show <$> parameters) <> ")"
diff --git a/lib/Language/Elna/Parser.hs b/lib/Language/Elna/Parser.hs
new file mode 100644
index 0000000..cd8f927
--- /dev/null
+++ b/lib/Language/Elna/Parser.hs
@@ -0,0 +1,107 @@
+module Language.Elna.Parser
+    ( Parser
+    , programP
+    ) where
+
+import Control.Monad (void)
+import Data.Text (Text)
+import qualified Data.Text as Text
+import Data.Void (Void)
+import Language.Elna.AST
+    ( Declaration(..)
+    , Identifier(..)
+    , Parameter(..)
+    , Program(..)
+    , TypeExpression(..)
+    , VariableDeclaration(..)
+    )
+import Text.Megaparsec (Parsec, (<?>), optional, between, sepBy)
+import Text.Megaparsec.Char (alphaNumChar, letterChar, space1)
+import qualified Text.Megaparsec.Char.Lexer as Lexer
+import Control.Applicative (Alternative(..))
+import Data.Maybe (isJust)
+
+type Parser = Parsec Void Text
+
+space :: Parser ()
+space = Lexer.space space1 (Lexer.skipLineComment "//")
+    $ Lexer.skipBlockComment "/*" "*/"
+
+lexeme :: forall a. Parser a -> Parser a
+lexeme = Lexer.lexeme space
+
+symbol :: Text -> Parser Text
+symbol = Lexer.symbol space
+
+blockP :: forall a. Parser a -> Parser a
+blockP = between (symbol "{") (symbol "}")
+
+procedureP :: Parser ()
+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 "]"
+
+colonP :: Parser ()
+colonP = void $ symbol ":"
+
+semicolonP :: Parser ()
+semicolonP = void $ symbol ";"
+
+identifierP :: Parser Identifier
+identifierP =
+    let wordParser = (:) <$> letterChar <*> many alphaNumChar <?> "identifier"
+     in fmap Identifier $ lexeme $ Text.pack <$> wordParser
+
+typeExpressionP :: Parser TypeExpression
+typeExpressionP = arrayTypeExpression
+    <|> NamedType <$> identifierP
+    <?> "type expression"
+  where
+    arrayTypeExpression = flip ArrayType
+        <$> (symbol "array" *> openBracketP *> lexeme Lexer.decimal <* closingBracketP)
+        <*> (symbol "of" *> typeExpressionP)
+
+typeDefinitionP :: Parser Declaration
+typeDefinitionP = TypeDefinition
+    <$> (symbol "type" *> identifierP)
+    <*> (symbol "=" *> typeExpressionP)
+    <?> "type definition"
+
+variableDeclarationP :: Parser VariableDeclaration
+variableDeclarationP = VariableDeclaration
+    <$> (symbol "var" *> identifierP)
+    <*> (colonP *> typeExpressionP)
+    <* semicolonP
+    <?> "variable declaration"
+
+parameterP :: Parser Parameter
+parameterP = paramCons
+    <$> optional (symbol "ref")
+    <*> identifierP
+    <*> (colonP *> typeExpressionP)
+  where
+    paramCons ref name typeName = Parameter name typeName (isJust ref)
+
+parametersP :: Parser [Parameter]
+parametersP = parensP $ sepBy parameterP (symbol ",")
+
+procedureDefinitionP :: Parser Declaration
+procedureDefinitionP = ProcedureDefinition
+    <$> (procedureP *> identifierP)
+    <*> parametersP
+    <*> blockP (many variableDeclarationP)
+    <*> pure mempty -- TODO
+    <?> "procedure definition"
+
+declarationP :: Parser Declaration
+declarationP = typeDefinitionP <|> procedureDefinitionP
+
+programP :: Parser Program
+programP = Program <$> many declarationP