108 lines
2.9 KiB
Haskell
108 lines
2.9 KiB
Haskell
|
module Language.Elna.Parser
|
||
|
|
( Parser
|
||
|
|
, programP
|
||
|
|
) where
|
||
|
|
|
||
|
|
import Control.Monad (void)
|
||
|
|
import Data.Text (Text)
|
||
|
|
import qualified Data.Text as Text
|
||
|
|
import Data.Void (Void)
|
||
|
|
import Language.Elna.AST
|
||
|
|
( Declaration(..)
|
||
|
|
, Identifier(..)
|
||
|
|
, Parameter(..)
|
||
|
|
, Program(..)
|
||
|
|
, TypeExpression(..)
|
||
|
|
, VariableDeclaration(..)
|
||
|
|
)
|
||
|
|
import Text.Megaparsec (Parsec, (<?>), optional, between, sepBy)
|
||
|
|
import Text.Megaparsec.Char (alphaNumChar, letterChar, space1)
|
||
|
|
import qualified Text.Megaparsec.Char.Lexer as Lexer
|
||
|
|
import Control.Applicative (Alternative(..))
|
||
|
|
import Data.Maybe (isJust)
|
||
|
|
|
||
|
|
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 ")")
|
||
|
|
|
||
|
|
openBracketP :: Parser ()
|
||
|
|
openBracketP = void $ symbol "["
|
||
|
|
|
||
|
|
closingBracketP :: Parser ()
|
||
|
|
closingBracketP = void $ 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" *> openBracketP *> lexeme Lexer.decimal <* closingBracketP)
|
||
|
|
<*> (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 ",")
|
||
|
|
|
||
|
|
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
|