luciano/xforms
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make x/for to unroll some reductions

Browse source 
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.
This commit is contained in:
Christophe Grand 2017-09-19 17:26:11 +02:00
parent 23feac44dc
commit 8f04ad0748
3 changed files with 70 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
README.md
View file

@ -21,7 +21,7 @@ Transducing contexts: `transjuxt` (for performing several transductions in a sin
Add this dependency to your project: Add this dependency to your project:
```clj ```clj
[net.cgrand/xforms "0.9.4"] [net.cgrand /xforms "0.9.5"]
``` ```
```clj ```clj
@ -209,6 +209,16 @@ Evaluation count : 24 in 6 samples of 4 calls.
## Changelog ## 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 ### 0.7.2
* Fix transients perf issue in Clojurescript * Fix transients perf issue in Clojurescript

2
project.clj
View file

@ -1,4 +1,4 @@
(defproject net.cgrand/xforms "0.9.4" (defproject net.cgrand/xforms "0.9.5"
:description "Extra transducers for Clojure" :description "Extra transducers for Clojure"
:url "https://github.com/cgrand/xforms" :url "https://github.com/cgrand/xforms"
:license {:name "Eclipse Public License" :license {:name "Eclipse Public License"

96
src/net/cgrand/xforms.cljc
View file

@ -14,7 +14,17 @@
(defn- no-user-meta? [x] (defn- no-user-meta? [x]
(= {} (dissoc (or (meta x) {}) :file :line :column :end-line :end-column))) (= {} (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 (defmacro for
"Like clojure.core/for with the first expression being replaced by % (or _). Returns a transducer. "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." When the first expression is not % (or _) returns an eduction."
@ -22,43 +32,53 @@
(if-not (and (symbol? %or_) (#{"%" "_"} (name %or_))) (if-not (and (symbol? %or_) (#{"%" "_"} (name %or_)))
`(eduction (for [~binding ~'% ~@seq-exprs] ~body-expr) ~%or_) `(eduction (for [~binding ~'% ~@seq-exprs] ~body-expr) ~%or_)
(let [rf (gensym 'rf) (let [rf (gensym 'rf)
acc (gensym 'acc) acc (gensym 'acc)
pair? #(and (vector? %) (= 2 (core/count %))) pair? #(and (vector? %) (= 2 (core/count %)))
destructuring-pair? (every-pred pair? destructuring-pair? (every-pred pair?
#(not-any? (some-fn keyword? #{'&}) %)) #(not-any? (some-fn keyword? #{'&}) %))
rpairs (core/partition 2 (rseq (vec seq-exprs))) rpairs (core/partition 2 (rseq (vec seq-exprs)))
build (fn [init] build (fn [init]
(core/reduce (fn [body [expr binding]] (core/reduce (fn [body [expr binding]]
(case binding (case binding
:let `(let ~expr ~body) :let `(let ~expr ~body)
:when `(if ~expr ~body ~acc) :when `(if ~expr ~body ~acc)
:while `(if ~expr ~body (reduced ~acc)) :while `(if ~expr ~body (reduced ~acc))
(if (destructuring-pair? binding) (if (and (coll? expr) (not (seq? expr))
`(let [expr# ~expr] (or (<= (core/count expr) 4) (:unroll (meta expr))))
(if (and (map? expr#) (kvreducible? expr#)) (let [body-rf (gensym 'body-rf)]
(core/reduce-kv (fn [~acc ~@binding] ~body) ~acc expr#) (if (and (destructuring-pair? binding) (every? vector? expr))
(core/reduce (fn [~acc ~binding] ~body) ~acc expr#))) `(let [~body-rf (fn [~acc ~@binding] ~body)]
`(core/reduce (fn [~acc ~binding] ~body) ~acc ~expr)))) (unreduced (unreduced-> ~acc
init rpairs)) ~@(map (fn [[k v]] `(~body-rf ~k ~v)) expr))))
nested-reduceds (core/for [[expr binding] rpairs `(let [~body-rf (fn [~acc ~binding] ~body)]
:when (not (keyword? binding))] (unreduced (unreduced-> ~acc
`reduced) ~@(map (fn [v] `(~body-rf ~v)) expr))))))
body (build `(let [acc# (~rf ~acc ~@(if (and (pair? body-expr) (no-user-meta? body-expr)) (if (destructuring-pair? binding)
body-expr `(let [expr# ~expr]
[body-expr]))] (if (and (map? expr#) (kvreducible? expr#))
(if (reduced? acc#) (core/reduce-kv (fn [~acc ~@binding] ~body) ~acc expr#)
(-> acc# ~@nested-reduceds) (core/reduce (fn [~acc ~binding] ~body) ~acc expr#)))
acc#)))] `(core/reduce (fn [~acc ~binding] ~body) ~acc ~expr)))))
`(fn [~rf] init rpairs))
(let [~rf (ensure-kvrf ~rf)] nested-reduceds (core/for [[expr binding] rpairs
(kvrf :when (not (keyword? binding))]
([] (~rf)) `reduced)
([~acc] (~rf ~acc)) body (build `(let [acc# (~rf ~acc ~@(if (and (pair? body-expr) (no-user-meta? body-expr))
([~acc ~binding] ~body) body-expr
~(if (destructuring-pair? binding) [body-expr]))]
`([~acc ~@binding] ~body) (if (reduced? acc#)
`([~acc k# v#] (-> acc# ~@nested-reduceds)
(let [~binding (net.cgrand.macrovich/case :clj (clojure.lang.MapEntry. k# v#) :cljs [k# v#])] ~body))))))))) 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] (defmacro kvrf [name? & fn-bodies]
(let [name (if (symbol? name?) name? (gensym '_)) (let [name (if (symbol? name?) name? (gensym '_))