Initial commit

1 files changed, 202 insertions, 0 deletions

diff --git a/src/Language/Elna/AST.hs b/src/Language/Elna/AST.hs
new file mode 100644
index 0000000..30c6627
--- /dev/null
+++ b/src/Language/Elna/AST.hs
@@ -0,0 +1,202 @@
+module Language.Elna.AST
+    ( ConstantDefinition(..)
+    , Expression(..)
+    , Identifier(..)
+    , Literal(..)
+    , ProcedureDeclaration(..)
+    , Program(..)
+    , Statement(..)
+    , VariableDeclaration(..)
+    , TypeName(..)
+    ) 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)
+
+newtype Identifier = Identifier { unIdentifier :: Text }
+    deriving Eq
+
+instance Show Identifier
+  where
+    show (Identifier identifier) = Text.unpack identifier
+
+data TypeName
+    = NamedType Identifier
+    | PointerType TypeName
+    | ArrayType TypeName Int32
+    | ProcedureType [Parameter]
+    deriving Eq
+
+instance Show TypeName
+  where
+    show (NamedType typeName) = show typeName
+    show (PointerType typeName) = '^' : show typeName
+    show (ArrayType typeName elementCount) = concat
+        [show typeName, "[", show elementCount, "]"]
+    show (ProcedureType parameters) = "proc" <> showParameters parameters
+
+data Literal
+    = StringLiteral Text
+    | IntegerLiteral Int32
+    | CharacterLiteral Word8
+    | BooleanLiteral Bool
+    deriving Eq
+
+instance Show Literal
+  where
+    show (StringLiteral string) = Text.unpack
+        $ "\"" <> string <> "\""
+    show (IntegerLiteral 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
+    | IfExpression Expression Statement Statement
+    | LoopExpression Expression Statement
+    | 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 (IfExpression condition if' else') = concat
+        [ "if ", show condition
+        , " then " <> show if'
+        , " else " <> show else'
+        ]
+    show (LoopExpression accumulator iteration) = concat
+        ["loop ", show accumulator, " do ", show iteration]
+    show (FieldExpression fieldExpression identifier) =
+        show fieldExpression <> "." <> show identifier
+
+data Statement
+    = LetStatement Identifier TypeName Expression
+    | CompoundStatement [Statement]
+    | CallStatement Identifier [Expression]
+    | ExpressionStatement Expression
+    | BreakStatement Expression
+    | ContinueStatement Expression
+    deriving Eq
+
+instance Show Statement
+  where
+    show (LetStatement identifier typeName definition) = concat
+        ["let ", show identifier, ": ", show typeName, " := ", show definition]
+    show (CompoundStatement statements) = "begin "
+        <> intercalate "; " (show <$> statements) <> " end"
+    show (CallStatement name parameters) = show name <> "("
+        <> intercalate ", " (show <$> parameters) <> ")"
+    show (ExpressionStatement expression) = show expression
+    show (BreakStatement break') = "break " <> show break'
+    show (ContinueStatement continue') = "continue " <> show continue'
+
+data ConstantDefinition =
+    ConstantDefinition Identifier TypeName Literal
+    deriving Eq
+
+instance Show ConstantDefinition
+  where
+    show (ConstantDefinition identifier typeName definition) = concat
+        [show identifier, ": ", show typeName, " := ", show definition, ";"]
+
+data Parameter = Parameter Identifier TypeName
+    deriving Eq
+
+instance Show Parameter
+  where
+    show (Parameter identifier typeName) =
+        show identifier <> ": " <> show typeName
+
+data ProcedureDeclaration
+    = ProcedureDeclaration Identifier [Parameter]
+    | ProcedureDefinition Identifier [Parameter] Bool [ConstantDefinition] Statement
+    deriving Eq
+
+instance Show ProcedureDeclaration
+  where
+    show (ProcedureDeclaration procedureName parameters) =
+        "proc " <> show procedureName <> showParameters parameters <> "; extern;"
+    show (ProcedureDefinition procedureName parameters exports constants body)
+        = "proc " <> show procedureName <> showParameters parameters <> ";"
+        <> showAttributes exports
+        <> showConstants constants
+        <> show body <> ";"
+
+data VariableDeclaration
+    = VariableDeclaration Identifier TypeName
+    | VariableDefinition Identifier TypeName (Maybe Literal) Bool
+    deriving Eq
+
+instance Show VariableDeclaration
+  where
+    show (VariableDeclaration identifier typeName)
+        = show identifier <> ": " <> show typeName <> "; extern;"
+    show (VariableDefinition identifier typeName initialValue exports)
+        = show identifier <> ": " <> show typeName
+        <> maybe "" ((" = " <>) . show) initialValue <> ";"
+        <> showAttributes exports
+
+data Program = Program [ConstantDefinition] [VariableDeclaration] [ProcedureDeclaration] Statement
+    deriving Eq
+
+instance Show Program
+  where
+    show (Program constants globals procedures body)
+        = showConstants constants <> showVariables globals
+        <> unlines (show <$> procedures) <> show body <> "."
+
+showAttributes :: Bool -> String
+showAttributes True = " export;"
+showAttributes False = ""
+
+showParameters :: [Parameter] -> String
+showParameters parameters =
+    "(" <> intercalate ", " (show <$> parameters) <> ")"
+
+showConstants :: [ConstantDefinition] -> String
+showConstants constants
+    | null constants = ""
+    | otherwise = " const " <> unwords (show <$> constants) <> "\n"
+
+showVariables :: [VariableDeclaration] -> String
+showVariables variables
+    | null variables = ""
+    | otherwise = " var " <> unwords (show <$> variables) <> "\n"