Add negate operator and polish literals

3 files changed, 62 insertions, 65 deletions

diff --git a/input.lisp b/input.lisp
index 2cdfd84..8b031fd 100644
--- a/input.lisp
+++ b/input.lisp
@@ -9,30 +9,18 @@
   (<= (+ window-size (input-cursor input))
       (length (input-data input))))
 
-(defun peek-1 (input)
+(defun prefix? (target input)
+  (string= target (input-data input) :start2 (input-cursor input) :end2 (+ (input-cursor input) (length target))))
+
+(defun peek (input)
   (char (input-data input)
         (input-cursor input)))
 
-(defun peek-n (input window-size)
-  (subseq (input-data input)
-          (input-cursor input)
-          (+ window-size (input-cursor input))))
-
-(defun peek-rest (input)
-  (subseq (input-data input)
-          (input-cursor input)
-          (length (input-data input))))
-
 (defun advance (input &optional (amount 1))
   (let ((new-input (copy-structure input)))
     (incf (input-cursor new-input) amount)
     new-input))
 
-(defun advance-to-end (input)
-  (let ((new-input (copy-structure input)))
-    (setf (input-cursor new-input) (length (input-data input)))
-    new-input))
-
 (declaim (ftype (function (simple-string) (values input &optional)) from-string))
 (defun from-string (str)
   (make-input :data str))
diff --git a/package.lisp b/package.lisp
index 45e8266..50ce3df 100644
--- a/package.lisp
+++ b/package.lisp
@@ -7,13 +7,15 @@
   (:use #:cl)
   (:export #:run
            #:fail
-           #:either
+           #:comp
+           #:one-of
+           #:all-of
+           #:negate
+           #:unit-if
            #:unit
            #:not-unit
-           #:unit-if
            #:literal
-           #:until-literal
-           #:comp
+           #:not-literal
            #:nothing
            #:optional
            #:many
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