summaryrefslogtreecommitdiff
path: root/base.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'base.lisp')
-rw-r--r--base.lisp49
1 files changed, 25 insertions, 24 deletions
diff --git a/base.lisp b/base.lisp
index 8206322..2a80086 100644
--- a/base.lisp
+++ b/base.lisp
@@ -15,37 +15,38 @@
(defun new (tree)
(lambda (input &key limit lazy)
- (declare (ignore lazy))
- (if (and limit (> limit 0))
- (make-failure :place input
- :message (format nil "Didn't reach expected limit: ~a." limit))
- (make-parsing :tree tree :left input))))
+ (declare (ignore limit lazy))
+ (make-parsing :tree tree :left input)))
-(defun bind (p f &key (greedy t))
+(defun bind (parser f &key (greedy t))
(lambda (input &key limit lazy)
(let (r)
(if greedy
- (setf r (funcall p input :limit limit))
+ (setf r (funcall parser input :limit limit))
(let ((next-parser (funcall f nil input))
- (limit -1))
+ (inner-limit -1))
(do ((sweep-input input (advance sweep-input)))
((or (not (has-data? sweep-input))
- (> limit -1)) nil)
+ (and limit (> (cursor-distance sweep-input input) limit))
+ (> inner-limit -1)) nil)
(when (lazy-parsing-p (funcall next-parser sweep-input :lazy t))
- (setf limit (cursor-distance sweep-input input))))
- (if (< limit 0)
+ (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 p input :limit limit)))))
- (if (parsing-p r)
- (if lazy
- (lambda (ignored-input &key lazy limit)
- (declare (ignore ignored-input limit))
- (funcall (funcall f (parsing-tree r) input)
- (parsing-left r)
- :lazy lazy
- :limit (if greedy (parsing-limit r))))
- (funcall (funcall f (parsing-tree r) input)
- (parsing-left r)
- :limit (if greedy (parsing-limit r))))
- r))))
+ (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)))))))