summaryrefslogtreecommitdiff
path: root/src/Language
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2024-07-23 22:44:42 +0200
committerEugen Wissner <belka@caraus.de>2024-07-23 22:44:42 +0200
commit9d1f0385945e926e7084e60fc72fe5846e7139b2 (patch)
tree96bd319dc0dc26059ce3f42d5a91f84624fe3ea0 /src/Language
parent01398f48bf2d17a3836a5d5b5467d0fb05e3f337 (diff)
downloadelna-9d1f0385945e926e7084e60fc72fe5846e7139b2.tar.gz
Split in lib and tests
Diffstat (limited to 'src/Language')
-rw-r--r--src/Language/Elna/AST.hs268
-rw-r--r--src/Language/Elna/Parser.hs37
2 files changed, 0 insertions, 305 deletions
diff --git a/src/Language/Elna/AST.hs b/src/Language/Elna/AST.hs
deleted file mode 100644
index 0ac8eb5..0000000
--- a/src/Language/Elna/AST.hs
+++ /dev/null
@@ -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"
diff --git a/src/Language/Elna/Parser.hs b/src/Language/Elna/Parser.hs
deleted file mode 100644
index 87ebc44..0000000
--- a/src/Language/Elna/Parser.hs
+++ /dev/null
@@ -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)