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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
|
#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PARSEQ.PLT
;; A Parser Combinator library.
;;
;; Bonzai Lab, LLC. All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; combinator.ss - higher level combinator for parsers...
;; yc 12/31/2009 - first version
;; yc 1/5/2010 - moved delimited, bracket, and alternate to token.ss
(require "depend.ss"
mzlib/defmacro
(for-syntax scheme/base
"depend.ss"
scheme/match
)
"primitive.ss"
"input.ss"
)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Parser COMBINATORS
;; bind
;; Parser a -> (a -> Parser b) -> Parser b
;; this is the function version of the monad - use this when you want to
;; create higher combinators dynamically...
(define (bind parser v->parser)
(lambda (in)
(let-values (((v in)
(parser in)))
((v->parser v) in))))
;; result
;; allows the transformation of the result of the parser...
(define (result parser transform)
(bind parser
(lambda (v)
(if (succeeded? v)
(return (transform v))
fail))))
(define (result* parser transform)
(bind parser
(lambda (v)
(if (and (succeeded? v) (list? v))
(return (apply transform v))
fail))))
;; seq
;; the macro-based monad for stringing multiple parsers together...
;; (seq parser) => parser
;; (seq v <- parser exp ...) => (bind paser (lambda (v) (if v (seq exp ...) fail))
(define-macro (seq . exps)
(define *in (gensym 'in)) ;; represents the input
(define *v (gensym 'v)) ;; represents the value
(define literal 'literal)
;; sequence body for creating a sequence combinator...
(define (body exps)
(match exps
((list exp)
`((,literal ,exp) ,*in))
((list-rest var '<- exp rest)
`(let-values (((,var ,*in)
((,literal ,exp) ,*in)))
(if (succeeded? ,var)
,(body rest)
(fail in))))
((list-rest exp rest)
(body `(,*v <- ,exp . ,rest)))
))
`(lambda (in)
(let ((,*in in))
,(body exps))))
;; sequence
;; a functional version of seq
(define (sequence parsers)
(lambda (IN)
(define (helper parsers in acc)
(if (null? parsers)
((return (reverse acc)) in)
(let-values (((v in)
((car parsers) in)))
(if (succeeded? v)
(helper (cdr parsers) in (cons v acc))
(fail IN)))))
(helper (map literal parsers) IN '())))
;; sequence*
(define (sequence* . parsers)
(sequence parsers))
;; #|
;; choice
;; (choice parser) => (bind parser (lambda (v) (if v (return v) fail))
;; (choice parser rest ...) => (bind parser (lambda (v) (if v (choice rest ...) fail)))
(define-macro (choice . exps)
(define *in (gensym 'in)) ;; represents the input
(define *v (gensym 'v)) ;; represents the value
(define (body exps)
(match exps
((list)
`(fail ,*in))
((list-rest exp rest)
`(let-values (((,*v ,*in)
((literal ,exp) ,*in)))
(if (succeeded? ,*v)
((return ,*v) ,*in)
,(body rest))))
))
`(lambda (,*in)
,(body exps)))
;;|#
;; one-of
;; a function version of choice
(define (one-of parsers)
(lambda (in)
(define (helper parsers)
(if (null? parsers)
(fail in)
(let-values (((v in)
((car parsers) in)))
(if (succeeded? v)
((return v) in)
(helper (cdr parsers))))))
(helper (map literal parsers))))
;; one-of*
(define (one-of* . parsers)
(one-of parsers))
;; all-of
(define (all-of parsers)
(lambda (in)
(define (helper parsers v)
(if (null? parsers)
((return v) in)
(let-values (((v IN)
((car parsers) in)))
(if (succeeded? v)
(helper (cdr parsers) v)
(fail in)))))
(helper (map literal parsers) (make-failed 0))))
;; all-of*
(define (all-of* . parsers)
(all-of parsers))
;; repeat
;; returns when # of occurence falls within the min and max range
;; default to [1,+inf]
(define (repeat parser (min 1) (max +inf.0))
(define (make parser)
(lambda (IN)
(define (helper prev-in acc count)
(let-values (((v in)
(parser prev-in)))
(if (succeeded? v)
(if (< count max)
(helper in (cons v acc) (add1 count))
((return (reverse acc)) prev-in))
(if (< count min)
(fail IN)
((return (reverse acc)) in)))))
(helper IN '() 0)))
(make (literal parser)))
;; zero-many
;; returns the matched values if zero or more matches
;; (this means that this parser will always match)
(define (zero-many parser)
(repeat parser 0))
;; one-many
;; matches if parser parses one or more times
(define (one-many parser)
(repeat parser))
;; zero-one
;; returns if the parser matches zero or one times
;; when the parser does not match, it defaults to fail, but you can pass in a
;; default value so it does not fail.
(define (zero-one parser default)
(lambda (in)
(let-values (((v in)
((literal parser) in)))
((return (if (succeeded? v) v default)) in))))
(provide bind
result
result*
seq
sequence
sequence*
choice
one-of
one-of*
all-of
all-of*
repeat
zero-many
one-many
zero-one
)
|
