Extract input to cursedHEADmain

1 files changed, 35 insertions, 38 deletions

diff --git a/core.lisp b/core.lisp
index ac06a1f..a9e9246 100644
--- a/core.lisp
+++ b/core.lisp
@@ -1,8 +1,7 @@
 (in-package #:monparser)
 
-(defun fail (message &key (priority 1))
-  (lambda (input)
-    (make-failure :place input :message message :priority priority)))
+(defparameter nothing
+  (new nil))
 
 (defmacro unit (&optional predicate)
   (cond ((null predicate)
@@ -15,16 +14,15 @@
          (if (eq (car predicate) 'function)
            (setf predicate `(funcall ,predicate it))
            (setf predicate
-                 (nsubst-if 'it
-                            (lambda (x)
-                              (and (symbolp x)
-                                   (string-equal (symbol-name x) "IT"))) predicate))))
+                 (symbol:normalize 'it predicate))))
         (t (error (format nil "Invalid predicate: ~a." predicate))))
   `(lambda (input)
-     (if (has-data? input)
-       (let ((it (peek input)))
+     (if (cursed:has-data? input)
+       (let ((it (cursed:peek input)))
          (if ,predicate
-           (make-parsing :tree it :left (advance input))
+           (make-parsing :tree it
+                         :start input
+                         :end (cursed:advance input))
            (make-failure :place input
                          :message (format nil "Expected: ~a, Got: ~:c." ',predicate it))))
        (make-failure :place input
@@ -32,14 +30,15 @@
 
 (defun one-of (first-parser second-parser &rest other-parsers)
   (lambda (input)
-    (let ((parsers `(,first-parser ,second-parser ,@other-parsers))
+    (let ((parsers (cons first-parser (cons 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))))
+                           (> (cursed:distance (parsing-end result)
+                                               (parsing-end r))
+                              0))
                    (setf result r)))
                 ((failure-p r)
                  (when (failure-p result)
@@ -47,32 +46,30 @@
                                           (failure-priority result))))
                      (when (or (> priority-cmp 0)
                                (and (= priority-cmp 0)
-                                    (>= (input-cursor (failure-place r))
-                                        (input-cursor (failure-place result)))))
+                                    (>= (cursed:distance (failure-place result)
+                                                         (failure-place r))
+                                        0)))
                        (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)
-  (if (null bindings)
-    `(new (progn ,@body))
-    (let ((var (first (car bindings)))
-          (parser (second (car bindings)))
-          (unused (gensym)))
-      (if (symbolp var)
-        (if (string= (symbol-name var) "_")
-          `(bind ,parser
-                 (lambda (&rest ,unused)
-                   (declare (ignore ,unused))
-                   (comp ,(cdr bindings) ,@body)))
-          `(bind ,parser
-                 (lambda (,var &rest ,unused)
-                   (declare (ignore ,unused))
-                   (comp ,(cdr bindings) ,@body))))
-        (if (and (consp var) (symbolp (car var)) (symbolp (cdr var)))
-          `(bind ,parser
-                 (lambda (,(car var) ,(cdr var) &rest ,unused)
-                   (declare (ignore ,unused))
-                   (comp ,(cdr bindings) ,@body)))
-          (error "Binding must be either a symbol or a cons of symbols."))))))
+(defun optional (p)
+  (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)))))