[add] ?> chaining macro

1 files changed, 34 insertions, 0 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