Fix lookahead input and introduce discarding bind

1 files changed, 13 insertions, 6 deletions

diff --git a/parser.lisp b/parser.lisp
index a1ef1a8..2da9975 100644
--- a/parser.lisp
+++ b/parser.lisp
@@ -29,6 +29,13 @@
         (funcall (funcall f (parsing-tree r)) (parsing-left r))
         r))))
 
+(defun discarding-bind (p q)
+  (lambda (input)
+    (let ((r (funcall p input)))
+      (if (parsing-p r)
+        (funcall q (parsing-left r))
+        r))))
+
 (defun fail (&optional (message "Unknown error."))
   (lambda (input)
     (make-critical-failure :place input :message message)))
@@ -53,12 +60,12 @@
           (make-normal-failure :place input :message "Predicate not satisfied.")))
       (make-normal-failure :place input :message "Reached end of input."))))
 
-(defun literal (predicate)
+(defun literal (str)
   (lambda (input)
-    (if (input::has-data? input (length predicate))
-      (let ((str (input::peek-n input (length predicate))))
-        (if (string= predicate str)
-          (make-parsing :tree str :left (input::advance input (length predicate)))
+    (if (input::has-data? input (length str))
+      (let ((c (input::peek-n input (length str))))
+        (if (string= str c)
+          (make-parsing :tree c :left (input::advance input (length c)))
           (make-normal-failure :place input :message "Predicate not satisfied.")))
       (make-normal-failure :place input :message "Reached end of input."))))
 
@@ -68,7 +75,7 @@
     (let ((v (first (car bindings)))
           (p (second (car bindings))))
       (if (eq v '_)
-        `(bind ,p (lambda () (comp ,(cdr bindings) ,@body)))
+        `(discarding-bind ,p (comp ,(cdr bindings) ,@body))
         `(bind ,p (lambda (,v) (comp ,(cdr bindings) ,@body)))))))
 
 (defparameter nothing