Add negate operator and polish literals

1 files changed, 52 insertions, 45 deletions

diff --git a/parser.lisp b/parser.lisp
index a92355c..55ded57 100644
--- a/parser.lisp
+++ b/parser.lisp
@@ -36,81 +36,88 @@
         (funcall q (parsing-left r))
         r))))
 
+(defmacro comp (bindings &body body)
+  (if (null bindings)
+    `(new (progn ,@body))
+    (let ((v (first (car bindings)))
+          (p (second (car bindings))))
+      (if (string= (symbol-name v) "_")
+        `(discarding-bind ,p (comp ,(cdr bindings) ,@body))
+        `(bind ,p (lambda (,v) (comp ,(cdr bindings) ,@body)))))))
+
 (defun fail (&optional (message "Unknown error."))
   (lambda (input)
     (make-critical-failure :place input :message message)))
 
-(defun either (first-parser second-parser &rest other-parsers)
+(defun one-of (first-parser second-parser &rest other-parsers)
   (lambda (input)
-    (labels ((either-rec (body)
+    (labels ((one-of-rec (body)
                          (if (cdr body)
                            (let ((r (funcall (car body) input)))
                              (if (normal-failure-p r)
-                               (either-rec (cdr body))
+                               (one-of-rec (cdr body))
                                r))
                            (funcall (car body) input))))
-      (either-rec (cons first-parser (cons second-parser other-parsers))))))
+      (one-of-rec (cons first-parser (cons second-parser other-parsers))))))
 
-(defun unit (predicate)
+(defun all-of (first-parser second-parser &rest other-parsers)
   (lambda (input)
-    (if (input::has-data? input)
-      (let ((c (input::peek-1 input)))
-        (if (char= c predicate)
-          (make-parsing :tree c :left (input::advance input))
-          (make-normal-failure :place input :message "Predicate not satisfied.")))
-      (make-normal-failure :place input :message "Reached end of input."))))
+    (labels ((all-of-rec (body)
+                         (if (cdr body)
+                           (let ((r (funcall (car body) input)))
+                             (if (parsing-p r)
+                               (all-of-rec (cdr body))
+                               r))
+                           (funcall (car body) input))))
+      (all-of-rec (cons first-parser (cons second-parser other-parsers))))))
 
-(defun not-unit (predicate)
+(defun negate (p)
   (lambda (input)
-    (if (input::has-data? input)
-      (let ((c (input::peek-1 input)))
-        (if (char/= c predicate)
-          (make-parsing :tree c :left (input::advance input))
-          (make-normal-failure :place input :message "Predicate not satisfied.")))
-      (make-normal-failure :place input :message "Reached end of input."))))
+    (let ((r (funcall p input)))
+      (cond ((parsing-p r)
+             (make-normal-failure :place input :message "Negated parser result."))
+            ((normal-failure-p r)
+             (make-parsing :tree nil :left input))
+            (t r)))))
 
 (defun unit-if (&optional (predicate #'characterp))
   (lambda (input)
     (if (input::has-data? input)
-      (let ((c (input::peek-1 input)))
+      (let ((c (input::peek input)))
         (if (funcall predicate c)
           (make-parsing :tree c :left (input::advance input))
           (make-normal-failure :place input :message "Predicate not satisfied.")))
       (make-normal-failure :place input :message "Reached end of input."))))
 
-(defun literal (predicate)
-  (lambda (input)
-    (if (input::has-data? input (length predicate))
-      (let ((c (input::peek-n input (length predicate))))
-        (if (string= predicate c)
-          (make-parsing :tree c :left (input::advance input (length c)))
-          (make-normal-failure :place input :message "Predicate not satisfied.")))
-      (make-normal-failure :place input :message "Reached end of input."))))
+(defun unit (target)
+  (unit-if (lambda (x) (char= x target))))
+
+(defun not-unit (target)
+  (unit-if (lambda (x) (char/= x target))))
 
-(defun until-literal (predicate)
+(defun literal (target)
   (lambda (input)
-    (let ((c (search predicate (input::input-data input) :start2 (input::input-cursor input))))
-      (if c
-        (let ((window (- c (input::input-cursor input))))
-          (if (> window 0)
-            (make-parsing :tree (input::peek-n input window) :left (input::advance input window))
-            (make-failure :place input :message "Predicate not satisfied.")))
-        (make-parsing :tree (input::peek-rest input) :left (input::advance-to-end input))))))
+    (if (input::has-data? input (length target))
+      (if (input::prefix? target input)
+        (make-parsing :tree target :left (input::advance input (length target)))
+        (make-normal-failure :place input :message "Predicate not satisfied."))
+      (make-normal-failure :place input :message "Not enough data."))))
 
-(defmacro comp (bindings &body body)
-  (if (null bindings)
-    `(new (progn ,@body))
-    (let ((v (first (car bindings)))
-          (p (second (car bindings))))
-      (if (eq v '_)
-        `(discarding-bind ,p (comp ,(cdr bindings) ,@body))
-        `(bind ,p (lambda (,v) (comp ,(cdr bindings) ,@body)))))))
+(defun not-literal (target)
+  (lambda (input)
+    (if (input::has-data? input (length target))
+      (if (input::prefix? target input)
+        (make-normal-failure :place input :message "Predicate not satisfied.")
+        (make-parsing :tree (input::peek input) :left (input::advance input)))
+      (if (input::has-data? input)
+        (make-parsing :tree (input::peek input) :left (input::advance input))
+        (make-normal-failure :place input :message "Reached end of input.")))))
 
 (defparameter nothing
   (new nil))
 
 (defun optional (p)
-  (either p nothing))
+  (one-of p nothing))
 
 (defun many (p)
   (comp ((x p)
@@ -121,7 +128,7 @@
   (comp ((v p)
          (sep (optional separator))
          (vn (if sep
-               (either (separated-list p separator)
+               (one-of (separated-list p separator)
                        (fail "Value expected."))
                nothing)))
     (if include-separator