Parse all statements
This commit is contained in:
parent
947c5aa7ef
commit
bf774475cc
GPG Key ID:
A27FDC1E8EE902C0
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user