aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorColin Okay <okay@toyful.space>2021-09-23 14:21:03 -0500
committerColin Okay <okay@toyful.space>2021-09-23 14:21:03 -0500
commitfac66522b7b05d2e520da18d187ab3128c2c1a9a (patch)
tree446d19f5f2b2c42d5e8bf088f3e0edf1a5662210
parentcc875b2c0a3d6c2fa078549a626568b53049f34b (diff)
just the reader macro
-rw-r--r--functions.lisp2
-rw-r--r--macros.lisp105
-rw-r--r--package.lisp9
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 #:$))