diff options
author | Boutade <thegoofist@protonmail.com> | 2019-04-23 22:41:33 -0500 |
---|---|---|
committer | Boutade <thegoofist@protonmail.com> | 2019-04-23 22:41:33 -0500 |
commit | c73d1a8a645c59e4589866d0ff9adec2d8666951 (patch) | |
tree | 4b9af274ba3263968d1832874b4c05a478628e60 /parzival.lisp | |
parent | 4e9d8e74b9e5f713a590ad9db33cec503e2e6bc4 (diff) |
renamed >>= to >>bind and redefined >>=. added >>map, >>string
Diffstat (limited to 'parzival.lisp')
-rw-r--r-- | parzival.lisp | 59 |
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)) |