diff --git a/lib/Language/Elna/AST.hs b/lib/Language/Elna/AST.hs index 0add1d2..3189469 100644 --- a/lib/Language/Elna/AST.hs +++ b/lib/Language/Elna/AST.hs @@ -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 diff --git a/lib/Language/Elna/Parser.hs b/lib/Language/Elna/Parser.hs index f387f60..109f1ba 100644 --- a/lib/Language/Elna/Parser.hs +++ b/lib/Language/Elna/Parser.hs @@ -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 diff --git a/tests/Language/Elna/ParserSpec.hs b/tests/Language/Elna/ParserSpec.hs index 11907ab..0230097 100644 --- a/tests/Language/Elna/ParserSpec.hs +++ b/tests/Language/Elna/ParserSpec.hs @@ -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