[add] >> chain operator; [modify] ?> to take functional accesors

2 files changed, 21 insertions, 8 deletions

diff --git a/hyperquirks.lisp b/hyperquirks.lisp
index de63a62..bb99819 100644
--- a/hyperquirks.lisp
+++ b/hyperquirks.lisp
@@ -49,15 +49,25 @@ returned from.
                        (expander (rest body)))))))
      `(block () ,@(expander body))))
 
-(?> (foo :none ) bar goo zar)
-
-(let ((tmp foo))
-  (unless ))
+(defmacro >> ((ob) &rest accessors)
+  "Chain access to OB. "
+  (let* ((tmpvar
+           (gensym))
+         (block-name
+           (gensym))
+         (body
+           (loop for a in accessors
+                 when (symbolp a)
+                   collect `(setf ,tmpvar (funcall ',a ,tmpvar))
+                 else
+                   collect `(setf ,tmpvar (funcall ,a ,tmpvar)))))
+    `(block ,block-name
+         (let ((,tmpvar ,ob))
+           ,@body))))
 
 
 (defmacro ?> ((ob &optional default (test 'null)) &rest accessors)
-  "Chain acces to OB, returning DEFAULT the first time TEST returns null.
-
+  "Chain access to OB, returning DEFAULT the first time TEST returns null.
 E.g. 
 
 
@@ -69,7 +79,6 @@ NIL
     (?> (num-tree) second third first))
 4
 "
-  (assert (every 'symbolp accessors))
   (let* ((tmpvar
            (gensym))
          (block-name
@@ -78,7 +87,10 @@ NIL
            (loop for a in accessors
                  collect `(when (funcall ',test ,tmpvar)
                             (return-from ,block-name ,default))
-                 collect `(setf ,tmpvar (funcall ',a ,tmpvar)))))
+                 when (symbolp a)
+                   collect `(setf ,tmpvar (funcall ',a ,tmpvar))
+                 else
+                   collect `(setf ,tmpvar (funcall ,a ,tmpvar)))))
     `(block ,block-name
          (let ((,tmpvar ,ob))
            ,@body))))
diff --git a/package.lisp b/package.lisp
index 086c314..dff7a7e 100644
--- a/package.lisp
+++ b/package.lisp
@@ -7,6 +7,7 @@
    #:defvarf
    #:imperative
    #:?>
+   #:>>
    #:imperative-cond
    #:with-plist
    #:group