Branch: master
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
193 lines (170 sloc) 4.99 KB
(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
(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)
(defn ^:private reducing-impl
[this f init body]
(reduce [~this ~f ~init]
(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]
~@(reducing-impl (gensym "this") f init body))))
(defn repeatedly
"Like core/repeatedly but reducible and not seqable"
(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"
(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))))))
;; alternatively (repeatedly (fn [] item))
(defn repeat
(reducible [rf init]
(loop [ret init]
(let [ret (rf ret item)]
(unless-reduced ret (recur ret))))))
(def ^:private yield
([result] result)
([result input]
(when input
(reduced input)))))
(defn yield-first
"Reduces through a collection, yielding first truthy value."
(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
([n] n)
([n _] (inc n))))
(defn count
"Like core/count but for reducible collections.
Takes optional transducer"
(reduce counting 0 coll))
([xfn coll]
(transduce xfn counting 0 coll)))
;; range
(deftype RangeIterator [^long ^:unsynchronized-mutable i
^long end
^long step]
(hasNext [_]
(if (pos? step)
(< i end)
(> i end)))
(next [_]
(let [ret i]
(set! i (+ i step))
(defmacro ^:private range-loop*
`(loop ~'[acc init i start]
(if (~comp ~'i ~'end)
(let ~'[ret (f acc i)]
(unless-reduced ~'ret ~'(recur ret (+ i step))))
(deftype Range [^Long start ^Long end ^Long step]
(iterator [_]
(RangeIterator. start end step))
(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
(persistent! counts))
([counts x]
(assoc! counts x (inc (get counts x 0)))))]
(transduce xfn rf (transient {}) coll)))