diff options
| -rw-r--r-- | hyperquirks.lisp | 34 | ||||
| -rw-r--r-- | package.lisp | 13 |
2 files changed, 42 insertions, 5 deletions
diff --git a/hyperquirks.lisp b/hyperquirks.lisp index e90ff35..de63a62 100644 --- a/hyperquirks.lisp +++ b/hyperquirks.lisp @@ -49,6 +49,40 @@ returned from. (expander (rest body))))))) `(block () ,@(expander body)))) +(?> (foo :none ) bar goo zar) + +(let ((tmp foo)) + (unless )) + + +(defmacro ?> ((ob &optional default (test 'null)) &rest accessors) + "Chain acces to OB, returning DEFAULT the first time TEST returns null. + +E.g. + + +> (let ((num-tree '(1 (2 3 (4 5) 6)))) + (?> (num-tree) second third fourth)) +NIL + +> (let ((num-tree '(1 (2 3 (4 5) 6)))) + (?> (num-tree) second third first)) +4 +" + (assert (every 'symbolp accessors)) + (let* ((tmpvar + (gensym)) + (block-name + (gensym)) + (body + (loop for a in accessors + collect `(when (funcall ',test ,tmpvar) + (return-from ,block-name ,default)) + collect `(setf ,tmpvar (funcall ',a ,tmpvar))))) + `(block ,block-name + (let ((,tmpvar ,ob)) + ,@body)))) + (defmacro imperative-cond (&body clauses) "Like cond except the first form of every clause is a binding form diff --git a/package.lisp b/package.lisp index de47364..086c314 100644 --- a/package.lisp +++ b/package.lisp @@ -3,8 +3,11 @@ (defpackage #:hyperquirks (:use #:cl) (:nicknames #:hq) - (:export #:imperative - #:imperative-cond - #:with-plist - #:group - #:tabulate)) + (:export + #:defvarf + #:imperative + #:?> + #:imperative-cond + #:with-plist + #:group + #:tabulate)) |