Evaluate one-of parsers lazily

1 files changed, 40 insertions, 30 deletions

diff --git a/parser.lisp b/parser.lisp
index ca13598..2fe6f67 100644
--- a/parser.lisp
+++ b/parser.lisp
@@ -28,31 +28,41 @@
       (format stream "~a: ~a" (cursor (failure-place obj)) (failure-message obj)))))
 
 (defun new (tree)
-  (lambda (input)
+  (lambda (input &optional lazy)
+    (declare (ignore lazy))
     (make-parsing :tree tree :left input)))
 
 (defun bind-with-input (p f)
-  (lambda (input)
+  (lambda (input &optional lazy)
     (let ((r (funcall p input)))
       (if (parsing-p r)
-        (funcall (the function (funcall f (parsing-tree r) input))
-                 (parsing-left r))
+        (if lazy
+          (lambda (ignored-input &optional lazy)
+            (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)))
         r))))
 
 (defun bind (p f)
-  (lambda (input)
+  (lambda (input &optional lazy)
     (let ((r (funcall p input)))
       (if (parsing-p r)
-        (funcall (the function (funcall f (parsing-tree r)))
-                 (parsing-left r))
+        (if lazy
+          (lambda (ignored-input &optional lazy)
+            (declare (ignore ignored-input))
+            (funcall (funcall f (parsing-tree r)) (parsing-left r) lazy))
+          (funcall (funcall f (parsing-tree r)) (parsing-left r)))
         r))))
 
 (defun discarding-bind (p f)
-  (lambda (input)
+  (lambda (input &optional lazy)
     (let ((r (funcall p input)))
       (if (parsing-p r)
-        (funcall (the function (funcall f))
-                 (parsing-left r))
+        (if lazy
+          (lambda (ignored-input &optional lazy)
+            (declare (ignore ignored-input))
+            (funcall (funcall f) (parsing-left r) lazy))
+          (funcall (funcall f) (parsing-left r)))
         r))))
 
 (defmacro comp (bindings &body body)
@@ -70,25 +80,23 @@
           `(bind-with-input ,p (lambda (,(car v) ,(cdr v)) (comp ,(cdr bindings) ,@body)))
           (error "Binding name/(name,input) must be either a symbol or a cons of symbols."))))))
 
-(defun crit (p)
-  (lambda (input)
-    (let ((r (funcall p input)))
-      (if (parsing-p r)
-        r
-        (error (format nil "~a" r))))))
-
 (defun one-of (first-parser second-parser &rest other-parsers)
-  (lambda (input)
-    (labels ((one-of-rec (parsers failures)
-                         (if (car parsers)
-                           (let ((r (funcall (car parsers) input)))
-                             (cond ((failure-p r)
-                                    (one-of-rec (cdr parsers) (cons r failures)))
-                                   ((listp r)
-                                    (one-of-rec (cdr parsers) (append r failures)))
-                                   (t r)))
-                           failures)))
-      (one-of-rec (cons first-parser (cons second-parser other-parsers)) nil))))
+  (lambda (input &optional lazy)
+    (declare (ignore lazy))
+    (labels ((one-of-rec (parsers)
+                         (let ((intermediate-parsers '())
+                               (result (make-failure :place input
+                                                     :message "Exausted options.")))
+                           (dolist (p parsers)
+                             (let ((r (funcall p input (> (length parsers) 1))))
+                               (cond ((functionp r)
+                                      (push r intermediate-parsers))
+                                     ((parsing-p r)
+                                      (setf result r)))))
+                           (if intermediate-parsers
+                             (one-of-rec intermediate-parsers)
+                             result))))
+      (one-of-rec (cons first-parser (cons second-parser other-parsers))))))
 
 (defmacro unit (&optional predicate)
   (cond ((null predicate)
@@ -102,7 +110,8 @@
                             (lambda (x)
                               (and (symbolp x)
                                    (string-equal (symbol-name x) "IT"))) predicate))))
-  `(lambda (input)
+  `(lambda (input &optional lazy)
+     (declare (ignore lazy))
      (if (has-data? input)
        (let ((it (peek input)))
          (if ,predicate
@@ -112,7 +121,8 @@
        (make-failure :place input :message "Reached end of input."))))
 
 (defun literal (target)
-  (lambda (input)
+  (lambda (input &optional lazy)
+    (declare (ignore lazy))
     (if (has-data? input)
       (if (prefix? target input)
         (make-parsing :tree target :left (advance input (length target)))