Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 494 lines (452 sloc) 22.457 kB
f5e912f @Ramarren Plurarize combinators in system/package name
authored
1 (in-package :parser-combinators)
540d1f9 @Ramarren Split parsers to their own file, eliminate comprehension attempt.
authored
2
a1bddb9 @Ramarren Change uses of MDO to NAMED-SEQ?/* as appropriate.
authored
3 (defun seq-list? (&rest parsers)
4 "Parser: Return a list of results of PARSERS."
5 (assert parsers)
6 (let ((parsers (map 'vector #'ensure-parser parsers)))
7 #'(lambda (inp)
8 (let ((continuation-stack (list (funcall (aref parsers 0) inp)))
9 (result-stack nil)
10 (continuation-count 1)
11 (result-count 0)
12 (l (length parsers)))
13 #'(lambda ()
14 (iter (while continuation-stack)
15 (until (= result-count l))
16 (let ((next-result (funcall (car continuation-stack))))
17 (cond ((null next-result)
18 (pop continuation-stack)
19 (decf continuation-count)
20 (pop result-stack)
21 (decf result-count))
22 ((= continuation-count l)
23 (incf result-count)
24 (push next-result result-stack))
25 (t
26 (incf result-count)
27 (push next-result result-stack)
28 (incf continuation-count)
29 (push (funcall (aref parsers result-count)
30 (suffix-of next-result))
31 continuation-stack))))
32 (finally
33 (return
34 (when result-stack
35 (let ((result
36 (make-instance 'parser-possibility
37 :tree (mapcar #'tree-of (reverse result-stack))
38 :suffix (suffix-of (car result-stack)))))
39 (decf result-count)
40 (pop result-stack)
41 result))))))))))
42
43 (defmacro %named-seq? (sequence-parser &rest parser-descriptions)
44 (assert (> (length parser-descriptions) 1))
45 (let ((name-vector (make-array (1- (length parser-descriptions)) :initial-element nil))
46 (parsers nil)
47 (result-form nil)
48 (gensym-list nil))
49 (iter (for description in parser-descriptions)
50 (for i from 0)
51 (cond ((= i (length name-vector))
52 (setf result-form description))
53 ((and (listp description)
54 (eql (car description) '<-))
55 (setf (aref name-vector i) (second description))
56 (push (third description) parsers))
57 (t
58 (push description parsers)
59 (let ((gensym (gensym)))
60 (push gensym gensym-list)
61 (setf (aref name-vector i) gensym)))))
62 (with-unique-names (inp continuation seq-parser result)
63 `(let ((,seq-parser (,sequence-parser ,@(nreverse parsers))))
64 #'(lambda (,inp)
65 (let ((,continuation (funcall ,seq-parser ,inp)))
66 #'(lambda ()
67 (when ,continuation
68 (let ((,result (funcall ,continuation)))
69 (if ,result
70 (destructuring-bind ,(map 'list #'identity name-vector)
71 (tree-of ,result)
72 ,@(when gensym-list
73 (list `(declare (ignore ,@gensym-list))))
74 (make-instance 'parser-possibility
75 :tree ,result-form
76 :suffix (suffix-of ,result)))
77 (setf ,continuation nil)))))))))))
78
79 (defmacro named-seq? (&rest parser-descriptions)
80 "Parser: This is similar to MDO, except that constructed parsers cannot depend on the results of
81 previous ones and the final form is not used as a parser, but is automatically used to construct the
82 result. All names bound using the (<- name parser) construct are only available in that final form.
83
84 This parser generator is useful when full generality of MDO is not necessary, as it is implemented
85 non-recursively and has better memory performance."
86 `(%named-seq? seq-list? ,@parser-descriptions))
87
2de71e5 @Ramarren Add cut-tag? parser modifier.
authored
88 (defparameter *cut-tag* nil)
89
1843cd9 @Ramarren Add tag? parser.
authored
90 (defun tag? (parser format-control &rest format-arguments)
2de71e5 @Ramarren Add cut-tag? parser modifier.
authored
91 "Parser modifier: add formatted string to tag stack for given parser."
92 (let ((tag (apply #'format nil format-control format-arguments)))
93 (with-parsers (parser)
94 #'(lambda (inp)
95 (if *cut-tag*
96 (let ((tag-stack *tag-stack*)
97 (continuation (funcall parser inp)))
98 #'(lambda ()
99 (let ((*tag-stack* tag-stack))
100 (funcall continuation))))
101 (let ((*tag-stack* (cons tag *tag-stack*)))
102 ;; bind *tag-stack* to mark any non-lazy parser results (usually first result will be
103 ;; evaluated strictly), save it and apply it to continuation
104 (let ((tag-stack *tag-stack*)
105 (continuation (funcall parser inp)))
106 #'(lambda ()
107 (let ((*tag-stack* tag-stack))
108 (funcall continuation))))))))))
109
110 (defun cut-tag? (parser format-control &rest format-arguments)
111 "Parser modifier: add formatted string to tag stack for given parser, suppressing all lower level
112 parsers."
1843cd9 @Ramarren Add tag? parser.
authored
113 (let ((tag (apply #'format nil format-control format-arguments)))
114 (with-parsers (parser)
115 #'(lambda (inp)
2de71e5 @Ramarren Add cut-tag? parser modifier.
authored
116 (let ((*cut-tag* t)
117 (*tag-stack* (cons tag *tag-stack*)))
a5157ec @Ramarren Make tag? parser work with lazy parses.
authored
118 ;; bind *tag-stack* to mark any non-lazy parser results (usually first result will be
119 ;; evaluated strictly), save it and apply it to continuation
120 (let ((tag-stack *tag-stack*)
121 (continuation (funcall parser inp)))
122 #'(lambda ()
2de71e5 @Ramarren Add cut-tag? parser modifier.
authored
123 (let ((*tag-stack* tag-stack)
124 (*cut-tag* t))
a5157ec @Ramarren Make tag? parser work with lazy parses.
authored
125 (funcall continuation)))))))))
1843cd9 @Ramarren Add tag? parser.
authored
126
780be6c @Ramarren Make context capture parser
authored
127 (def-cached-parser context?
128 "Parser: return current context without consuming any input"
129 (define-oneshot-result inp is-unread
f7fed2c @Ramarren Add test for context capture, export symbol, fix a mistake
authored
130 (make-instance 'parser-possibility :tree inp :suffix inp)))
780be6c @Ramarren Make context capture parser
authored
131
d58b456 @Ramarren Add (end?) and tests.
authored
132 (def-cached-parser end?
133 "Parser: matches end of input, returns t"
570c799 @Ramarren Tag end of input parser.
authored
134 (tag?
135 (define-oneshot-result inp is-unread
136 (update-front-context inp)
137 (when (end-context-p inp)
138 (make-instance 'parser-possibility :tree t :suffix inp)))
139 "end of input"))
d58b456 @Ramarren Add (end?) and tests.
authored
140
cf1eff4 @Ramarren Reimplement basic repetition parsers in terms of (between? ...)
authored
141 ;;; implement repetition parsers in terms of (between? ...)
28e2775 @Ramarren Add some more repetition parsers.
authored
142
7b4f8ec @Ramarren Implement non-recursive between?
authored
143 (defun between? (parser min max &optional (result-type 'list))
ae52aad @Ramarren Untabify and whitespace cleanup.
authored
144 "Parser: accept between min and max expressions accepted by parser"
7b4f8ec @Ramarren Implement non-recursive between?
authored
145 (assert (or (null min)
146 (null max)
147 (>= max min)))
791b0a7 @Ramarren Allow zero-width parsers.
authored
148 ;; min=zero or nil means accept zero width results
7b4f8ec @Ramarren Implement non-recursive between?
authored
149 (assert (or (null min)
791b0a7 @Ramarren Allow zero-width parsers.
authored
150 (zerop min)
7b4f8ec @Ramarren Implement non-recursive between?
authored
151 (plusp min)))
791b0a7 @Ramarren Allow zero-width parsers.
authored
152 ;; can't have 0-0 parser
7b4f8ec @Ramarren Implement non-recursive between?
authored
153 (assert (or (null max)
154 (plusp max)))
155 ;; gather results depth-first, longest first, ie. gather shorter on returning
a1c55d9 @Ramarren Make vectors and characters accepted as parsers.
authored
156 (with-parsers (parser)
157 #'(lambda (inp)
158 (let ((continuation-stack nil)
159 (result-stack nil)
160 (count 1)
161 (zero-width (or (null min)
162 (zerop min)))
163 (state :next-result))
164 (push (funcall parser inp) continuation-stack)
165 #'(lambda ()
166 (setf state :next-result)
167 (iter
168 ;; (print state)
169 ;; (print result-stack)
170 ;; (print zero-width)
171 ;; (print count)
172 (while (or continuation-stack
173 zero-width))
174 (ecase state
175 (:next-result
176 (let ((next-result (funcall (car continuation-stack))))
177 (cond ((null next-result)
178 (pop continuation-stack)
179 (decf count)
180 (setf state :check-count))
181 ((and max (= count max))
182 (push next-result result-stack)
183 (setf state :return))
184 (t
185 (incf count)
186 (when (and result-stack
187 (eq (suffix-of (car result-stack))
188 (suffix-of next-result)))
189 (error "Subparser in repetition parser didn't advance the input."))
190 (push next-result result-stack)
191 (push (funcall parser (suffix-of next-result)) continuation-stack)))))
192 (:check-count
193 (cond ((or (null continuation-stack)
194 (and (or (null min)
195 (>= count min))
196 (or (null max)
197 (<= count max))))
0e9a378 @Ramarren Check if subparser advanced the input
authored
198 (setf state :return))
a1c55d9 @Ramarren Make vectors and characters accepted as parsers.
authored
199 (t (pop result-stack)
200 (setf state :next-result))))
201 (:return
202 (return
203 (cond (result-stack
204 (let ((result
205 (make-instance 'parser-possibility
206 :tree (map result-type #'tree-of (reverse result-stack))
207 :suffix (suffix-of (car result-stack)))))
208 (pop result-stack)
209 result))
210 (zero-width
211 (setf zero-width nil)
212 (make-instance 'parser-possibility
d246c1d @Ramarren Replace coerce with map to guarantee consistency in between?. Fixes #5.
authored
213 ;; use map to gurantee the result type is handled the
214 ;; same way as in the case above
215 :tree (map result-type #'identity nil)
a1c55d9 @Ramarren Make vectors and characters accepted as parsers.
authored
216 :suffix inp))))))))))))
7b4f8ec @Ramarren Implement non-recursive between?
authored
217
cf1eff4 @Ramarren Reimplement basic repetition parsers in terms of (between? ...)
authored
218 (defun many? (parser)
219 "Parser: accept zero or more repetitions of expression accepted by parser"
220 (between? parser nil nil))
221
222 (defun many1? (parser)
223 "Parser: accept one or more of expression accepted by parser"
224 (between? parser 1 nil))
225
226 (defun times? (parser count)
227 "Parser: accept exactly count expressions accepted by parser"
228 (between? parser count count))
229
230 (defun atleast? (parser count)
231 "Parser: accept at least count expressions accepted by parser"
232 (between? parser count nil))
233
234 (defun atmost? (parser count)
235 "Parser: accept at most count expressions accepted by parser"
236 (between? parser nil count))
28e2775 @Ramarren Add some more repetition parsers.
authored
237
540d1f9 @Ramarren Split parsers to their own file, eliminate comprehension attempt.
authored
238 (defun sepby1? (parser-item parser-separator)
dde9ff6 @Ramarren Add docstrings.
authored
239 "Parser: accept at least one of parser-item separated by parser-separator"
d1852c2 @Ramarren Remove obviously redundant uses of WITH-PARSERS
authored
240 (named-seq? (<- x parser-item)
241 (<- xs (many? (mdo parser-separator (<- y parser-item) (result y))))
242 (cons x xs)))
540d1f9 @Ramarren Split parsers to their own file, eliminate comprehension attempt.
authored
243
244 (defun bracket? (parser-open parser-center parser-close)
dde9ff6 @Ramarren Add docstrings.
authored
245 "Parser: accept parser-center bracketed by parser-open and parser-close"
d1852c2 @Ramarren Remove obviously redundant uses of WITH-PARSERS
authored
246 (named-seq? parser-open (<- xs parser-center) parser-close xs))
540d1f9 @Ramarren Split parsers to their own file, eliminate comprehension attempt.
authored
247
248 (defun sepby? (parser-item parser-separator)
dde9ff6 @Ramarren Add docstrings.
authored
249 "Parser: accept zero or more of parser-item separated by parser-separator"
d1852c2 @Ramarren Remove obviously redundant uses of WITH-PARSERS
authored
250 (choice (sepby1? parser-item parser-separator) (result nil)))
fb73b89 @Ramarren Add question marks to parser combinators
authored
251
e1cb150 @Ramarren Reimplement chainl1?/chainr1? using between?, to avoid consuming stac…
authored
252 ;; since all intermediate results have to be kept anyway for backtracking, they might be just as
253 ;; well be kept not on the stack, so chainl/r1? can be implemented in terms of between? as well
254
255 (defun sepby1-cons? (p op)
256 "Parser: as sepby1, but returns a list of a result of p and pairs (op p). Mainly a component parser for chains"
a1c55d9 @Ramarren Make vectors and characters accepted as parsers.
authored
257 (with-parsers (p op)
a1bddb9 @Ramarren Change uses of MDO to NAMED-SEQ?/* as appropriate.
authored
258 (let ((between-parser (between? (named-seq? (<- op-result op)
259 (<- p-result p)
260 (cons op-result p-result))
a1c55d9 @Ramarren Make vectors and characters accepted as parsers.
authored
261 1 nil)))
262 #'(lambda (inp)
263 (let ((front-continuation (funcall p inp))
264 (between-continuation nil)
265 (front nil)
266 (chain nil)
267 (state :next-result))
268 #'(lambda ()
269 (setf state :next-result)
270 (iter
271 (ecase state
272 (:next-result
273 (cond (between-continuation
274 (if-let (next-chain (funcall between-continuation))
275 (setf chain next-chain
276 state :return)
277 (setf between-continuation nil
278 chain nil
279 state :return)))
280 (front-continuation
281 (if-let (next-front (funcall front-continuation))
282 (setf front next-front
283 between-continuation (funcall between-parser (suffix-of next-front)))
284 (setf front-continuation nil)))
285 (t (setf state :return))))
286 (:return
287 (return (cond
288 (chain (make-instance 'parser-possibility
289 :suffix (suffix-of chain)
290 :tree (cons (tree-of front) (tree-of chain))))
291 (front (prog1 (make-instance 'parser-possibility
292 :tree (list (tree-of front))
293 :suffix (suffix-of front))
294 (setf front nil))))))))))))))
e1cb150 @Ramarren Reimplement chainl1?/chainr1? using between?, to avoid consuming stac…
authored
295
fb73b89 @Ramarren Add question marks to parser combinators
authored
296 (defun chainl1? (p op)
dde9ff6 @Ramarren Add docstrings.
authored
297 "Parser: accept one or more p reduced by result of op with left associativity"
a1c55d9 @Ramarren Make vectors and characters accepted as parsers.
authored
298 (with-parsers (p op)
299 (let ((subparser (sepby1-cons? p op)))
a1bddb9 @Ramarren Change uses of MDO to NAMED-SEQ?/* as appropriate.
authored
300 (named-seq? (<- chain subparser)
301 (destructuring-bind (front . chain) chain
302 (iter (for left initially front
303 then (funcall op
304 left
305 right))
306 (for (op . right) in chain)
307 (finally (return left))))))))
fb73b89 @Ramarren Add question marks to parser combinators
authored
308
309 (defun chainr1? (p op)
dde9ff6 @Ramarren Add docstrings.
authored
310 "Parser: accept one or more p reduced by result of op with right associativity"
a1c55d9 @Ramarren Make vectors and characters accepted as parsers.
authored
311 (with-parsers (p op)
312 (let ((subparser (sepby1-cons? p op)))
a1bddb9 @Ramarren Change uses of MDO to NAMED-SEQ?/* as appropriate.
authored
313 (named-seq? (<- chain subparser)
314 (destructuring-bind (front . chain) chain
315 (iter (with chain = (reverse chain))
316 (with current-op = (car (car chain)))
317 (with current-right = (cdr (car chain)))
318 (for (op . right) in (cdr chain))
319 (setf current-right (funcall current-op right current-right)
320 current-op op)
321 (finally (return (funcall op front current-right)))))))))
fb73b89 @Ramarren Add question marks to parser combinators
authored
322
323 (defun chainl? (p op v)
dde9ff6 @Ramarren Add docstrings.
authored
324 "Parser: like chainl1?, but will return v if no p can be parsed"
d1852c2 @Ramarren Remove obviously redundant uses of WITH-PARSERS
authored
325 (choice
326 (chainl1? p op)
327 (result v)))
fb73b89 @Ramarren Add question marks to parser combinators
authored
328
329 (defun chainr? (p op v)
dde9ff6 @Ramarren Add docstrings.
authored
330 "Parser: like chainr1?, but will return v if no p can be parsed"
d1852c2 @Ramarren Remove obviously redundant uses of WITH-PARSERS
authored
331 (choice
332 (chainr1? p op)
333 (result v)))
72f1b52 @Ramarren Fix find-after?/*
authored
334
99ad3ea @Ramarren Add breadth first possibility search for find-after.
authored
335 (defclass result-node (parser-possibility)
336 ((emit :initarg :emit :initform t :accessor emit-of)
337 (up :initarg :up :initform nil :accessor up-of)
338 (count :initarg :count :initform 0 :accessor count-of)
339 (suffix-continuation :initarg :suffix-continuation :accessor suffix-continuation-of)))
340
341 (defun gather-nodes (node)
342 (let ((nodes))
343 (iter (for current-node initially node then (up-of current-node))
344 (while current-node)
345 (when (emit-of current-node)
346 (push current-node nodes))
347 (finally (return nodes)))))
348
349 (defun breadth? (parser min max &optional (result-type 'list))
350 "Parser: like between? but breadth first (shortest matches first)"
a1c55d9 @Ramarren Make vectors and characters accepted as parsers.
authored
351 (with-parsers (parser)
352 #'(lambda (inp)
353 (let ((queue (make-queue (list
354 (make-instance 'result-node
355 :suffix inp
356 :suffix-continuation (funcall parser inp)
357 :tree nil
358 :emit nil
359 :up nil))))
360 (node nil))
361 #'(lambda ()
362 (iter
363 (until (empty-p queue))
364 (setf node (pop-front queue))
365 (for count = (count-of node))
366 (iter (for result next (funcall (suffix-continuation-of node)))
367 (while result)
368 (for suffix = (suffix-of result))
369 (unless (and max
370 (= count max))
371 (push-back queue (make-instance 'result-node
372 :suffix suffix
373 :suffix-continuation (funcall parser suffix)
374 :up node
375 :count (1+ count)
376 :tree (tree-of result)))))
8255c2d @Ramarren Emit empty match from breadth? when min is nil.
authored
377 (when (or (null min)
378 (>= count min))
a1c55d9 @Ramarren Make vectors and characters accepted as parsers.
authored
379 (return (make-instance 'parser-possibility
380 :tree (map result-type #'tree-of (gather-nodes node))
381 :suffix (suffix-of node))))))))))
99ad3ea @Ramarren Add breadth first possibility search for find-after.
authored
382
72f1b52 @Ramarren Fix find-after?/*
authored
383 (defun find-after? (p q)
fa0b790 @Ramarren Clarify docstrings for find?, find-after? and find-after-collect?.
authored
384 "Parser: Find q after some sequence of p, earliest matches first."
d1852c2 @Ramarren Remove obviously redundant uses of WITH-PARSERS
authored
385 (named-seq? (breadth? p nil nil nil)
386 (<- result q)
387 result))
72f1b52 @Ramarren Fix find-after?/*
authored
388
0c6c8f7 @Ramarren Add (find-before? ...) parser.
authored
389 (defun find-before? (p q &optional (result-type 'list))
390 "Parser: Find a sequence of p terminated by q, doesn't consume q."
391 (with-parsers (p q)
392 #'(lambda (inp)
393 (let ((p-parse-continuation (funcall (breadth? p nil nil result-type) inp)))
394 #'(lambda ()
395 (let ((result nil))
396 (iter (until (or result
397 (null p-parse-continuation)))
398 (for p-result = (funcall p-parse-continuation))
399 (if p-result
400 (when (funcall (funcall q (suffix-of p-result)))
401 (setf result p-result))
402 (setf p-parse-continuation nil)))
403 result))))))
404
025c025 @Ramarren Add first-after-collect?/*, make non-backtracking version find q as s…
authored
405 (defun find-after-collect? (p q &optional (result-type 'list))
a1bddb9 @Ramarren Change uses of MDO to NAMED-SEQ?/* as appropriate.
authored
406 "Parser: Find q after some sequence of p, earliest match first. Return cons of list of p-results and q"
d1852c2 @Ramarren Remove obviously redundant uses of WITH-PARSERS
authored
407 (named-seq? (<- prefix (breadth? p nil nil result-type))
408 (<- q-result q)
409 (cons prefix q-result)))
025c025 @Ramarren Add first-after-collect?/*, make non-backtracking version find q as s…
authored
410
72f1b52 @Ramarren Fix find-after?/*
authored
411 (defun find? (q)
fa0b790 @Ramarren Clarify docstrings for find?, find-after? and find-after-collect?.
authored
412 "Parser: Find q, earliest match first."
d1852c2 @Ramarren Remove obviously redundant uses of WITH-PARSERS
authored
413 (find-after? (item) q))
3b37be8 @Ramarren Implement expression parser.
authored
414
7679c36 @Ramarren Add HOOK?
authored
415 (defun hook? (function p)
416 "Parser: apply function to result of p"
d1852c2 @Ramarren Remove obviously redundant uses of WITH-PARSERS
authored
417 (named-seq? (<- result p) (funcall function result)))
7679c36 @Ramarren Add HOOK?
authored
418
ae14062 @Ramarren Add CHOOK?
authored
419 (defun chook? (result p)
420 "Parser: return result if p matches"
d1852c2 @Ramarren Remove obviously redundant uses of WITH-PARSERS
authored
421 (named-seq? p result))
ae14062 @Ramarren Add CHOOK?
authored
422
66d56cc @deepfire Add CHOOKAHEAD?: return result if p matches, but do no advance
deepfire authored
423 (defun chookahead? (result p)
424 "Parser: return result if p matches, but do no advance"
425 (with-parsers (p)
426 (define-oneshot-result inp is-unread
427 (let ((p-result (funcall (funcall p inp))))
428 (when p-result
429 (make-instance 'parser-possibility :tree result :suffix inp))))))
1ad1e25 @Ramarren Added debugging utility parser/macro as proposed by Samium Gromoff in…
authored
430
ab99892 @Ramarren Add OPT?/*.
authored
431 (defun opt? (p)
432 "Parser: result of p or nil"
433 (choice p (result nil)))
434
1120d31 @Ramarren Add validate?
authored
435 (defun validate? (p validation-function &optional (pre-hook #'identity))
436 "Parser: call validation-function on result of (funcall pre-hook p), fail if it returns nil,
437 otherwhise return it as a result"
438 (mdo (<- p-result p)
439 (let ((hooked (funcall pre-hook p-result)))
440 (if (funcall validation-function hooked)
441 (result hooked)
442 (zero)))))
443
c12c799 @Ramarren Add except?.
authored
444 (defun except? (p q)
445 "Parser: match p unless q matches."
446 (let ((not-q-result (gensym)))
447 (with-parsers (p q)
448 (mdo (<- maybe-q-result (choice1 q (result not-q-result)))
449 (if (eql maybe-q-result not-q-result)
450 p
451 (zero))))))
452
989108c @Ramarren Add macro to name generated parser, so it can call itself, and rewrit…
authored
453 (defmacro named? (name &body body)
454 "Parser macro: give BODY a NAME, so it can refer to itself without causing generator recursion."
455 (with-unique-names (parser wrapped inp)
456 `(let ((,wrapped (zero)))
457 (let ((,name
458 #'(lambda (,inp)
459 (funcall ,wrapped ,inp))))
460 (let ((,parser
461 ,@body))
462 (setf ,wrapped ,parser)
463 ,parser)))))
464
465 (defun nested? (p &key (min nil) (max nil) (result-type 'list) (bracket-left #\() (bracket-right #\)))
466 "Parser: parse a sequence of p, like between?, but with p possibly nested in brackets."
467 (if (and bracket-left bracket-right)
468 (named? nested-parser
469 (between? (choice (bracket? bracket-left nested-parser bracket-right)
470 p)
471 min
472 max
473 result-type))
474 (between? p min max result-type)))
475
3b37be8 @Ramarren Implement expression parser.
authored
476 (defun expression? (term operators &optional (bracket-left nil) (bracket-right nil))
477 "Parser: Reduce a sequence of terms with unary/binary operators with precedence.
478 OPERATORS is a list of (op-parser :left/:right/:unary), where OP-PARSER is a parser consuming
479 an operator and returning a reduction function. Highest precedence first."
a1c55d9 @Ramarren Make vectors and characters accepted as parsers.
authored
480 (with-parsers (term bracket-left bracket-right)
8dfc8fd @Ramarren Use named? in expression?/*
authored
481 (named? expr-parser
482 (iter (for (op assoc) in operators)
483 (for base initially (choice (bracket? bracket-left expr-parser bracket-right)
484 term)
485 then (ecase assoc
486 (:left (chainl1? base op))
487 (:right (chainr1? base op))
488 (:unary (choice
489 (named-seq? (<- op-fun op)
490 (<- subexpr base)
491 (funcall op-fun subexpr))
492 base))))
493 (finally (return base))))))
Something went wrong with that request. Please try again.