1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
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
|
