summaryrefslogtreecommitdiff
path: root/parser.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'parser.lisp')
-rw-r--r--parser.lisp51
1 files changed, 31 insertions, 20 deletions
diff --git a/parser.lisp b/parser.lisp
index 5495f74..6bb1cf5 100644
--- a/parser.lisp
+++ b/parser.lisp
@@ -28,40 +28,51 @@
(format stream "~a: ~a" (cursor (failure-place obj)) (failure-message obj)))))
(defun new (tree)
- (lambda (input &optional lazy)
- (declare (ignore lazy))
+ (lambda (input &key limit lazy)
+ (declare (ignore lazy limit))
(make-parsing :tree tree :left input)))
(defun bind-with-input (p f)
- (lambda (input &optional lazy)
+ (lambda (input &key limit lazy)
(let ((r (funcall p input)))
(if (parsing-p r)
(if lazy
- (lambda (ignored-input &optional lazy)
+ (lambda (ignored-input &key lazy limit)
(declare (ignore ignored-input))
- (funcall (funcall f (parsing-tree r) input) (parsing-left r) lazy))
+ (funcall (funcall f (parsing-tree r) input) (parsing-left r) :lazy lazy :limit limit))
(funcall (funcall f (parsing-tree r) input) (parsing-left r)))
r))))
-(defun bind (p f)
- (lambda (input &optional lazy)
- (let ((r (funcall p input)))
+(defun bind (p f &key (greedy t))
+ (lambda (input &key limit lazy)
+ (let (r)
+ (if greedy
+ (setf r (funcall p input))
+ (let ((next-parser (funcall f (make-parsing :tree nil :left input)))
+ (limit 0))
+ (do ((sweep-input input (advance sweep-input))) (limit nil)
+ (when (and (has-data? sweep-input)
+ (functionp (funcall next-parser sweep-input t)))
+ (setf limit (input-sub sweep-input input))))
+ (if (= 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 &optional lazy)
+ (lambda (ignored-input &key lazy limit)
(declare (ignore ignored-input))
- (funcall (funcall f (parsing-tree r)) (parsing-left r) lazy))
+ (funcall (funcall f (parsing-tree r)) (parsing-left r) :lazy lazy :limit limit))
(funcall (funcall f (parsing-tree r)) (parsing-left r)))
r))))
(defun discarding-bind (p f)
- (lambda (input &optional lazy)
+ (lambda (input &key limit lazy)
(let ((r (funcall p input)))
(if (parsing-p r)
(if lazy
- (lambda (ignored-input &optional lazy)
+ (lambda (ignored-input &key lazy limit)
(declare (ignore ignored-input))
- (funcall (funcall f) (parsing-left r) lazy))
+ (funcall (funcall f) (parsing-left r) :lazy lazy :limit limit))
(funcall (funcall f) (parsing-left r)))
r))))
@@ -79,13 +90,13 @@
(error "Binding must be either a symbol or a cons of symbols."))))))
(defun one-of (first-parser second-parser &rest other-parsers)
- (lambda (input &optional lazy)
- (declare (ignore lazy))
+ (lambda (input &key limit lazy)
+ (declare (ignore lazy limit))
(labels ((one-of-rec (parsers)
(let ((intermediate-parsers '())
(result nil))
(dolist (p parsers)
- (let ((r (funcall p input (> (length parsers) 1))))
+ (let ((r (funcall p input :lazy (> (length parsers) 1))))
(cond ((functionp r)
(push r intermediate-parsers))
((parsing-p r)
@@ -114,8 +125,8 @@
(lambda (x)
(and (symbolp x)
(string-equal (symbol-name x) "IT"))) predicate))))
- `(lambda (input &optional lazy)
- (declare (ignore lazy))
+ `(lambda (input &key limit lazy)
+ (declare (ignore lazy limit))
(if (has-data? input)
(let ((it (peek input)))
(if ,predicate
@@ -125,8 +136,8 @@
(make-failure :place input :message "Reached end of input."))))
(defun literal (target)
- (lambda (input &optional lazy)
- (declare (ignore lazy))
+ (lambda (input &key limit lazy)
+ (declare (ignore lazy limit))
(if (has-data? input)
(if (prefix? target input)
(make-parsing :tree target :left (advance input (length target)))