From 1ee29b34f0b5132023a1684f4624312112184b57 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Thu, 23 Jun 2022 07:12:51 -0500 Subject: [add] >> chain operator; [modify] ?> to take functional accesors --- hyperquirks.lisp | 28 ++++++++++++++++++++-------- 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 -- cgit v1.2.3