Negate integral expressions

lib/Language/Elna/Frontend/AST.hs

@@ -0,0 +1,169 @@
+module Language.Elna.Frontend.AST
+    ( Declaration(..)
+    , Identifier(..)
+    , Parameter(..)
+    , Program(..)
+    , Statement(..)
+    , TypeExpression(..)
+    , VariableDeclaration(..)
+    {-, VariableAccess(..)
+    , Condition(..)-}
+    , Expression(..)
+    , Literal(..)
+    ) where
+
+import Data.Int (Int32)
+import Data.List (intercalate)
+import Data.Word ({-Word16, -}Word32)
+import Language.Elna.Location (Identifier(..), showArrayType)
+
+newtype Program = Program [Declaration]
+    deriving Eq
+
+instance Show Program
+  where
+    show (Program declarations) = unlines (show <$> declarations)
+
+data Declaration
+    = ProcedureDeclaration Identifier [Parameter] [VariableDeclaration] [Statement]
+    -- | TypeDefinition Identifier TypeExpression
+    deriving Eq
+
+instance Show Declaration
+  where
+    {- show (TypeDefinition identifier typeExpression) =
+        concat ["type ", show identifier, " = ", show typeExpression, ";"] -}
+    show (ProcedureDeclaration procedureName parameters variables body)
+        = "proc " <> show procedureName <> showParameters parameters <> " {\n"
+        <> unlines (("  " <>) . show <$> variables)
+        <> unlines (("  " <>) . show <$> body)
+        <> "}"
+
+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
+        ]
+
+showParameters :: [Parameter] -> String
+showParameters parameters =
+    "(" <> intercalate ", " (show <$> parameters) <> ")"
+
+data TypeExpression
+    = NamedType Identifier
+    | ArrayType Word32 TypeExpression
+    deriving Eq
+
+instance Show TypeExpression
+  where
+    show (NamedType typeName) = show typeName
+    show (ArrayType elementCount typeName) = showArrayType elementCount typeName
+
+data Statement
+    = EmptyStatement
+    {-| AssignmentStatement VariableAccess Expression
+    | IfStatement Condition Statement (Maybe Statement)
+    | WhileStatement Condition Statement
+    | CompoundStatement [Statement]-}
+    | CallStatement Identifier [Expression]
+    deriving Eq
+
+instance Show Statement
+  where
+    show EmptyStatement = ";"
+    {-show (AssignmentStatement lhs 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) =
+        concat ["{\n", unlines (show <$> statements), " }"]-}
+    show (CallStatement name parameters) = show name <> "("
+        <> intercalate ", " (show <$> parameters) <> ")"
+
+data VariableDeclaration =
+    VariableDeclaration Identifier TypeExpression
+    deriving Eq
+
+newtype Literal
+    = IntegerLiteral Int32
+    {- | HexadecimalLiteral Int32
+    | CharacterLiteral Word16
+    | BooleanLiteral Bool -}
+    deriving Eq
+
+instance Show Literal
+  where
+    show (IntegerLiteral integer) = show integer
+    {- show (HexadecimalLiteral integer) = '0' : 'x' : showHex integer ""
+    show (CharacterLiteral character) =
+        '\'' : chr (fromEnum character) : ['\'']
+    show (BooleanLiteral boolean)
+        | boolean = "true"
+        | otherwise = "false" -}
+
+instance Show VariableDeclaration
+  where
+    show (VariableDeclaration identifier typeExpression) =
+        concat ["var ", show identifier, ": " <> show typeExpression, ";"]
+
+data Expression
+    = LiteralExpression Literal
+    | SumExpression Expression Expression
+    | SubtractionExpression Expression Expression
+    | NegationExpression Expression
+{-    | VariableExpression VariableAccess
+    | ProductExpression Expression Expression
+    | DivisionExpression Expression Expression -}
+    deriving Eq
+
+instance Show Expression
+  where
+    show (LiteralExpression literal) = show literal
+    show (SumExpression lhs rhs) = concat [show lhs, " + ", show rhs]
+    show (SubtractionExpression lhs rhs) = concat [show lhs, " - ", show rhs]
+    show (NegationExpression negation) = '-' : show negation
+    {- show (VariableExpression variable) = show variable
+    show (ProductExpression lhs rhs) = concat [show lhs, " * ", show rhs]
+    show (DivisionExpression lhs rhs) = concat [show lhs, " / ", show rhs] -}
+{-
+import Data.Char (chr)
+import Numeric (showHex)
+
+data VariableAccess
+    = VariableAccess Identifier
+    | ArrayAccess VariableAccess Expression
+    deriving Eq
+
+instance Show VariableAccess
+  where
+    show (VariableAccess variableName) = show variableName
+    show (ArrayAccess arrayAccess elementIndex) =
+        concat [show arrayAccess, "[", show elementIndex, "]"]
+
+data Condition
+    = EqualCondition Expression Expression
+    | NonEqualCondition Expression Expression
+    | LessCondition Expression Expression
+    | GreaterCondition Expression Expression
+    | LessOrEqualCondition Expression Expression
+    | GreaterOrEqualCondition Expression Expression
+    deriving Eq
+
+instance Show Condition
+  where
+    show (EqualCondition lhs rhs) = concat [show lhs, " = ", show rhs]
+    show (NonEqualCondition lhs rhs) = concat [show lhs, " # ", show rhs]
+    show (LessCondition lhs rhs) = concat [show lhs, " < ", show rhs]
+    show (GreaterCondition lhs rhs) = concat [show lhs, " > ", show rhs]
+    show (LessOrEqualCondition lhs rhs) = concat [show lhs, " <= ", show rhs]
+    show (GreaterOrEqualCondition lhs rhs) = concat [show lhs, " >= ", show rhs]
+-}