171 lines
4.8 KiB
Haskell
171 lines
4.8 KiB
Haskell
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
|
|
( Declaration(..)
|
|
, Expression(..)
|
|
, Identifier(..)
|
|
, Literal(..)
|
|
, Parameter(..)
|
|
, Program(..)
|
|
, Statement(..)
|
|
, TypeExpression(..)
|
|
, VariableDeclaration(..)
|
|
)
|
|
import Text.Megaparsec (Parsec, (<?>), optional, between, sepBy, choice)
|
|
import Text.Megaparsec.Char (alphaNumChar, char, letterChar, space1, asciiChar)
|
|
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 = flip ArrayType
|
|
<$> (symbol "array" *> bracketsP (lexeme Lexer.decimal))
|
|
<*> (symbol "of" *> typeExpressionP)
|
|
|
|
typeDefinitionP :: Parser Declaration
|
|
typeDefinitionP = TypeDefinition
|
|
<$> (symbol "type" *> identifierP)
|
|
<*> (symbol "=" *> typeExpressionP)
|
|
<?> "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)
|
|
|
|
parametersP :: Parser [Parameter]
|
|
parametersP = parensP $ sepBy parameterP (symbol ",")
|
|
|
|
literalP :: Parser Literal
|
|
literalP
|
|
= HexadecimalLiteral <$> Lexer.hexadecimal
|
|
<|> IntegerLiteral <$> Lexer.decimal
|
|
<|> CharacterLiteral <$> charP
|
|
<|> BooleanLiteral <$> (symbol "true" $> True)
|
|
<|> BooleanLiteral <$> (symbol "false" $> False)
|
|
where
|
|
-- TODO: Escape characters.
|
|
charP = fromIntegral . fromEnum
|
|
<$> between (char '\'') (char '\'') asciiChar
|
|
|
|
termP :: Parser Expression
|
|
termP = choice
|
|
[ parensP expressionP
|
|
, VariableExpression <$> identifierP
|
|
, LiteralExpression <$> literalP
|
|
]
|
|
|
|
operatorTable :: [[Operator Parser Expression]]
|
|
operatorTable =
|
|
[ [Postfix (ArrayExpression <$> bracketsP expressionP)]
|
|
, unaryOperator
|
|
, factoryOperator
|
|
, termOperator
|
|
, comparisonOperator
|
|
]
|
|
where
|
|
unaryOperator =
|
|
[ prefix "-" NegationExpression
|
|
, prefix "+" id
|
|
]
|
|
factoryOperator =
|
|
[ binary "*" ProductExpression
|
|
, binary "/" DivisionExpression
|
|
]
|
|
termOperator =
|
|
[ binary "+" SumExpression
|
|
, binary "-" SubtractionExpression
|
|
]
|
|
comparisonOperator =
|
|
[ binary "<" LessExpression
|
|
, binary "<=" LessOrEqualExpression
|
|
, binary ">" GreaterExpression
|
|
, binary ">=" GreaterOrEqualExpression
|
|
, binary "=" EqualExpression
|
|
, binary "#" NonEqualExpression
|
|
]
|
|
prefix name f = Prefix (f <$ symbol name)
|
|
binary name f = InfixL (f <$ symbol name)
|
|
|
|
expressionP :: Parser Expression
|
|
expressionP = makeExprParser termP operatorTable
|
|
|
|
statementP :: Parser Statement
|
|
statementP
|
|
= EmptyStatement <$ semicolonP
|
|
<|> AssignmentStatement <$> expressionP <* symbol ":=" <*> expressionP
|
|
<|> CompoundStatement <$> blockP (many statementP)
|
|
<?> "statement" -- TODO: further statements
|
|
|
|
procedureDefinitionP :: Parser Declaration
|
|
procedureDefinitionP = ProcedureDefinition
|
|
<$> (procedureP *> identifierP)
|
|
<*> parametersP
|
|
<*> blockP (many variableDeclarationP)
|
|
<*> pure mempty -- TODO
|
|
<?> "procedure definition"
|
|
|
|
declarationP :: Parser Declaration
|
|
declarationP = typeDefinitionP <|> procedureDefinitionP
|
|
|
|
programP :: Parser Program
|
|
programP = Program <$> many declarationP
|