1-----------------------------------------------------------------------------
2Tests %monad without %lexer.
3
4> {
5> import Char
6> }
7
8> %name calc
9> %tokentype { Token }
10
11> %monad { P } { thenP } { returnP }
12
13> %token
14>	let		{ TokenLet }
15>	in		{ TokenIn }
16>	int		{ TokenInt $$ }
17>	var		{ TokenVar $$ }
18>	'='		{ TokenEq }
19>	'+'		{ TokenPlus }
20>	'-'		{ TokenMinus }
21>	'*'		{ TokenTimes }
22>	'/'		{ TokenDiv }
23>	'('		{ TokenOB }
24>	')'		{ TokenCB }
25
26> %%
27
28> Exp :: {Exp}
29>     : let var '=' Exp in Exp	{ Let $2 $4 $6 }
30>     | Exp1			{ Exp1 $1 }
31>
32> Exp1 :: {Exp1}
33>      : Exp1 '+' Term		{ Plus $1 $3 }
34>      | Exp1 '-' Term		{ Minus $1 $3 }
35>      | Term			{ Term $1 }
36>
37> Term :: {Term}
38>      : Term '*' Factor	{ Times $1 $3 }
39>      | Term '/' Factor	{ Div $1 $3 }
40>      | Factor			{ Factor $1 }
41>
42
43> Factor :: {Factor}
44>        : int			{ Int $1 }
45> 	 | var			{ Var $1 }
46> 	 | '(' Exp ')'		{ Brack $2 }
47
48> {
49
50-----------------------------------------------------------------------------
51The monad serves two purposes:
52
53	* it passes the current line number around
54	* it deals with success/failure.
55
56> data ParseResult a
57>	= ParseOk a
58>	| ParseFail String
59
60> type P a = Int -> ParseResult a
61
62> thenP :: P a -> (a -> P b) -> P b
63> m `thenP` k = \l ->
64>	case m l of
65>		ParseFail s -> ParseFail s
66>		ParseOk a -> k a l
67
68> returnP :: a -> P a
69> returnP a = \l -> ParseOk a
70
71-----------------------------------------------------------------------------
72
73Now we declare the datastructure that we are parsing.
74
75> data Exp  = Let String Exp Exp | Exp1 Exp1
76> data Exp1 = Plus Exp1 Term | Minus Exp1 Term | Term Term
77> data Term = Times Term Factor | Div Term Factor | Factor Factor
78> data Factor = Int Int | Var String | Brack Exp
79
80The datastructure for the tokens...
81
82> data Token
83>	= TokenLet
84>	| TokenIn
85>	| TokenInt Int
86>	| TokenVar String
87>	| TokenEq
88>	| TokenPlus
89>	| TokenMinus
90>	| TokenTimes
91>	| TokenDiv
92>	| TokenOB
93>	| TokenCB
94>	| TokenEOF
95
96.. and a simple lexer that returns this datastructure.
97
98> lexer :: String -> [Token]
99> lexer [] = []
100> lexer (c:cs)
101>	| isSpace c = lexer cs
102> 	| isAlpha c = lexVar (c:cs)
103>	| isDigit c = lexNum (c:cs)
104> lexer ('=':cs) = TokenEq : lexer cs
105> lexer ('+':cs) = TokenPlus : lexer cs
106> lexer ('-':cs) = TokenMinus : lexer cs
107> lexer ('*':cs) = TokenTimes : lexer cs
108> lexer ('/':cs) = TokenDiv : lexer cs
109> lexer ('(':cs) = TokenOB : lexer cs
110> lexer (')':cs) = TokenCB : lexer cs
111
112> lexNum cs = TokenInt (read num) : lexer rest
113>	where (num,rest) = span isDigit cs
114
115> lexVar cs =
116>    case span isAlpha cs of
117>	("let",rest) -> TokenLet : lexer rest
118>	("in",rest)  -> TokenIn : lexer rest
119>	(var,rest)   -> TokenVar var : lexer rest
120
121> runCalc :: String -> Exp
122> runCalc s = case calc (lexer s) 1 of
123>		ParseOk e -> e
124>		ParseFail s -> error s
125
126> happyError = \tks i -> error (
127>	"Parse error in line " ++ show (i::Int) ++ "\n")
128
129-----------------------------------------------------------------------------
130
131Here we test our parser.
132
133> main = case runCalc "1 + 2 + 3" of {
134>	(Exp1 (Plus (Plus (Term (Factor (Int 1))) (Factor (Int 2))) (Factor (Int 3))))  ->
135> 	case runCalc "1 * 2 + 3" of {
136>	(Exp1 (Plus (Term (Times (Factor (Int 1)) (Int 2))) (Factor (Int 3)))) ->
137>	case runCalc "1 + 2 * 3" of {
138>	(Exp1 (Plus (Term (Factor (Int 1))) (Times (Factor (Int 2)) (Int 3)))) ->
139>	case runCalc "let x = 2 in x * (x - 2)" of {
140>	(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";
141>	_ -> quit } ; _ -> quit } ; _ -> quit } ; _ -> quit }
142> quit = print "Test failed\n"
143> }
144