elna/lib/Language/Elna/AST.hs

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

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 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 Expression
    = VariableExpression Identifier
    | LiteralExpression Literal
    | NegationExpression 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
    | ArrayExpression 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]
    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 (ArrayExpression arrayExpression indexExpression) =
        concat [show arrayExpression, "[", show indexExpression, "]"]

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