Unify bind operations

1 files changed, 26 insertions, 34 deletions

diff --git a/parser.lisp b/parser.lisp
index 6bb1cf5..32d9d50 100644
--- a/parser.lisp
+++ b/parser.lisp
@@ -32,61 +32,53 @@
     (declare (ignore lazy limit))
     (make-parsing :tree tree :left input)))
 
-(defun bind-with-input (p f)
-  (lambda (input &key limit lazy)
-    (let ((r (funcall p input)))
-      (if (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 limit))
-          (funcall (funcall f (parsing-tree r) input) (parsing-left r)))
-        r))))
-
+; (parser<a> (a -> parser<b>) -> b)
 (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))
+        (let ((next-parser (funcall f nil input))
+              (limit -1))
           (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."))
+          (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 &key lazy limit)
-            (declare (ignore ignored-input))
-            (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 &key limit lazy)
-    (let ((r (funcall p input)))
-      (if (parsing-p r)
-        (if lazy
-          (lambda (ignored-input &key lazy limit)
-            (declare (ignore ignored-input))
-            (funcall (funcall f) (parsing-left r) :lazy lazy :limit limit))
-          (funcall (funcall f) (parsing-left r)))
+          (lambda (ignored-input &key lazy inner-limit)
+            (declare (ignore ignored-input inner-limit))
+            (funcall (funcall f (parsing-tree r) input)
+                     (parsing-left r)
+                     :lazy lazy
+                     :limit (if limit (1- limit))))
+          (funcall (funcall f (parsing-tree r) input)
+                   (parsing-left r)
+                   :limit (if limit (1- limit))))
         r))))
 
 (defmacro comp (bindings &body body)
   (if (null bindings)
     `(new (progn ,@body))
     (let ((v (first (car bindings)))
-          (p (second (car bindings))))
+          (p (second (car bindings)))
+          (unused (gensym)))
       (if (symbolp v)
         (if (string= (symbol-name v) "_")
-          `(discarding-bind ,p (lambda () (comp ,(cdr bindings) ,@body)))
-          `(bind ,p (lambda (,v) (comp ,(cdr bindings) ,@body))))
+          `(bind ,p (lambda (&rest ,unused)
+                      (declare (ignore ,unused))
+                      (comp ,(cdr bindings) ,@body)))
+          `(bind ,p (lambda (,v &rest ,unused)
+                      (declare (ignore ,unused))
+                      (comp ,(cdr bindings) ,@body))))
         (if (and (consp v) (symbolp (car v)) (symbolp (cdr v)))
-          `(bind-with-input ,p (lambda (,(car v) ,(cdr v)) (comp ,(cdr bindings) ,@body)))
+          `(bind ,p (lambda (,(car v) ,(cdr v) &rest ,unused)
+                      (declare (ignore ,unused))
+                      (comp ,(cdr bindings) ,@body)))
           (error "Binding must be either a symbol or a cons of symbols."))))))
 
 (defun one-of (first-parser second-parser &rest other-parsers)