blob: a5d8b9d36d5cee7486de6b5dc8237a1eaef09eaa (
plain)
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
|
(in-package #:monparser)
(defstruct parsing
tree
left
limit)
(defstruct failure
place
message)
(defun lazy-parsing-p (r)
(or (functionp r)
(parsing-p r)))
(defun new (tree)
(lambda (input &key limit lazy)
(declare (ignore limit lazy))
(make-parsing :tree tree :left input)))
(defun bind (parser f &key (greedy t))
(lambda (input &key limit lazy)
(let (r)
(if greedy
(setf r (funcall parser input :limit limit))
(let ((next-parser (funcall f nil input))
(inner-limit -1))
(do ((sweep-input input (advance sweep-input)))
((or (if limit
(> (cursor-distance sweep-input input) limit)
(not (has-data? sweep-input)))
(> inner-limit -1))
nil)
(when (lazy-parsing-p (funcall next-parser sweep-input :lazy t))
(setf inner-limit (cursor-distance sweep-input input))
(when limit (decf limit inner-limit))))
(if (< inner-limit 0)
(setf r (make-failure :place input
:message "Reached end of input while sweeping."))
(setf r (funcall parser input :limit inner-limit)))))
(cond ((parsing-p r)
(if lazy
(lambda (ignored-input &key lazy limit)
(declare (ignore ignored-input))
(funcall (funcall f (parsing-tree r) input)
(parsing-left r)
:lazy lazy
:limit (if greedy (parsing-limit r) limit)))
(funcall (funcall f (parsing-tree r) input)
(parsing-left r)
:limit (if greedy (parsing-limit r) limit))))
((failure-p r)
r)
(t (error (format nil "Invalid return value: ~a" r)))))))
|
