diff options
Diffstat (limited to 'lib/Language')
| -rw-r--r-- | lib/Language/Elna/AST.hs | 29 | ||||
| -rw-r--r-- | lib/Language/Elna/Parser.hs | 73 |
2 files changed, 69 insertions, 33 deletions
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 |