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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
|
module Fun.Parser where
import Data.Char
import Fun.Tree
type Parser a = String -> Maybe (a, String)
char :: Parser Char
char [] = Nothing
char (x : xs) = Just (x, xs)
digit :: Parser Char
digit = char <=> isDigit
digits :: Parser String
digits = iter digit
number :: Parser Integer
number =
literal '-'
<-+> digits
>>> (\n -> -1 * (read n :: Integer))
<|> digits
>>> (\n -> read n :: Integer)
space :: Parser Char
space = char <=> isSpace
newline :: Parser Char
newline = char <=> (== '\n')
notSpace :: Parser Char
notSpace = char <=> (not . isSpace)
letter :: Parser Char
letter = char <=> isAlpha
letters :: Parser String
letters = iter letter
alphanum :: Parser Char
alphanum = digit <|> letter
literal :: Char -> Parser Char
literal c = char <=> (== c)
result :: a -> Parser a
result a cs = Just (a, cs)
iter :: Parser Char -> Parser String
iter m = (iterS m) <=> (/= "")
iterS :: Parser a -> Parser [a]
iterS m = m <+> iterS m >>> (\(x, y) -> x : y) <|> result []
token :: Parser a -> Parser a
token = (<+-> iterS space)
-- A parser that will accept a given alpha string
acceptWord :: String -> Parser String
acceptWord w = token (letters <=> (== w))
-- A parser that will accept a given string
accept :: String -> Parser String
accept w = token ((iter notSpace) <=> (== w))
-- Given a parser and a predicate return the parser only if it satisfies the predicate
infix 7 <=>
(<=>) :: Parser a -> (a -> Bool) -> Parser a
(parser <=> predicate) input = case parser input of
Nothing -> Nothing
Just (a, rest) -> if (predicate a) then Just (a, rest) else Nothing
-- Combine two parser together pairing their results up in a tuple
infixl 6 <+>
(<+>) :: Parser a -> Parser b -> Parser (a, b)
(parserA <+> parserB) input = case parserA input of
Nothing -> Nothing
Just (resultA, remainder) -> case parserB remainder of
Nothing -> Nothing
Just (resultB, cs) -> Just ((resultA, resultB), cs)
-- Sequence operator that discards the second result
infixl 6 <+->
(<+->) :: Parser a -> Parser b -> Parser a
(parserA <+-> parserB) input = case parserA input of
Nothing -> Nothing
Just (resultA, remainder) -> case parserB remainder of
Nothing -> Nothing
Just (_, cs) -> Just (resultA, cs)
-- Sequence operator that discards the first result
infixl 6 <-+>
(<-+>) :: Parser a -> Parser b -> Parser b
(parserA <-+> parserB) input = case parserA input of
Nothing -> Nothing
Just (resultA, remainder) -> case parserB remainder of
Nothing -> Nothing
Just (resultB, cs) -> Just (resultB, cs)
-- Transform a parsers result
infixl 5 >>>
(>>>) :: Parser a -> (a -> b) -> Parser b
(parser >>> transformer) input = case parser input of
Nothing -> Nothing
Just (resultA, remainder) -> Just ((transformer resultA), remainder)
-- Extract a parsers result
infix 4 +>
(+>) :: Parser a -> (a -> Parser b) -> Parser b
(parser +> function) input = case parser input of
Nothing -> Nothing
Just (a, cs) -> function a cs
-- Combine two parsers using a 'or' type operation
infixl 3 <|>
(<|>) :: Parser a -> Parser a -> Parser a
(parserA <|> parserB) input = case parserA input of
Nothing -> parserB input
result -> result
----
tree :: Parser Tree
tree = iterS program >>> Tree
program :: Parser Program
program = iterS block >>> Program
block :: Parser Block
block = functionBlock <+-> newline >>> Block
visibility :: Parser Char
visibility = literal '+' <|> literal '-'
functionBlock :: Parser FunctionBlock
functionBlock =
functionDeclaration
<+> iterS functionDefinition
>>> (\(a, b) -> FunctionBlock a b)
functionDeclaration :: Parser FunctionDeclaration
functionDeclaration =
functionDeclarationWithoutFlags <|> functionDeclarationWithFlags
functionDeclarationWithoutFlags :: Parser FunctionDeclaration
functionDeclarationWithoutFlags =
functionName
<+> functionDeclarationDelimiter
<+> iterS functionType
<+-> newline
>>> (\((a, b), c) -> FunctionDeclarationWithoutFlags a b c)
functionDeclarationWithFlags :: Parser FunctionDeclaration
functionDeclarationWithFlags =
functionName
<+> functionDeclarationDelimiter
<+> functionTypeList
<+-> space
<+-> literal '%'
<+-> space
<+> iterS functionFlag
<+-> newline
>>> (\(((a, b), c), d) -> FunctionDeclarationWithFlags a b c d)
functionDeclarationDelimiter :: Parser Char
functionDeclarationDelimiter =
space <-+> literal ':' <-+> visibility <+-> literal ':' <+-> space
functionName :: Parser String
functionName = letter <+> iterS alphanum >>> (\(a, b) -> a : b)
functionTypeList :: Parser [String]
functionTypeList =
iterS ((functionType <+-> space <+-> literal ':' <+-> space) <|> functionType)
functionType :: Parser String
functionType = letter <+> iterS alphanum >>> (\(a, b) -> a : b)
functionFlag :: Parser String
functionFlag = letters
functionDefinition :: Parser FunctionDefinition
functionDefinition =
letters
<+-> space
<+-> literal ':'
<+-> space
<+> letters
<+-> newline
>>> (\(a, b) -> FunctionDefinition a b)
|
