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

WIP cljc conversion, basics (like (x/into {} (x/by-key odd? (x/reduce +)) (range 10))) work

Browse source
This commit is contained in:
Christophe Grand 2016-12-15 17:39:28 +01:00
parent 3190a96041
commit bae1a9d1ad
3 changed files with 179 additions and 149 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
project.clj
View file

@ -3,4 +3,6 @@
#_#_:url "http://example.com/FIXME" #_#_:url "http://example.com/FIXME"
:license {:name "Eclipse Public License" :license {:name "Eclipse Public License"
:url "http://www.eclipse.org/legal/epl-v10.html"} :url "http://www.eclipse.org/legal/epl-v10.html"}
:dependencies [[org.clojure/clojure "1.7.0"]]) :dependencies [[org.clojure/clojure "1.8.0"]
[org.clojure/clojurescript "1.9.369"]
[net.cgrand/macrovich "0.1.0"]])

111
src/net/cgrand/xforms.clj → src/net/cgrand/xforms.cljc
View file

@ -1,10 +1,16 @@
(ns net.cgrand.xforms (ns net.cgrand.xforms
"Extra transducers for Clojure" "Extra transducers for Clojure"
{:author "Christophe Grand"} {:author "Christophe Grand"}
#?(:cljs (:require-macros
[net.cgrand.macrovich :as macros]
[net.cgrand.xforms :refer [for kvrf let-complete]])
:clj (:require [net.cgrand.macrovich :as macros]))
(:refer-clojure :exclude [reduce reductions into count for partition str last keys vals min max]) (:refer-clojure :exclude [reduce reductions into count for partition str last keys vals min max])
(:require [clojure.core :as clj] (:require [#?(:clj clojure.core :cljs cljs.core) :as core]
[net.cgrand.xforms.rfs :as rf])) [net.cgrand.xforms.rfs :as rf]))
(macros/deftime
(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."
@ -13,24 +19,24 @@
`(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 (clj/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 (clj/partition 2 (rseq (vec seq-exprs))) rpairs (core/partition 2 (rseq (vec seq-exprs)))
build (fn [init] build (fn [init]
(clj/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 (destructuring-pair? binding)
`(let [expr# ~expr] `(let [expr# ~expr]
(if (and (map? expr#) (satisfies? clojure.core.protocols/IKVReduce expr#)) (if (and (map? expr#) (kvreducible? expr#))
(clj/reduce-kv (fn [~acc ~@binding] ~body) ~acc expr#) (core/reduce-kv (fn [~acc ~@binding] ~body) ~acc expr#)
(clj/reduce (fn [~acc ~binding] ~body) ~acc expr#))) (core/reduce (fn [~acc ~binding] ~body) ~acc expr#)))
`(clj/reduce (fn [~acc ~binding] ~body) ~acc ~expr)))) `(core/reduce (fn [~acc ~binding] ~body) ~acc ~expr))))
init rpairs)) init rpairs))
nested-reduceds (clj/for [[expr binding] rpairs nested-reduceds (core/for [[expr binding] rpairs
:when (not (keyword? binding))] :when (not (keyword? binding))]
`reduced) `reduced)
body (build `(let [acc# (~rf ~acc ~@(if (and (pair? body-expr) (nil? (meta body-expr))) body (build `(let [acc# (~rf ~acc ~@(if (and (pair? body-expr) (nil? (meta body-expr)))
@ -48,37 +54,22 @@
~(if (destructuring-pair? binding) ~(if (destructuring-pair? binding)
`([~acc ~@binding] ~body) `([~acc ~@binding] ~body)
`([~acc k# v#] `([~acc k# v#]
(let [~binding (clojure.lang.MapEntry. k# v#)] ~body))))))))) (let [~binding (macros/case :clj (clojure.lang.MapEntry. k# v#) :cljs [k# v#])] ~body)))))))))
(defprotocol KvRfable "Protocol for reducing fns that accept key and val as separate arguments."
(some-kvrf [f] "Returns a kvrf or nil"))
(extend-protocol KvRfable
Object (some-kvrf [_] nil)
nil (some-kvrf [_] nil))
(defmacro kvrf [name? & fn-bodies] (defmacro kvrf [name? & fn-bodies]
(let [name (if (symbol? name?) name? (gensym '_)) (let [name (if (symbol? name?) name? (gensym '_))
fn-bodies (if (symbol? name?) fn-bodies (cons name? fn-bodies)) fn-bodies (if (symbol? name?) fn-bodies (cons name? fn-bodies))
fn-bodies (if (vector? (first fn-bodies)) (list fn-bodies) fn-bodies)] fn-bodies (if (vector? (first fn-bodies)) (list fn-bodies) fn-bodies)]
`(reify `(reify
clojure.lang.Fn ~@(macros/case :clj '[clojure.lang.Fn])
KvRfable KvRfable
(some-kvrf [this#] this#) (some-kvrf [this#] this#)
clojure.lang.IFn ~(macros/case :cljs `core/IFn :clj 'clojure.lang.IFn)
~@(clj/for [[args & body] fn-bodies] ~@(core/for [[args & body] fn-bodies]
(let [nohint-args (map (fn [arg] (if (:tag (meta arg)) (gensym 'arg) arg)) args) (let [nohint-args (map (fn [arg] (if (:tag (meta arg)) (gensym 'arg) arg)) args)
rebind (mapcat (fn [arg nohint] rebind (mapcat (fn [arg nohint]
(when-not (= arg nohint) [arg nohint])) args nohint-args)] (when-not (= arg nohint) [arg nohint])) args nohint-args)]
`(invoke [~name ~@nohint-args] (let [~@rebind] ~@body))))))) `(~(macros/case :cljs `core/-invoke :clj 'invoke) [~name ~@nohint-args] (let [~@rebind] ~@body)))))))
(defn ensure-kvrf [rf]
(or (some-kvrf rf)
(kvrf
([] (rf))
([acc] (rf acc))
([acc x] (rf acc x))
([acc k v] (rf acc (clojure.lang.MapEntry. k v))))))
(defmacro ^:private let-complete [[binding volatile] & body] (defmacro ^:private let-complete [[binding volatile] & body]
`(let [v# @~volatile] `(let [v# @~volatile]
@ -86,6 +77,29 @@
(vreset! ~volatile ~volatile) (vreset! ~volatile ~volatile)
(let [~binding v#] (let [~binding v#]
~@body)))) ~@body))))
)
(declare into reduce multiplex by-key)
(defprotocol KvRfable "Protocol for reducing fns that accept key and val as separate arguments."
(some-kvrf [f] "Returns a kvrf or nil"))
(macros/usetime
(defn kvreducible? [coll]
(satisfies? #?(:clj clojure.core.protocols/IKVReduce :cljs IKVReduce) coll))
(extend-protocol KvRfable
#?(:clj Object :cljs default) (some-kvrf [_] nil)
nil (some-kvrf [_] nil))
(defn ensure-kvrf [rf]
(or (some-kvrf rf)
(kvrf
([] (rf))
([acc] (rf acc))
([acc x] (rf acc x))
([acc k v] (rf acc #?(:clj (clojure.lang.MapEntry. k v) :cljs [k v]))))))
(defn reduce (defn reduce
"A transducer that reduces a collection to a 1-item collection consisting of only the reduced result. "A transducer that reduces a collection to a 1-item collection consisting of only the reduced result.
@ -111,7 +125,7 @@
(defn- into-rf [to] (defn- into-rf [to]
(cond (cond
(instance? clojure.lang.IEditableCollection to) (instance? #?(:clj clojure.lang.IEditableCollection :cljs IEditableCollection) to)
(if (map? to) (if (map? to)
(kvrf (kvrf
([] (transient to)) ([] (transient to))
@ -142,9 +156,9 @@
(into to identity from)) (into to identity from))
([to xform from] ([to xform from]
(let [rf (xform (into-rf to))] (let [rf (xform (into-rf to))]
(if-let [rf (and (map? from) (satisfies? clojure.core.protocols/IKVReduce from) (some-kvrf rf))] (if-let [rf (and (map? from) (kvreducible? from) (some-kvrf rf))]
(rf (clj/reduce-kv rf (rf) from)) (rf (core/reduce-kv rf (rf) from))
(rf (clj/reduce rf (rf) from)))))) (rf (core/reduce rf (rf) from))))))
(defn minimum (defn minimum
([comparator] ([comparator]
@ -222,7 +236,7 @@
(if (and (nil? kfn) (nil? vfn)) (if (and (nil? kfn) (nil? vfn))
(kvrf self (kvrf self
([] (rf)) ([] (rf))
([acc] (let-complete [m m] (rf (clj/reduce (fn [acc krf] (krf acc)) acc (clj/vals (persistent! m)))))) ([acc] (let-complete [m m] (rf (core/reduce (fn [acc krf] (krf acc)) acc (core/vals (persistent! m))))))
([acc x] ([acc x]
(self acc (key' x) (val' x))) (self acc (key' x) (val' x)))
([acc k v] ([acc k v]
@ -241,7 +255,7 @@
vfn (or vfn val')] vfn (or vfn val')]
(kvrf self (kvrf self
([] (rf)) ([] (rf))
([acc] (let-complete [m m] (rf (clj/reduce (fn [acc krf] (krf acc)) acc (clj/vals (persistent! m)))))) ([acc] (let-complete [m m] (rf (core/reduce (fn [acc krf] (krf acc)) acc (core/vals (persistent! m))))))
([acc x] ([acc x]
(let [k (kfn x) (let [k (kfn x)
krf (or (get @m k) (doto (xform (make-rf k)) (->> (vswap! m assoc! k)))) krf (or (get @m k) (doto (xform (make-rf k)) (->> (vswap! m assoc! k))))
@ -255,7 +269,7 @@
(vswap! m assoc! k nop-rf) (vswap! m assoc! k nop-rf)
(krf @acc))) (krf @acc)))
acc))) acc)))
([acc k v] (self acc (clojure.lang.MapEntry. k v))))))))))) ([acc k v] (self acc #?(:clj (clojure.lang.MapEntry. k v) :cljs [k v])))))))))))
(defn partition (defn partition
"Returns a partitioning transducer. Each partition is independently transformed using the xform transducer." "Returns a partitioning transducer. Each partition is independently transformed using the xform transducer."
@ -282,7 +296,7 @@
(if (zero? b) (if (zero? b)
; this transduce may return a reduced because of mxrf wrapping reduceds coming from rf ; this transduce may return a reduced because of mxrf wrapping reduceds coming from rf
(let [acc (transduce xform mxrf acc dq)] (let [acc (transduce xform mxrf acc dq)]
(dotimes [_ (clj/min n step)] (.poll dq)) (dotimes [_ (core/min n step)] (.poll dq))
(vswap! barrier + step) (vswap! barrier + step)
acc) acc)
acc))))))) acc)))))))
@ -376,6 +390,7 @@
(vreset! vi (let [i (inc i)] (if (= n i) 0 i))) (vreset! vi (let [i (inc i)] (if (= n i) 0 i)))
(rf acc (f (vreset! vwacc (f (invf wacc x') x)))))))))))) (rf acc (f (vreset! vwacc (f (invf wacc x') x))))))))))))
#?(:clj
(defn window-by-time (defn window-by-time
"Returns a transducer which computes a windowed accumulator over chronologically sorted items. "Returns a transducer which computes a windowed accumulator over chronologically sorted items.
@ -390,7 +405,7 @@
(window-by-time timef n (window-by-time timef n
(fn (fn
([] clojure.lang.PersistentQueue/EMPTY) ([] clojure.lang.PersistentQueue/EMPTY)
([q] (f (clj/reduce f (f) q))) ([q] (f (core/reduce f (f) q)))
([q x] (conj q x))) ([q x] (conj q x)))
(fn [q _] (pop q)))) (fn [q _] (pop q))))
([timef n f invf] ([timef n f invf]
@ -434,17 +449,17 @@
acc (flush! acc prev-limit limit)] acc (flush! acc prev-limit limit)]
(when-not (reduced? acc) (when-not (reduced? acc)
(vswap! vwacc f x)) (vswap! vwacc f x))
acc)))))))) acc)))))))))
(defn count (defn count
"Count the number of items. Either used directly as a transducer or invoked with two args "Count the number of items. Either used directly as a transducer or invoked with two args
as a transducing context." as a transducing context."
([rf] ([rf]
(let [n (java.util.concurrent.atomic.AtomicLong.)] (let [n #?(:clj (java.util.concurrent.atomic.AtomicLong.) :cljs (atom 0))]
(fn (fn
([] (rf)) ([] (rf))
([acc] (rf (unreduced (rf acc (.get n))))) ([acc] (rf (unreduced (rf acc #?(:clj (.get n) :cljs @n)))))
([acc _] (.incrementAndGet n) acc)))) ([acc _] #?(:clj (.incrementAndGet n) :cljs (swap! n inc)) acc))))
([xform coll] ([xform coll]
(transduce (comp xform count) rf/last coll))) (transduce (comp xform count) rf/last coll)))
@ -479,7 +494,7 @@
acc))) acc)))
acc @rfs)) acc @rfs))
(fn [acc invoke] (fn [acc invoke]
(clj/reduce (core/reduce
(fn [acc rf] (fn [acc rf]
(let [acc (invoke rf acc)] (let [acc (invoke rf acc)]
(if (reduced? acc) (if (reduced? acc)
@ -495,12 +510,12 @@
([acc] (rf (invoke-rfs acc #(%1 %2)))) ([acc] (rf (invoke-rfs acc #(%1 %2))))
([acc x] ([acc x]
(let [acc (invoke-rfs acc #(%1 %2 x))] (let [acc (invoke-rfs acc #(%1 %2 x))]
(if (zero? (clj/count @rfs)) (if (zero? (core/count @rfs))
(ensure-reduced acc) (ensure-reduced acc)
acc))) acc)))
([acc k v] ([acc k v]
(let [acc (invoke-rfs acc #(%1 %2 k v))] (let [acc (invoke-rfs acc #(%1 %2 k v))]
(if (zero? (clj/count @rfs)) (if (zero? (core/count @rfs))
(ensure-reduced acc) (ensure-reduced acc)
acc))))))) acc)))))))
@ -515,8 +530,8 @@
(let [collect-xform (if (map? xforms-map) (let [collect-xform (if (map? xforms-map)
(into {}) (into {})
(reduce (kvrf (reduce (kvrf
([] (clj/reduce (fn [v _] (conj! v nil)) ([] (core/reduce (fn [v _] (conj! v nil))
(transient []) (range (clj/count xforms-map)))) (transient []) (range (core/count xforms-map))))
([v] (persistent! v)) ([v] (persistent! v))
([v i x] (assoc! v i x))))) ([v i x] (assoc! v i x)))))
xforms-map (if (map? xforms-map) xforms-map (zipmap (range) xforms-map))] xforms-map (if (map? xforms-map) xforms-map (zipmap (range) xforms-map))]
@ -525,3 +540,5 @@
collect-xform))) collect-xform)))
([xforms-map coll] ([xforms-map coll]
(transduce (transjuxt xforms-map) rf/last coll))) (transduce (transjuxt xforms-map) rf/last coll)))
)

35
src/net/cgrand/xforms/rfs.clj → src/net/cgrand/xforms/rfs.cljc
View file

@ -1,7 +1,22 @@
(ns net.cgrand.xforms.rfs (ns net.cgrand.xforms.rfs
{:author "Christophe Grand"} {:author "Christophe Grand"}
(:refer-clojure :exclude [str last min max]) (:refer-clojure :exclude [str last min max])
(:require [clojure.core :as clj])) #?(:cljs (:require-macros
[net.cgrand.macrovich :as macros]
[net.cgrand.xforms.rfs :refer [or-instance?]])
:clj (:require [net.cgrand.macrovich :as macros]))
(:require [#?(:clj clojure.core :cljs cljs.core) :as core])
#?(:cljs (:import [goog.string StringBuffer])))
(macros/deftime
(defmacro ^:private or-instance? [class x y]
(let [xsym (gensym 'x_)]
`(let [~xsym ~x]
(if (instance? ~class ~xsym) ~(with-meta xsym {:tag class}) ~y)))))
(declare str!)
(macros/usetime
(defn minimum (defn minimum
([comparator] ([comparator]
@ -43,20 +58,15 @@
([x] x) ([x] x)
([_ x] x)) ([_ x] x))
(defmacro ^:private or-instance? [class x y]
(let [xsym (gensym 'x_)]
`(let [~xsym ~x]
(if (instance? ~class ~xsym) ~(with-meta xsym {:tag class}) ~y))))
(defn str! (defn str!
"Like xforms/str but returns a StringBuilder." "Like xforms/str but returns a StringBuilder."
([] (StringBuilder.)) ([] (#?(:clj StringBuilder. :cljs StringBuffer.)))
([sb] (or-instance? StringBuilder sb (StringBuilder. (clj/str sb)))) ; the instance? checks are for compatibility with str in case of seeded reduce/transduce. ([sb] (or-instance? #?(:clj StringBuilder :cljs StringBuffer) sb (#?(:clj StringBuilder. :cljs StringBuffer.) (core/str sb)))) ; the instance? checks are for compatibility with str in case of seeded reduce/transduce.
([sb x] (.append (or-instance? StringBuilder sb (StringBuilder. (clj/str sb))) x))) ([sb x] (.append (or-instance? #?(:clj StringBuilder :cljs StringBuffer) sb (#?(:clj StringBuilder. :cljs StringBuffer.) (core/str sb))) x)))
(def str (def str
"Reducing function to build strings in linear time. Acts as replacement for clojure.core/str in a reduce/transduce call." "Reducing function to build strings in linear time. Acts as replacement for clojure.core/str in a reduce/transduce call."
(completing str! clj/str)) (completing str! core/str))
#_(defn juxt #_(defn juxt
"Returns a reducing fn which compute all rfns at once and whose final return "Returns a reducing fn which compute all rfns at once and whose final return
@ -67,12 +77,12 @@
([] (mapv #(vector % (volatile! (%))) rfns)) ([] (mapv #(vector % (volatile! (%))) rfns))
([acc] (mapv (fn [[rf vacc]] (rf (unreduced @vacc))) acc)) ([acc] (mapv (fn [[rf vacc]] (rf (unreduced @vacc))) acc))
([acc x] ([acc x]
(let [some-unreduced (clj/reduce (fn [some-unreduced [rf vacc]] (let [some-unreduced (core/reduce (fn [some-unreduced [rf vacc]]
(when-not (reduced? @vacc) (vswap! vacc rf x) true)) (when-not (reduced? @vacc) (vswap! vacc rf x) true))
false acc)] false acc)]
(if some-unreduced acc (reduced acc)))) (if some-unreduced acc (reduced acc))))
([acc k v] ([acc k v]
(let [some-unreduced (clj/reduce (fn [some-unreduced [rf vacc]] (let [some-unreduced (core/reduce (fn [some-unreduced [rf vacc]]
(when-not (reduced? @vacc) (vswap! vacc rf k v) true)) (when-not (reduced? @vacc) (vswap! vacc rf k v) true))
false acc)] false acc)]
(if some-unreduced acc (reduced acc))))))) (if some-unreduced acc (reduced acc)))))))
@ -87,3 +97,4 @@
([acc] (zipmap keys (f acc))) ([acc] (zipmap keys (f acc)))
([acc x] (f acc x)) ([acc x] (f acc x))
([acc k v] (f acc k v)))))) ([acc k v] (f acc k v))))))
)