Split in lib and tests
This commit is contained in:
parent
01398f48bf
commit
9d1f038594
GPG Key ID:
A27FDC1E8EE902C0
52
elna.cabal
52
elna.cabal
@ -15,19 +15,49 @@ build-type: Simple
|
||||
extra-doc-files: TODO README
|
||||
|
||||
common warnings
|
||||
ghc-options: -Wall
|
||||
|
||||
executable elna
|
||||
import: warnings
|
||||
main-is: Main.hs
|
||||
other-modules:
|
||||
Language.Elna.AST
|
||||
Language.Elna.Parser
|
||||
default-extensions:
|
||||
OverloadedStrings
|
||||
build-depends:
|
||||
base ^>=4.17.2.1,
|
||||
megaparsec ^>= 9.6,
|
||||
text ^>= 2.0
|
||||
hs-source-dirs: src
|
||||
ghc-options: -Wall
|
||||
default-extensions:
|
||||
ExplicitForAll,
|
||||
OverloadedStrings
|
||||
|
||||
library elna-internal
|
||||
import: warnings
|
||||
exposed-modules:
|
||||
Language.Elna.AST
|
||||
Language.Elna.Parser
|
||||
build-depends:
|
||||
vector >= 0.12 && < 0.14
|
||||
hs-source-dirs: lib
|
||||
|
||||
executable elna
|
||||
import: warnings
|
||||
main-is: Main.hs
|
||||
build-depends:
|
||||
elna-internal
|
||||
hs-source-dirs: src
|
||||
default-language: GHC2021
|
||||
|
||||
test-suite elna-test
|
||||
import: warnings
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
other-modules:
|
||||
Language.Elna.ParserSpec
|
||||
hs-source-dirs:
|
||||
tests
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
|
||||
|
||||
build-depends:
|
||||
elna-internal,
|
||||
hspec >= 2.10.9 && < 2.12,
|
||||
hspec-expectations ^>= 0.8.2,
|
||||
hspec-megaparsec ^>= 2.2.0,
|
||||
text,
|
||||
vector
|
||||
build-tool-depends:
|
||||
hspec-discover:hspec-discover
|
||||
default-language: GHC2021
|
||||
|
||||
170
lib/Language/Elna/AST.hs
Normal file
170
lib/Language/Elna/AST.hs
Normal file
@ -0,0 +1,170 @@
|
||||
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 (Word8)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Char (chr)
|
||||
import Data.String (IsString(..))
|
||||
|
||||
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 Word8
|
||||
| BooleanLiteral Bool
|
||||
deriving Eq
|
||||
|
||||
instance Show Literal
|
||||
where
|
||||
show (IntegerLiteral integer) = show integer
|
||||
show (HexadecimalLiteral integer) = show integer
|
||||
show (CharacterLiteral character) =
|
||||
'\'' : chr (fromEnum character) : ['\'']
|
||||
show (BooleanLiteral boolean)
|
||||
| boolean = "true"
|
||||
| otherwise = "false"
|
||||
|
||||
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
|
||||
| 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 (FieldExpression fieldExpression identifier) =
|
||||
show fieldExpression <> "." <> show identifier
|
||||
|
||||
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 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) = "begin "
|
||||
<> intercalate "; " (show <$> statements) <> " end"
|
||||
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 <> ";"
|
||||
<> 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) <> ")"
|
||||
107
lib/Language/Elna/Parser.hs
Normal file
107
lib/Language/Elna/Parser.hs
Normal file
@ -0,0 +1,107 @@
|
||||
module Language.Elna.Parser
|
||||
( Parser
|
||||
, programP
|
||||
) where
|
||||
|
||||
import Control.Monad (void)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Void (Void)
|
||||
import Language.Elna.AST
|
||||
( Declaration(..)
|
||||
, Identifier(..)
|
||||
, Parameter(..)
|
||||
, Program(..)
|
||||
, TypeExpression(..)
|
||||
, VariableDeclaration(..)
|
||||
)
|
||||
import Text.Megaparsec (Parsec, (<?>), optional, between, sepBy)
|
||||
import Text.Megaparsec.Char (alphaNumChar, letterChar, space1)
|
||||
import qualified Text.Megaparsec.Char.Lexer as Lexer
|
||||
import Control.Applicative (Alternative(..))
|
||||
import Data.Maybe (isJust)
|
||||
|
||||
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
|
||||
|
||||
blockP :: forall a. Parser a -> Parser a
|
||||
blockP = between (symbol "{") (symbol "}")
|
||||
|
||||
procedureP :: Parser ()
|
||||
procedureP = void $ symbol "proc"
|
||||
|
||||
parensP :: forall a. Parser a -> Parser a
|
||||
parensP = between (symbol "(") (symbol ")")
|
||||
|
||||
openBracketP :: Parser ()
|
||||
openBracketP = void $ symbol "["
|
||||
|
||||
closingBracketP :: Parser ()
|
||||
closingBracketP = void $ symbol "]"
|
||||
|
||||
colonP :: Parser ()
|
||||
colonP = void $ symbol ":"
|
||||
|
||||
semicolonP :: Parser ()
|
||||
semicolonP = void $ symbol ";"
|
||||
|
||||
identifierP :: Parser Identifier
|
||||
identifierP =
|
||||
let wordParser = (:) <$> letterChar <*> many alphaNumChar <?> "identifier"
|
||||
in fmap Identifier $ lexeme $ Text.pack <$> wordParser
|
||||
|
||||
typeExpressionP :: Parser TypeExpression
|
||||
typeExpressionP = arrayTypeExpression
|
||||
<|> NamedType <$> identifierP
|
||||
<?> "type expression"
|
||||
where
|
||||
arrayTypeExpression = flip ArrayType
|
||||
<$> (symbol "array" *> openBracketP *> lexeme Lexer.decimal <* closingBracketP)
|
||||
<*> (symbol "of" *> typeExpressionP)
|
||||
|
||||
typeDefinitionP :: Parser Declaration
|
||||
typeDefinitionP = TypeDefinition
|
||||
<$> (symbol "type" *> identifierP)
|
||||
<*> (symbol "=" *> typeExpressionP)
|
||||
<?> "type definition"
|
||||
|
||||
variableDeclarationP :: Parser VariableDeclaration
|
||||
variableDeclarationP = VariableDeclaration
|
||||
<$> (symbol "var" *> identifierP)
|
||||
<*> (colonP *> typeExpressionP)
|
||||
<* semicolonP
|
||||
<?> "variable declaration"
|
||||
|
||||
parameterP :: Parser Parameter
|
||||
parameterP = paramCons
|
||||
<$> optional (symbol "ref")
|
||||
<*> identifierP
|
||||
<*> (colonP *> typeExpressionP)
|
||||
where
|
||||
paramCons ref name typeName = Parameter name typeName (isJust ref)
|
||||
|
||||
parametersP :: Parser [Parameter]
|
||||
parametersP = parensP $ sepBy parameterP (symbol ",")
|
||||
|
||||
procedureDefinitionP :: Parser Declaration
|
||||
procedureDefinitionP = ProcedureDefinition
|
||||
<$> (procedureP *> identifierP)
|
||||
<*> parametersP
|
||||
<*> blockP (many variableDeclarationP)
|
||||
<*> pure mempty -- TODO
|
||||
<?> "procedure definition"
|
||||
|
||||
declarationP :: Parser Declaration
|
||||
declarationP = typeDefinitionP <|> procedureDefinitionP
|
||||
|
||||
programP :: Parser Program
|
||||
programP = Program <$> many declarationP
|
||||
@ -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)
|
||||
58
tests/Language/Elna/ParserSpec.hs
Normal file
58
tests/Language/Elna/ParserSpec.hs
Normal file
@ -0,0 +1,58 @@
|
||||
module Language.Elna.ParserSpec
|
||||
( spec
|
||||
) where
|
||||
|
||||
import Test.Hspec (Spec, describe, it, pendingWith, xit)
|
||||
import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn, parseSatisfies)
|
||||
import Language.Elna.Parser (programP)
|
||||
import Text.Megaparsec (parse)
|
||||
import Language.Elna.AST
|
||||
( Declaration(..)
|
||||
, Parameter(..)
|
||||
, Program(..)
|
||||
, TypeExpression(..)
|
||||
)
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "programP" $ do
|
||||
it "parses an empty main function" $
|
||||
parse programP "" `shouldSucceedOn` "proc main() {}"
|
||||
|
||||
it "parses type definition for a type starting like array" $
|
||||
let expected = Program [TypeDefinition "t" $ NamedType "arr"]
|
||||
actual = parse programP "" "type t = arr"
|
||||
in actual `shouldParse` expected
|
||||
|
||||
it "parses array type definition" $
|
||||
let expected = Program [TypeDefinition "t" $ ArrayType (NamedType "integer") 10]
|
||||
actual = parse programP "" "type t = array[10] of integer"
|
||||
in actual `shouldParse` expected
|
||||
|
||||
it "parses parameters" $
|
||||
let given = "proc main(x: integer) {}"
|
||||
parameters = [Parameter "x" (NamedType "integer") False]
|
||||
expected = Program [ProcedureDefinition "main" parameters [] []]
|
||||
actual = parse programP "" given
|
||||
in actual `shouldParse` expected
|
||||
|
||||
it "parses ref parameters" $
|
||||
let given = "proc main(x: integer, ref y: boolean) {}"
|
||||
parameters =
|
||||
[ Parameter "x" (NamedType "integer") False
|
||||
, Parameter "y" (NamedType "boolean") True
|
||||
]
|
||||
expected = Program [ProcedureDefinition "main" parameters [] []]
|
||||
actual = parse programP "" given
|
||||
in actual `shouldParse` expected
|
||||
|
||||
it "parses variable declaration" $
|
||||
let given = "proc main() { var x: integer; }"
|
||||
expected (Program [ProcedureDefinition _ _ variables _]) =
|
||||
not $ null variables
|
||||
expected _ = False
|
||||
actual = parse programP "" given
|
||||
in actual `parseSatisfies` expected
|
||||
|
||||
it "parses procedure body statements" $
|
||||
pendingWith "Not implemented"
|
||||
1
tests/Spec.hs
Normal file
1
tests/Spec.hs
Normal file
@ -0,0 +1 @@
|
||||
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
|
||||
Loading…
Reference in New Issue
Block a user