elna/lib/Language/Elna/Parser.hs

220 lines
5.9 KiB
Haskell
Raw Normal View History

2024-07-23 22:44:42 +02:00
module Language.Elna.Parser
( Parser
, programP
) where
2024-09-08 02:08:13 +02:00
-- import Control.Monad (void)
-- import Control.Monad.Combinators.Expr (Operator(..), makeExprParser)
2024-07-23 22:44:42 +02:00
import Data.Text (Text)
2024-09-08 02:08:13 +02:00
-- import qualified Data.Text as Text
2024-07-23 22:44:42 +02:00
import Data.Void (Void)
import Language.Elna.AST
2024-09-08 02:08:13 +02:00
( Program(..)
{-, VariableAccess(..)
2024-08-15 20:13:56 +02:00
, Condition(..)
, Declaration(..)
2024-07-24 01:22:20 +02:00
, Expression(..)
2024-07-23 22:44:42 +02:00
, Identifier(..)
2024-07-24 01:22:20 +02:00
, Literal(..)
2024-07-23 22:44:42 +02:00
, Parameter(..)
2024-07-24 01:22:20 +02:00
, Statement(..)
2024-07-23 22:44:42 +02:00
, TypeExpression(..)
2024-09-08 02:08:13 +02:00
, VariableDeclaration(..)-}
2024-07-23 22:44:42 +02:00
)
2024-07-25 01:39:53 +02:00
import Text.Megaparsec
( Parsec
2024-09-08 02:08:13 +02:00
{-, MonadParsec(..)
2024-07-25 01:39:53 +02:00
, (<?>)
, optional
, between
, sepBy
2024-09-08 02:08:13 +02:00
, choice -}
2024-07-25 01:39:53 +02:00
)
2024-09-08 02:08:13 +02:00
{- import Text.Megaparsec.Char
2024-07-25 01:39:53 +02:00
( alphaNumChar
, char
, letterChar
, space1
, string
)
2024-07-23 22:44:42 +02:00
import qualified Text.Megaparsec.Char.Lexer as Lexer
import Control.Applicative (Alternative(..))
import Data.Maybe (isJust)
2024-07-24 01:22:20 +02:00
import Data.Functor (($>))
2024-09-08 02:08:13 +02:00
-}
2024-07-23 22:44:42 +02:00
type Parser = Parsec Void Text
2024-09-08 02:08:13 +02:00
{-
2024-07-23 22:44:42 +02:00
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 ")")
2024-07-24 01:22:20 +02:00
bracketsP :: forall a. Parser a -> Parser a
bracketsP = between (symbol "[") (symbol "]")
2024-07-23 22:44:42 +02:00
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
2024-07-26 12:22:07 +02:00
arrayTypeExpression = ArrayType
2024-07-24 01:22:20 +02:00
<$> (symbol "array" *> bracketsP (lexeme Lexer.decimal))
2024-07-23 22:44:42 +02:00
<*> (symbol "of" *> typeExpressionP)
typeDefinitionP :: Parser Declaration
typeDefinitionP = TypeDefinition
<$> (symbol "type" *> identifierP)
<*> (symbol "=" *> typeExpressionP)
<* semicolonP
2024-07-23 22:44:42 +02:00
<?> "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)
2024-07-25 01:39:53 +02:00
commaP :: Parser ()
commaP = void $ symbol ","
2024-07-23 22:44:42 +02:00
2024-07-24 01:22:20 +02:00
literalP :: Parser Literal
literalP
2024-07-25 01:39:53 +02:00
= HexadecimalLiteral <$> (string "0x" *> lexeme Lexer.hexadecimal)
<|> IntegerLiteral <$> lexeme Lexer.decimal
<|> CharacterLiteral <$> lexeme charP
2024-07-24 01:22:20 +02:00
<|> BooleanLiteral <$> (symbol "true" $> True)
<|> BooleanLiteral <$> (symbol "false" $> False)
where
charP = fromIntegral . fromEnum
2024-07-25 01:39:53 +02:00
<$> between (char '\'') (char '\'') Lexer.charLiteral
2024-07-24 01:22:20 +02:00
termP :: Parser Expression
termP = choice
[ parensP expressionP
, LiteralExpression <$> literalP
2024-08-15 20:13:56 +02:00
, VariableExpression <$> variableAccessP
2024-07-24 01:22:20 +02:00
]
2024-08-15 20:13:56 +02:00
variableAccessP :: Parser VariableAccess
variableAccessP = do
identifier <- identifierP
indices <- many $ bracketsP expressionP
pure $ foldr (flip ArrayAccess) (VariableAccess identifier) indices
2024-07-24 01:22:20 +02:00
operatorTable :: [[Operator Parser Expression]]
operatorTable =
2024-08-15 20:13:56 +02:00
[ unaryOperator
2024-07-25 01:39:53 +02:00
, factorOperator
2024-07-24 01:22:20 +02:00
, termOperator
]
where
2024-08-15 20:13:56 +02:00
unaryOperator =
2024-07-24 01:22:20 +02:00
[ prefix "-" NegationExpression
, prefix "+" id
]
2024-07-25 01:39:53 +02:00
factorOperator =
2024-07-24 01:22:20 +02:00
[ 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
2024-08-15 20:13:56 +02:00
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
]
2024-07-24 01:22:20 +02:00
statementP :: Parser Statement
statementP
= EmptyStatement <$ semicolonP
<|> CompoundStatement <$> blockP (many statementP)
2024-07-25 01:39:53 +02:00
<|> try assignmentP
<|> try ifElseP
<|> try whileP
<|> try callP
<?> "statement"
where
ifElseP = IfStatement
2024-08-15 20:13:56 +02:00
<$> (symbol "if" *> parensP conditionP)
2024-07-25 01:39:53 +02:00
<*> statementP
<*> optional (symbol "else" *> statementP)
whileP = WhileStatement
2024-08-15 20:13:56 +02:00
<$> (symbol "while" *> parensP conditionP)
2024-07-25 01:39:53 +02:00
<*> statementP
callP = CallStatement
<$> identifierP
<*> parensP (sepBy expressionP commaP)
<* semicolonP
assignmentP = AssignmentStatement
2024-08-15 20:13:56 +02:00
<$> variableAccessP
2024-07-25 01:39:53 +02:00
<* symbol ":="
<*> expressionP
<* semicolonP
2024-07-24 01:22:20 +02:00
2024-07-23 22:44:42 +02:00
procedureDefinitionP :: Parser Declaration
2024-07-25 01:39:53 +02:00
procedureDefinitionP = procedureCons
2024-07-23 22:44:42 +02:00
<$> (procedureP *> identifierP)
2024-07-25 01:39:53 +02:00
<*> parensP (sepBy parameterP commaP)
<*> blockP ((,) <$> many variableDeclarationP <*> many statementP)
2024-07-23 22:44:42 +02:00
<?> "procedure definition"
2024-07-25 01:39:53 +02:00
where
procedureCons procedureName parameters (variables, body) =
ProcedureDefinition procedureName parameters variables body
2024-07-23 22:44:42 +02:00
declarationP :: Parser Declaration
declarationP = typeDefinitionP <|> procedureDefinitionP
2024-09-08 02:08:13 +02:00
-}
2024-07-23 22:44:42 +02:00
programP :: Parser Program
2024-09-08 02:08:13 +02:00
programP = pure Program -- <$> many declarationP