Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
cond-let and cond-let| macros, to leverage bindings between test and result expressions, as well as earlier ones (for cond-let)
;; (cond-let
;; (odd? x) [x n] (inc x)
;; (< n 10) [y (inc n)] 10
;; :else n))
;; we want the above to yield
;; (let [x n]
;; (if (odd? x)
;; (inc x)
;; (let [y (inc n)]
;; (if (< n 10)
;; 10
;; (if :else
;; n
;; (throw ...."no matching clause"))))))
(defmacro cond-let
"Takes ternary clauses which can use bindings visible to both the test
and result expression, as well as all following clauses (except when shadowed);
the last clause which can be binary and follows 'cond semantics.
Each ternary clause can be of the form
text-expr binding-vector result-expr
or
test-expr :>> result-expr
if there are no new bindings added to the clause
(:>> is an ordinary keyword)
"
[& clauses]
(let [emit (fn emit [args]
(let [[[pred binds expr :as clause] more]
(split-at 3 args)
n (count args)]
(cond
(= n 0) `(throw (IllegalArgumentException.
(str "No matching clause: " ~expr)))
(< n 2) `(throw (IllegalArgumentException.
(str "Must have at least 2 arguments: "
~clause)))
(= n 2)
`(if ~pred
~(second clause)
~(emit more))
(= :>> (second clause))
`(if ~pred
~expr
~(emit more))
:else
`(let ~binds
(if ~pred
~expr
~(emit more))))))]
(emit clauses)))
;; (cond-let>
;; (odd? x) [x n] (inc x)
;; (even? n) :>> (dec n)
;; (< 10 (+ y z)) [y (inc n) z 80] (* 2 n z)
;; :else n
;; we want the above to yield:
;; (or ((fn [x]
;; (when (odd? x)
;; (inc x)) n)
;; ((fn []
;; (when (even? n)
;; (dec n))))
;; ((fn [y z]
;; (when (< 10 (+ y z))
;; (* 2 n z))) (inc n) 80)
;; ((fn []
;; (when :else
;; n)))
;; (throw..."No matching clause.."))
(defmacro cond-let>
"Same as for cond-let, except bindings are local to each clause only."
[& clauses]
(let [params+args (fn [bindings]
(->> (partition 2 bindings)
(reduce (fn [[prms args] [sym expr]]
[(conj prms sym), (conj args expr)])
[[] []])))
emit-fn (fn [params pred expr]
`(fn ~params
(when ~pred
~expr)))
emit-call (fn [fdecl args]
(list* fdecl args))
emit-branch (fn [pred binds expr]
(let [[params args] (params+args binds)
fdecl (emit-fn params pred expr)]
(emit-call fdecl args)))
emit (fn emit [args]
(let [[[pred binds expr :as clause] more]
(split-at 3 args)
n (count args)]
(cond
(= n 0) (list `(throw (IllegalArgumentException.
(str "No matching clause: "))))
(< n 2) `(throw (IllegalArgumentException.
(str "Must have at least 2 arguments: " ~clause)))
(= n 2) (cons (emit-branch pred []
(second clause))
(emit more))
(= :>> (second clause)) (cons (emit-branch pred [] expr)
(emit more))
:else (cons (emit-branch pred binds expr)
(emit more)))))]
`(or ~@(emit clauses))))
(defn cond-let-sample [n]
(cond-let
(neg? x) [x n] (inc x)
(even? n) :>> (* (quot x n) (dec n))
(< 10 (+ y z)) [y (inc n) z 3] (* 2 n z)
:else n))
(cond-let-sample -3) ;; => -2
(cond-let-sample 34) ;; => 33
(cond-let-sample 7) ;; => 42
(cond-let-sample 3) ;; => 3
(defn cond-let>-sample [n]
(cond-let>
(neg? x) [x n] (inc x)
(even? n) :>> (dec n)
(< 10 (+ y z)) [y (inc n) z 3] (* 2 n z)
:else n))
(cond-let>-sample -3) ;; => -2
(cond-let>-sample 34) ;; => 33
(cond-let>-sample 7) ;; => 42
(cond-let>-sample 3) ;; => 3
@miikka

This comment has been minimized.

Copy link

@miikka miikka commented Jul 13, 2020

Why not generate let instead of fn for cond-let>?

;; we want the above to yield:
;;     (or (let [x n]
;;           (when (odd? x)
;;             (inc x))
;;         (when (even? n)
;;           (dec n))))
;;         (let [y (inc n) z 80]
;;           (when (< 10 (+ y z))
;;             (* 2 n z)))
;;         (when :else
;;           n)
;;         (throw..."No matching clause.."))
@KingCode

This comment has been minimized.

Copy link

@KingCode KingCode commented Jul 14, 2020

@miikka Good point. I am not sure myself of the best way, but I tried to explain here.

I am looking forward to learning from @cgrand's comments and any improvements.

EDIT: I made the change you suggested, thanks!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.