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
|
This is a simple test for happy.
First thing to declare is the name of your parser,
and the type of the tokens the parser reads.
> {
> import Data.Char
> }
> %name calc
> %tokentype { Token }
The parser will be of type [Token] -> ?, where ? is determined by the
production rules. Now we declare all the possible tokens:
> %token
> let { TokenLet }
> in { TokenIn }
> int { TokenInt $$ }
> var { TokenVar $$ }
> '=' { TokenEq }
> '+' { TokenPlus }
> '-' { TokenMinus }
> '*' { TokenTimes }
> '/' { TokenDiv }
> '(' { TokenOB }
> ')' { TokenCB }
The *new* system.
%token
let ( let )
in ( in )
int ( digit+ )
var ( {alpha}{alphanum}+ )
'=' ( = )
'+' ( + )
'-' ( - )
'*' ( * )
'/' ( / )
'(' ( \( )
')' ( \) )
%whitespace ( {space}|{tab} )
%newline ( {newline} )
The left hand side are the names of the terminals or tokens,
and the right hand side is how to pattern match them.
Like yacc, we include %% here, for no real reason.
> %%
Now we have the production rules.
> Exp :: { Exp }
> Exp : let var '=' Exp in Exp { Let $2 $4 $6 }
> | Exp1 { Exp1 $1 }
>
> Exp1 :: { Exp1 }
> Exp1 : Exp1 '+' Term { Plus $1 $3 }
> | Exp1 '-' Term { Minus $1 $3 }
> | Term { Term $1 }
>
> Term :: { Term }
> Term : Term '*' Factor { Times $1 $3 }
> | Term '/' Factor { Div $1 $3 }
> | Factor { Factor $1 }
>
> Factor :: { Factor }
> Factor : int { Int $1 }
> | var { Var $1 }
> | '(' Exp ')' { Brack $2 }
We are simply returning the parsed data structure !
Now we need some extra code, to support this parser,
and make in complete:
> {
All parsers must declair this function,
which is called when an error is detected.
Note that currently we do no error recovery.
> happyError tks = error "Parse error"
Now we declare the datastructure that we are parsing.
> data Exp = Let String Exp Exp | Exp1 Exp1
> data Exp1 = Plus Exp1 Term | Minus Exp1 Term | Term Term
> data Term = Times Term Factor | Div Term Factor | Factor Factor
> data Factor = Int Int | Var String | Brack Exp
The datastructure for the tokens...
> data Token
> = TokenLet
> | TokenIn
> | TokenInt Int
> | TokenVar String
> | TokenEq
> | TokenPlus
> | TokenMinus
> | TokenTimes
> | TokenDiv
> | TokenOB
> | TokenCB
.. and a simple lexer that returns this datastructure.
> lexer :: String -> [Token]
> lexer [] = []
> lexer (c:cs)
> | isSpace c = lexer cs
> | isAlpha c = lexVar (c:cs)
> | isDigit c = lexNum (c:cs)
> lexer ('=':cs) = TokenEq : lexer cs
> lexer ('+':cs) = TokenPlus : lexer cs
> lexer ('-':cs) = TokenMinus : lexer cs
> lexer ('*':cs) = TokenTimes : lexer cs
> lexer ('/':cs) = TokenDiv : lexer cs
> lexer ('(':cs) = TokenOB : lexer cs
> lexer (')':cs) = TokenCB : lexer cs
> lexNum cs = TokenInt (read num) : lexer rest
> where (num,rest) = span isDigit cs
> lexVar cs =
> case span isAlpha cs of
> ("let",rest) -> TokenLet : lexer rest
> ("in",rest) -> TokenIn : lexer rest
> (var,rest) -> TokenVar var : lexer rest
To run the program, call this in gofer, or use some code
to print it.
> runCalc :: String -> Exp
> runCalc = calc . lexer
Here we test our parser.
> main = case runCalc "1 + 2 + 3" of {
> (Exp1 (Plus (Plus (Term (Factor (Int 1))) (Factor (Int 2))) (Factor (Int 3)))) ->
> case runCalc "1 * 2 + 3" of {
> (Exp1 (Plus (Term (Times (Factor (Int 1)) (Int 2))) (Factor (Int 3)))) ->
> case runCalc "1 + 2 * 3" of {
> (Exp1 (Plus (Term (Factor (Int 1))) (Times (Factor (Int 2)) (Int 3)))) ->
> case runCalc "let x = 2 in x * (x - 2)" of {
> (Let "x" (Exp1 (Term (Factor (Int 2)))) (Exp1 (Term (Times (Factor (Var "x")) (Brack (Exp1 (Minus (Term (Factor (Var "x"))) (Factor (Int 2))))))))) -> print "Test works\n";
> _ -> quit } ; _ -> quit } ; _ -> quit } ; _ -> quit }
> quit = print "Test failed\n"
> }
|
