Implement bind sweep

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)))