Big update

1 files changed, 38 insertions, 25 deletions

diff --git a/core.lisp b/core.lisp
index a9e9246..833eb41 100644
--- a/core.lisp
+++ b/core.lisp
@@ -3,6 +3,14 @@
 (defparameter nothing
   (new nil))
 
+(defun normalize (sym expression)
+  (nsubst-if sym
+             (lambda (x)
+               (and (symbolp x)
+                    (string-equal (symbol-name x)
+                                  (symbol-name sym))))
+             expression))
+
 (defmacro unit (&optional predicate)
   (cond ((null predicate)
          (setf predicate 't))
@@ -14,29 +22,31 @@
          (if (eq (car predicate) 'function)
            (setf predicate `(funcall ,predicate it))
            (setf predicate
-                 (symbol:normalize 'it predicate))))
+                 (normalize 'it predicate))))
         (t (error (format nil "Invalid predicate: ~a." predicate))))
-  `(lambda (input)
-     (if (cursed:has-data? input)
-       (let ((it (cursed:peek input)))
+  `(lambda (start input)
+     (declare (ignore start))
+     (if (has-data? input)
+       (let ((it (peek input)))
          (if ,predicate
            (make-parsing :tree it
                          :start input
-                         :end (cursed:advance 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)))))
 
 (defun one-of (first-parser second-parser &rest other-parsers)
-  (lambda (input)
+  (lambda (start input)
+    (declare (ignore start))
     (let ((parsers (cons first-parser (cons second-parser other-parsers)))
           (result (make-failure :place input)))
       (dolist (p parsers)
-        (let ((r (funcall p input)))
+        (let ((r (funcall p input input)))
           (cond ((parsing-p r)
                  (when (or (not (parsing-p result))
-                           (> (cursed:distance (parsing-end result)
+                           (> (distance (parsing-end result)
                                                (parsing-end r))
                               0))
                    (setf result r)))
@@ -46,7 +56,7 @@
                                           (failure-priority result))))
                      (when (or (> priority-cmp 0)
                                (and (= priority-cmp 0)
-                                    (>= (cursed:distance (failure-place result)
+                                    (>= (distance (failure-place result)
                                                          (failure-place r))
                                         0)))
                        (setf result r)))))
@@ -57,19 +67,22 @@
   (one-of p nothing))
 
 (defun many (p &key all)
-  (lambda (input)
-    (let* ((result '())
-           (input-left input)
-           (last-failure
-             (do ((r (funcall p input-left) (funcall p input-left))) ((failure-p r) r)
-               (when (parsing-p r)
-                 (setf input-left (parsing-end r))
-                 (when (parsing-tree r)
-                   (push (parsing-tree r) result))))))
-      (if (or (not result)
-              (and result all (cursed:has-data? (failure-place last-failure))))
-        (make-failure :place (failure-place last-failure)
-                      :message (failure-message last-failure))
-        (make-parsing :tree (reverse result)
-                      :start input
-                      :end input-left)))))
+  (lambda (start input)
+    (declare (ignore start))
+    (let* ((result '()))
+      (do ((r (funcall p input input)
+              (funcall p (parsing-end r) (parsing-end r))))
+        ((or (failure-p r)
+             (= (index (parsing-start r))
+                (index (parsing-end r))))
+         nil)
+        (push r result))
+      (cond ((not result)
+             (make-failure :place input
+                           :message "No matches."))
+            ((and all (has-data? (parsing-end (first result))))
+             (make-failure :place (parsing-end (first result))
+                           :message "Input not exausted."))
+            (t (make-parsing :tree (reverse (mapcar (lambda (x) (parsing-tree x)) result))
+                             :start input
+                             :end (parsing-end (first result))))))))