summaryrefslogtreecommitdiff
path: root/hyperquirks.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'hyperquirks.lisp')
-rw-r--r--hyperquirks.lisp28
1 files changed, 20 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))))