Parse all statements

This commit is contained in:
Eugen Wissner 2024-07-25 01:39:53 +02:00
parent 947c5aa7ef
commit bf774475cc
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
3 changed files with 156 additions and 36 deletions

View File

@ -12,11 +12,12 @@ module Language.Elna.AST
import Data.Int (Int32)
import Data.List (intercalate)
import Data.Word (Word8)
import Data.Word (Word16)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Char (chr)
import Data.String (IsString(..))
import Numeric (showHex)
newtype Identifier = Identifier { unIdentifier :: Text }
deriving Eq
@ -43,14 +44,14 @@ instance Show TypeExpression
data Literal
= IntegerLiteral Int32
| HexadecimalLiteral Int32
| CharacterLiteral Word8
| CharacterLiteral Word16
| BooleanLiteral Bool
deriving Eq
instance Show Literal
where
show (IntegerLiteral integer) = show integer
show (HexadecimalLiteral integer) = show integer
show (HexadecimalLiteral integer) = '0' : 'x' : showHex integer ""
show (CharacterLiteral character) =
'\'' : chr (fromEnum character) : ['\'']
show (BooleanLiteral boolean)
@ -84,7 +85,7 @@ instance Show Expression
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 (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]
@ -105,17 +106,16 @@ instance Show Statement
where
show EmptyStatement = ";"
show (AssignmentStatement lhs rhs) =
concat [show lhs, " := ", show rhs, show rhs, ";"]
concat [show lhs, " := ", 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"
concat ["while (", show expression, ") ", show statement, ";"]
show (CompoundStatement statements) =
concat ["{\n", unlines (show <$> statements), " }"]
show (CallStatement name parameters) = show name <> "("
<> intercalate ", " (show <$> parameters) <> ")"
@ -136,7 +136,7 @@ data VariableDeclaration =
instance Show VariableDeclaration
where
show (VariableDeclaration identifier typeExpression) =
concat [" var ", show identifier, ": " <> show typeExpression, ";"]
concat ["var ", show identifier, ": " <> show typeExpression, ";"]
data Declaration
= TypeDefinition Identifier TypeExpression
@ -146,11 +146,12 @@ data Declaration
instance Show Declaration
where
show (TypeDefinition identifier typeExpression) =
concat ["type ", show identifier, " = ", show typeExpression]
concat ["type ", show identifier, " = ", show typeExpression, ";"]
show (ProcedureDefinition procedureName parameters variables body)
= "proc " <> show procedureName <> showParameters parameters <> ";"
<> unlines (show <$> variables)
<> unlines (show <$> body) <> ";"
= "proc " <> show procedureName <> showParameters parameters <> " {\n"
<> unlines ((" " <>) . show <$> variables)
<> unlines ((" " <>) . show <$> body)
<> "}"
newtype Program = Program [Declaration]
deriving Eq

View File

@ -19,8 +19,22 @@ import Language.Elna.AST
, TypeExpression(..)
, VariableDeclaration(..)
)
import Text.Megaparsec (Parsec, (<?>), optional, between, sepBy, choice)
import Text.Megaparsec.Char (alphaNumChar, char, letterChar, space1, asciiChar)
import Text.Megaparsec
( Parsec
, (<?>)
, optional
, between
, sepBy
, choice
, MonadParsec(..)
)
import Text.Megaparsec.Char
( alphaNumChar
, char
, letterChar
, space1
, string
)
import qualified Text.Megaparsec.Char.Lexer as Lexer
import Control.Applicative (Alternative(..))
import Data.Maybe (isJust)
@ -91,33 +105,32 @@ parameterP = paramCons
where
paramCons ref name typeName = Parameter name typeName (isJust ref)
parametersP :: Parser [Parameter]
parametersP = parensP $ sepBy parameterP (symbol ",")
commaP :: Parser ()
commaP = void $ symbol ","
literalP :: Parser Literal
literalP
= HexadecimalLiteral <$> Lexer.hexadecimal
<|> IntegerLiteral <$> Lexer.decimal
<|> CharacterLiteral <$> charP
= HexadecimalLiteral <$> (string "0x" *> lexeme Lexer.hexadecimal)
<|> IntegerLiteral <$> lexeme Lexer.decimal
<|> CharacterLiteral <$> lexeme charP
<|> BooleanLiteral <$> (symbol "true" $> True)
<|> BooleanLiteral <$> (symbol "false" $> False)
where
-- TODO: Escape characters.
charP = fromIntegral . fromEnum
<$> between (char '\'') (char '\'') asciiChar
<$> between (char '\'') (char '\'') Lexer.charLiteral
termP :: Parser Expression
termP = choice
[ parensP expressionP
, VariableExpression <$> identifierP
, LiteralExpression <$> literalP
, VariableExpression <$> identifierP
]
operatorTable :: [[Operator Parser Expression]]
operatorTable =
[ [Postfix (ArrayExpression <$> bracketsP expressionP)]
[ [Postfix (flip ArrayExpression <$> bracketsP expressionP)]
, unaryOperator
, factoryOperator
, factorOperator
, termOperator
, comparisonOperator
]
@ -126,7 +139,7 @@ operatorTable =
[ prefix "-" NegationExpression
, prefix "+" id
]
factoryOperator =
factorOperator =
[ binary "*" ProductExpression
, binary "/" DivisionExpression
]
@ -151,17 +164,39 @@ expressionP = makeExprParser termP operatorTable
statementP :: Parser Statement
statementP
= EmptyStatement <$ semicolonP
<|> AssignmentStatement <$> expressionP <* symbol ":=" <*> expressionP
<|> CompoundStatement <$> blockP (many statementP)
<?> "statement" -- TODO: further statements
<|> try assignmentP
<|> try ifElseP
<|> try whileP
<|> try callP
<?> "statement"
where
ifElseP = IfStatement
<$> (symbol "if" *> parensP expressionP)
<*> statementP
<*> optional (symbol "else" *> statementP)
whileP = WhileStatement
<$> (symbol "while" *> parensP expressionP)
<*> statementP
callP = CallStatement
<$> identifierP
<*> parensP (sepBy expressionP commaP)
<* semicolonP
assignmentP = AssignmentStatement
<$> expressionP
<* symbol ":="
<*> expressionP
<* semicolonP
procedureDefinitionP :: Parser Declaration
procedureDefinitionP = ProcedureDefinition
procedureDefinitionP = procedureCons
<$> (procedureP *> identifierP)
<*> parametersP
<*> blockP (many variableDeclarationP)
<*> pure mempty -- TODO
<*> parensP (sepBy parameterP commaP)
<*> blockP ((,) <$> many variableDeclarationP <*> many statementP)
<?> "procedure definition"
where
procedureCons procedureName parameters (variables, body) =
ProcedureDefinition procedureName parameters variables body
declarationP :: Parser Declaration
declarationP = typeDefinitionP <|> procedureDefinitionP

View File

@ -2,14 +2,18 @@ module Language.Elna.ParserSpec
( spec
) where
import Test.Hspec (Spec, describe, it, pendingWith, xit)
import Test.Hspec (Spec, describe, it)
import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn, parseSatisfies)
import Language.Elna.Parser (programP)
import Text.Megaparsec (parse)
import Language.Elna.AST
( Declaration(..)
, Expression(..)
, Literal(..)
, Statement(..)
, Parameter(..)
, Program(..)
, VariableDeclaration(..)
, TypeExpression(..)
)
@ -54,5 +58,85 @@ spec =
actual = parse programP "" given
in actual `parseSatisfies` expected
it "parses procedure body statements" $
pendingWith "Not implemented"
it "parses negation" $
let given = "proc main(x: integer) { var y: integer; y := -x; }"
parameters = pure $ Parameter "x" (NamedType "integer") False
variables = pure
$ VariableDeclaration "y"
$ NamedType "integer"
body = pure
$ AssignmentStatement (VariableExpression "y")
$ NegationExpression
$ VariableExpression "x"
expected = Program
[ProcedureDefinition "main" parameters variables body]
actual = parse programP "" given
in actual `shouldParse` expected
it "parses comparison with lower precedence than other binary operators" $
let given = "proc main() { var x: boolean; x := 1 + 2 = 3 * 4; }"
variables = pure
$ VariableDeclaration "x"
$ NamedType "boolean"
lhs = SumExpression (LiteralExpression (IntegerLiteral 1))
$ LiteralExpression (IntegerLiteral 2)
rhs = ProductExpression (LiteralExpression (IntegerLiteral 3))
$ LiteralExpression (IntegerLiteral 4)
body = pure
$ AssignmentStatement (VariableExpression "x")
$ EqualExpression lhs rhs
expected = Program
[ProcedureDefinition "main" [] variables body]
actual = parse programP "" given
in actual `shouldParse` expected
it "parses hexadecimals" $
let given = "proc main() { var x: integer; x := 0x10; }"
variables = pure
$ VariableDeclaration "x"
$ NamedType "integer"
body = pure
$ AssignmentStatement (VariableExpression "x")
$ LiteralExpression (HexadecimalLiteral 16)
expected = Program
[ProcedureDefinition "main" [] variables body]
actual = parse programP "" given
in actual `shouldParse` expected
it "parses procedure calls" $
let given = "proc main() { f('c'); }"
body = pure
$ CallStatement "f" [LiteralExpression (CharacterLiteral 99)]
expected = Program
[ProcedureDefinition "main" [] [] body]
actual = parse programP "" given
in actual `shouldParse` expected
it "parses an if statement" $
let given = "proc main() { if (true) ; }"
body = pure
$ IfStatement (LiteralExpression $ BooleanLiteral True) EmptyStatement Nothing
expected = Program
[ProcedureDefinition "main" [] [] body]
actual = parse programP "" given
in actual `shouldParse` expected
it "associates else with the nearst if statement" $
let given = "proc main() { if (true) if (false) ; else ; }"
if' = IfStatement (LiteralExpression $ BooleanLiteral False) EmptyStatement
$ Just EmptyStatement
body = pure
$ IfStatement (LiteralExpression $ BooleanLiteral True) if' Nothing
expected = Program
[ProcedureDefinition "main" [] [] body]
actual = parse programP "" given
in actual `shouldParse` expected
it "parses a while statement" $
let given = "proc main() { while (true) ; }"
body = pure
$ WhileStatement (LiteralExpression $ BooleanLiteral True) EmptyStatement
expected = Program
[ProcedureDefinition "main" [] [] body]
actual = parse programP "" given
in actual `shouldParse` expected