diff options
Diffstat (limited to 'lib/Language/Elna/Parser.hs')
| -rw-r--r-- | lib/Language/Elna/Parser.hs | 187 |
1 files changed, 94 insertions, 93 deletions
diff --git a/lib/Language/Elna/Parser.hs b/lib/Language/Elna/Parser.hs index 4828bf5..57ebb1b 100644 --- a/lib/Language/Elna/Parser.hs +++ b/lib/Language/Elna/Parser.hs @@ -3,89 +3,48 @@ module Language.Elna.Parser , programP ) where --- import Control.Monad (void) +import Control.Monad (void) -- import Control.Monad.Combinators.Expr (Operator(..), makeExprParser) import Data.Text (Text) --- import qualified Data.Text as Text +import qualified Data.Text as Text import Data.Void (Void) import Language.Elna.AST - ( Program(..) - {-, VariableAccess(..) - , Condition(..) - , Declaration(..) - , Expression(..) + ( Declaration(..) , Identifier(..) - , Literal(..) , Parameter(..) + , Program(..) , Statement(..) , TypeExpression(..) - , VariableDeclaration(..)-} + , VariableDeclaration(..) + {-, VariableAccess(..) + , Condition(..) + , Expression(..) + , Literal(..)-} ) import Text.Megaparsec ( Parsec - {-, MonadParsec(..) , (<?>) + --, MonadParsec(..) + , eof , optional , between , sepBy - , choice -} + --, choice ) -{- import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as Lexer +import Text.Megaparsec.Char ( alphaNumChar - , char +-- , char , letterChar , space1 - , string +-- , string ) -import qualified Text.Megaparsec.Char.Lexer as Lexer import Control.Applicative (Alternative(..)) import Data.Maybe (isJust) -import Data.Functor (($>)) --} +-- import Data.Functor (($>)) + type Parser = Parsec Void Text {- -space :: Parser () -space = Lexer.space space1 (Lexer.skipLineComment "//") - $ Lexer.skipBlockComment "/*" "*/" - -lexeme :: forall a. Parser a -> Parser a -lexeme = Lexer.lexeme space - -symbol :: Text -> Parser Text -symbol = Lexer.symbol space - -blockP :: forall a. Parser a -> Parser a -blockP = between (symbol "{") (symbol "}") - -procedureP :: Parser () -procedureP = void $ symbol "proc" - -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 ":" - -semicolonP :: Parser () -semicolonP = void $ symbol ";" - -identifierP :: Parser Identifier -identifierP = - let wordParser = (:) <$> letterChar <*> many alphaNumChar <?> "identifier" - in fmap Identifier $ lexeme $ Text.pack <$> wordParser - -typeExpressionP :: Parser TypeExpression -typeExpressionP = arrayTypeExpression - <|> NamedType <$> identifierP - <?> "type expression" - where - arrayTypeExpression = ArrayType - <$> (symbol "array" *> bracketsP (lexeme Lexer.decimal)) - <*> (symbol "of" *> typeExpressionP) - typeDefinitionP :: Parser Declaration typeDefinitionP = TypeDefinition <$> (symbol "type" *> identifierP) @@ -93,24 +52,6 @@ typeDefinitionP = TypeDefinition <* semicolonP <?> "type definition" -variableDeclarationP :: Parser VariableDeclaration -variableDeclarationP = VariableDeclaration - <$> (symbol "var" *> identifierP) - <*> (colonP *> typeExpressionP) - <* semicolonP - <?> "variable declaration" - -parameterP :: Parser Parameter -parameterP = paramCons - <$> optional (symbol "ref") - <*> identifierP - <*> (colonP *> typeExpressionP) - where - paramCons ref name typeName = Parameter name typeName (isJust ref) - -commaP :: Parser () -commaP = void $ symbol "," - literalP :: Parser Literal literalP = HexadecimalLiteral <$> (string "0x" *> lexeme Lexer.hexadecimal) @@ -174,17 +115,80 @@ conditionP = do , 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 ";" + +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 (lexeme Lexer.decimal)) + <*> (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) + {-<|> CompoundStatement <$> blockP (many statementP) <|> try assignmentP <|> try ifElseP <|> try whileP - <|> try callP + <|> try callP -} <?> "statement" - where + {-where ifElseP = IfStatement <$> (symbol "if" *> parensP conditionP) <*> statementP @@ -201,19 +205,16 @@ statementP <* symbol ":=" <*> expressionP <* semicolonP - -procedureDefinitionP :: Parser Declaration -procedureDefinitionP = procedureCons - <$> (procedureP *> identifierP) - <*> parensP (sepBy parameterP commaP) - <*> blockP ((,) <$> many variableDeclarationP <*> many statementP) - <?> "procedure definition" - where - procedureCons procedureName parameters (variables, body) = - ProcedureDefinition procedureName parameters variables body +-} +variableDeclarationP :: Parser VariableDeclaration +variableDeclarationP = VariableDeclaration + <$> (symbol "var" *> identifierP) + <*> (colonP *> typeExpressionP) + <* semicolonP + <?> "variable declaration" declarationP :: Parser Declaration -declarationP = typeDefinitionP <|> procedureDefinitionP --} +declarationP = procedureDeclarationP -- <|> typeDefinitionP + programP :: Parser Program -programP = pure Program -- <$> many declarationP +programP = Program <$> many declarationP <* eof |