diff options
| -rw-r--r-- | hyperquirks.lisp | 28 | ||||
| -rw-r--r-- | package.lisp | 1 |
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 |