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

cljd support

Browse source
This commit is contained in:
Baptiste Dupuch 2023-07-06 14:01:06 +02:00 committed by Christophe Grand
parent 1e23966d5e
commit c6f4b7d041
2 changed files with 174 additions and 127 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
deps.edn
View file

@ -5,6 +5,13 @@
{:dev {:dev
{:extra-paths ["dev"]} {:extra-paths ["dev"]}
:cljd
{:extra-deps
{tensegritics/clojuredart
{:local/root "../../../cljd/open-source/ClojureDart"}
#_{:git/url "https://github.com/tensegritics/ClojureDart.git"
:sha "ae1b485e84ccc35b122f776dfc7cc62198274701"}}}
:clj-1-9 :clj-1-9
{:extra-deps {:extra-deps
{org.clojure/clojure {:mvn/version "1.9.0"} {org.clojure/clojure {:mvn/version "1.9.0"}

254
src/net/cgrand/xforms.cljc
View file

@ -4,24 +4,31 @@
#?(:cljs (:require-macros #?(:cljs (:require-macros
[net.cgrand.macrovich :as macros] [net.cgrand.macrovich :as macros]
[net.cgrand.xforms :refer [for kvrf let-complete]]) [net.cgrand.xforms :refer [for kvrf let-complete]])
:clj (:require [net.cgrand.macrovich :as macros])) :default (:require [net.cgrand.macrovich :as macros]))
(:refer-clojure :exclude [some reduce reductions into count for partition (:refer-clojure :exclude [some reduce reductions into count for partition
str last keys vals min max drop-last take-last str last keys vals min max drop-last take-last
sort sort-by time #?@(:bb [] :clj [satisfies?])]) sort sort-by time #?@(:bb [] :cljd/clj-host [] :clj [satisfies?])])
(:require [#?(:clj clojure.core :cljs cljs.core) :as core] (:require [#?(:cljd cljd.core :clj clojure.core :cljs cljs.core) :as core]
[net.cgrand.xforms.rfs :as rf] [net.cgrand.xforms.rfs :as rf]
#?(:clj [clojure.core.protocols])) #?@(:cljd [["dart:collection" :as dart:coll]] :clj [[clojure.core.protocols]] :cljs []))
#?(:cljd/clj-host
; customize the clj/jvm ns used for macroexpansion
(:host-ns (:require [clojure.core :as core]
[net.cgrand.macrovich :as macros])))
#?(:cljs (:import [goog.structs Queue]))) #?(:cljs (:import [goog.structs Queue])))
(defn- pair? [x] (and (vector? x) (= 2 (core/count x)))) (defn- ^:macro-support pair? [x] (and (vector? x) (= 2 (core/count x))))
(let [kw-or-& #(or (keyword? %) (= '& %))] (def ^:macro-support destructuring-pair?
(defn destructuring-pair? [x] (let [kw-or-& #(or (keyword? %) (= '& %))]
(and (pair? x) (fn [x]
(not (kw-or-& (first x)))))) (and (pair? x)
(not (kw-or-& (first x)))))))
(macros/deftime (macros/deftime
(defn- no-user-meta? [x] (defn- ^:macro-support no-user-meta? [x]
(= {} (dissoc (or (meta x) {}) :file :line :column :end-line :end-column))) (= {} (dissoc (or (meta x) {}) :file :line :column :end-line :end-column)))
(defmacro unreduced-> (defmacro unreduced->
@ -82,7 +89,7 @@
([~acc] (~rf ~acc)) ([~acc] (~rf ~acc))
([~acc ~binding] ~body))))))) ([~acc ~binding] ~body)))))))
(defn- arity [[arglist & body :as fn-body]] (defn- ^:macro-support arity [[arglist & body :as fn-body]]
(let [[fixargs varargs] (split-with (complement #{'&}) arglist)] (let [[fixargs varargs] (split-with (complement #{'&}) arglist)]
(if (seq varargs) (zipmap (range (core/count fixargs) 4) (repeat fn-body))) (if (seq varargs) (zipmap (range (core/count fixargs) 4) (repeat fn-body)))
{(core/count fixargs) fn-body})) {(core/count fixargs) fn-body}))
@ -98,20 +105,36 @@
(if (destructuring-pair? arg) (if (destructuring-pair? arg)
(let [[karg varg] arg] (let [[karg varg] arg]
`([~acc ~karg ~varg] ~@body)) `([~acc ~karg ~varg] ~@body))
`([~acc k# v#] (let [~arg (macros/case :clj (clojure.lang.MapEntry. k# v#) :cljs [k# v#])] ~@body))))) `([~acc k# v#] (let [~arg
(macros/case
:clj (clojure.lang.MapEntry. k# v#)
:cljs [k# v#]
:cljd (MapEntry k# v#))] ~@body)))))
(not (arities 2)) (conj (let [[[acc karg varg] & body] (arities 3)] (not (arities 2)) (conj (let [[[acc karg varg] & body] (arities 3)]
`([~acc [~karg ~varg]] ~@body))))] `([~acc [~karg ~varg]] ~@body))))
fn-bodies
(core/for [[[acc x :as args] & body :as fn-body] fn-bodies]
(if (and (= 2 (core/count args)) (vector? x))
`([~acc x#] (let [~x x#] ~@body))
fn-body))]
`(reify `(reify
#?@(:bb [] ;; babashka currently only supports reify with one Java interface at a time #?@(:bb [] ;; babashka currently only supports reify with one Java interface at a time
:default [~@(macros/case :clj '[clojure.lang.Fn])]) :default [~@(macros/case :cljd '[cljd.core/Fn] :clj '[clojure.lang.Fn])])
KvRfable KvRfable
(some-kvrf [this#] this#) (some-kvrf [this#] this#)
~(macros/case :cljs `core/IFn :clj 'clojure.lang.IFn) ~(macros/case :cljs `core/IFn :clj 'clojure.lang.IFn :cljd 'cljd.core/IFn)
#_~@(map (fn [[args & body]]
(list* 'cljd.core/-invoke (core/into [name] args) body))
#_'[([f] 0) ([f a] 1) ([f a b] 2) ([f a b c] 3)]
fn-bodies
#_(throw (ex-info "CACA" {:dc fn-bodies})))
~@(core/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)]
`(~(macros/case :cljs `core/-invoke :clj 'invoke) [~name ~@nohint-args] ~@(if (seq rebind) [`(let [~@rebind] ~@body)] body))))))) `(~(macros/case :cljd 'cljd.core/-invoke :cljs `core/-invoke :clj 'invoke)
[~name ~@nohint-args] ~@(if (seq rebind) [`(let [~@rebind] ~@body)] body)))))))
(defmacro ^:private let-complete [[binding volatile] & body] (defmacro ^:private let-complete [[binding volatile] & body]
`(let [v# @~volatile] `(let [v# @~volatile]
@ -131,6 +154,7 @@
;; Workaround clojure.core/satisfies? being slow in Clojure ;; Workaround clojure.core/satisfies? being slow in Clojure
;; see https://ask.clojure.org/index.php/3304/make-satisfies-as-fast-as-a-protocol-method-call ;; see https://ask.clojure.org/index.php/3304/make-satisfies-as-fast-as-a-protocol-method-call
#?(:bb nil #?(:bb nil
:cljd nil
:clj :clj
(defn fast-satisfies?-fn (defn fast-satisfies?-fn
"Ported from https://github.com/clj-commons/manifold/blob/37658e91f836047a630586a909a2e22debfbbfc6/src/manifold/utils.clj#L77-L89" "Ported from https://github.com/clj-commons/manifold/blob/37658e91f836047a630586a909a2e22debfbbfc6/src/manifold/utils.clj#L77-L89"
@ -147,11 +171,14 @@
val) val)
val)))))) val))))))
#?(:cljs #?(:cljs
(defn kvreducible? [coll] (defn kvreducible? [coll]
(satisfies? IKVReduce coll)) (satisfies? IKVReduce coll))
:cljd
(defn kvreducible? [coll]
(satisfies? cljd.core/IKVReduce coll))
:clj :clj
(let [satisfies-ikvreduce? #?(:bb #(satisfies? clojure.core.protocols/IKVReduce %) (let [satisfies-ikvreduce? #?(:bb #(satisfies? clojure.core.protocols/IKVReduce %)
:default (fast-satisfies?-fn #'clojure.core.protocols/IKVReduce))] :default (fast-satisfies?-fn #'clojure.core.protocols/IKVReduce))]
@ -163,7 +190,7 @@
(extend-protocol KvRfable (extend-protocol KvRfable
#?(:clj Object :cljs default) (some-kvrf [_] nil) #?(:cljd fallback :clj Object :cljs default) (some-kvrf [_] nil)
#?@(:clj [nil (some-kvrf [_] nil)])) #?@(:clj [nil (some-kvrf [_] nil)]))
(defn ensure-kvrf [rf] (defn ensure-kvrf [rf]
@ -197,8 +224,9 @@
(defn- into-rf [to] (defn- into-rf [to]
(cond (cond
#?(:clj (instance? clojure.lang.IEditableCollection to) #?(:cljd (satisfies? cljd.core/IEditableCollection to)
:cljs (satisfies? IEditableCollection to)) :clj (instance? clojure.lang.IEditableCollection to)
:cljs (satisfies? IEditableCollection to))
(if (map? to) (if (map? to)
(kvrf (kvrf
([] (transient to)) ([] (transient to))
@ -235,8 +263,9 @@
(defn- without-rf [from] (defn- without-rf [from]
(cond (cond
#?(:clj (instance? clojure.lang.IEditableCollection from) #?(:cljd (satisfies? cljd.core/IEditableCollection from)
:cljs (satisfies? IEditableCollection from)) :clj (instance? clojure.lang.IEditableCollection from)
:cljs (satisfies? IEditableCollection from))
(if (map? from) (if (map? from)
(fn (fn
([] (transient from)) ([] (transient from))
@ -410,32 +439,36 @@
(comp (apply by-key by-key-args) (into coll))) (comp (apply by-key by-key-args) (into coll)))
(macros/replace (macros/replace
[#?(:cljs {(java.util.ArrayDeque. n) (Queue.) [#?(:cljd {(java.util.ArrayDeque. n) (dart:coll/Queue)
.add .add
.poll .removeFirst
.size .-length})
#?(:cljs {(java.util.ArrayDeque. n) (Queue.)
.add .enqueue .add .enqueue
.poll .dequeue .poll .dequeue
.size .getCount}) .size .getCount})
#?(:clj {(.getValues dq) dq})] #?(:clj {(.getValues dq) dq})]
(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."
([n] ([n]
(partition n n (into []))) (partition n n (into [])))
([n step-or-xform] ([n step-or-xform]
(if (fn? step-or-xform) (if (fn? step-or-xform)
(partition n n step-or-xform) (partition n n step-or-xform)
(partition n step-or-xform (into [])))) (partition n step-or-xform (into []))))
([^long n step pad-or-xform] ([#?(:cljd ^int n :default ^long n) step pad-or-xform]
(if (fn? pad-or-xform) (if (fn? pad-or-xform)
(let [xform pad-or-xform] (let [xform pad-or-xform]
(fn [rf] (fn [rf]
(let [mxrf (multiplexable rf) (let [mxrf (multiplexable rf)
dq (java.util.ArrayDeque. n) dq (java.util.ArrayDeque. n)
barrier (volatile! n) barrier (volatile! n)
xform (comp (map #(if (identical? dq %) nil %)) xform)] xform (comp (map #(if (identical? dq %) nil %)) xform)]
(fn (fn
([] (rf)) ([] (rf))
([acc] (.clear dq) (rf acc)) ([acc] (.clear dq) (rf acc))
([acc x] ([acc x]
(let [b (vswap! barrier dec)] (let [b (vswap! barrier dec)]
(when (< b n) (.add dq (if (nil? x) dq x))) (when (< b n) (.add dq (if (nil? x) dq x)))
(if (zero? b) (if (zero? b)
@ -445,24 +478,24 @@
(vswap! barrier + step) (vswap! barrier + step)
acc) acc)
acc))))))) acc)))))))
(partition n step pad-or-xform (into [])))) (partition n step pad-or-xform (into []))))
([^long n step pad xform] ([#?(:cljd ^int n :default ^long n) step pad xform]
(fn [rf] (fn [rf]
(let [mxrf (multiplexable rf) (let [mxrf (multiplexable rf)
dq (java.util.ArrayDeque. n) dq (java.util.ArrayDeque. n)
barrier (volatile! n) barrier (volatile! n)
xform (comp (map #(if (identical? dq %) nil %)) xform)] xform (comp (map #(if (identical? dq %) nil %)) xform)]
(fn (fn
([] (rf)) ([] (rf))
([acc] (if (< @barrier n) ([acc] (if (< @barrier n)
(let [xform (comp cat (take n) xform) (let [xform (comp cat (take n) xform)
; don't use mxrf for completion: we want completion and don't want reduced-wrapping ; don't use mxrf for completion: we want completion and don't want reduced-wrapping
acc (transduce xform rf acc [(.getValues dq) pad])] acc (transduce xform rf acc [(.getValues dq) pad])]
(vreset! barrier n) (vreset! barrier n)
(.clear dq) (.clear dq)
acc) acc)
(rf acc))) (rf acc)))
([acc x] ([acc x]
(let [b (vswap! barrier dec)] (let [b (vswap! barrier dec)]
(when (< b n) (.add dq (if (nil? x) dq x))) (when (< b n) (.add dq (if (nil? x) dq x)))
(if (zero? b) (if (zero? b)
@ -477,7 +510,7 @@
(fn [rf] (fn [rf]
(let ))) (let )))
(defn take-last [^long n] (defn take-last [#?(:cljd ^int n :default ^long n)]
(fn [rf] (fn [rf]
(let [dq (java.util.ArrayDeque. n)] (let [dq (java.util.ArrayDeque. n)]
(fn (fn
@ -490,7 +523,7 @@
(defn drop-last (defn drop-last
([] (drop-last 1)) ([] (drop-last 1))
([^long n] ([#?(:cljd ^int n :default ^long n)]
(fn [rf] (fn [rf]
(let [dq (java.util.ArrayDeque. n) (let [dq (java.util.ArrayDeque. n)
xform (map #(if (identical? dq %) nil %)) xform (map #(if (identical? dq %) nil %))
@ -527,17 +560,20 @@
([] (sort compare)) ([] (sort compare))
([cmp] ([cmp]
(fn [rf] (fn [rf]
(let [buf #?(:clj (java.util.ArrayList.) :cljs #js [])] (let [buf #?(:cljd #dart [] :clj (java.util.ArrayList.) :cljs #js [])]
(fn (fn
([] (rf)) ([] (rf))
([acc] (rf (core/reduce rf acc (doto buf #?(:clj (java.util.Collections/sort cmp) :cljs (.sort (fn->comparator cmp))))))) ([acc] (rf (core/reduce rf acc (doto buf #?(:cljd (.sort (dart-comparator cmp))
([acc x] (#?(:clj .add :cljs .push) buf x) acc)))))) :clj (java.util.Collections/sort cmp)
:cljs (.sort (fn->comparator cmp)))))))
([acc x] (#?(:cljd .add :clj .add :cljs .push) buf x) acc))))))
(defn sort-by (defn sort-by
([kfn] (sort-by kfn compare)) ([kfn] (sort-by kfn compare))
([kfn cmp] ([kfn cmp]
(sort (fn [a b] (sort (fn [a b]
#?(:clj (.compare ^java.util.Comparator cmp (kfn a) (kfn b)) #?(:cljd (cmp (kfn a) (kfn b))
:clj (.compare ^java.util.Comparator cmp (kfn a) (kfn b))
:cljs (cmp (kfn a) (kfn b))))))) :cljs (cmp (kfn a) (kfn b)))))))
(defn reductions (defn reductions
@ -603,7 +639,8 @@
(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 #?(:cljd nil
:clj
(defn iterator (defn iterator
"Iterator transducing context, returns an iterator on the transformed data. "Iterator transducing context, returns an iterator on the transformed data.
Equivalent to (.iterator (eduction xform (iterator-seq src-iterator))) except there's is no buffering on values (as in iterator-seq), Equivalent to (.iterator (eduction xform (iterator-seq src-iterator))) except there's is no buffering on values (as in iterator-seq),
@ -634,7 +671,8 @@
(if (identical? NULL x) nil x)) (if (identical? NULL x) nil x))
(throw (java.util.NoSuchElementException.)))))))) (throw (java.util.NoSuchElementException.))))))))
#?(:clj #?(:cljd nil
:clj
(defn window-by-time (defn window-by-time
"ALPHA "ALPHA
Returns a transducer which computes a windowed accumulator over chronologically sorted items. Returns a transducer which computes a windowed accumulator over chronologically sorted items.
@ -700,11 +738,11 @@
"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 #?(:clj (java.util.concurrent.atomic.AtomicLong.) :cljs (atom 0))] (let [n #?(:cljd (volatile! 0) :clj (java.util.concurrent.atomic.AtomicLong.) :cljs (volatile! 0))]
(fn (fn
([] (rf)) ([] (rf))
([acc] (rf (unreduced (rf acc #?(:clj (.get n) :cljs @n))))) ([acc] (rf (unreduced (rf acc #?(:cljd @n :clj (.get n) :cljs @n)))))
([acc _] #?(:clj (.incrementAndGet n) :cljs (swap! n inc)) acc)))) ([acc _] #?(:cljd (vswap! n inc) :clj (.incrementAndGet n) :cljs (vswap! n inc)) acc))))
([xform coll] ([xform coll]
(transduce (comp xform count) rf/last coll))) (transduce (comp xform count) rf/last coll)))
@ -798,43 +836,45 @@
(.addAndGet at (- (System/nanoTime) t)) (swap! at + (- (system-time) t)) (.addAndGet at (- (System/nanoTime) t)) (swap! at + (- (system-time) t))
.size .getCount})] .size .getCount})]
(defn time #?(:cljd nil
"Measures the time spent in this transformation and prints the measured time. :default
(defn time
"Measures the time spent in this transformation and prints the measured time.
tag-or-f may be either a function of 1 argument (measured time in ms) in which case tag-or-f may be either a function of 1 argument (measured time in ms) in which case
this function will be called instead of printing, or tag-or-f will be print before the measured time." this function will be called instead of printing, or tag-or-f will be print before the measured time."
([xform] (time "Elapsed time" xform)) ([xform] (time "Elapsed time" xform))
([tag-or-f xform] ([tag-or-f xform]
(let [pt (if (fn? tag-or-f) (let [pt (if (fn? tag-or-f)
tag-or-f tag-or-f
#(println (core/str tag-or-f ": " % " msecs")))] #(println (core/str tag-or-f ": " % " msecs")))]
(fn [rf] (fn [rf]
(let [at (java.util.concurrent.atomic.AtomicLong.) (let [at (java.util.concurrent.atomic.AtomicLong.)
rf rf
(fn (fn
([] (rf)) ([] (rf))
([acc] (let [t (System/nanoTime) ([acc] (let [t (System/nanoTime)
r (rf acc)] r (rf acc)]
(.addAndGet at (- t (System/nanoTime))) (.addAndGet at (- t (System/nanoTime)))
r)) r))
([acc x] ([acc x]
(let [t (System/nanoTime) (let [t (System/nanoTime)
r (rf acc x)] r (rf acc x)]
(.addAndGet at (- t (System/nanoTime))) (.addAndGet at (- t (System/nanoTime)))
r))) r)))
rf (xform rf)] rf (xform rf)]
(fn (fn
([] (rf)) ([] (rf))
([acc] ([acc]
(let [t (System/nanoTime) (let [t (System/nanoTime)
r (rf acc) r (rf acc)
total (.addAndGet at (- (System/nanoTime) t))] total (.addAndGet at (- (System/nanoTime) t))]
(pt #?(:clj (* total 1e-6) :cljs total)) (pt #?(:clj (* total 1e-6) :cljs total))
r)) r))
([acc x] ([acc x]
(let [t (System/nanoTime) (let [t (System/nanoTime)
r (rf acc x)] r (rf acc x)]
(.addAndGet at (- (System/nanoTime) t)) (.addAndGet at (- (System/nanoTime) t))
r))))))))) r))))))))))
#_(defn rollup #_(defn rollup
"Roll-up input data along the provided dimensions (which are functions of one input item), "Roll-up input data along the provided dimensions (which are functions of one input item),