1> {
2> module Calc where
3> import Char
4> }
5
6First thing to declare is the name of your parser,
7and the type of the tokens the parser reads.
8
9> %name calc
10> %tokentype { Token }
11
12The parser will be of type [Token] -> ?, where ? is determined by the
13production rules.  Now we declare all the possible tokens:
14
15> %token
16>	let		{ TokenLet }
17>	in		{ TokenIn }
18>	int		{ TokenInt $$ }
19>	var		{ TokenVar $$ }
20>	'='		{ TokenEq }
21>	'+'		{ TokenPlus }
22>	'-'		{ TokenMinus }
23>	'*'		{ TokenTimes }
24>	'/'		{ TokenDiv }
25>	'('		{ TokenOB }
26>	')'		{ TokenCB }
27
28The left hand side are the names of the terminals or tokens,
29and the right hand side is how to pattern match them.
30
31Like yacc, we include %% here, for no real reason.
32
33> %%
34
35Now we have the production rules.
36
37> Exp :: { Exp }
38> Exp : let var '=' Exp in Exp	{ Let $2 $4 $6 }
39>     | Exp1			{ Exp1 $1 }
40>
41> Exp1 : Exp1 '+' Term		{ Plus $1 $3 }
42>      | Exp1 '-' Term		{ Minus $1 $3 }
43>      | Term			{ Term $1 }
44>
45> Term : Term '*' Factor	{ Times $1 $3 }
46>      | Term '/' Factor	{ Div $1 $3 }
47>      | Factor			{ Factor $1 }
48>
49> Factor : int			{ Int $1 }
50> 	 | var			{ Var $1 }
51> 	 | '(' Exp ')'		{ Brack $2 }
52
53We are simply returning the parsed data structure !
54Now we need some extra code, to support this parser,
55and make in complete:
56
57> {
58
59All parsers must declare this function,
60which is called when an error is detected.
61Note that currently we do no error recovery.
62
63> happyError :: [Token] -> a
64> happyError _ = error ("Parse error\n")
65
66Now we declare the datastructure that we are parsing.
67
68> data Exp  = Let String Exp Exp | Exp1 Exp1
69> data Exp1 = Plus Exp1 Term | Minus Exp1 Term | Term Term
70> data Term = Times Term Factor | Div Term Factor | Factor Factor
71> data Factor = Int Int | Var String | Brack Exp
72
73The datastructure for the tokens...
74
75> data Token
76>	= TokenLet
77>	| TokenIn
78>	| TokenInt Int
79>	| TokenVar String
80>	| TokenEq
81>	| TokenPlus
82>	| TokenMinus
83>	| TokenTimes
84>	| TokenDiv
85>	| TokenOB
86>	| TokenCB
87
88.. and a simple lexer that returns this datastructure.
89
90> lexer :: String -> [Token]
91> lexer [] = []
92> lexer (c:cs)
93>	| isSpace c = lexer cs
94> 	| isAlpha c = lexVar (c:cs)
95>	| isDigit c = lexNum (c:cs)
96> lexer ('=':cs) = TokenEq : lexer cs
97> lexer ('+':cs) = TokenPlus : lexer cs
98> lexer ('-':cs) = TokenMinus : lexer cs
99> lexer ('*':cs) = TokenTimes : lexer cs
100> lexer ('/':cs) = TokenDiv : lexer cs
101> lexer ('(':cs) = TokenOB : lexer cs
102> lexer (')':cs) = TokenCB : lexer cs
103
104> lexNum cs = TokenInt (read num) : lexer rest
105>	where (num,rest) = span isDigit cs
106
107> lexVar cs =
108>    case span isAlpha cs of
109>	("let",rest) -> TokenLet : lexer rest
110>	("in",rest)  -> TokenIn : lexer rest
111>	(var,rest)   -> TokenVar var : lexer rest
112
113To run the program, call this in gofer, or use some code
114to print it.
115
116 runCalc :: String -> Exp
117 runCalc = calc . lexer
118
119Here we test our parser.
120
121 main = case runCalc "1 + 2 + 3" of {
122	(Exp1 (Plus (Plus (Term (Factor (Int 1))) (Factor (Int 2))) (Factor (Int 3))))  ->
123 	case runCalc "1 * 2 + 3" of {
124	(Exp1 (Plus (Term (Times (Factor (Int 1)) (Int 2))) (Factor (Int 3)))) ->
125	case runCalc "1 + 2 * 3" of {
126	(Exp1 (Plus (Term (Factor (Int 1))) (Times (Factor (Int 2)) (Int 3)))) ->
127	case runCalc "let x = 2 in x * (x - 2)" of {
128	(Let "x" (Exp1 (Term (Factor (Int 2)))) (Exp1 (Term (Times (Factor (Var "x")) (Brack (Exp1 (Minus (Term (Factor (Var "x"))) (Factor (Int 2))))))))) -> print "AndysTest works\n" ;
129	_ -> quit } ; _ -> quit } ; _ -> quit } ; _ -> quit }
130 quit = print "runCalc failed\n"
131
132> }
133