Turn bind and one-of into macros to avoid eagerly evaluating arguments

3 files changed, 43 insertions, 42 deletions

diff --git a/base.lisp b/base.lisp
index 61c47bc..bbfab80 100644
--- a/base.lisp
+++ b/base.lisp
@@ -13,18 +13,18 @@
     (declare (ignore lazy))
     (make-parsing :tree tree :left input)))
 
-(defun bind (parser f)
-  (lambda (input &key lazy)
-    (let ((r (funcall parser input)))
-      (cond ((parsing-p r)
-             (if lazy
-               (lambda (ignored-input &key lazy)
-                 (declare (ignore ignored-input))
-                 (funcall (funcall f (parsing-tree r) input)
-                          (parsing-left r)
-                          :lazy lazy))
-               (funcall (funcall f (parsing-tree r) input)
-                        (parsing-left r))))
-            ((failure-p r)
-             r)
-            (t (error (format nil "Invalid return value: ~a" r)))))))
+(defmacro bind (parser f)
+  `(lambda (input &key lazy)
+     (let ((r (funcall ,parser input)))
+       (cond ((parsing-p r)
+              (if lazy
+                (lambda (ignored-input &key lazy)
+                  (declare (ignore ignored-input))
+                  (funcall (funcall ,f (parsing-tree r) input)
+                           (parsing-left r)
+                           :lazy lazy))
+                (funcall (funcall ,f (parsing-tree r) input)
+                         (parsing-left r))))
+             ((failure-p r)
+              r)
+             (t (error (format nil "Invalid return value: ~a" r)))))))
diff --git a/core.lisp b/core.lisp
index 2870f7b..4ba3cd7 100644
--- a/core.lisp
+++ b/core.lisp
@@ -30,33 +30,33 @@
                          :message (format nil "Expected: ~a, Got: ~a" ',predicate it))))
        (make-failure :place input :message "Reached end of input."))))
 
-(defun one-of (first-parser second-parser &rest other-parsers)
-  (lambda (input &key lazy)
-    (declare (ignore lazy))
-    (labels ((one-of-rec (parsers)
-                         (let ((intermediate-parsers '())
-                               (result (make-failure :place input
-                                                     :message "Exhausted options.")))
-                           (dolist (p parsers)
-                             (let ((r (funcall p
-                                               input
-                                               :lazy (> (length parsers) 1))))
-                               (cond ((functionp r)
-                                      (push r intermediate-parsers))
-                                     ((parsing-p r)
-                                      (when (or (not (parsing-p result))
-                                                (> (input-cursor (parsing-left r))
-                                                   (input-cursor (parsing-left result))))
-                                        (setf result r)))
-                                     ((failure-p r)
-                                      (when (or (failure-p result)
-                                                (= (length parsers) 1))
-                                        (setf result r)))
-                                     (t (error (format nil "Invalid return value: ~a" r))))))
-                           (if intermediate-parsers
-                             (one-of-rec intermediate-parsers)
-                             result))))
-      (one-of-rec (cons first-parser (cons second-parser other-parsers))))))
+(defmacro one-of (first-parser second-parser &rest other-parsers)
+  `(lambda (input &key lazy)
+     (declare (ignore lazy))
+     (labels ((one-of-rec (parsers)
+                          (let ((intermediate-parsers '())
+                                (result (make-failure :place input
+                                                      :message "Exhausted options.")))
+                            (dolist (p parsers)
+                              (let ((r (funcall p
+                                                input
+                                                :lazy (> (length parsers) 1))))
+                                (cond ((functionp r)
+                                       (push r intermediate-parsers))
+                                      ((parsing-p r)
+                                       (when (or (not (parsing-p result))
+                                                 (> (input-cursor (parsing-left r))
+                                                    (input-cursor (parsing-left result))))
+                                         (setf result r)))
+                                      ((failure-p r)
+                                       (when (or (failure-p result)
+                                                 (= (length parsers) 1))
+                                         (setf result r)))
+                                      (t (error (format nil "Invalid return value: ~a" r))))))
+                            (if intermediate-parsers
+                              (one-of-rec intermediate-parsers)
+                              result))))
+       (one-of-rec (list ,first-parser ,second-parser ,@other-parsers)))))
 
 (defmacro comp (bindings &body body)
   (if (null bindings)
diff --git a/package.lisp b/package.lisp
index bd3f17b..cf3f1df 100644
--- a/package.lisp
+++ b/package.lisp
@@ -15,6 +15,7 @@
            #:optional
            #:many
            #:repeat
+           #:whitespace?
            #:whitespace
            #:separated-list
            #:surround))