renamed >>= to >>bind and redefined >>=. added >>map, >>string

1 files changed, 42 insertions, 17 deletions

diff --git a/parzival.lisp b/parzival.lisp
index 302c829..e4d38e1 100644
--- a/parzival.lisp
+++ b/parzival.lisp
@@ -7,18 +7,6 @@
 ;;; e.g. >>foo returns a parser while >goo> is a parser
 
 
-(defmacro >>if ((var parser stream) then else)
-  (let ((ok? (gensym))
-        (stream2 (gensym)))
-    `(multiple-value-bind (,var ,ok? ,stream2) (funcall ,parser ,stream)
-       (if ,ok?
-           (funcall ,then ,stream2)
-           (funcall ,else ,stream2)))))
-
-(defmacro >>when (lambda-list form)
-  `(>>if ,lambda-list ,form >fail>))
-
-
 (defmacro >def> (name parser)
   `(progn
      (defvar ,name ,parser)
@@ -32,15 +20,39 @@
 
 (>def> >item> (lambda (stream) (values (read-char stream) t stream)))
 
+(defmacro >>if ((var parser stream) then else)
+  (let ((ok? (gensym))
+        (stream2 (gensym)))
+    `(multiple-value-bind (,var ,ok? ,stream2) (funcall ,parser ,stream)
+       (if ,ok?
+           (funcall ,then ,stream2)
+           (funcall ,else ,stream2)))))
+
+(defmacro >>when ((var parser stream) form)
+  `(>>if (,var ,parser ,stream) ,form >fail>))
 
-(defun >>= (p f)
+(defun >>bind (p f)
   (lambda (stream)
     (>>when (result p stream)
             (funcall f result))))
 
+(defun >>= (p f &rest fs)
+  (if fs
+      (apply #'>>= (cons (>>bind p f) fs))
+      (>>bind p f)))
+
+(defun >>and (p1 p2 &rest ps)
+  (if ps
+      (apply #'>>and (cons (>>bind p1 (lambda (ignore) p2)) ps))
+      (>>bind p1 (lambda (ignore) p2))))
+
+(defun >>map (f p)
+  (lambda (s)
+    (>>when (val p s) (>>result (funcall f val)))))
+
 ;; fails if p fails
 (defun >>cons (x p)
-  (>>= p (lambda (res) (>>result (cons x res)))))
+  (>>map (lambda (xs) (cons x xs)) p))
 
 
 ;; succeeds with (x) even if p fails, otherwise (cons x result-of-p)
@@ -51,10 +63,10 @@
           (>>result (cons x nil)))))
 
 (defun >>many (p)
-  (>>= p (lambda (x) (>>cons? x (>>many p)))))
+  (>>bind p (lambda (x) (>>cons? x (>>many p)))))
 
 (defun >>sat (pred)
-  (>>= >item>
+  (>>bind >item>
        (lambda (c) (if (funcall pred c)
                        (>>result c)
                        >fail>))))
@@ -62,6 +74,10 @@
 (defun >>char (c)
   (>>sat (lambda (x) (char-equal x c))))
 
+(defun >>string (str)
+  (>>map (lambda (ignore) str)
+         (apply #'>>and (loop for c across str collect (>>char c)))))
+
 (>def> >uppercase> (>>sat #'upper-case-p))
 (>def> >lowercase> (>>sat #'lower-case-p))
 (>def> >alphanum> (>>sat #'alphanumericp))
@@ -73,7 +89,7 @@
 
 (>def> >digit> (>>sat #'digit-p))
 
-(defun >>or (p1 p2)
+(defun >>plus (p1 p2)
   (lambda (stream)
     (let ((stream (replay-on stream)))
       (>>if (result p1 stream)
@@ -82,4 +98,13 @@
               (rewind s)
               (funcall p2 s))))))
 
+(defun >>or (p1 p2 &rest ps)
+  (if ps
+      (>>plus p1 (apply #'>>or (cons p2 ps)))
+      (>>plus p1 p2)))
+
+
+(>def> >space> (>>char #\Space))
+(>def> >spaces> (>>many >space>))
+(>def> >newline> (>>char #\Newline))