Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
transducers with wrap
(defprotocol IReducing
"A value protocol for augmented reducing functions."
(-init
"Returns default initial unwrapped value."
[this])
(-finish
"Returns final wrapped result, and performs flushing or cleaning
of internal state. Returned wrap should have cleaned state,
so that eventual subsequent calls to -finish will perform
correctly.
Input may be reduced, which signals that
finalization of early terminated reduction should be performed.
Implementation must return reduced object at when `wrap` is reduced."
[this wrap])
(-wrap
"Returns wrapped result `ret`. Initializes reducing state."
[this ret])
(-unwrap
"Returns unwrapped result `ret`."
[this wrap])
(-step
"Returns new wrapped result based on applying given input values
to the `wrap`."
[this wrap, val]
[this wrap, val, val2]
[this wrap, val, val2, val3]
[this wrap, val, val2, val3, val4]
[this wrap, val, val2, val3, val4, more]))
(defn ^:private unwrap-advance
[r wrap]
(if (reduced? wrap)
(reduced (-unwrap r @wrap))
(-unwrap r wrap)))
(defn ^:private reducing-function
"Returns a reducing function created from augmented reducing
function `r`."
[r]
(fn
([wrap val] (-step r wrap val))
([wrap val val2] (-step r wrap val val2))
([wrap val val2 val3] (-step r wrap val val2 val3))
([wrap val val2 val3 val4]
(-step r wrap val val2 val3 val4))
([wrap val val2 val3 val4 & more]
(-step r wrap val val2 val3 val4 more))))
(defn ^:private reduce-augmented*
"Returns a result of the reduction of `coll` with `reduce-fn`
function taking [coll reducef init] in that order, and with the
augmented reducing function `r` and with initial value `init`,
which defaults to (-init r). May return reduced object."
([coll, reduce-fn, r]
(reduce-augmented* coll reduce-fn r (-init r)))
([coll, reduce-fn, r, init]
(->> (reduce-fn coll (reducing-function r) (-wrap r init))
(-finish r)
(unwrap-advance r))))
(defn strip-reduced
"Returns a referenced object if `x` is reduced, otherwise returns
`x`."
[x]
(if (reduced? x) @x x))
(defn ^:private reduce*
[coll, reducef, init]
(if (nil? coll) init (reduce reducef init coll)))
(defn reduce-augmented
"Returns a result of the reduction of `coll` with the augmented
reducing function `r` and with initial value `init`, which
defaults to (-init r)."
([r, coll]
(strip-reduced (reduce-augmented* coll reduce* r (-init r))))
([r, init, coll]
(strip-reduced (reduce-augmented* coll reduce* r init))))
(deftype BareReducing
"An augmented reducing type which uses `reducef` for reducing
steps and for an initial value."
[reducef]
IReducing
(-init [this] (reducef))
(-finish [this wrap] wrap)
(-wrap [this ret] ret)
(-unwrap [this wrap] wrap)
(-step [this wrap val] (reducef wrap val))
(-step [this wrap val val2] (reducef wrap val val2))
(-step [this wrap val val2 val3] (reducef wrap val val2 val3))
(-step [this wrap val val2 val3 val4]
(reducef wrap val val2 val3 val4))
(-step [this wrap val val2 val3 val4 more]
(apply reducef wrap val val2 val3 val4 more)))
(deftype Reducing
"An augmented reducing type which uses `reducef` for reducing
steps and `init` for an initial value."
[reducef, init]
IReducing
(-init [this] init)
(-finish [this wrap] wrap)
(-wrap [this ret] ret)
(-unwrap [this wrap] wrap)
(-step [this wrap val] (reducef wrap val))
(-step [this wrap val val2] (reducef wrap val val2))
(-step [this wrap val val2 val3] (reducef wrap val val2 val3))
(-step [this wrap val val2 val3 val4]
(reducef wrap val val2 val3 val4))
(-step [this wrap val val2 val3 val4 more]
(apply reducef wrap val val2 val3 val4 more)))
(defn reducing
"Returns an augmented reducing function which uses `reducef` for
reducing steps and `init` for an initial value, without fold
support. Uses (reducef) as an initial value if `init` is not
supplied."
([reducef]
(->BareReducing reducef))
([reducef, init]
(->Reducing reducef init)))
(defn transduce
"Returns a result of the reduction of `coll` with reducing function `reducef`
and initial value `init`, which defaults to (reducef) if not provided,
and transducer `xform`."
([xform, reducef, coll]
(reduce-augmented (xform (reducing reducef)) coll))
([xform, reducef, init, coll]
(reduce-augmented (xform (reducing reducef init)) coll)))
;; take
(deftype IntWrap [i ret])
(defn ^:private int-advance
[ret i]
(if (reduced? ret)
(reduced (->IntWrap i @ret))
(->IntWrap i ret))
(defn ^:private reduced-int-advance
[ret i]
(if (reduced? ret)
(reduced (->IntWrap i @ret))
(reduced (->IntWrap i ret))))
(deftype TakeReducing
"Reducing type for take."
[r n]
IReducing
(-init [this] (-init r))
(-finish [this wrap]
(->> (if (reduced? wrap)
(reduced (.-ret ^IntWrap @wrap))
(.-ret ^IntWrap wrap))
(-finish r)
(->IntWrap nil)))
(-wrap [this ret] (->IntWrap (dec n) (-wrap r ret)))
(-unwrap [this wrap]
(-unwrap r (.-ret ^IntWrap wrap)))
(-step [this wrap val]
(let [ret (.-ret ^IntWrap wrap)
i (.-i ^IntWrap wrap)]
(if (zero? i)
(reduced-int-advance (-step r ret val) i)
(int-advance (-step r ret val) (dec i))))))
(defn take
"A transducer that passes at most `n` step values."
([n]
(fn [r] (->TakeReducing r n)))
([n coll]
;; ... elided
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment