Expand on alternative parsers and lookahead idea

3 files changed, 55 insertions, 13 deletions

diff --git a/input.lisp b/input.lisp
index 1900459..2cdfd84 100644
--- a/input.lisp
+++ b/input.lisp
@@ -18,11 +18,21 @@
           (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 8656c7c..45e8266 100644
--- a/package.lisp
+++ b/package.lisp
@@ -6,13 +6,15 @@
 (defpackage #:parser
   (:use #:cl)
   (:export #:run
-           #:new
-           #:bind
            #:fail
            #:either
            #:unit
+           #:not-unit
+           #:unit-if
+           #:literal
+           #:until-literal
            #:comp
            #:nothing
-           #:zero-or-one
-           #:zero-or-more
-           #:one-or-more))
+           #:optional
+           #:many
+           #:separated-list))
diff --git a/parser.lisp b/parser.lisp
index 989938b..a92355c 100644
--- a/parser.lisp
+++ b/parser.lisp
@@ -51,7 +51,25 @@
                            (funcall (car body) input))))
       (either-rec (cons first-parser (cons second-parser other-parsers))))))
 
-(defun unit (&optional (predicate #'characterp))
+(defun unit (predicate)
+  (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."))))
+
+(defun not-unit (predicate)
+  (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."))))
+
+(defun unit-if (&optional (predicate #'characterp))
   (lambda (input)
     (if (input::has-data? input)
       (let ((c (input::peek-1 input)))
@@ -60,15 +78,25 @@
           (make-normal-failure :place input :message "Predicate not satisfied.")))
       (make-normal-failure :place input :message "Reached end of input."))))
 
-(defun literal (str)
+(defun literal (predicate)
   (lambda (input)
-    (if (input::has-data? input (length str))
-      (let ((c (input::peek-n input (length str))))
-        (if (string= str c)
+    (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 until-literal (predicate)
+  (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))))))
+
 (defmacro comp (bindings &body body)
   (if (null bindings)
     `(new (progn ,@body))
@@ -89,11 +117,13 @@
          (xs (optional (many p))))
     (cons x xs)))
 
-(defun separated-list (p separator)
+(defun separated-list (p separator &key (include-separator nil))
   (comp ((v p)
-         (sep (optional (the-char separator)))
+         (sep (optional separator))
          (vn (if sep
                (either (separated-list p separator)
                        (fail "Value expected."))
                nothing)))
-    (cons v vn)))
+    (if include-separator
+      (cons v (cons sep vn))
+      (cons v vn))))