Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 368 lines (322 sloc) 10.769 kb
89e5dce @richhickey added reducers
richhickey authored
1 ; Copyright (c) Rich Hickey. All rights reserved.
2 ; The use and distribution terms for this software are covered by the
3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4 ; which can be found in the file epl-v10.html at the root of this distribution.
5 ; By using this software in any fashion, you are agreeing to be bound by
6 ; the terms of this license.
7 ; You must not remove this notice, or any other, from this software.
8
9 (ns ^{:doc
10 "A library for reduction and parallel folding. Alpha and subject
fd96484 @richhickey doc fix for Java 7 support
richhickey authored
11 to change. Note that fold and its derivatives require Java 7+ or
12 Java 6 + jsr166y.jar for fork/join support. See Clojure's pom.xml for the
89e5dce @richhickey added reducers
richhickey authored
13 dependency info."
14 :author "Rich Hickey"}
15 clojure.core.reducers
7d84a9f @richhickey transducers wip - added cat, mapcat transducer arity, removed flatmap, t...
richhickey authored
16 (:refer-clojure :exclude [reduce map mapcat filter remove take take-while drop flatten cat])
89e5dce @richhickey added reducers
richhickey authored
17 (:require [clojure.walk :as walk]))
18
19 (alias 'core 'clojure.core)
20 (set! *warn-on-reflection* true)
21
22 ;;;;;;;;;;;;;; some fj stuff ;;;;;;;;;;
23
41ff918 @tsdh Compile-time dispatch usage of jsr166y vs. bundled FJ.
tsdh authored
24 (defmacro ^:private compile-if
25 "Evaluate `exp` and if it returns logical true and doesn't error, expand to
26 `then`. Else expand to `else`.
89e5dce @richhickey added reducers
richhickey authored
27
41ff918 @tsdh Compile-time dispatch usage of jsr166y vs. bundled FJ.
tsdh authored
28 (compile-if (Class/forName \"java.util.concurrent.ForkJoinTask\")
29 (do-cool-stuff-with-fork-join)
30 (fall-back-to-executor-services))"
31 [exp then else]
32 (if (try (eval exp)
33 (catch Throwable _ false))
34 `(do ~then)
35 `(do ~else)))
89e5dce @richhickey added reducers
richhickey authored
36
41ff918 @tsdh Compile-time dispatch usage of jsr166y vs. bundled FJ.
tsdh authored
37 (compile-if
38 (Class/forName "java.util.concurrent.ForkJoinTask")
39 ;; We're running a JDK 7+
40 (do
41 (def pool (delay (java.util.concurrent.ForkJoinPool.)))
89e5dce @richhickey added reducers
richhickey authored
42
41ff918 @tsdh Compile-time dispatch usage of jsr166y vs. bundled FJ.
tsdh authored
43 (defn fjtask [^Callable f]
44 (java.util.concurrent.ForkJoinTask/adapt f))
89e5dce @richhickey added reducers
richhickey authored
45
41ff918 @tsdh Compile-time dispatch usage of jsr166y vs. bundled FJ.
tsdh authored
46 (defn- fjinvoke [f]
47 (if (java.util.concurrent.ForkJoinTask/inForkJoinPool)
48 (f)
49 (.invoke ^java.util.concurrent.ForkJoinPool @pool ^java.util.concurrent.ForkJoinTask (fjtask f))))
50
51 (defn- fjfork [task] (.fork ^java.util.concurrent.ForkJoinTask task))
52
53 (defn- fjjoin [task] (.join ^java.util.concurrent.ForkJoinTask task)))
fd96484 @richhickey doc fix for Java 7 support
richhickey authored
54 ;; We're running a JDK <7
41ff918 @tsdh Compile-time dispatch usage of jsr166y vs. bundled FJ.
tsdh authored
55 (do
56 (def pool (delay (jsr166y.ForkJoinPool.)))
57
58 (defn fjtask [^Callable f]
59 (jsr166y.ForkJoinTask/adapt f))
60
61 (defn- fjinvoke [f]
62 (if (jsr166y.ForkJoinTask/inForkJoinPool)
63 (f)
64 (.invoke ^jsr166y.ForkJoinPool @pool ^jsr166y.ForkJoinTask (fjtask f))))
65
66 (defn- fjfork [task] (.fork ^jsr166y.ForkJoinTask task))
67
68 (defn- fjjoin [task] (.join ^jsr166y.ForkJoinTask task))))
89e5dce @richhickey added reducers
richhickey authored
69 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
70
71 (defn reduce
72 "Like core/reduce except:
73 When init is not provided, (f) is used.
74 Maps are reduced with reduce-kv"
75 ([f coll] (reduce f (f) coll))
76 ([f init coll]
77 (if (instance? java.util.Map coll)
78 (clojure.core.protocols/kv-reduce coll f init)
79 (clojure.core.protocols/coll-reduce coll f init))))
80
81 (defprotocol CollFold
82 (coll-fold [coll n combinef reducef]))
83
84 (defn fold
85 "Reduces a collection using a (potentially parallel) reduce-combine
86 strategy. The collection is partitioned into groups of approximately
87 n (default 512), each of which is reduced with reducef (with a seed
88 value obtained by calling (combinef) with no arguments). The results
89 of these reductions are then reduced with combinef (default
90 reducef). combinef must be associative, and, when called with no
91 arguments, (combinef) must produce its identity element. These
92 operations may be performed in parallel, but the results will
93 preserve order."
94 {:added "1.5"}
95 ([reducef coll] (fold reducef reducef coll))
96 ([combinef reducef coll] (fold 512 combinef reducef coll))
97 ([n combinef reducef coll]
98 (coll-fold coll n combinef reducef)))
99
100 (defn reducer
101 "Given a reducible collection, and a transformation function xf,
102 returns a reducible collection, where any supplied reducing
103 fn will be transformed by xf. xf is a function of reducing fn to
104 reducing fn."
105 {:added "1.5"}
106 ([coll xf]
107 (reify
108 clojure.core.protocols/CollReduce
109 (coll-reduce [this f1]
110 (clojure.core.protocols/coll-reduce this f1 (f1)))
111 (coll-reduce [_ f1 init]
112 (clojure.core.protocols/coll-reduce coll (xf f1) init)))))
113
114 (defn folder
115 "Given a foldable collection, and a transformation function xf,
116 returns a foldable collection, where any supplied reducing
117 fn will be transformed by xf. xf is a function of reducing fn to
118 reducing fn."
119 {:added "1.5"}
120 ([coll xf]
121 (reify
122 clojure.core.protocols/CollReduce
123 (coll-reduce [_ f1]
124 (clojure.core.protocols/coll-reduce coll (xf f1) (f1)))
125 (coll-reduce [_ f1 init]
126 (clojure.core.protocols/coll-reduce coll (xf f1) init))
127
128 CollFold
129 (coll-fold [_ n combinef reducef]
130 (coll-fold coll n combinef (xf reducef))))))
131
132 (defn- do-curried
133 [name doc meta args body]
134 (let [cargs (vec (butlast args))]
135 `(defn ~name ~doc ~meta
136 (~cargs (fn [x#] (~name ~@cargs x#)))
137 (~args ~@body))))
138
139 (defmacro ^:private defcurried
140 "Builds another arity of the fn that returns a fn awaiting the last
141 param"
142 [name doc meta args & body]
143 (do-curried name doc meta args body))
144
145 (defn- do-rfn [f1 k fkv]
146 `(fn
147 ([] (~f1))
148 ~(clojure.walk/postwalk
149 #(if (sequential? %)
150 ((if (vector? %) vec identity)
151 (core/remove #{k} %))
152 %)
153 fkv)
154 ~fkv))
155
156 (defmacro ^:private rfn
157 "Builds 3-arity reducing fn given names of wrapped fn and key, and k/v impl."
158 [[f1 k] fkv]
159 (do-rfn f1 k fkv))
160
161 (defcurried map
162 "Applies f to every value in the reduction of coll. Foldable."
163 {:added "1.5"}
164 [f coll]
165 (folder coll
166 (fn [f1]
167 (rfn [f1 k]
168 ([ret k v]
169 (f1 ret (f k v)))))))
170
6c17a8d @tsdh Implement clojure.core.reducers/mapcat.
tsdh authored
171 (defcurried mapcat
172 "Applies f to every value in the reduction of coll, concatenating the result
173 colls of (f val). Foldable."
174 {:added "1.5"}
175 [f coll]
176 (folder coll
177 (fn [f1]
f3259f4 @cgrand CLJ-1160: Prevents mapcat from swallowing Reduced instances
cgrand authored
178 (let [f1 (fn
179 ([ret v]
180 (let [x (f1 ret v)] (if (reduced? x) (reduced x) x)))
181 ([ret k v]
182 (let [x (f1 ret k v)] (if (reduced? x) (reduced x) x))))]
183 (rfn [f1 k]
184 ([ret k v]
185 (reduce f1 ret (f k v))))))))
6c17a8d @tsdh Implement clojure.core.reducers/mapcat.
tsdh authored
186
89e5dce @richhickey added reducers
richhickey authored
187 (defcurried filter
188 "Retains values in the reduction of coll for which (pred val)
189 returns logical true. Foldable."
190 {:added "1.5"}
191 [pred coll]
192 (folder coll
193 (fn [f1]
194 (rfn [f1 k]
195 ([ret k v]
196 (if (pred k v)
197 (f1 ret k v)
198 ret))))))
199
200 (defcurried remove
201 "Removes values in the reduction of coll for which (pred val)
202 returns logical true. Foldable."
203 {:added "1.5"}
204 [pred coll]
205 (filter (complement pred) coll))
206
2430b7a @richhickey finish flatten refactoring
richhickey authored
207 (defcurried flatten
208 "Takes any nested combination of sequential things (lists, vectors,
209 etc.) and returns their contents as a single, flat foldable
210 collection."
211 {:added "1.5"}
212 [coll]
213 (folder coll
214 (fn [f1]
215 (fn
216 ([] (f1))
217 ([ret v]
218 (if (sequential? v)
219 (clojure.core.protocols/coll-reduce (flatten v) f1 ret)
220 (f1 ret v)))))))
221
89e5dce @richhickey added reducers
richhickey authored
222 (defcurried take-while
223 "Ends the reduction of coll when (pred val) returns logical false."
224 {:added "1.5"}
225 [pred coll]
226 (reducer coll
227 (fn [f1]
228 (rfn [f1 k]
229 ([ret k v]
230 (if (pred k v)
231 (f1 ret k v)
232 (reduced ret)))))))
233
234 (defcurried take
235 "Ends the reduction of coll after consuming n values."
236 {:added "1.5"}
237 [n coll]
238 (reducer coll
239 (fn [f1]
240 (let [cnt (atom n)]
241 (rfn [f1 k]
242 ([ret k v]
243 (swap! cnt dec)
244 (if (neg? @cnt)
245 (reduced ret)
246 (f1 ret k v))))))))
247
248 (defcurried drop
249 "Elides the first n values from the reduction of coll."
250 {:added "1.5"}
251 [n coll]
252 (reducer coll
253 (fn [f1]
254 (let [cnt (atom n)]
255 (rfn [f1 k]
256 ([ret k v]
257 (swap! cnt dec)
258 (if (neg? @cnt)
259 (f1 ret k v)
260 ret)))))))
261
262 ;;do not construct this directly, use cat
263 (deftype Cat [cnt left right]
264 clojure.lang.Counted
265 (count [_] cnt)
266
267 clojure.lang.Seqable
268 (seq [_] (concat (seq left) (seq right)))
41ff918 @tsdh Compile-time dispatch usage of jsr166y vs. bundled FJ.
tsdh authored
269
89e5dce @richhickey added reducers
richhickey authored
270 clojure.core.protocols/CollReduce
271 (coll-reduce [this f1] (clojure.core.protocols/coll-reduce this f1 (f1)))
272 (coll-reduce
273 [_ f1 init]
274 (clojure.core.protocols/coll-reduce
275 right f1
276 (clojure.core.protocols/coll-reduce left f1 init)))
277
278 CollFold
279 (coll-fold
280 [_ n combinef reducef]
281 (fjinvoke
282 (fn []
283 (let [rt (fjfork (fjtask #(coll-fold right n combinef reducef)))]
284 (combinef
285 (coll-fold left n combinef reducef)
286 (fjjoin rt)))))))
287
288 (defn cat
289 "A high-performance combining fn that yields the catenation of the
290 reduced values. The result is reducible, foldable, seqable and
291 counted, providing the identity collections are reducible, seqable
292 and counted. The single argument version will build a combining fn
293 with the supplied identity constructor. Tests for identity
294 with (zero? (count x)). See also foldcat."
295 {:added "1.5"}
296 ([] (java.util.ArrayList.))
297 ([ctor]
298 (fn
299 ([] (ctor))
300 ([left right] (cat left right))))
301 ([left right]
302 (cond
303 (zero? (count left)) right
304 (zero? (count right)) left
305 :else
306 (Cat. (+ (count left) (count right)) left right))))
307
308 (defn append!
309 ".adds x to acc and returns acc"
310 {:added "1.5"}
311 [^java.util.Collection acc x]
312 (doto acc (.add x)))
313
314 (defn foldcat
315 "Equivalent to (fold cat append! coll)"
316 {:added "1.5"}
317 [coll]
318 (fold cat append! coll))
319
320 (defn monoid
321 "Builds a combining fn out of the supplied operator and identity
322 constructor. op must be associative and ctor called with no args
323 must return an identity value for it."
324 {:added "1.5"}
325 [op ctor]
326 (fn m
327 ([] (ctor))
328 ([a b] (op a b))))
329
330 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; fold impls ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
331 (defn- foldvec
332 [v n combinef reducef]
333 (cond
334 (empty? v) (combinef)
335 (<= (count v) n) (reduce reducef (combinef) v)
336 :else
337 (let [split (quot (count v) 2)
338 v1 (subvec v 0 split)
339 v2 (subvec v split (count v))
340 fc (fn [child] #(foldvec child n combinef reducef))]
341 (fjinvoke
342 #(let [f1 (fc v1)
343 t2 (fjtask (fc v2))]
344 (fjfork t2)
345 (combinef (f1) (fjjoin t2)))))))
346
347 (extend-protocol CollFold
3e89a16 @bendlas CLJ-1098: Implement IKVReduce and CollFold for nil
bendlas authored
348 nil
349 (coll-fold
350 [coll n combinef reducef]
351 (combinef))
352
89e5dce @richhickey added reducers
richhickey authored
353 Object
354 (coll-fold
355 [coll n combinef reducef]
356 ;;can't fold, single reduce
357 (reduce reducef (combinef) coll))
41ff918 @tsdh Compile-time dispatch usage of jsr166y vs. bundled FJ.
tsdh authored
358
89e5dce @richhickey added reducers
richhickey authored
359 clojure.lang.IPersistentVector
360 (coll-fold
361 [v n combinef reducef]
362 (foldvec v n combinef reducef))
363
364 clojure.lang.PersistentHashMap
365 (coll-fold
366 [m n combinef reducef]
367 (.fold m n combinef reducef fjinvoke fjtask fjfork fjjoin)))
Something went wrong with that request. Please try again.