From 8f04ad0748f2de36588ddd062e3d46f738a75f63 Mon Sep 17 00:00:00 2001 From: Christophe Grand Date: Tue, 19 Sep 2017 17:26:11 +0200 Subject: [PATCH] Make x/for to unroll some reductions When an expression in collection position in `x/for` is a collection literal with less than 4 items (or tagged with `^:unroll`) then the collection is not allocated and the reduction over it is unrolled. --- README.md | 12 ++++- project.clj | 2 +- src/net/cgrand/xforms.cljc | 96 +++++++++++++++++++++++--------------- 3 files changed, 70 insertions(+), 40 deletions(-) diff --git a/README.md b/README.md index ea5ee3c..2c5f905 100644 --- a/README.md +++ b/README.md @@ -21,7 +21,7 @@ Transducing contexts: `transjuxt` (for performing several transductions in a sin Add this dependency to your project: ```clj -[net.cgrand/xforms "0.9.4"] +[net.cgrand /xforms "0.9.5"] ``` ```clj @@ -209,6 +209,16 @@ Evaluation count : 24 in 6 samples of 4 calls. ## Changelog +### 0.9.5 + + * Short (up to 4) literal collections (or literal collections with `:unroll` metadata) in collection positions in `x/for` are unrolled. + This means that the collection is not allocated. + If it's a collection of pairs (e.g. maps), pairs themselves won't be allocated. + +### 0.9.4 + + * Add `x/into-by-key` short hand + ### 0.7.2 * Fix transients perf issue in Clojurescript diff --git a/project.clj b/project.clj index 4f50d9b..c30cb0f 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject net.cgrand/xforms "0.9.4" +(defproject net.cgrand/xforms "0.9.5" :description "Extra transducers for Clojure" :url "https://github.com/cgrand/xforms" :license {:name "Eclipse Public License" diff --git a/src/net/cgrand/xforms.cljc b/src/net/cgrand/xforms.cljc index f0b8d4c..05d8607 100644 --- a/src/net/cgrand/xforms.cljc +++ b/src/net/cgrand/xforms.cljc @@ -14,7 +14,17 @@ (defn- no-user-meta? [x] (= {} (dissoc (or (meta x) {}) :file :line :column :end-line :end-column))) - + +(defmacro unreduced-> + "Thread first while threaded value is not reduced. + Doesn't unreduce the final value." + ([x] x) + ([x expr & exprs] + `(let [x# ~x] + (if (reduced? x#) + x# + (unreduced-> (-> x# ~expr) ~@exprs))))) + (defmacro for "Like clojure.core/for with the first expression being replaced by % (or _). Returns a transducer. When the first expression is not % (or _) returns an eduction." @@ -22,43 +32,53 @@ (if-not (and (symbol? %or_) (#{"%" "_"} (name %or_))) `(eduction (for [~binding ~'% ~@seq-exprs] ~body-expr) ~%or_) (let [rf (gensym 'rf) - acc (gensym 'acc) - pair? #(and (vector? %) (= 2 (core/count %))) - destructuring-pair? (every-pred pair? - #(not-any? (some-fn keyword? #{'&}) %)) - rpairs (core/partition 2 (rseq (vec seq-exprs))) - build (fn [init] - (core/reduce (fn [body [expr binding]] - (case binding - :let `(let ~expr ~body) - :when `(if ~expr ~body ~acc) - :while `(if ~expr ~body (reduced ~acc)) - (if (destructuring-pair? binding) - `(let [expr# ~expr] - (if (and (map? expr#) (kvreducible? expr#)) - (core/reduce-kv (fn [~acc ~@binding] ~body) ~acc expr#) - (core/reduce (fn [~acc ~binding] ~body) ~acc expr#))) - `(core/reduce (fn [~acc ~binding] ~body) ~acc ~expr)))) - init rpairs)) - nested-reduceds (core/for [[expr binding] rpairs - :when (not (keyword? binding))] - `reduced) - body (build `(let [acc# (~rf ~acc ~@(if (and (pair? body-expr) (no-user-meta? body-expr)) - body-expr - [body-expr]))] - (if (reduced? acc#) - (-> acc# ~@nested-reduceds) - acc#)))] - `(fn [~rf] - (let [~rf (ensure-kvrf ~rf)] - (kvrf - ([] (~rf)) - ([~acc] (~rf ~acc)) - ([~acc ~binding] ~body) - ~(if (destructuring-pair? binding) - `([~acc ~@binding] ~body) - `([~acc k# v#] - (let [~binding (net.cgrand.macrovich/case :clj (clojure.lang.MapEntry. k# v#) :cljs [k# v#])] ~body))))))))) + acc (gensym 'acc) + pair? #(and (vector? %) (= 2 (core/count %))) + destructuring-pair? (every-pred pair? + #(not-any? (some-fn keyword? #{'&}) %)) + rpairs (core/partition 2 (rseq (vec seq-exprs))) + build (fn [init] + (core/reduce (fn [body [expr binding]] + (case binding + :let `(let ~expr ~body) + :when `(if ~expr ~body ~acc) + :while `(if ~expr ~body (reduced ~acc)) + (if (and (coll? expr) (not (seq? expr)) + (or (<= (core/count expr) 4) (:unroll (meta expr)))) + (let [body-rf (gensym 'body-rf)] + (if (and (destructuring-pair? binding) (every? vector? expr)) + `(let [~body-rf (fn [~acc ~@binding] ~body)] + (unreduced (unreduced-> ~acc + ~@(map (fn [[k v]] `(~body-rf ~k ~v)) expr)))) + `(let [~body-rf (fn [~acc ~binding] ~body)] + (unreduced (unreduced-> ~acc + ~@(map (fn [v] `(~body-rf ~v)) expr)))))) + (if (destructuring-pair? binding) + `(let [expr# ~expr] + (if (and (map? expr#) (kvreducible? expr#)) + (core/reduce-kv (fn [~acc ~@binding] ~body) ~acc expr#) + (core/reduce (fn [~acc ~binding] ~body) ~acc expr#))) + `(core/reduce (fn [~acc ~binding] ~body) ~acc ~expr))))) + init rpairs)) + nested-reduceds (core/for [[expr binding] rpairs + :when (not (keyword? binding))] + `reduced) + body (build `(let [acc# (~rf ~acc ~@(if (and (pair? body-expr) (no-user-meta? body-expr)) + body-expr + [body-expr]))] + (if (reduced? acc#) + (-> acc# ~@nested-reduceds) + acc#)))] + `(fn [~rf] + (let [~rf (ensure-kvrf ~rf)] + (kvrf + ([] (~rf)) + ([~acc] (~rf ~acc)) + ([~acc ~binding] ~body) + ~(if (destructuring-pair? binding) + `([~acc ~@binding] ~body) + `([~acc k# v#] + (let [~binding (net.cgrand.macrovich/case :clj (clojure.lang.MapEntry. k# v#) :cljs [k# v#])] ~body))))))))) (defmacro kvrf [name? & fn-bodies] (let [name (if (symbol? name?) name? (gensym '_))