Added >> to hyperquirks

2 files changed, 51 insertions, 10 deletions

diff --git a/hyperquirks.lisp b/hyperquirks.lisp
index 5be4485..39166e6 100644
--- a/hyperquirks.lisp
+++ b/hyperquirks.lisp
@@ -110,16 +110,57 @@ returned from.
                        (expander (rest body)))))))
      `(block () ,@(expander body))))
 
+(>> ()
+    (foo _x)
+    (bar 1 2 _y)
+    (funcall _z 10 20))
 
-(defmacro $> (input-form &rest functions)
-  (loop :with sub = input-form
-        :for next-form :in piped-to-forms
-        :when (symbolp next-form)
-          :do (setf sub `(funcall ,next-form ,sub))
-        :when (consp next-form)
-          :do (setf sub `(,(first next-form) ,sub ,@(rest next-form)))
-        :finally (return sub )))
+(defmacro >> ((&key (prefix "_")) initform &rest pipe-forms)
+  "Pipe a value through a series of forms and function calls. 
 
+For Example:
+
+(>> () 10 +1 write-to-string (format nil \"~a-wut\" _arg))
+
+expands into 
+
+(FORMAT NIL \"~a-wut?\" (FUNCALL 'WRITE-TO-STRING (FUNCALL '1+ 10)))
+
+and evaluates to
+
+\"11-wut?\"
+
+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
+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."
+
+  (let ((prefix
+          (etypecase prefix
+            (string prefix)
+            (symbol (symbol-name prefix)))))
+    (labels ((var-p (v)
+               (and (symbolp v)
+                    (string= prefix (symbol-name v) :end2 (length prefix))))
+             (pipe-form-p (form)
+               (or (symbolp form)
+                   (= 1 (count-if #'var-p form))))
+             (folder (expansion form)
+               (etypecase form
+                 (cons  (substitute-if expansion #'var-p form))
+                 (symbol `(funcall ',form ,expansion)))))
+      (assert (every #'pipe-form-p pipe-forms)
+              ()
+              "Invalid pipe form: ~s"
+              (find-if-not #'pipe-form-p pipe-forms))
+
+      (reduce #'folder pipe-forms :initial-value initform))))
 
 (defmacro binding-cond (&body clauses)
   "Like cond except the first form of every clause is a binding form
diff --git a/package.lisp b/package.lisp
index 342dbbf..5025869 100644
--- a/package.lisp
+++ b/package.lisp
@@ -5,8 +5,8 @@
   (:nicknames #:hq)
   (:export
    #:with-env
+   #:>>
    #:let+
    #:imperative
    #:binding-cond
-   #:defun-case
-))
+   #:defun-case))