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
|
> module Parse where
The Parser monad in "Comprehending Monads"
> infixr 9 `thenP`
> infixr 9 `thenP_`
> infixr 9 `plusP`
> type P t a = [t] -> [(a,[t])]
> unitP :: a -> P t a
> unitP a = \i -> [(a,i)]
> thenP :: P t a -> (a -> P t b) -> P t b
> m `thenP` k = \i0 -> [(b,i2) | (a,i1) <- m i0, (b,i2) <- k a i1]
> thenP_ :: P t a -> P t b -> P t b
> m `thenP_` k = \i0 -> [(b,i2) | (a,i1) <- m i0, (b,i2) <- k i1]
zeroP is the parser that always fails to parse its input
> zeroP :: P t a
> zeroP = \i -> []
plusP combines two parsers in parallel
(called "alt" in "Comprehending Monads")
> plusP :: P t a -> P t a -> P t a
> a1 `plusP` a2 = \i -> (a1 i) ++ (a2 i)
itemP is the parser that parses a single token
(called "next" in "Comprehending Monads")
> itemP :: P t t
> itemP = \i -> [(head i, tail i) | not (null i)]
force successful parse
> cutP :: P t a -> P t a
> cutP p = \u -> let l = p u in if null l then [] else [head l]
find all complete parses of a given string
> useP :: P t a -> [t] -> [a]
> useP m = \x -> [ a | (a,[]) <- m x ]
find first complete parse
> theP :: P t a -> [t] -> a
> theP m = head . (useP m)
Some standard parser definitions
mapP applies f to all current parse trees
> mapP :: (a -> b) -> P t a -> P t b
> f `mapP` m = m `thenP` (\a -> unitP (f a))
filter is the parser that parses a single token if it satisfies a
predicate and fails otherwise.
> filterP :: (a -> Bool) -> P t a -> P t a
> p `filterP` m = m `thenP` (\a -> (if p a then unitP a else zeroP))
lit recognises literals
> litP :: Eq t => t -> P t ()
> litP t = ((==t) `filterP` itemP) `thenP` (\c -> unitP () )
> showP :: (Text a) => P t a -> [t] -> String
> showP m xs = show (theP m xs)
Simon Peyton Jones adds some useful operations:
> zeroOrMoreP :: P t a -> P t [a]
> zeroOrMoreP p = oneOrMoreP p `plusP` unitP []
> oneOrMoreP :: P t a -> P t [a]
> oneOrMoreP p = seq p
> where seq p = p `thenP` (\a ->
> (seq p `thenP` (\as -> unitP (a:as)))
> `plusP`
> unitP [a] )
> oneOrMoreWithSepP :: P t a -> P t b -> P t [a]
> oneOrMoreWithSepP p1 p2 = seq1 p1 p2
> where seq1 p1 p2 = p1 `thenP` (\a -> seq2 p1 p2 a `plusP` unitP [a])
> seq2 p1 p2 a = p2 `thenP` (\_ ->
> seq1 p1 p2 `thenP` (\as -> unitP (a:as) ))
|
