diff options
author | Colin Okay <okay@toyful.space> | 2021-09-23 14:21:03 -0500 |
---|---|---|
committer | Colin Okay <okay@toyful.space> | 2021-09-23 14:21:03 -0500 |
commit | fac66522b7b05d2e520da18d187ab3128c2c1a9a (patch) | |
tree | 446d19f5f2b2c42d5e8bf088f3e0edf1a5662210 | |
parent | cc875b2c0a3d6c2fa078549a626568b53049f34b (diff) |
just the reader macro
-rw-r--r-- | functions.lisp | 2 | ||||
-rw-r--r-- | macros.lisp | 105 | ||||
-rw-r--r-- | package.lisp | 9 |
3 files changed, 4 insertions, 112 deletions
diff --git a/functions.lisp b/functions.lisp index 8296f87..aeccbb3 100644 --- a/functions.lisp +++ b/functions.lisp @@ -2,7 +2,7 @@ (in-package #:lambda-riffs) -(defun -> (arg &rest fns) +(defun threading> (arg &rest fns) (dolist (fn fns arg) (setf arg (funcall fn arg)))) diff --git a/macros.lisp b/macros.lisp index 9ac67f4..cad9e6e 100644 --- a/macros.lisp +++ b/macros.lisp @@ -27,8 +27,7 @@ (symbol-name form1))) (read stream)) (list '$ () form1))))) - - + (set-dispatch-macro-character #\# #\~ (lambda (stream subchar arg) @@ -123,107 +122,7 @@ surrounding form. `(lambda ,new-params ,expr))) -(defmacro conj (&rest preds) - "A composition macro. Short circuiting predicate conjunction." - (let ((block-label (gensym))) - `(let ((preds (list ,@preds))) - (lambda (arg) - (block ,block-label - (unless preds (return-from ,block-label t)) - (let (acc) - (dolist (p preds acc) - (setf acc (funcall p arg)) - (unless acc (return-from ,block-label nil))))))))) - - -(defmacro disj (&rest preds) - "A composition macro. Short circuiting predicate disjunction." - (let ((block-label (gensym))) - `(let ((preds (list ,@preds))) - (lambda (arg) - (block ,block-label - (unless preds (return-from ,block-label nil)) - (let (acc) - (dolist (p preds acc) - (setf acc (funcall p arg)) - (when acc (return-from ,block-label acc))))))))) - -(defmacro make-lazy (form) - "Wraps FORM in a thunk. Intended to be used with teh #~ and #! reader macros: - -(let ((computation #~(progn (print 'hey) 10))) - (cons #!computation #!computation)) - -HEY -(10 . 10) - -The first time the computation is forced, it is run, and HEY is -printed. But the next time only the return value is used. -" - (let ((run-p (gensym)) - (val (gensym))) - `(let ((,run-p nil) - (,val nil)) - (lambda () - (unless ,run-p - (setf ,val ,form) - (setf ,run-p t)) - ,val)))) - - - - - -(defmacro binding> ((&key (exit-when #'null) exit-value exit-function) init &rest functions) - "A threading macro. Some examples: - -(binding> () - \"hey dude what's the big idea\" ; starting state - #$(values (search \"the\" $s) $s) ; multiple-values are passed along as arguments - #$(subseq $2 $1)) : returns the result of the last form - -should return \"the big idea\" - -(binding> (:exit-value \"☹\") - \"hey dude what's the big idea?\" - #$(values (search \"NOOOOOOPE\" $s) $s) - #$(subseq $2 $1)) - -should return \"☹\" - -EXIT-WHEN should be a function, a predicate, that operates on the -first value returned from one of the forms. If EXIT-WHEN returns -non-NIL, then the form exits early. - -If EXIT-FUNCTION is non-NIL it is expected to be a function that -accepts a list, the list of values returned from the last function in -the chain. - -If EXIT-FUNCTION is NIL, then EXIT-VALUE is returned instead. - -e.g - -(binding> (:exit-when #'evenp - :exit-function #$(list* :failed $x)) - 33 - #$(+ 11 $x) - #$(- 5 $x)) - -will return (:FAILED 44) - -The default value of EXIT-WHEN is the predicate NULL. -" - (let ((vals (gensym)) - (fn (gensym)) - (block-label (gensym))) - `(let ((,vals (multiple-value-list ,init))) - (block ,block-label - (dolist (,fn (list ,@functions) (values-list ,vals)) - (setq ,vals (multiple-value-list (apply ,fn ,vals))) - (when (funcall ,exit-when (car ,vals)) - (return-from ,block-label - (if ,exit-function (funcall ,exit-function ,vals) - ,exit-value)))))))) + diff --git a/package.lisp b/package.lisp index 00cd296..6239056 100644 --- a/package.lisp +++ b/package.lisp @@ -2,11 +2,4 @@ (defpackage #:lambda-riffs (:use #:cl) - (:export #:$ - #:-> - #:monadic> - #:all> - #:some> - #:make-lazy - #:conj - #:disj)) + (:export #:$)) |