From a3f84febe484a78cd4ffc7032312754ab2f41b21 Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Fri, 10 Mar 2023 20:10:13 -0800
Subject: Added >> to hyperquirks

---
 hyperquirks.lisp | 57 ++++++++++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 49 insertions(+), 8 deletions(-)

(limited to 'hyperquirks.lisp')

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
-- 
cgit v1.2.3