Split in lib and tests
This commit is contained in:
@ -1,268 +0,0 @@
|
||||
module Language.Elna.AST
|
||||
( ConstantDefinition(..)
|
||||
, Declaration(..)
|
||||
, Expression(..)
|
||||
, Identifier(..)
|
||||
, Literal(..)
|
||||
, ProcedureDeclaration(..)
|
||||
, Program(..)
|
||||
, Statement(..)
|
||||
, VariableDeclaration(..)
|
||||
, TypeDefinition(..)
|
||||
, TypeName(..)
|
||||
) where
|
||||
|
||||
import Data.Int (Int32)
|
||||
import Data.List (intercalate)
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
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
|
||||
| ByteLiteral Word8
|
||||
| CharacterLiteral Word8
|
||||
| BooleanLiteral Bool
|
||||
| RecordLiteral (NonEmpty Argument)
|
||||
| VariantLiteral (NonEmpty Argument)
|
||||
| EnumLiteral Identifier
|
||||
deriving Eq
|
||||
|
||||
instance Show Literal
|
||||
where
|
||||
show (StringLiteral string) = Text.unpack
|
||||
$ "\"" <> string <> "\""
|
||||
show (IntegerLiteral integer) = show integer
|
||||
show (ByteLiteral word) = show word
|
||||
show (CharacterLiteral character) =
|
||||
'\'' : chr (fromEnum character) : ['\'']
|
||||
show (BooleanLiteral boolean)
|
||||
| boolean = "true"
|
||||
| otherwise = "false"
|
||||
show (RecordLiteral arguments) = showArguments arguments
|
||||
show (VariantLiteral arguments) = showArguments arguments
|
||||
show (EnumLiteral identifier) = show identifier
|
||||
|
||||
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 Identifier 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 identifier accumulator iteration) = concat
|
||||
[ "loop ", show identifier
|
||||
, " := ", 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 Argument = Argument Identifier Literal
|
||||
deriving Eq
|
||||
|
||||
instance Show Argument
|
||||
where
|
||||
show (Argument identifier value) =
|
||||
concat [show identifier, ": ", show value]
|
||||
|
||||
data ProcedureDeclaration
|
||||
= ExternProcedureDeclaration Identifier [Parameter]
|
||||
| ProcedureDefinition Identifier [Parameter] Bool [ConstantDefinition] Statement
|
||||
deriving Eq
|
||||
|
||||
instance Show ProcedureDeclaration
|
||||
where
|
||||
show (ExternProcedureDeclaration 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
|
||||
= ExternVariableDeclaration Identifier TypeName
|
||||
| VariableDefinition Identifier TypeName (Maybe Literal) Bool
|
||||
deriving Eq
|
||||
|
||||
instance Show VariableDeclaration
|
||||
where
|
||||
show (ExternVariableDeclaration identifier typeName)
|
||||
= show identifier <> ": " <> show typeName <> "; extern;"
|
||||
show (VariableDefinition identifier typeName initialValue exports)
|
||||
= show identifier <> ": " <> show typeName
|
||||
<> maybe "" ((" = " <>) . show) initialValue <> ";"
|
||||
<> showAttributes exports
|
||||
|
||||
data TypeDefinition
|
||||
= RecordDefinition Identifier (NonEmpty Parameter)
|
||||
| VariantDefinition Identifier (NonEmpty Parameter)
|
||||
| EnumerationDefinition Identifier (NonEmpty Identifier)
|
||||
deriving Eq
|
||||
|
||||
instance Show TypeDefinition
|
||||
where
|
||||
show (RecordDefinition identifier fields) = show identifier
|
||||
<> " = record " <> intercalate "; " (NonEmpty.toList $ show <$> fields)
|
||||
<> " end;"
|
||||
show (VariantDefinition identifier fields) = show identifier
|
||||
<> " = variant " <> intercalate "; " (NonEmpty.toList $ show <$> fields)
|
||||
<> " end;"
|
||||
show (EnumerationDefinition identifier members) = show identifier <> " = ("
|
||||
<> intercalate ", " (NonEmpty.toList $ show <$> members) <> ");"
|
||||
|
||||
data Declaration
|
||||
= TypeDeclaration TypeDefinition
|
||||
| ConstantDeclaration ConstantDefinition
|
||||
| VariableDeclaration VariableDeclaration
|
||||
| ProcedureDeclaration ProcedureDeclaration
|
||||
deriving Eq
|
||||
|
||||
instance Show Declaration
|
||||
where
|
||||
show (TypeDeclaration typeDefinition) = show typeDefinition
|
||||
show (ConstantDeclaration constantDefinition) = show constantDefinition
|
||||
show (VariableDeclaration variableDeclaration) = show variableDeclaration
|
||||
show (ProcedureDeclaration procedureDeclaration) = show procedureDeclaration
|
||||
|
||||
data Program = Program [Declaration] Statement
|
||||
deriving Eq
|
||||
|
||||
instance Show Program
|
||||
where
|
||||
show (Program declarations body) =
|
||||
let declarations' = foldr showDeclaration ("", []) declarations
|
||||
in unlines (snd declarations') <> show body <> "."
|
||||
where
|
||||
showDeclaration :: Declaration -> (String, [String]) -> (String, [String])
|
||||
showDeclaration (TypeDeclaration typeDeclaration) (previous, accumulator)
|
||||
| previous == "type" = ("type", show typeDeclaration : accumulator)
|
||||
| otherwise = ("type", "type " <> show typeDeclaration : accumulator)
|
||||
showDeclaration (ConstantDeclaration constantDeclaration) (previous, accumulator)
|
||||
| previous == "const" = ("const", show constantDeclaration : accumulator)
|
||||
| otherwise = ("const", "const " <> show constantDeclaration : accumulator)
|
||||
showDeclaration (VariableDeclaration variableDeclaration) (previous, accumulator)
|
||||
| previous == "var" = ("var", show variableDeclaration : accumulator)
|
||||
| otherwise = ("var", "var " <> show variableDeclaration : accumulator)
|
||||
showDeclaration (ProcedureDeclaration procedureDeclaration) (_previous, accumulator) =
|
||||
("proc", show procedureDeclaration : accumulator)
|
||||
|
||||
showAttributes :: Bool -> String
|
||||
showAttributes True = " export;"
|
||||
showAttributes False = ""
|
||||
|
||||
showParameters :: [Parameter] -> String
|
||||
showParameters parameters =
|
||||
"(" <> intercalate ", " (show <$> parameters) <> ")"
|
||||
|
||||
showArguments :: NonEmpty Argument -> String
|
||||
showArguments arguments =
|
||||
"(" <> intercalate "; " (NonEmpty.toList $ show <$> arguments) <> ")"
|
||||
|
||||
showConstants :: [ConstantDefinition] -> String
|
||||
showConstants constants
|
||||
| null constants = ""
|
||||
| otherwise = " const " <> unwords (show <$> constants) <> "\n"
|
||||
@ -1,37 +0,0 @@
|
||||
module Language.Elna.Parser
|
||||
( Parser
|
||||
, programP
|
||||
) where
|
||||
|
||||
import Control.Monad (void)
|
||||
import Data.Text (Text)
|
||||
import Data.Void (Void)
|
||||
import Language.Elna.AST
|
||||
( Statement(..)
|
||||
, Program(..)
|
||||
)
|
||||
import Text.Megaparsec (Parsec)
|
||||
import Text.Megaparsec.Char (space1)
|
||||
import qualified Text.Megaparsec.Char.Lexer as Lexer
|
||||
|
||||
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
|
||||
|
||||
beginP :: Parser ()
|
||||
beginP = void $ symbol "begin"
|
||||
|
||||
endP :: Parser ()
|
||||
endP = void $ symbol "end"
|
||||
|
||||
programP :: Parser Program
|
||||
programP = beginP >> endP >> symbol "."
|
||||
>> pure (Program mempty $ CompoundStatement mempty)
|
||||
Reference in New Issue
Block a user