Modify: versatility improvements to >> macro

1 files changed, 29 insertions, 9 deletions

diff --git a/hyperquirks.lisp b/hyperquirks.lisp
index dd818a0..97cf3ec 100644
--- a/hyperquirks.lisp
+++ b/hyperquirks.lisp
@@ -110,6 +110,11 @@ returned from.
                        (expander (rest body)))))))
      `(block () ,@(expander body))))
 
+(eval-when (:compile-toplevel :load-toplevel :execute) 
+  (defun flatten (ls)
+    (if (atom ls) (list ls)
+        (mapcan #'flatten ls))))
+
 (defmacro >> ((&key (prefix "_")) initform &rest pipe-forms)
   "Pipe a value through a series of forms and function calls. 
 
@@ -117,7 +122,7 @@ For Example:
 
 (>> () 10 +1 write-to-string (format nil \"~a-wut\" _arg))
 
-expands into 
+expands into, roughly:
 
 (FORMAT NIL \"~a-wut?\" (FUNCALL 'WRITE-TO-STRING (FUNCALL '1+ 10)))
 
@@ -125,17 +130,23 @@ and evaluates to
 
 \"11-wut?\"
 
-In the above, _arg is a substitution variable. The macro uses
+In the above, _ARG is a substitution variable. The macro uses
 substitution variables to nest the accumlated expression into the form
 that contains the variable.
 
-PREFIX is a string or symbol that indicates the prefix to SUBSTITUTION
+PREFIX is a string or symbol that indicates the prefix to substitution
 variables.
 
 PIPE-FORMS, as in the example above, must be either (1) a symbol that
-names a function, or (2) a list one of whose members is a substitution
-variable."
+names a function, or (2) a tree containing exactly one substitution
+variable.
+
+The same substitution variable can appear more than once in a pipe
+form. When they do, the value of the previous form is passed into all
+instances is substituted in.
 
+However, two different substitution variables CANNOT APPEAR in a
+single pipe form."
   (let ((prefix
           (etypecase prefix
             (string prefix)
@@ -145,11 +156,20 @@ variable."
                     (string= prefix (symbol-name v) :end2 (length prefix))))
              (pipe-form-p (form)
                (or (symbolp form)
-                   (= 1 (count-if #'var-p form))))
+                   (let* ((vars
+                            (remove-if-not #'var-p (flatten form)))
+                          (vars-len
+                            (length vars)))
+                     ;; either a symbol 
+                     (and (<= 1 vars-len)
+                          ;; which all must be the same
+                          (loop :for x :in (rest vars) :always (eql x (first vars)))))))
              (folder (expansion form)
-               (etypecase form
-                 (cons  (substitute-if expansion #'var-p form))
-                 (symbol `(funcall ',form ,expansion)))))
+               (let ((tmp (gensym)))
+                 `(let ((,tmp ,expansion)) 
+                    ,(etypecase form
+                       (cons  (subst-if tmp #'var-p form))
+                       (symbol `(funcall ',form ,tmp)))))))
       (assert (every #'pipe-form-p pipe-forms)
               ()
               "Invalid pipe form: ~s"