diff options
author | colin <colin@cicadas.surf> | 2023-03-11 10:09:24 -0800 |
---|---|---|
committer | colin <colin@cicadas.surf> | 2023-03-11 10:09:24 -0800 |
commit | fb88cb03d36a682faf0f4de57e95baf1134e46d5 (patch) | |
tree | 266e15258d74fc9895cf89da1c18800025ea3631 /hyperquirks.lisp | |
parent | a0461d4a4a48d00ab4743f3abcfcdab7c8d5858e (diff) |
Modify: versatility improvements to >> macro
Diffstat (limited to 'hyperquirks.lisp')
-rw-r--r-- | hyperquirks.lisp | 38 |
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" |