elna/lib/Language/Elna/AST.hs

module Language.Elna.AST
    ( VariableAccess(..)
    , Condition(..)
    , Declaration(..)
    , Expression(..)
    , Identifier(..)
    , Literal(..)
    , Parameter(..)
    , Program(..)
    , Statement(..)
    , VariableDeclaration(..)
    , TypeExpression(..)
    ) where

import Data.Int (Int32)
import Data.List (intercalate)
import Data.Word (Word16, Word32)
import Data.Char (chr)
import Language.Elna.Location (Identifier(..), showArrayType)
import Numeric (showHex)

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 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"

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 Expression
    = VariableExpression VariableAccess
    | LiteralExpression Literal
    | NegationExpression Expression
    | SumExpression Expression Expression
    | SubtractionExpression Expression Expression
    | ProductExpression Expression Expression
    | DivisionExpression Expression Expression
    deriving Eq

instance Show Expression
  where
    show (VariableExpression variable) = show variable
    show (LiteralExpression literal) = show literal
    show (NegationExpression negation) = '-' : show negation
    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]

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]

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 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 <> " {\n"
        <> 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) <> ")"