Make many into an iterative parser

5 files changed, 81 insertions, 71 deletions

diff --git a/core.lisp b/core.lisp
index 6e4bf6e..ac06a1f 100644
--- a/core.lisp
+++ b/core.lisp
@@ -30,37 +30,28 @@
        (make-failure :place input
                      :message (format nil "Reached end of input. Expected: ~a." ',predicate)))))
 
-(defparameter end
+(defun one-of (first-parser second-parser &rest other-parsers)
   (lambda (input)
-    (if (has-data? input)
-      (make-failure :place input :message "Didn't reach end of input.")
-      (make-parsing :tree nil :left input))))
-
-(defun select-parser (input parsers)
-  (let ((result (make-failure :place input)))
-    (dolist (p parsers)
-      (let ((r (funcall p input)))
-        (cond ((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 (failure-p result)
-                 (let ((priority-cmp (- (failure-priority r)
-                                        (failure-priority result))))
-                   (when (or (> priority-cmp 0)
-                             (and (= priority-cmp 0)
-                                  (>= (input-cursor (failure-place r))
-                                      (input-cursor (failure-place result)))))
-                     (setf result r)))))
-              (t (error (format nil "Invalid return value: ~a." r))))))
-    result))
-
-(defmacro one-of (first-parser second-parser &rest other-parsers)
-  `(lambda (input)
-     (select-parser input
-                    (list ,first-parser ,second-parser ,@other-parsers))))
+    (let ((parsers `(,first-parser ,second-parser ,@other-parsers))
+          (result (make-failure :place input)))
+      (dolist (p parsers)
+        (let ((r (funcall p input)))
+          (cond ((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 (failure-p result)
+                   (let ((priority-cmp (- (failure-priority r)
+                                          (failure-priority result))))
+                     (when (or (> priority-cmp 0)
+                               (and (= priority-cmp 0)
+                                    (>= (input-cursor (failure-place r))
+                                        (input-cursor (failure-place result)))))
+                       (setf result r)))))
+                (t (error (format nil "Invalid return value: ~a." r))))))
+      result)))
 
 ;;; TODO: Find a way to be able to use the input without needing to define a name for it.
 (defmacro comp (bindings &body body)
diff --git a/extra.lisp b/extra.lisp
index 20a13b1..11e32f8 100644
--- a/extra.lisp
+++ b/extra.lisp
@@ -1,5 +1,12 @@
 (in-package #:monparser)
 
+(defun whitespace? (x)
+  (or (char= x #\Space)
+      (not (graphic-char-p x))))
+
+(defparameter whitespace
+  (many (unit #'whitespace?)))
+
 (defmacro literal (word)
   (when (not (stringp word))
     (error "Literal only accepts strings as input."))
@@ -13,39 +20,13 @@
     `(comp ,(reverse binding-list)
        ,(cons 'list (reverse name-list)))))
 
-(defparameter nothing
-  (new nil))
-
-(defun optional (p)
-  (one-of p nothing))
-
-(defun many (p &key all)
-  (comp ((x p)
-         (xs (if all
-               (one-of end
-                       (many p :all all))
-               (optional (many p)))))
-    (if x (cons x xs) xs)))
-
-(defun repeat (p min &optional (max 0))
-  (if (> min 0)
-    (comp ((x p)
-           (xs (repeat p (1- min) (1- max))))
-      (cons x xs))
-    (if (> max 0)
-      (comp ((x (optional p))
-             (xs (repeat p 0 (if x (1- max) 0))))
-        (if x (cons x xs) x))
-      nothing)))
-
-(defun whitespace? (x)
-  (or (char= x #\Space)
-      (not (graphic-char-p x))))
-
 (defun separated-list (p separator)
-  (comp ((v p)
-         (sep (optional separator))
-         (vn (if sep
-               (separated-list p separator)
-               nothing)))
-    (cons v vn)))
+  (many 
+    (comp ((v p)
+           (_ (optional separator)))
+      v)))
+
+(defun surround (left p &optional right)
+  (comp ((_ left)
+         (value p)
+         (_ (or right nothing)))))
diff --git a/monparser.asd b/monparser.asd
index aa5bc2c..68165a9 100644
--- a/monparser.asd
+++ b/monparser.asd
@@ -5,5 +5,6 @@
    (:file "input")
    (:file "base")
    (:file "core")
+   (:file "quant")
    (:file "extra")
    (:file "main")))
diff --git a/package.lisp b/package.lisp
index e0a58e5..dca5908 100644
--- a/package.lisp
+++ b/package.lisp
@@ -5,15 +5,19 @@
            #:failure-p
            #:failure-place
            #:failure-message
-           #:comp
-           #:one-of
-           #:unit
+
            #:fail
-           #:end
-           #:literal
+           #:unit
+           #:one-of
+           #:comp
+
            #:nothing
            #:optional
            #:many
            #:repeat
+
+           #:literal
            #:whitespace?
-           #:separated-list))
+           #:whitespace
+           #:separated-list
+           #:surround))
diff --git a/quant.lisp b/quant.lisp
new file mode 100644
index 0000000..bdd0cfc
--- /dev/null
+++ b/quant.lisp
@@ -0,0 +1,33 @@
+(in-package #:monparser)
+
+(defparameter nothing
+  (new nil))
+
+(defun optional (p)
+  (one-of p nothing))
+
+(defun many (p &key all)
+  (lambda (input)
+    (let* ((result '())
+           (last-failure
+             (do ((r (funcall p input) (funcall p input))) ((failure-p r) r)
+               (when (parsing-p r)
+                 (setf input (parsing-left r))
+                 (when (parsing-tree r)
+                   (push (parsing-tree r) result))))))
+      (if (or (not result)
+              (and result all (has-data? (failure-place last-failure))))
+        (make-failure :place input :message (failure-message last-failure))
+        (make-parsing :tree (reverse result) :left input)))))
+
+; TODO: Need to be redone in a non-recursive way
+(defun repeat (p min &optional (max 0))
+  (if (> min 0)
+    (comp ((x p)
+           (xs (repeat p (1- min) (1- max))))
+      (cons x xs))
+    (if (> max 0)
+      (comp ((x (optional p))
+             (xs (repeat p 0 (if x (1- max) 0))))
+        (if x (cons x xs) x))
+      nothing)))