cljd support

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

View file

@ -5,6 +5,13 @@
{: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
{:extra-deps
{org.clojure/clojure {:mvn/version "1.9.0"}

View file

@ -4,24 +4,31 @@
#?(:cljs (:require-macros
[net.cgrand.macrovich :as macros]
[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
str last keys vals min max drop-last take-last
sort sort-by time #?@(:bb [] :clj [satisfies?])])
(:require [#?(:clj clojure.core :cljs cljs.core) :as core]
sort sort-by time #?@(:bb [] :cljd/clj-host [] :clj [satisfies?])])
(:require [#?(:cljd cljd.core :clj clojure.core :cljs cljs.core) :as core]
[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])))
(defn- pair? [x] (and (vector? x) (= 2 (core/count x))))
(defn- ^:macro-support pair? [x] (and (vector? x) (= 2 (core/count x))))
(def ^:macro-support destructuring-pair?
(let [kw-or-& #(or (keyword? %) (= '& %))]
(defn destructuring-pair? [x]
(fn [x]
(and (pair? x)
(not (kw-or-& (first x))))))
(not (kw-or-& (first x)))))))
(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)))
(defmacro unreduced->
@ -82,7 +89,7 @@
([~acc] (~rf ~acc))
([~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)]
(if (seq varargs) (zipmap (range (core/count fixargs) 4) (repeat fn-body)))
{(core/count fixargs) fn-body}))
@ -98,20 +105,36 @@
(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)))))
`([~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)]
`([~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
#?@(: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
(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]
(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] ~@(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]
`(let [v# @~volatile]
@ -131,6 +154,7 @@
;; 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
#?(:bb nil
:cljd nil
:clj
(defn fast-satisfies?-fn
"Ported from https://github.com/clj-commons/manifold/blob/37658e91f836047a630586a909a2e22debfbbfc6/src/manifold/utils.clj#L77-L89"
@ -147,11 +171,14 @@
val)
val))))))
#?(:cljs
(defn kvreducible? [coll]
(satisfies? IKVReduce coll))
:cljd
(defn kvreducible? [coll]
(satisfies? cljd.core/IKVReduce coll))
:clj
(let [satisfies-ikvreduce? #?(:bb #(satisfies? clojure.core.protocols/IKVReduce %)
:default (fast-satisfies?-fn #'clojure.core.protocols/IKVReduce))]
@ -163,7 +190,7 @@
(extend-protocol KvRfable
#?(:clj Object :cljs default) (some-kvrf [_] nil)
#?(:cljd fallback :clj Object :cljs default) (some-kvrf [_] nil)
#?@(:clj [nil (some-kvrf [_] nil)]))
(defn ensure-kvrf [rf]
@ -197,7 +224,8 @@
(defn- into-rf [to]
(cond
#?(:clj (instance? clojure.lang.IEditableCollection to)
#?(:cljd (satisfies? cljd.core/IEditableCollection to)
:clj (instance? clojure.lang.IEditableCollection to)
:cljs (satisfies? IEditableCollection to))
(if (map? to)
(kvrf
@ -235,7 +263,8 @@
(defn- without-rf [from]
(cond
#?(:clj (instance? clojure.lang.IEditableCollection from)
#?(:cljd (satisfies? cljd.core/IEditableCollection from)
:clj (instance? clojure.lang.IEditableCollection from)
:cljs (satisfies? IEditableCollection from))
(if (map? from)
(fn
@ -410,7 +439,11 @@
(comp (apply by-key by-key-args) (into coll)))
(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
.poll .dequeue
.size .getCount})
@ -424,7 +457,7 @@
(if (fn? step-or-xform)
(partition n n step-or-xform)
(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)
(let [xform pad-or-xform]
(fn [rf]
@ -446,7 +479,7 @@
acc)
acc)))))))
(partition n step pad-or-xform (into []))))
([^long n step pad xform]
([#?(:cljd ^int n :default ^long n) step pad xform]
(fn [rf]
(let [mxrf (multiplexable rf)
dq (java.util.ArrayDeque. n)
@ -477,7 +510,7 @@
(fn [rf]
(let )))
(defn take-last [^long n]
(defn take-last [#?(:cljd ^int n :default ^long n)]
(fn [rf]
(let [dq (java.util.ArrayDeque. n)]
(fn
@ -490,7 +523,7 @@
(defn drop-last
([] (drop-last 1))
([^long n]
([#?(:cljd ^int n :default ^long n)]
(fn [rf]
(let [dq (java.util.ArrayDeque. n)
xform (map #(if (identical? dq %) nil %))
@ -527,17 +560,20 @@
([] (sort compare))
([cmp]
(fn [rf]
(let [buf #?(:clj (java.util.ArrayList.) :cljs #js [])]
(let [buf #?(:cljd #dart [] :clj (java.util.ArrayList.) :cljs #js [])]
(fn
([] (rf))
([acc] (rf (core/reduce rf acc (doto buf #?(:clj (java.util.Collections/sort cmp) :cljs (.sort (fn->comparator cmp)))))))
([acc x] (#?(:clj .add :cljs .push) buf x) acc))))))
([acc] (rf (core/reduce rf acc (doto buf #?(:cljd (.sort (dart-comparator cmp))
: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
([kfn] (sort-by kfn compare))
([kfn cmp]
(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)))))))
(defn reductions
@ -603,7 +639,8 @@
(vreset! vi (let [i (inc i)] (if (= n i) 0 i)))
(rf acc (f (vreset! vwacc (f (invf wacc x') x))))))))))))
#?(:clj
#?(:cljd nil
:clj
(defn iterator
"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),
@ -634,7 +671,8 @@
(if (identical? NULL x) nil x))
(throw (java.util.NoSuchElementException.))))))))
#?(:clj
#?(:cljd nil
:clj
(defn window-by-time
"ALPHA
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
as a transducing context."
([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
([] (rf))
([acc] (rf (unreduced (rf acc #?(:clj (.get n) :cljs @n)))))
([acc _] #?(:clj (.incrementAndGet n) :cljs (swap! n inc)) acc))))
([acc] (rf (unreduced (rf acc #?(:cljd @n :clj (.get n) :cljs @n)))))
([acc _] #?(:cljd (vswap! n inc) :clj (.incrementAndGet n) :cljs (vswap! n inc)) acc))))
([xform coll]
(transduce (comp xform count) rf/last coll)))
@ -798,6 +836,8 @@
(.addAndGet at (- (System/nanoTime) t)) (swap! at + (- (system-time) t))
.size .getCount})]
#?(:cljd nil
: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
@ -834,7 +874,7 @@
(let [t (System/nanoTime)
r (rf acc x)]
(.addAndGet at (- (System/nanoTime) t))
r)))))))))
r))))))))))
#_(defn rollup
"Roll-up input data along the provided dimensions (which are functions of one input item),