[add] ?> chaining macro

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))