Split in lib and tests
This commit is contained in:
parent
01398f48bf
commit
9d1f038594
50
elna.cabal
50
elna.cabal
@ -15,19 +15,49 @@ build-type: Simple
|
|||||||
extra-doc-files: TODO README
|
extra-doc-files: TODO README
|
||||||
|
|
||||||
common warnings
|
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:
|
build-depends:
|
||||||
base ^>=4.17.2.1,
|
base ^>=4.17.2.1,
|
||||||
megaparsec ^>= 9.6,
|
megaparsec ^>= 9.6,
|
||||||
text ^>= 2.0
|
text ^>= 2.0
|
||||||
|
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
|
hs-source-dirs: src
|
||||||
default-language: GHC2021
|
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