diff options
Diffstat (limited to 'lib/Language/Elna/Frontend/Parser.hs')
| -rw-r--r-- | lib/Language/Elna/Frontend/Parser.hs | 223 |
1 files changed, 223 insertions, 0 deletions
diff --git a/lib/Language/Elna/Frontend/Parser.hs b/lib/Language/Elna/Frontend/Parser.hs new file mode 100644 index 0000000..4093f25 --- /dev/null +++ b/lib/Language/Elna/Frontend/Parser.hs @@ -0,0 +1,223 @@ +module Language.Elna.Frontend.Parser + ( Parser + , programP + ) where + +import Control.Monad (void) +import Control.Monad.Combinators.Expr (Operator(..), makeExprParser) +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Void (Void) +import Language.Elna.Frontend.AST + ( Declaration(..) + , Identifier(..) + , Parameter(..) + , Program(..) + , Statement(..) + , TypeExpression(..) + , VariableDeclaration(..) + {-, VariableAccess(..) + , Condition(..)-} + , Expression(..) + , Literal(..) + ) +import Text.Megaparsec + ( Parsec + , (<?>) + , MonadParsec(..) + , eof + , optional + , between + , sepBy + , choice + ) +import qualified Text.Megaparsec.Char.Lexer as Lexer +import Text.Megaparsec.Char + ( alphaNumChar +-- , char + , letterChar + , space1 +-- , string + ) +import Control.Applicative (Alternative(..)) +import Data.Maybe (isJust) +-- import Data.Functor (($>)) + +type Parser = Parsec Void Text + +literalP :: Parser Literal +literalP + = {- HexadecimalLiteral <$> (string "0x" *> lexeme Lexer.hexadecimal) + <|> -} IntegerLiteral <$> Lexer.signed space integerP + {- <|> CharacterLiteral <$> lexeme charP + <|> BooleanLiteral <$> (symbol "true" $> True) + <|> BooleanLiteral <$> (symbol "false" $> False) + where + charP = fromIntegral . fromEnum + <$> between (char '\'') (char '\'') Lexer.charLiteral -} +{- +typeDefinitionP :: Parser Declaration +typeDefinitionP = TypeDefinition + <$> (symbol "type" *> identifierP) + <*> (symbol "=" *> typeExpressionP) + <* semicolonP + <?> "type definition" +-} +termP :: Parser Expression +termP = choice + [ parensP expressionP + , LiteralExpression <$> literalP + -- , VariableExpression <$> variableAccessP + ] + +operatorTable :: [[Operator Parser Expression]] +operatorTable = + [ unaryOperator + -- , factorOperator + , termOperator + ] + where + unaryOperator = + [ prefix "-" NegationExpression + , prefix "+" id + ] + {- factorOperator = + [ binary "*" ProductExpression + , binary "/" DivisionExpression + ] -} + termOperator = + [ binary "+" SumExpression + , binary "-" SubtractionExpression + ] + prefix name f = Prefix (f <$ symbol name) + binary name f = InfixL (f <$ symbol name) + +expressionP :: Parser Expression +expressionP = makeExprParser termP operatorTable +{- +variableAccessP :: Parser VariableAccess +variableAccessP = do + identifier <- identifierP + indices <- many $ bracketsP expressionP + pure $ foldr (flip ArrayAccess) (VariableAccess identifier) indices + +conditionP :: Parser Condition +conditionP = do + lhs <- expressionP + conditionCons <- choice comparisonOperator + conditionCons lhs <$> expressionP + where + comparisonOperator = + [ symbol "<" >> pure LessCondition + , symbol "<=" >> pure LessOrEqualCondition + , symbol ">" >> pure GreaterCondition + , symbol ">=" >> pure GreaterOrEqualCondition + , symbol "=" >> pure EqualCondition + , symbol "#" >> pure NonEqualCondition + ] +-} +symbol :: Text -> Parser Text +symbol = Lexer.symbol space + +space :: Parser () +space = Lexer.space space1 (Lexer.skipLineComment "//") + $ Lexer.skipBlockComment "/*" "*/" + +lexeme :: forall a. Parser a -> Parser a +lexeme = Lexer.lexeme space + +blockP :: forall a. Parser a -> Parser a +blockP = between (symbol "{") (symbol "}") + +parensP :: forall a. Parser a -> Parser a +parensP = between (symbol "(") (symbol ")") + +bracketsP :: forall a. Parser a -> Parser a +bracketsP = between (symbol "[") (symbol "]") + +colonP :: Parser () +colonP = void $ symbol ":" + +commaP :: Parser () +commaP = void $ symbol "," + +semicolonP :: Parser () +semicolonP = void $ symbol ";" + +integerP :: Integral a => Parser a +integerP = lexeme Lexer.decimal + +identifierP :: Parser Identifier +identifierP = + let wordParser = (:) <$> letterChar <*> many alphaNumChar <?> "identifier" + in fmap Identifier $ lexeme $ Text.pack <$> wordParser + +procedureP :: Parser () +procedureP = void $ symbol "proc" + +parameterP :: Parser Parameter +parameterP = paramCons + <$> optional (symbol "ref") + <*> identifierP + <*> (colonP *> typeExpressionP) + where + paramCons ref name typeName = Parameter name typeName (isJust ref) + +typeExpressionP :: Parser TypeExpression +typeExpressionP = arrayTypeExpression + <|> NamedType <$> identifierP + <?> "type expression" + where + arrayTypeExpression = ArrayType + <$> (symbol "array" *> bracketsP integerP) + <*> (symbol "of" *> typeExpressionP) + +procedureDeclarationP :: Parser Declaration +procedureDeclarationP = procedureCons + <$> (procedureP *> identifierP) + <*> parensP (sepBy parameterP commaP) + <*> blockP ((,) <$> many variableDeclarationP <*> many statementP) + <?> "procedure definition" + where + procedureCons procedureName parameters (variables, body) = + ProcedureDeclaration procedureName parameters variables body + +statementP :: Parser Statement +statementP + = EmptyStatement <$ semicolonP + {-<|> CompoundStatement <$> blockP (many statementP) + <|> try assignmentP + <|> try ifElseP + <|> try whileP -} + <|> try callP + <?> "statement" + where + callP = CallStatement + <$> identifierP + <*> parensP (sepBy expressionP commaP) + <* semicolonP + {-ifElseP = IfStatement + <$> (symbol "if" *> parensP conditionP) + <*> statementP + <*> optional (symbol "else" *> statementP) + whileP = WhileStatement + <$> (symbol "while" *> parensP conditionP) + <*> statementP + assignmentP = AssignmentStatement + <$> variableAccessP + <* symbol ":=" + <*> expressionP + <* semicolonP -} + +variableDeclarationP :: Parser VariableDeclaration +variableDeclarationP = VariableDeclaration + <$> (symbol "var" *> identifierP) + <*> (colonP *> typeExpressionP) + <* semicolonP + <?> "variable declaration" + +declarationP :: Parser Declaration +declarationP = procedureDeclarationP -- <|> typeDefinitionP + +programP :: Parser Program +programP = Program <$> many declarationP <* eof |