module Language.Elna.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.AST ( Program(..) {-, VariableAccess(..) , Condition(..) , Declaration(..) , Expression(..) , Identifier(..) , Literal(..) , Parameter(..) , Statement(..) , TypeExpression(..) , VariableDeclaration(..)-} ) import Text.Megaparsec ( Parsec {-, MonadParsec(..) , () , optional , between , sepBy , choice -} ) {- 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) 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) <*> (symbol "=" *> typeExpressionP) <* 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) <|> IntegerLiteral <$> lexeme Lexer.decimal <|> CharacterLiteral <$> lexeme charP <|> BooleanLiteral <$> (symbol "true" $> True) <|> BooleanLiteral <$> (symbol "false" $> False) where charP = fromIntegral . fromEnum <$> between (char '\'') (char '\'') Lexer.charLiteral termP :: Parser Expression termP = choice [ parensP expressionP , LiteralExpression <$> literalP , VariableExpression <$> variableAccessP ] variableAccessP :: Parser VariableAccess variableAccessP = do identifier <- identifierP indices <- many $ bracketsP expressionP pure $ foldr (flip ArrayAccess) (VariableAccess identifier) indices 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 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 ] statementP :: Parser Statement statementP = EmptyStatement <$ semicolonP <|> CompoundStatement <$> blockP (many statementP) <|> try assignmentP <|> try ifElseP <|> try whileP <|> try callP "statement" where ifElseP = IfStatement <$> (symbol "if" *> parensP conditionP) <*> statementP <*> optional (symbol "else" *> statementP) whileP = WhileStatement <$> (symbol "while" *> parensP conditionP) <*> statementP callP = CallStatement <$> identifierP <*> parensP (sepBy expressionP commaP) <* semicolonP assignmentP = AssignmentStatement <$> variableAccessP <* 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 declarationP :: Parser Declaration declarationP = typeDefinitionP <|> procedureDefinitionP -} programP :: Parser Program programP = pure Program -- <$> many declarationP