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
|
{-
An ambiguous grammar.
frown --backtrack Ambiguous.g
Try
expr (lexer "a+b+c+d") :: [Expr]
-}
module Ambiguous
where
import Char
import Monad
data AddOp = Plus | Minus
deriving (Show)
data MulOp = Times | Divide
deriving (Show)
data Expr = Add Expr AddOp Expr
| Mul Expr MulOp Expr
| Id String
deriving (Show)
unparse (Id s) = s
unparse (Add e1 Plus e2) = "(" ++ unparse e1 ++ "+" ++ unparse e2 ++ ")"
unparse (Add e1 Minus e2) = "(" ++ unparse e1 ++ "-" ++ unparse e2 ++ ")"
unparse (Mul e1 Times e2) = "(" ++ unparse e1 ++ "*" ++ unparse e2 ++ ")"
unparse (Mul e1 Divide e2) = "(" ++ unparse e1 ++ "/" ++ unparse e2 ++ ")"
type Result = []
%{
Terminal = Ident {String}
| Addop {AddOp}
| Mulop {MulOp}
| LPar
| RPar;
expr {Expr};
expr {Add e1 op e2} : expr {e1}, Addop {op}, expr {e2};
{Mul e1 op e2} | expr {e1}, Mulop {op}, expr {e2};
{e} | LPar, expr {e}, RPar;
{Id s} | Ident {s};
}%
frown ts = fail "syntax error"
data Terminal = Ident String | Addop AddOp | Mulop MulOp | LPar | RPar
lexer :: String -> [Terminal]
lexer [] = []
lexer ('+' : cs) = Addop Plus : lexer cs
lexer ('-' : cs) = Addop Minus : lexer cs
lexer ('*' : cs) = Mulop Times : lexer cs
lexer ('/' : cs) = Mulop Divide : lexer cs
lexer ('(' : cs) = LPar : lexer cs
lexer (')' : cs) = RPar : lexer cs
lexer (c : cs)
| isAlpha c = let (n, cs') = span isAlphaNum cs
in Ident (c : n) : lexer cs'
| otherwise = lexer cs
|
