-
Notifications
You must be signed in to change notification settings - Fork 0
/
reducers.clj
192 lines (170 loc) · 4.99 KB
/
reducers.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
(ns ghadi.reducers
(:refer-clojure :exclude [range zipmap repeatedly iterate some count select-keys cycle repeat frequencies])
(:require [clojure.core.protocols :as p])
(:import java.util.Iterator
ghadi.XFIterable))
(defmacro unless-reduced
"A macro for correct reducible collections.
Conditionally unwraps a Reduced or continues."
[sym else]
(assert (symbol? sym))
`(if (reduced? ~sym)
(deref ~sym)
~else))
(defn ^:private reducing-impl
[this f init body]
`(clojure.lang.IReduceInit
(reduce [~this ~f ~init]
~@body)))
(defmacro reducible
"Reifies CollReduce with the 1-arity signature
delegating to the provided two argument signature"
[bindings & body]
(assert (and (vector? bindings)
(= (clojure.core/count bindings) 2)
(every? symbol? bindings)))
(let [[f init] bindings]
`(reify
~@(reducing-impl (gensym "this") f init body))))
(defn repeatedly
"Like core/repeatedly but reducible and not seqable"
[f]
(reducible [rf init]
(loop [acc init]
(let [ret (rf acc (f))]
(unless-reduced ret (recur ret))))))
(defn iterate
"Like core/iterate but reducible and not seqable"
[f seed]
(reducible [rf init]
(loop [ret (rf init seed) seed seed]
(unless-reduced ret
(let [next (f seed)]
(recur (rf ret next) next))))))
(defn cycle
"Like core/cycle but only reducible. Will coerce argument to vector"
[coll]
(let [coll (vec coll)
n (clojure.core/count coll)]
(reducible [rf init]
(if (pos? n)
(loop [acc init i 0]
(if (< i n)
(let [ret (rf acc (coll i))
i (unchecked-inc i)]
(unless-reduced ret
(recur ret (if (= i n) 0 i))))))
init))))
;; alternatively (repeatedly (fn [] item))
(defn repeat
[item]
(reducible [rf init]
(loop [ret init]
(let [ret (rf ret item)]
(unless-reduced ret (recur ret))))))
(def ^:private yield
(fn
([result] result)
([result input]
(when input
(reduced input)))))
(defn yield-first
"Reduces through a collection, yielding first truthy value."
([coll]
(reduce yield nil coll))
([xfn coll]
(transduce xfn yield nil coll)))
(defn some
"Like core/some but uses reduce. Takes an optional transducer."
([pred coll]
(yield-first (map pred) coll))
([pred xfn coll]
(yield-first (comp xfn (map pred)) coll)))
;; locate / find-first / search
(defn any
"Equivalent to (first (filter pred coll)) but uses reduce.
Takes an optional transducer."
([pred coll]
(yield-first (filter pred) coll))
([pred xfn coll]
(yield-first (comp xfn (filter pred)) coll)))
(def ^:private counting
(fn
([n] n)
([n _] (inc n))))
(defn count
"Like core/count but for reducible collections.
Takes optional transducer"
([coll]
(reduce counting 0 coll))
([xfn coll]
(transduce xfn counting 0 coll)))
;;
;; range
;;
(deftype RangeIterator [^long ^:unsynchronized-mutable i
^long end
^long step]
Iterator
(hasNext [_]
(if (pos? step)
(< i end)
(> i end)))
(next [_]
(let [ret i]
(set! i (+ i step))
ret)))
(defmacro ^:private range-loop*
[comp]
`(loop ~'[acc init i start]
(if (~comp ~'i ~'end)
(let ~'[ret (f acc i)]
(unless-reduced ~'ret ~'(recur ret (+ i step))))
~'acc)))
(deftype Range [^Long start ^Long end ^Long step]
Iterable
(iterator [_]
(RangeIterator. start end step))
clojure.lang.IReduceInit
(reduce [_ f init]
(if (pos? step)
(range-loop* <)
(range-loop* >))))
(defn range
"Unlike core/range accepts only Longs. Step must be non-zero.
Natively Iterable and reducible, but not seqable."
([] (range 0 Long/MAX_VALUE 1))
([end] (range 0 end 1))
([start end] (range start end 1))
([start end step]
(if (or (not (integer? step))
(zero? step))
(throw (IllegalArgumentException. "step must be non-zero integer, consider using repeatedly.")))
(Range. start end step)))
(defn zipmap
"Unlike core's zipmap, uses iterators and transients"
[keys vals]
(let [keys (clojure.lang.RT/iter keys)
vals (clojure.lang.RT/iter vals)]
(loop [m (transient {})]
(if (and (.hasNext keys) (.hasNext vals))
(recur (assoc! m (.next keys) (.next vals)))
(persistent! m)))))
(defn select-keys
"Like core/select-keys but transduces over transients"
[map keyseq]
(into {} (keep #(find map %)) keyseq))
(defn transiterate
"Takes an Iterable and a transducer and returns a transformed Iterable.
Analogous to (sequence xfn coll) but for Iterables"
[xfn iterable]
(XFIterable. xfn iterable))
(defn frequencies
"Like core/frequencies but takes a transducer"
[xfn coll]
(let [rf (fn
([counts]
(persistent! counts))
([counts x]
(assoc! counts x (inc (get counts x 0)))))]
(transduce xfn rf (transient {}) coll)))