Split in lib and tests
This commit is contained in:
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
|
||||
Reference in New Issue
Block a user