First advances to lookahead implementation

1 files changed, 22 insertions, 4 deletions

diff --git a/parser.lisp b/parser.lisp
index 04d3f2b..a1ef1a8 100644
--- a/parser.lisp
+++ b/parser.lisp
@@ -33,7 +33,7 @@
   (lambda (input)
     (make-critical-failure :place input :message message)))
 
-(defun either (first-parser &rest other-parsers)
+(defun either (first-parser second-parser &rest other-parsers)
   (lambda (input)
     (labels ((either-rec (body)
                          (if (cdr body)
@@ -42,17 +42,26 @@
                                (either-rec (cdr body))
                                r))
                            (funcall (car body) input))))
-      (either-rec (cons first-parser other-parsers)))))
+      (either-rec (cons first-parser (cons second-parser other-parsers))))))
 
 (defun unit (&optional (predicate #'characterp))
   (lambda (input)
     (if (input::has-data? input)
-      (let ((c (input::element input)))
+      (let ((c (input::peek-1 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 ((str (input::peek-n input (length predicate))))
+        (if (string= predicate str)
+          (make-parsing :tree str :left (input::advance input (length predicate)))
+          (make-normal-failure :place input :message "Predicate not satisfied.")))
+      (make-normal-failure :place input :message "Reached end of input."))))
+
 (defmacro comp (bindings &body body)
   (if (null bindings)
     `(new (progn ,@body))
@@ -65,7 +74,7 @@
 (defparameter nothing
   (new nil))
 
-(defun zero-or-one (p)
+(defun optional (p)
   (either p nothing))
 
 (defun zero-or-more (p)
@@ -78,3 +87,12 @@
   (comp ((x p)
          (xs (zero-or-more p)))
     (cons x xs)))
+
+(defun separated-list (p separator)
+  (comp ((v p)
+         (sep (optional (the-char separator)))
+         (vn (if sep
+               (either (separated-list p separator)
+                       (fail "Value expected."))
+               nothing)))
+    (cons v vn)))