From b96d9d79949d9900220909d90fcadb0e56449c55 Mon Sep 17 00:00:00 2001 From: Christophe Grand Date: Wed, 18 Oct 2017 14:39:15 -0500 Subject: [PATCH] Make kvrf smarter: can infer arity 2 from and 3 from 2 --- README.md | 4 ++-- project.clj | 2 +- src/net/cgrand/xforms.cljc | 42 ++++++++++++++++++++++---------------- 3 files changed, 27 insertions(+), 21 deletions(-) diff --git a/README.md b/README.md index c0d78ad..e78a187 100644 --- a/README.md +++ b/README.md @@ -27,7 +27,7 @@ In `net.cgrand.xforms.io`: *Transducing contexts*: - * in `net.cgrand.xforms`: `transjuxt` (for performing several transductions in a single pass), `into`, `count` and `some`. + * in `net.cgrand.xforms`: `transjuxt` (for performing several transductions in a single pass), `iterator` (clojure only), `into`, `count` and `some`. * in `net.cgrand.xforms.io`: `line-out` (3+ args) and `edn-out` (3+ args). *Reducible views* (in `net.cgrand.xforms.io`): `lines-in` and `edn-in`. @@ -37,7 +37,7 @@ In `net.cgrand.xforms.io`: Add this dependency to your project: ```clj -[net.cgrand /xforms "0.11.0"] +[net.cgrand /xforms "0.12.0"] ``` ```clj diff --git a/project.clj b/project.clj index 7518399..97c9580 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject net.cgrand/xforms "0.11.0" +(defproject net.cgrand/xforms "0.12.0" :description "Extra transducers for Clojure" :url "https://github.com/cgrand/xforms" :license {:name "Eclipse Public License" diff --git a/src/net/cgrand/xforms.cljc b/src/net/cgrand/xforms.cljc index ae896b4..c5047b2 100644 --- a/src/net/cgrand/xforms.cljc +++ b/src/net/cgrand/xforms.cljc @@ -25,6 +25,10 @@ x# (unreduced-> (-> x# ~expr) ~@exprs))))) +(defn- pair? [x] (and (vector? x) (= 2 (core/count x)))) +(defn- destructuring-pair? [x] + (and (pair? x) (not (or (keyword? x) (= '& x))))) + (defmacro for "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." @@ -33,9 +37,6 @@ `(eduction (for [~binding ~'% ~@seq-exprs] ~body-expr) ~%or_) (let [rf (gensym 'rf) acc (gensym 'acc) - pair? #(and (vector? %) (= 2 (core/count %))) - destructuring-pair? (every-pred pair? - #(not-any? (some-fn keyword? #{'&}) %)) rpairs (core/partition 2 (rseq (vec seq-exprs))) build (fn [init] (core/reduce (fn [body [expr binding]] @@ -74,16 +75,27 @@ (kvrf ([] (~rf)) ([~acc] (~rf ~acc)) - ([~acc ~binding] ~body) - ~(if (destructuring-pair? binding) - `([~acc ~@binding] ~body) - `([~acc k# v#] - (let [~binding (net.cgrand.macrovich/case :clj (clojure.lang.MapEntry. k# v#) :cljs [k# v#])] ~body))))))))) + ([~acc ~binding] ~body))))))) + +(defn- arity [[arglist & body :as fn-body]] + (let [[fixargs varargs] (split-with (complement #{'&}) arglist)] + (if (seq varargs) (zipmap (range (core/count fixargs) 4) (repeat fn-body))) + {(core/count fixargs) fn-body})) (defmacro kvrf [name? & fn-bodies] (let [name (if (symbol? name?) name? (gensym '_)) 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) + arities (core/into {} (mapcat arity) fn-bodies) + _ (when-not (core/some arities [2 3]) (throw (ex-info "Either arity 2 or 3 should be defined in kvrf." {:form &form}))) + fn-bodies (cond-> fn-bodies + (not (arities 3)) (conj (let [[[acc arg] & body] (arities 2)] + (if (destructuring-pair? arg) + (let [[karg varg] arg] + `([~acc ~karg ~varg] ~@body)) + `([~acc k# v#] (let [~arg (macros/case :clj (clojure.lang.MapEntry. k# v#) :cljs [k# v#])] ~@body))))) + (not (arities 2)) (conj (let [[[acc karg varg] & body] (arities 3)] + `([~acc [~karg ~varg]] ~@body))))] `(reify ~@(macros/case :clj '[clojure.lang.Fn]) KvRfable @@ -93,7 +105,7 @@ (let [nohint-args (map (fn [arg] (if (:tag (meta arg)) (gensym 'arg) arg)) args) rebind (mapcat (fn [arg nohint] (when-not (= arg nohint) [arg nohint])) args nohint-args)] - `(~(macros/case :cljs `core/-invoke :clj 'invoke) [~name ~@nohint-args] (let [~@rebind] ~@body))))))) + `(~(macros/case :cljs `core/-invoke :clj 'invoke) [~name ~@nohint-args] ~@(if (seq rebind) [`(let [~@rebind] ~@body)] body))))))) (defmacro ^:private let-complete [[binding volatile] & body] `(let [v# @~volatile] @@ -122,8 +134,7 @@ (kvrf ([] (rf)) ([acc] (rf acc)) - ([acc x] (rf acc x)) - ([acc k v] (rf acc #?(:clj (clojure.lang.MapEntry. k v) :cljs [k v])))))) + ([acc x] (rf acc x))))) (defn reduce "A transducer that reduces a collection to a 1-item collection consisting of only the reduced result. @@ -207,14 +218,12 @@ (kvrf ([] (rf)) ([acc] (rf acc)) - ([acc kv] (rf acc (val kv))) ([acc k v] (rf acc v)))) (defn keys [rf] (kvrf ([] (rf)) ([acc] (rf acc)) - ([acc kv] (rf acc (key kv))) ([acc k v] (rf acc k)))) ;; for both map entries and vectors @@ -264,8 +273,6 @@ (kvrf self ([] (rf)) ([acc] (let-complete [m m] (rf (core/reduce (fn [acc krf] (krf acc)) acc (core/vals (persistent! m)))))) - ([acc x] - (self acc (key' x) (val' x))) ([acc k v] (let [krf (or (get @m k) (doto (xform (make-rf k)) (->> (vswap! m assoc! k)))) acc (krf acc v)] @@ -295,8 +302,7 @@ (do (vswap! m assoc! k nop-rf) (krf @acc))) - acc))) - ([acc k v] (self acc #?(:clj (clojure.lang.MapEntry. k v) :cljs [k v]))))))))))) + acc))))))))))) (defn into-by-key "A shorthand for the common case (comp (x/by-key ...) (x/into {}))."