Improve usability

5 files changed, 48 insertions, 35 deletions

diff --git a/base.lisp b/base.lisp
index fe28cd0..0599a3c 100644
--- a/base.lisp
+++ b/base.lisp
@@ -15,6 +15,13 @@
 (deftype parser ()
   `(function (cursor cursor) result))
 
+(defmacro lazy (parser &rest args)
+  (let ((start (gensym))
+        (input (gensym)))
+    `(the parser
+          (lambda (,start ,input)
+            (funcall (,parser ,@args) ,start ,input)))))
+
 (defun line-and-column (str index)
   (let ((line 1) (column 1))
     (dotimes (i index)
@@ -56,22 +63,22 @@
   (if (null bindings)
     `(new (progn ,@body))
     (let ((var (first (car bindings)))
-          (parser (second (car bindings)))
-          (unused (gensym)))
+          (parser (second (car bindings))))
       (cond ((symbolp var)
              (if (string= (symbol-name var) "_")
                `(bind ,parser
-                      (lambda (&rest ,unused)
-                        (declare (ignore ,unused))
-                        (comp ,(cdr bindings) ,@body)))
+                      (the (function (result) parser)
+                           (lambda (,var)
+                             (declare (ignore ,var))
+                             (comp ,(cdr bindings) ,@body))))
                `(bind ,parser
-                      (lambda (,var &rest ,unused)
-                        (let ((,var (parsing-tree ,var)))
-                          (declare (ignore ,unused))
-                          (comp ,(cdr bindings) ,@body))))))
+                      (the (function (result) parser)
+                           (lambda (,var)
+                             (let ((,var (parsing-tree ,var)))
+                               (comp ,(cdr bindings) ,@body)))))))
             ((and (listp var) (= (length var) 1) (symbolp (car var)))
              `(bind ,parser
-                    (lambda (,(first var) &rest ,unused)
-                      (declare (ignore ,unused))
-                      (comp ,(cdr bindings) ,@body))))
+                    (the (function (result) parser)
+                         (lambda (,(first var))
+                           (comp ,(cdr bindings) ,@body)))))
             (t (error "Binding must be either a symbol or a list of one symbol."))))))
diff --git a/core.lisp b/core.lisp
index 43dd234..9fef78f 100644
--- a/core.lisp
+++ b/core.lisp
@@ -25,19 +25,21 @@
            (setf predicate
                  (normalize 'it predicate))))
         (t (error (format nil "Invalid predicate: ~a." predicate))))
-  `(the parser
-        (lambda (start input)
-          (declare (ignore start))
-          (if (has-data? input)
-            (let ((it (peek input)))
-              (if ,predicate
-                (make-parsing :tree it
-                              :start input
-                              :end (advance input))
-                (make-failure :place input
-                              :message (format nil "Expected: ~a, Got: ~:c." ',predicate it))))
-            (make-failure :place input
-                          :message (format nil "Reached end of input. Expected: ~a." ',predicate))))))
+  (let ((start (gensym))
+        (input (gensym)))
+    `(the parser
+          (lambda (,start ,input)
+            (declare (ignore ,start))
+            (if (has-data? ,input)
+              (let ((it (peek ,input)))
+                (if ,predicate
+                  (make-parsing :tree it
+                                :start ,input
+                                :end (advance ,input))
+                  (make-failure :place ,input
+                                :message (format nil "Expected: ~a, Got: ~:c." ',predicate it))))
+              (make-failure :place ,input
+                            :message (format nil "Reached end of input. Expected: ~a." ',predicate)))))))
 
 (declaim (ftype (function (parser parser &rest parser) parser) one-of))
 (defun one-of (first-parser second-parser &rest other-parsers)
diff --git a/extra.lisp b/extra.lisp
index c0a6a8a..9805ca0 100644
--- a/extra.lisp
+++ b/extra.lisp
@@ -4,7 +4,7 @@
   (or (char= it #\Space)
       (not (graphic-char-p it))))
 
-(declaim (ftype (function (parser integer integer) parser) repeat))
+(declaim (ftype (function (parser integer &optional integer) parser) repeat))
 (defun repeat (p min &optional (max 0))
   (if (> min 0)
     (comp ((x p)
@@ -29,11 +29,11 @@
     `(comp ,(reverse binding-list)
        ,(cons 'list (reverse name-list)))))
 
-(declaim (ftype (function (parser parser parser) parser) within))
-(defun within (left p right)
+(declaim (ftype (function (parser parser &optional parser) parser) within))
+(defun within (left p &optional right)
   (comp ((_ left)
          (cell p)
-         (_ right))
+         (_ (or right left)))
     cell))
 
 (declaim (ftype (function (parser parser) parser) interlinked))
diff --git a/main.lisp b/main.lisp
index 3e6f255..683b70f 100644
--- a/main.lisp
+++ b/main.lisp
@@ -18,9 +18,12 @@
 
 (defmacro defparser (name args parser)
   (let ((message (format nil "In ~a:~&" name)))
-    (cond ((equal args :const)
-           `(defparameter ,name (append-on-failure ,parser ,message)))
-          ((listp args)
-           `(defun ,name ,args (append-on-failure ,parser ,message)))
-          (t (error
-               (format nil "Cannot define ~a: ~a is not :const or a list." name args))))))
+    (if (and (listp args) (every #'symbolp args))
+      (let (definition)
+        (when (= (length args) 0)
+          (push `(defparameter ,name (,name)) definition))
+        (push `(defun ,name (,@args) (append-on-failure ,parser ,message))
+              definition)
+        (push 'progn definition)
+        definition)
+      (error "Malformed argument list."))))
diff --git a/package.lisp b/package.lisp
index acdefef..80036ab 100644
--- a/package.lisp
+++ b/package.lisp
@@ -2,6 +2,7 @@
   (:use #:cl)
   (:export #:parse
            #:defparser
+           #:lazy
            #:parsing
            #:parsing-p
            #:parsing-tree