diff options
Diffstat (limited to 'parser.lisp')
-rw-r--r-- | parser.lisp | 51 |
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))) |