summaryrefslogtreecommitdiff
path: root/assets/viz/2/cljs/core.cljs
diff options
context:
space:
mode:
Diffstat (limited to 'assets/viz/2/cljs/core.cljs')
-rw-r--r--assets/viz/2/cljs/core.cljs1843
1 files changed, 1323 insertions, 520 deletions
diff --git a/assets/viz/2/cljs/core.cljs b/assets/viz/2/cljs/core.cljs
index a87e53b..c7f6d9a 100644
--- a/assets/viz/2/cljs/core.cljs
+++ b/assets/viz/2/cljs/core.cljs
@@ -11,17 +11,34 @@
goog.math.Integer
[goog.string :as gstring]
[goog.object :as gobject]
- [goog.array :as garray])
+ [goog.array :as garray]
+ [goog.Uri])
(:import [goog.string StringBuffer]))
;; next line is auto-generated by the build-script - Do not edit!
-(def *clojurescript-version* "1.9.473")
+(def *clojurescript-version* "1.10.439")
+;; Setting of these Vars is in ClojureScript code is associated with intrinsics
+;; that affect compilation state, but otherwise turn into no-ops in the emitted
+;; JavaScript.
+
+;; The scope of *unchecked-if* is controlled by balanced pairs of set! calls.
(def *unchecked-if* false)
+;; The scope of *unchecked-arrays* is file-scope: In JVM ClojureScript its side-
+;; effect is to set same-named analyzer dynamic Var, which is unset via binding
+;; scopes. In self-hosted it is cleared via cljs.js/post-file-side-effects.
+(def *unchecked-arrays* false)
+;; The scope of *warn-on-infer* is file-scope: Its side effect is to set the
+;; cljs.analyzer/*cljs-warnings* dynamic Var, which is unset via binding scopes.
(def *warn-on-infer* false)
+(set! *unchecked-arrays* true)
+
(defonce PROTOCOL_SENTINEL #js {})
+(def MODULE_URIS nil) ;; set by compiler
+(def MODULE_INFOS nil) ;; set by compiler
+
(goog-define
^{:dynamic true
:doc "Var bound to the name value of the compiler build :target option.
@@ -49,17 +66,22 @@
^{:doc "Each runtime environment provides a different way to print output.
Whatever function *print-fn* is bound to will be passed any
Strings which should be printed." :dynamic true}
- *print-fn*
- (fn [_]
- (throw (js/Error. "No *print-fn* fn set for evaluation environment"))))
+ *print-fn* nil)
+
+(defn ^{:doc "Arranges to have tap functions executed via the supplied f, a
+ function of no arguments. Returns true if successful, false otherwise." :dynamic true}
+ *exec-tap-fn*
+ [f]
+ (and
+ (exists? js/setTimeout)
+ (js/setTimeout f 0)
+ true))
(defonce
^{:doc "Each runtime environment provides a different way to print error output.
Whatever function *print-err-fn* is bound to will be passed any
Strings which should be printed." :dynamic true}
- *print-err-fn*
- (fn [_]
- (throw (js/Error. "No *print-err-fn* fn set for evaluation environment"))))
+ *print-err-fn* nil)
(defn set-print-fn!
"Set *print-fn* to f."
@@ -140,6 +162,12 @@
:jsdoc ["@type {null|number}"]}
*print-level* nil)
+(def
+ ^{:dynamic true
+ :doc "*print-fns-bodies* controls whether functions print their source or
+ only their names."}
+ *print-fn-bodies* false)
+
(defonce
^{:dynamic true
:jsdoc ["@type {*}"]}
@@ -158,12 +186,14 @@
"Set *print-fn* to console.log"
[]
(set! *print-newline* false)
- (set! *print-fn*
- (fn [& args]
- (.apply (.-log js/console) js/console (into-array args))))
- (set! *print-err-fn*
- (fn [& args]
- (.apply (.-error js/console) js/console (into-array args))))
+ (set-print-fn!
+ (fn []
+ (let [xs (js-arguments)]
+ (.apply (.-log js/console) js/console (garray/clone xs)))))
+ (set-print-err-fn!
+ (fn []
+ (let [xs (js-arguments)]
+ (.apply (.-error js/console) js/console (garray/clone xs)))))
nil)
(def
@@ -252,8 +282,8 @@
[p x]
(let [x (if (nil? x) nil x)]
(cond
- (aget p (goog/typeOf x)) true
- (aget p "_") true
+ (unchecked-get p (goog/typeOf x)) true
+ (unchecked-get p "_") true
:else false)))
(set! *unchecked-if* false)
@@ -267,6 +297,11 @@
argv as arguments"}
*main-cli-fn* nil)
+(def
+ ^{:doc "A sequence of the supplied command line arguments, or nil if
+ none were supplied"}
+ *command-line-args* nil)
+
(defn type
"Return x's constructor."
[x]
@@ -409,17 +444,67 @@
(recur (inc i)))
a))))
+(defn- maybe-warn
+ [e]
+ (when *print-err-fn*
+ (*print-err-fn* e)))
+
+(defn- checked-aget
+ ([array idx]
+ (when-assert
+ (try
+ (assert (or (array? array) (goog/isArrayLike array)))
+ (assert (number? idx))
+ (assert (not (neg? idx)))
+ (assert (< idx (alength array)))
+ (catch :default e
+ (maybe-warn e))))
+ (unchecked-get array idx))
+ ([array idx & idxs]
+ (apply checked-aget (checked-aget array idx) idxs)))
+
+(defn- checked-aset
+ ([array idx val]
+ (when-assert
+ (try
+ (assert (or (array? array) (goog/isArrayLike array)))
+ (assert (number? idx))
+ (assert (not (neg? idx)))
+ (assert (< idx (alength array)))
+ (catch :default e
+ (maybe-warn e))))
+ (unchecked-set array idx val))
+ ([array idx idx2 & idxv]
+ (apply checked-aset (checked-aget array idx) idx2 idxv)))
+
+(defn- checked-aget'
+ ([array idx]
+ {:pre [(or (array? array) (goog/isArrayLike array))
+ (number? idx) (not (neg? idx)) (< idx (alength array))]}
+ (unchecked-get array idx))
+ ([array idx & idxs]
+ (apply checked-aget' (checked-aget' array idx) idxs)))
+
+(defn- checked-aset'
+ ([array idx val]
+ {:pre [(or (array? array) (goog/isArrayLike array))
+ (number? idx) (not (neg? idx)) (< idx (alength array))]}
+ (unchecked-set array idx val))
+ ([array idx idx2 & idxv]
+ (apply checked-aset' (checked-aget' array idx) idx2 idxv)))
+
(defn aget
- "Returns the value at the index."
- ([array i]
- (cljs.core/aget array i))
- ([array i & idxs]
- (apply aget (aget array i) idxs)))
+ "Returns the value at the index/indices. Works on JavaScript arrays."
+ ([array idx]
+ (cljs.core/aget array idx))
+ ([array idx & idxs]
+ (apply aget (aget array idx) idxs)))
(defn aset
- "Sets the value at the index."
- ([array i val]
- (cljs.core/aset array i val))
+ "Sets the value at the index/indices. Works on JavaScript arrays.
+ Returns val."
+ ([array idx val]
+ (cljs.core/aset array idx val))
([array idx idx2 & idxv]
(apply aset (aget array idx) idx2 idxv)))
@@ -442,7 +527,7 @@
"Invoke JavaScript object method via string. Needed when the
string is not a valid unquoted property name."
[obj s & args]
- (.apply (aget obj s) obj (into-array args)))
+ (.apply (unchecked-get obj s) obj (into-array args)))
;;;;;;;;;;;;;;;;;;;;;;;;;;; core protocols ;;;;;;;;;;;;;
@@ -546,6 +631,10 @@
"Returns a new collection of coll with a mapping from key k to
value v added to it."))
+(defprotocol IFind
+ "Protocol for implementing entry finding in collections."
+ (-find [coll k] "Returns the map entry for key, or nil if key not present."))
+
(defprotocol IMap
"Protocol for adding mapping functionality to collections."
#_(-assoc-ex [coll k v])
@@ -846,17 +935,17 @@
(defn ^number m3-hash-unencoded-chars [in]
(let [h1 (loop [i 1 h1 m3-seed]
- (if (< i (alength in))
+ (if (< i (.-length in))
(recur (+ i 2)
(m3-mix-H1 h1
(m3-mix-K1
(bit-or (.charCodeAt in (dec i))
(bit-shift-left (.charCodeAt in i) 16)))))
h1))
- h1 (if (== (bit-and (alength in) 1) 1)
- (bit-xor h1 (m3-mix-K1 (.charCodeAt in (dec (alength in)))))
+ h1 (if (== (bit-and (.-length in) 1) 1)
+ (bit-xor h1 (m3-mix-K1 (.charCodeAt in (dec (.-length in)))))
h1)]
- (m3-fmix h1 (imul 2 (alength in)))))
+ (m3-fmix h1 (imul 2 (.-length in)))))
;;;;;;;;;;;;;;;;;;; symbols ;;;;;;;;;;;;;;;
@@ -869,7 +958,7 @@
;;http://hg.openjdk.java.net/jdk7u/jdk7u6/jdk/file/8c2c5d63a17e/src/share/classes/java/lang/String.java
(defn hash-string* [s]
(if-not (nil? s)
- (let [len (alength s)]
+ (let [len (.-length s)]
(if (pos? len)
(loop [i 0 hash 0]
(if (< i len)
@@ -880,7 +969,7 @@
(defn add-to-string-hash-cache [k]
(let [h (hash-string* k)]
- (aset string-hash-cache k h)
+ (gobject/set string-hash-cache k h)
(set! string-hash-cache-count (inc string-hash-cache-count))
h))
@@ -890,7 +979,7 @@
(set! string-hash-cache-count 0))
(if (nil? k)
0
- (let [h (aget string-hash-cache k)]
+ (let [h (unchecked-get string-hash-cache k)]
(if (number? h)
h
(add-to-string-hash-cache k)))))
@@ -901,15 +990,15 @@
[o]
(cond
(implements? IHash o)
- (-hash ^not-native o)
+ (bit-xor (-hash ^not-native o) 0)
(number? o)
(if (js/isFinite o)
(js-mod (Math/floor o) 2147483647)
(case o
- Infinity
+ ##Inf
2146435072
- -Infinity
+ ##-Inf
-1048576
2146959360))
@@ -924,12 +1013,12 @@
(m3-hash-int (hash-string o))
(instance? js/Date o)
- (.valueOf o)
+ (bit-xor (.valueOf o) 0)
(nil? o) 0
:else
- (-hash o)))
+ (bit-xor (-hash o) 0)))
(defn hash-combine [seed hash]
; a la boost
@@ -1125,7 +1214,7 @@
(IndexedSeq. coll 0 nil))
(string? coll)
- (when-not (zero? (alength coll))
+ (when-not (zero? (.-length coll))
(IndexedSeq. coll 0 nil))
(native-satisfies? ISeqable coll)
@@ -1633,7 +1722,7 @@ reduces them without incurring seq initialization"
(cons o coll))
IEmptyableCollection
- (-empty [coll] (with-meta (.-EMPTY List) meta))
+ (-empty [coll] (-with-meta (.-EMPTY List) meta))
IHash
(-hash [coll] (hash-ordered-coll coll))
@@ -1721,7 +1810,7 @@ reduces them without incurring seq initialization"
(alength coll)
(string? coll)
- (alength coll)
+ (.-length coll)
(implements? ISeqable coll)
(accumulating-seq-count coll)
@@ -1775,8 +1864,11 @@ reduces them without incurring seq initialization"
(.charAt coll n)
(throw (js/Error. "Index out of bounds")))
- (implements? ISeq coll)
- (linear-traversal-nth coll n)
+ (or (implements? ISeq coll)
+ (implements? ISequential coll))
+ (if (neg? n)
+ (throw (js/Error. "Index out of bounds"))
+ (linear-traversal-nth coll n))
(native-satisfies? IIndexed coll)
(-nth coll n)
@@ -1805,11 +1897,14 @@ reduces them without incurring seq initialization"
(.charAt coll n)
not-found)
- (implements? ISeq coll)
- (linear-traversal-nth coll n not-found)
+ (or (implements? ISeq coll)
+ (implements? ISequential coll))
+ (if (neg? n)
+ not-found
+ (linear-traversal-nth coll n not-found))
(native-satisfies? IIndexed coll)
- (-nth coll n)
+ (-nth coll n not-found)
:else
(throw (js/Error. (str "nth not supported on this type "
@@ -1819,7 +1914,7 @@ reduces them without incurring seq initialization"
"Returns the nth rest of coll, coll when n is 0."
[coll n]
(loop [n n xs coll]
- (if (and (pos? n) (seq xs))
+ (if-let [xs (and (pos? n) (seq xs))]
(recur (dec n) (rest xs))
xs)))
@@ -1865,7 +1960,7 @@ reduces them without incurring seq initialization"
:else not-found)
not-found)))
-(declare PersistentHashMap)
+(declare PersistentHashMap PersistentArrayMap MapEntry)
(defn assoc
"assoc[iate]. When applied to a map, returns a new map of the
@@ -1875,7 +1970,7 @@ reduces them without incurring seq initialization"
([coll k v]
(if-not (nil? coll)
(-assoc coll k v)
- (hash-map k v)))
+ (array-map k v)))
([coll k v & kvs]
(let [ret (assoc coll k v)]
(if kvs
@@ -2020,9 +2115,13 @@ reduces them without incurring seq initialization"
(satisfies? ISet x)))
(defn ^boolean associative?
- "Returns true if coll implements Associative"
+ "Returns true if coll implements IAssociative"
[x] (satisfies? IAssociative x))
+(defn ^boolean ifind?
+ "Returns true if coll implements IFind"
+ [x] (satisfies? IFind x))
+
(defn ^boolean sequential?
"Returns true if coll satisfies ISequential"
[x] (satisfies? ISequential x))
@@ -2069,12 +2168,11 @@ reduces them without incurring seq initialization"
(defn js-keys
"Return the JavaScript keys for an object."
[obj]
- (let [keys (array)]
- (gobject/forEach obj (fn [val key obj] (.push keys key)))
- keys))
+ (gobject/getKeys obj))
(defn js-delete
- "Delete a property from a JavaScript object."
+ "Delete a property from a JavaScript object.
+ Returns true upon success, false otherwise."
[obj key]
(cljs.core/js-delete obj key))
@@ -2126,6 +2224,7 @@ reduces them without incurring seq initialization"
"Return true if the seq function is supported for s"
[s]
(or
+ (nil? s)
(satisfies? ISeqable s)
(array? s)
(string? s)))
@@ -2176,7 +2275,7 @@ reduces them without incurring seq initialization"
:else false))
(defn ^boolean neg-int?
- "Return true if x satisfies int? and is positive."
+ "Return true if x satisfies int? and is negative."
[x]
(cond
(integer? x) (neg? x)
@@ -2194,13 +2293,13 @@ reduces them without incurring seq initialization"
[x]
(cond
(integer? x)
- (or (not (neg? x)) (zero? x))
+ (not (neg? x))
(instance? goog.math.Integer x)
- (or (not (.isNegative x)) (.isZero x))
+ (not (.isNegative x))
(instance? goog.math.Long x)
- (or (not (.isNegative x)) (.isZero x))
+ (not (.isNegative x))
:else false))
@@ -2234,10 +2333,12 @@ reduces them without incurring seq initialization"
(defn find
"Returns the map entry for key, or nil if key not present."
[coll k]
- (when (and (not (nil? coll))
- (associative? coll)
- (contains? coll k))
- [k (get coll k)]))
+ (if (ifind? coll)
+ (-find coll k)
+ (when (and (not (nil? coll))
+ (associative? coll)
+ (contains? coll k))
+ (MapEntry. k (get coll k) nil))))
(defn ^boolean distinct?
"Returns true if no two of the arguments are ="
@@ -2332,7 +2433,7 @@ reduces them without incurring seq initialization"
(defn sort-by
"Returns a sorted sequence of the items in coll, where the sort
order is determined by comparing (keyfn item). Comp can be
- boolean-valued comparison funcion, or a -/0/+ valued comparator.
+ boolean-valued comparison function, or a -/0/+ valued comparator.
Comp defaults to compare."
([keyfn coll]
(sort-by keyfn compare coll))
@@ -2363,6 +2464,29 @@ reduces them without incurring seq initialization"
(garray/shuffle a)
(vec a)))
+(defn- iter-reduce
+ ([coll f]
+ (let [iter (-iterator coll)]
+ (if (.hasNext iter)
+ (let [init (.next iter)]
+ (loop [acc init]
+ (if ^boolean (.hasNext iter)
+ (let [nacc (f acc (.next iter))]
+ (if (reduced? nacc)
+ @nacc
+ (recur nacc)))
+ acc)))
+ (f))))
+ ([coll f init]
+ (let [iter (-iterator coll)]
+ (loop [acc init]
+ (if ^boolean (.hasNext iter)
+ (let [nacc (f acc (.next iter))]
+ (if (reduced? nacc)
+ @nacc
+ (recur nacc)))
+ acc)))))
+
(defn reduce
"f should be a function of 2 arguments. If val is not supplied,
returns the result of applying f to the first 2 items in coll, then
@@ -2387,6 +2511,9 @@ reduces them without incurring seq initialization"
(native-satisfies? IReduce coll)
(-reduce coll f)
+ (iterable? coll)
+ (iter-reduce coll f)
+
:else
(seq-reduce f coll)))
([f val coll]
@@ -2403,6 +2530,9 @@ reduces them without incurring seq initialization"
(native-satisfies? IReduce coll)
(-reduce coll f val)
+ (iterable? coll)
+ (iter-reduce coll f val)
+
:else
(seq-reduce f val coll))))
@@ -2885,7 +3015,7 @@ reduces them without incurring seq initialization"
[obj fn-map]
(doseq [[key-name f] fn-map]
(let [str-name (name key-name)]
- (aset obj str-name f)))
+ (gobject/set obj str-name f)))
obj)
;;;;;;;;;;;;;;;; cons ;;;;;;;;;;;;;;;;
@@ -3046,7 +3176,7 @@ reduces them without incurring seq initialization"
"Returns a seq of the items in coll in reverse order. Not lazy."
[coll]
(if (reversible? coll)
- (rseq coll)
+ (or (rseq coll) ())
(reduce conj () coll)))
(defn list
@@ -3105,7 +3235,7 @@ reduces them without incurring seq initialization"
(-conj [coll o] (Cons. nil o coll nil))
IEmptyableCollection
- (-empty [coll] (with-meta (.-EMPTY List) meta))
+ (-empty [coll] (-with-meta (.-EMPTY List) meta))
ISequential
IEquiv
@@ -3214,7 +3344,7 @@ reduces them without incurring seq initialization"
(defn ^boolean qualified-ident?
"Return true if x is a symbol or keyword with a namespace"
- [x] (and (ident? x) (namespace x) true))
+ [x] (boolean (and (ident? x) (namespace x) true)))
(defn ^boolean simple-symbol?
"Return true if x is a symbol without a namespace"
@@ -3222,7 +3352,7 @@ reduces them without incurring seq initialization"
(defn ^boolean qualified-symbol?
"Return true if x is a symbol with a namespace"
- [x] (and (symbol? x) (namespace x) true))
+ [x] (boolean (and (symbol? x) (namespace x) true)))
(defn ^boolean simple-keyword?
"Return true if x is a keyword without a namespace"
@@ -3230,7 +3360,7 @@ reduces them without incurring seq initialization"
(defn ^boolean qualified-keyword?
"Return true if x is a keyword with a namespace"
- [x] (and (keyword? x) (namespace x) true))
+ [x] (boolean (and (keyword? x) (namespace x) true)))
(defn keyword
"Returns a Keyword with the given namespace and name. Do not use :
@@ -3283,7 +3413,7 @@ reduces them without incurring seq initialization"
(not fn))
IWithMeta
- (-with-meta [coll meta] (LazySeq. meta fn s __hash))
+ (-with-meta [coll meta] (LazySeq. meta #(-seq coll) nil __hash))
IMeta
(-meta [coll] meta)
@@ -3309,7 +3439,7 @@ reduces them without incurring seq initialization"
(-conj [coll o] (cons o coll))
IEmptyableCollection
- (-empty [coll] (with-meta (.-EMPTY List) meta))
+ (-empty [coll] (-with-meta (.-EMPTY List) meta))
ISequential
IEquiv
@@ -3342,7 +3472,7 @@ reduces them without incurring seq initialization"
(aset buf end o)
(set! end (inc end)))
- (chunk [_ o]
+ (chunk [_]
(let [ret (ArrayChunk. buf 0 end)]
(set! buf nil)
ret))
@@ -3399,7 +3529,7 @@ reduces them without incurring seq initialization"
(-lastIndexOf coll x (count coll)))
(lastIndexOf [coll x start]
(-lastIndexOf coll x start))
-
+
IWithMeta
(-with-meta [coll m]
(ChunkedCons. chunk more m __hash))
@@ -3428,9 +3558,8 @@ reduces them without incurring seq initialization"
(-next [coll]
(if (> (-count chunk) 1)
(ChunkedCons. (-drop-first chunk) more meta nil)
- (let [more (-seq more)]
- (when-not (nil? more)
- more))))
+ (when-not (nil? more)
+ (-seq more))))
IChunkedSeq
(-chunked-first [coll] chunk)
@@ -3450,7 +3579,7 @@ reduces them without incurring seq initialization"
(cons o this))
IEmptyableCollection
- (-empty [coll] (with-meta (.-EMPTY List) meta))
+ (-empty [coll] (-with-meta (.-EMPTY List) meta))
IHash
(-hash [coll] (caching-hash coll hash-ordered-coll __hash)))
@@ -3482,11 +3611,11 @@ reduces them without incurring seq initialization"
;;;;;;;;;;;;;;;;
(defn to-array
- "Naive impl of to-array as a start."
- [s]
+ "Returns an array containing the contents of coll."
+ [coll]
(let [ary (array)]
- (loop [s s]
- (if (seq s)
+ (loop [s (seq coll)]
+ (if-not (nil? s)
(do (. ary push (first s))
(recur (next s)))
ary))))
@@ -3497,7 +3626,7 @@ reduces them without incurring seq initialization"
[coll]
(let [ret (make-array (count coll))]
(loop [i 0 xs (seq coll)]
- (when xs
+ (when-not (nil? xs)
(aset ret i (to-array (first xs)))
(recur (inc i) (next xs))))
ret))
@@ -3604,11 +3733,12 @@ reduces them without incurring seq initialization"
(defn spread
[arglist]
- (cond
- (nil? arglist) nil
- (nil? (next arglist)) (seq (first arglist))
- :else (cons (first arglist)
- (spread (next arglist)))))
+ (when-not (nil? arglist)
+ (let [n (next arglist)]
+ (if (nil? n)
+ (seq (first arglist))
+ (cons (first arglist)
+ (spread n))))))
(defn concat
"Returns a lazy seq representing the concatenation of the elements in the supplied colls."
@@ -3719,52 +3849,89 @@ reduces them without incurring seq initialization"
(gen-apply-to)
(set! *unchecked-if* true)
+
+(defn- apply-to-simple
+ "Internal. DO NOT USE!
+ Assumes args was already called with seq beforehand!"
+ ([f ^seq args]
+ (if (nil? args)
+ (if (.-cljs$core$IFn$_invoke$arity$0 f)
+ (.cljs$core$IFn$_invoke$arity$0 f)
+ (.call f f))
+ (apply-to-simple f (-first args) (next args))))
+ ([f a0 ^seq args]
+ (if (nil? args)
+ (if (.-cljs$core$IFn$_invoke$arity$1 f)
+ (.cljs$core$IFn$_invoke$arity$1 f a0)
+ (.call f f a0))
+ (apply-to-simple f a0 (-first args) (next args))))
+ ([f a0 a1 ^seq args]
+ (if (nil? args)
+ (if (.-cljs$core$IFn$_invoke$arity$2 f)
+ (.cljs$core$IFn$_invoke$arity$2 f a0 a1)
+ (.call f f a0 a1))
+ (apply-to-simple f a0 a1 (-first args) (next args))))
+ ([f a0 a1 a2 ^seq args]
+ (if (nil? args)
+ (if (.-cljs$core$IFn$_invoke$arity$3 f)
+ (.cljs$core$IFn$_invoke$arity$3 f a0 a1 a2)
+ (.call f f a0 a1 a2))
+ (apply-to-simple f a0 a1 a2 (-first args) (next args))))
+ ([f a0 a1 a2 a3 ^seq args]
+ (if (nil? args)
+ (if (.-cljs$core$IFn$_invoke$arity$4 f)
+ (.cljs$core$IFn$_invoke$arity$4 f a0 a1 a2 a3)
+ (.call f f a0 a1 a2 a3))
+ (gen-apply-to-simple f 4 args))))
+
(defn apply
"Applies fn f to the argument list formed by prepending intervening arguments to args."
([f args]
- (let [fixed-arity (.-cljs$lang$maxFixedArity f)]
- (if (.-cljs$lang$applyTo f)
- (let [bc (bounded-count (inc fixed-arity) args)]
- (if (<= bc fixed-arity)
- (apply-to f bc args)
- (.cljs$lang$applyTo f args)))
- (.apply f f (to-array args)))))
+ (if (.-cljs$lang$applyTo f)
+ (let [fixed-arity (.-cljs$lang$maxFixedArity f)
+ bc (bounded-count (inc fixed-arity) args)]
+ (if (<= bc fixed-arity)
+ (apply-to f bc args)
+ (.cljs$lang$applyTo f args)))
+ (apply-to-simple f (seq args))))
([f x args]
+ (if (.-cljs$lang$applyTo f)
(let [arglist (list* x args)
- fixed-arity (.-cljs$lang$maxFixedArity f)]
- (if (.-cljs$lang$applyTo f)
- (let [bc (bounded-count (inc fixed-arity) arglist)]
- (if (<= bc fixed-arity)
- (apply-to f bc arglist)
- (.cljs$lang$applyTo f arglist)))
- (.apply f f (to-array arglist)))))
+ fixed-arity (.-cljs$lang$maxFixedArity f)
+ bc (inc (bounded-count fixed-arity args))]
+ (if (<= bc fixed-arity)
+ (apply-to f bc arglist)
+ (.cljs$lang$applyTo f arglist)))
+ (apply-to-simple f x (seq args))))
([f x y args]
+ (if (.-cljs$lang$applyTo f)
(let [arglist (list* x y args)
- fixed-arity (.-cljs$lang$maxFixedArity f)]
- (if (.-cljs$lang$applyTo f)
- (let [bc (bounded-count (inc fixed-arity) arglist)]
- (if (<= bc fixed-arity)
- (apply-to f bc arglist)
- (.cljs$lang$applyTo f arglist)))
- (.apply f f (to-array arglist)))))
+ fixed-arity (.-cljs$lang$maxFixedArity f)
+ bc (+ 2 (bounded-count (dec fixed-arity) args))]
+ (if (<= bc fixed-arity)
+ (apply-to f bc arglist)
+ (.cljs$lang$applyTo f arglist)))
+ (apply-to-simple f x y (seq args))))
([f x y z args]
+ (if (.-cljs$lang$applyTo f)
(let [arglist (list* x y z args)
- fixed-arity (.-cljs$lang$maxFixedArity f)]
- (if (.-cljs$lang$applyTo f)
- (let [bc (bounded-count (inc fixed-arity) arglist)]
- (if (<= bc fixed-arity)
- (apply-to f bc arglist)
- (.cljs$lang$applyTo f arglist)))
- (.apply f f (to-array arglist)))))
+ fixed-arity (.-cljs$lang$maxFixedArity f)
+ bc (+ 3 (bounded-count (- fixed-arity 2) args))]
+ (if (<= bc fixed-arity)
+ (apply-to f bc arglist)
+ (.cljs$lang$applyTo f arglist)))
+ (apply-to-simple f x y z (seq args))))
([f a b c d & args]
- (let [arglist (cons a (cons b (cons c (cons d (spread args)))))
- fixed-arity (.-cljs$lang$maxFixedArity f)]
- (if (.-cljs$lang$applyTo f)
- (let [bc (bounded-count (inc fixed-arity) arglist)]
- (if (<= bc fixed-arity)
- (apply-to f bc arglist)
- (.cljs$lang$applyTo f arglist)))
- (.apply f f (to-array arglist))))))
+ (if (.-cljs$lang$applyTo f)
+ (let [spread-args (spread args)
+ arglist (cons a (cons b (cons c (cons d spread-args))))
+ fixed-arity (.-cljs$lang$maxFixedArity f)
+ bc (+ 4 (bounded-count (- fixed-arity 3) spread-args))]
+ (if (<= bc fixed-arity)
+ (apply-to f bc arglist)
+ (.cljs$lang$applyTo f arglist)))
+ (apply-to-simple f a b c d (spread args)))))
+
(set! *unchecked-if* false)
(defn vary-meta
@@ -3803,7 +3970,7 @@ reduces them without incurring seq initialization"
(deftype StringIter [s ^:mutable i]
Object
- (hasNext [_] (< i (alength s)))
+ (hasNext [_] (< i (.-length s)))
(next [_]
(let [ret (.charAt s i)]
(set! i (inc i))
@@ -3851,48 +4018,60 @@ reduces them without incurring seq initialization"
(defn iter [coll]
(cond
+ (iterable? coll) (-iterator coll)
(nil? coll) (nil-iter)
(string? coll) (string-iter coll)
(array? coll) (array-iter coll)
- (iterable? coll) (-iterator coll)
(seqable? coll) (seq-iter coll)
:else (throw (js/Error. (str "Cannot create iterator from " coll)))))
-(declare LazyTransformer)
+(deftype Many [vals]
+ Object
+ (add [this o]
+ (.push vals o)
+ this)
+ (remove [this]
+ (.shift vals))
+ (isEmpty [this]
+ (zero? (.-length vals)))
+ (toString [this]
+ (str "Many: " vals)))
-(defn lazy-transformer [stepper]
- (LazyTransformer. stepper nil nil nil))
+(def ^:private NONE #js {})
-(deftype Stepper [xform iter]
+(deftype Single [^:mutable val]
+ Object
+ (add [this o]
+ (if (identical? val NONE)
+ (do
+ (set! val o)
+ this)
+ (Many. #js [val o])))
+ (remove [this]
+ (if (identical? val NONE)
+ (throw (js/Error. (str "Removing object from empty buffer")))
+ (let [ret val]
+ (set! val NONE)
+ ret)))
+ (isEmpty [this]
+ (identical? val NONE))
+ (toString [this]
+ (str "Single: " val)))
+
+(deftype Empty []
Object
- (step [this lt]
- (loop []
- (if (and (not (nil? (.-stepper lt)))
- (.hasNext iter))
- (if (reduced? (xform lt (.next iter)))
- (when-not (nil? (.-rest lt))
- (set! (.. lt -rest -stepper) nil))
- (recur))))
- (when-not (nil? (.-stepper lt))
- (xform lt))))
-
-(defn stepper [xform iter]
- (letfn [(stepfn
- ([result]
- (let [lt (if (reduced? result)
- @result
- result)]
- (set! (.-stepper lt) nil)
- result))
- ([result input]
- (let [lt result]
- (set! (.-first lt) input)
- (set! (.-rest lt) (lazy-transformer (.-stepper lt)))
- (set! (.-stepper lt) nil)
- (.-rest lt))))]
- (Stepper. (xform stepfn) iter)))
-
-(deftype MultiStepper [xform iters nexts]
+ (add [this o]
+ (Single. o))
+ (remove [this]
+ (throw (js/Error. (str "Removing object from empty buffer"))))
+ (isEmpty [this]
+ true)
+ (toString [this]
+ "Empty"))
+
+(def ^:private EMPTY (Empty.))
+
+(deftype MultiIterator [iters]
Object
(hasNext [_]
(loop [iters (seq iters)]
@@ -3903,124 +4082,80 @@ reduces them without incurring seq initialization"
(recur (next iters))))
true)))
(next [_]
- (dotimes [i (alength iters)]
- (aset nexts i (.next (aget iters i))))
- (prim-seq nexts 0))
- (step [this lt]
- (loop []
- (if (and (not (nil? (.-stepper lt)))
- (.hasNext this))
- (if (reduced? (apply xform (cons lt (.next this))))
- (when-not (nil? (.-rest lt))
- (set! (.. lt -rest -stepper) nil))
- (recur))))
- (when-not (nil? (.-stepper lt))
- (xform lt))))
-
-(defn multi-stepper
- ([xform iters]
- (multi-stepper xform iters
- (make-array (alength iters))))
- ([xform iters nexts]
- (letfn [(stepfn
- ([result]
- (let [lt (if (reduced? result)
- @result
- result)]
- (set! (.-stepper lt) nil)
- lt))
- ([result input]
- (let [lt result]
- (set! (.-first lt) input)
- (set! (.-rest lt) (lazy-transformer (.-stepper lt)))
- (set! (.-stepper lt) nil)
- (.-rest lt))))]
- (MultiStepper. (xform stepfn) iters nexts))))
-
-(deftype LazyTransformer [^:mutable stepper ^:mutable first ^:mutable rest meta]
+ (let [nexts (array)]
+ (dotimes [i (alength iters)]
+ (aset nexts i (.next (aget iters i))))
+ (prim-seq nexts 0))))
+
+(defn- chunkIteratorSeq [iter]
+ (lazy-seq
+ (when ^boolean (.hasNext iter)
+ (let [arr (array)]
+ (loop [n 0]
+ (if (and (.hasNext iter) (< n 32))
+ (do
+ (aset arr n (.next iter))
+ (recur (inc n)))
+ (chunk-cons (array-chunk arr 0 n) (chunkIteratorSeq iter))))))))
+
+(deftype TransformerIterator [^:mutable buffer ^:mutable _next ^:mutable completed ^:mutable xf sourceIter multi]
Object
- (indexOf [coll x]
- (-indexOf coll x 0))
- (indexOf [coll x start]
- (-indexOf coll x start))
- (lastIndexOf [coll x]
- (-lastIndexOf coll x (count coll)))
- (lastIndexOf [coll x start]
- (-lastIndexOf coll x start))
-
- IWithMeta
- (-with-meta [this new-meta]
- (LazyTransformer. stepper first rest new-meta))
-
- IMeta
- (-meta [this] meta)
-
- ICollection
- (-conj [this o]
- (cons o (-seq this)))
-
- IEmptyableCollection
- (-empty [this]
- ())
-
- ISequential
- IEquiv
- (-equiv [this other]
- (let [s (-seq this)]
- (if-not (nil? s)
- (equiv-sequential this other)
- (and (sequential? other)
- (nil? (seq other))))))
-
- IHash
- (-hash [this]
- (hash-ordered-coll this))
-
- ISeqable
- (-seq [this]
- (when-not (nil? stepper)
- (.step stepper this))
- (if (nil? rest)
- nil
- this))
-
- ISeq
- (-first [this]
- (when-not (nil? stepper)
- (-seq this))
- (if (nil? rest)
- nil
- first))
-
- (-rest [this]
- (when-not (nil? stepper)
- (-seq this))
- (if (nil? rest)
- ()
- rest))
-
- INext
- (-next [this]
- (when-not (nil? stepper)
- (-seq this))
- (if (nil? rest)
- nil
- (-seq rest))))
-
-(es6-iterable LazyTransformer)
-
-(set! (.-create LazyTransformer)
- (fn [xform coll]
- (LazyTransformer. (stepper xform (iter coll)) nil nil nil)))
-
-(set! (.-createMulti LazyTransformer)
- (fn [xform colls]
- (let [iters (array)]
- (doseq [coll colls]
- (.push iters (iter coll)))
- (LazyTransformer.
- (multi-stepper xform iters (make-array (alength iters)))
- nil nil nil))))
+ (step [this]
+ (if-not (identical? _next NONE)
+ true
+ (loop []
+ (if (identical? _next NONE)
+ (if ^boolean (.isEmpty buffer)
+ (if ^boolean completed
+ false
+ (if ^boolean (.hasNext sourceIter)
+ (let [iter (if ^boolean multi
+ (apply xf (cons nil (.next sourceIter)))
+ (xf nil (.next sourceIter)))]
+ (when (reduced? iter)
+ (xf nil)
+ (set! completed true))
+ (recur))
+ (do
+ (xf nil)
+ (set! completed true)
+ (recur))))
+ (do
+ (set! _next (.remove buffer))
+ (recur)))
+ true))))
+ (hasNext [this]
+ (.step this))
+ (next [this]
+ (if ^boolean (.hasNext this)
+ (let [ret _next]
+ (set! _next NONE)
+ ret)
+ (throw (js/Error. "No such element"))))
+ (remove [_]
+ (js/Error. "Unsupported operation")))
+
+(es6-iterable TransformerIterator)
+
+(defn transformer-iterator
+ [xform sourceIter multi]
+ (let [iterator (TransformerIterator. EMPTY NONE false nil sourceIter multi)]
+ (set! (.-xf iterator)
+ (xform (fn
+ ([] nil)
+ ([acc] acc)
+ ([acc o]
+ (set! (.-buffer iterator) (.add (.-buffer iterator) o))
+ acc))))
+ iterator))
+
+(set! (.-create TransformerIterator)
+ (fn [xform source]
+ (transformer-iterator xform source false)))
+
+(set! (.-createMulti TransformerIterator)
+ (fn [xform sources]
+ (transformer-iterator xform (MultiIterator. (to-array sources)) true)))
(defn sequence
"Coerces coll to a (possibly empty) sequence, if it is not already
@@ -4036,9 +4171,13 @@ reduces them without incurring seq initialization"
coll
(or (seq coll) ())))
([xform coll]
- (.create LazyTransformer xform coll))
+ (or (chunkIteratorSeq
+ (.create TransformerIterator xform (iter coll)))
+ ()))
([xform coll & colls]
- (.createMulti LazyTransformer xform (to-array (cons coll colls)))))
+ (or (chunkIteratorSeq
+ (.createMulti TransformerIterator xform (map iter (cons coll colls))))
+ ())))
(defn ^boolean every?
"Returns true if (pred x) is logical true for every x in coll, else
@@ -4078,7 +4217,7 @@ reduces them without incurring seq initialization"
"Returns true if n is odd, throws an exception if n is not an integer"
[n] (not (even? n)))
-(defn ^boolean complement
+(defn complement
"Takes a fn f and returns a fn that takes the same arguments as f,
has the same effects, if any, and returns the opposite truth value."
[f]
@@ -4243,7 +4382,7 @@ reduces them without incurring seq initialization"
(-equiv this other))
IAtom
-
+
IEquiv
(-equiv [o other] (identical? o other))
@@ -4301,27 +4440,57 @@ reduces them without incurring seq initialization"
new-value))
(-reset! a new-value)))
+(defn reset-vals!
+ "Sets the value of atom to newval. Returns [old new], the value of the
+ atom before and after the reset."
+ {:added "1.9"}
+ [a new-value]
+ (let [validate (.-validator a)]
+ (when-not (nil? validate)
+ (when-not (validate new-value)
+ (throw (js/Error. "Validator rejected reference state"))))
+ (let [old-value (.-state a)]
+ (set! (.-state a) new-value)
+ (when-not (nil? (.-watches a))
+ (-notify-watches a old-value new-value))
+ [old-value new-value])))
+
(defn swap!
"Atomically swaps the value of atom to be:
(apply f current-value-of-atom args). Note that f may be called
multiple times, and thus should be free of side effects. Returns
the value that was swapped in."
([a f]
- (if (instance? Atom a)
- (reset! a (f (.-state a)))
- (-swap! a f)))
+ (if (instance? Atom a)
+ (reset! a (f (.-state a)))
+ (-swap! a f)))
([a f x]
- (if (instance? Atom a)
- (reset! a (f (.-state a) x))
- (-swap! a f x)))
+ (if (instance? Atom a)
+ (reset! a (f (.-state a) x))
+ (-swap! a f x)))
([a f x y]
- (if (instance? Atom a)
- (reset! a (f (.-state a) x y))
- (-swap! a f x y)))
+ (if (instance? Atom a)
+ (reset! a (f (.-state a) x y))
+ (-swap! a f x y)))
([a f x y & more]
- (if (instance? Atom a)
- (reset! a (apply f (.-state a) x y more))
- (-swap! a f x y more))))
+ (if (instance? Atom a)
+ (reset! a (apply f (.-state a) x y more))
+ (-swap! a f x y more))))
+
+(defn swap-vals!
+ "Atomically swaps the value of atom to be:
+ (apply f current-value-of-atom args). Note that f may be called
+ multiple times, and thus should be free of side effects.
+ Returns [old new], the value of the atom before and after the swap."
+ {:added "1.9"}
+ ([a f]
+ (reset-vals! a (f (.-state a))))
+ ([a f x]
+ (reset-vals! a (f (.-state a) x)))
+ ([a f x y]
+ (reset-vals! a (f (.-state a) x y)))
+ ([a f x y & more]
+ (reset-vals! a (apply f (.-state a) x y more))))
(defn compare-and-set!
"Atomically sets the value of atom to newval if and only if the
@@ -4340,6 +4509,9 @@ reduces them without incurring seq initialization"
is not acceptable to the new validator, an Error will be thrown and the
validator will not be changed."
[iref val]
+ (when (and (some? val)
+ (not (val (-deref iref))))
+ (throw (js/Error. "Validator rejected reference state")))
(set! (.-validator iref) val))
(defn get-validator
@@ -4621,21 +4793,175 @@ reduces them without incurring seq initialization"
s)))]
(lazy-seq (step pred coll)))))
+(deftype Cycle [meta all prev ^:mutable current ^:mutable _next]
+ Object
+ (toString [coll]
+ (pr-str* coll))
+ (currentval [coll]
+ (when-not ^seq current
+ (if-let [c (next prev)]
+ (set! current c)
+ (set! current all)))
+ current)
+
+ IPending
+ (-realized? [coll]
+ (some? current))
+
+ IWithMeta
+ (-with-meta [coll meta] (Cycle. meta all prev current _next))
+
+ IMeta
+ (-meta [coll] meta)
+
+ ISeq
+ (-first [coll]
+ (first (.currentval coll)))
+ (-rest [coll]
+ (when (nil? _next)
+ (set! _next (Cycle. nil all (.currentval coll) nil nil)))
+ _next)
+
+ INext
+ (-next [coll]
+ (-rest coll))
+
+ ICollection
+ (-conj [coll o] (cons o coll))
+
+ IEmptyableCollection
+ (-empty [coll] (-with-meta (.-EMPTY List) meta))
+
+ ISequential
+ ISeqable
+ (-seq [coll] coll)
+
+ IReduce
+ (-reduce [coll f]
+ (loop [s (.currentval coll) ret (first s)]
+ (let [s (or (next s) all)
+ ret (f ret (first s))]
+ (if (reduced? ret)
+ @ret
+ (recur s ret)))))
+ (-reduce [coll f start]
+ (loop [s (.currentval coll) ret start]
+ (let [ret (f ret (first s))]
+ (if (reduced? ret)
+ @ret
+ (recur (or (next s) all) ret))))))
+
(defn cycle
"Returns a lazy (infinite!) sequence of repetitions of the items in coll."
- [coll] (lazy-seq
- (when-let [s (seq coll)]
- (concat s (cycle s)))))
+ [coll] (if-let [vals (seq coll)]
+ (Cycle. nil vals nil vals nil)
+ (.-EMPTY List)))
(defn split-at
"Returns a vector of [(take n coll) (drop n coll)]"
[n coll]
[(take n coll) (drop n coll)])
+(deftype Repeat [meta count val ^:mutable next ^:mutable __hash]
+ Object
+ (toString [coll]
+ (pr-str* coll))
+ (equiv [this other]
+ (-equiv this other))
+ (indexOf [coll x]
+ (-indexOf coll x 0))
+ (indexOf [coll x start]
+ (-indexOf coll x start))
+ (lastIndexOf [coll x]
+ (-lastIndexOf coll x count))
+ (lastIndexOf [coll x start]
+ (-lastIndexOf coll x start))
+
+ IPending
+ (-realized? [coll] false)
+
+ IWithMeta
+ (-with-meta [coll meta] (Repeat. meta count val next nil))
+
+ IMeta
+ (-meta [coll] meta)
+
+ ISeq
+ (-first [coll]
+ val)
+ (-rest [coll]
+ (if (nil? next)
+ (if (> count 1)
+ (do
+ (set! next (Repeat. nil (dec count) val nil nil))
+ next)
+ (if (== -1 count)
+ coll
+ ()))
+ next))
+
+ INext
+ (-next [coll]
+ (if (nil? next)
+ (if (> count 1)
+ (do
+ (set! next (Repeat. nil (dec count) val nil nil))
+ next)
+ (if (== -1 count)
+ coll
+ nil))
+ next))
+
+ ICollection
+ (-conj [coll o] (cons o coll))
+
+ IEmptyableCollection
+ (-empty [coll] (-with-meta (.-EMPTY List) meta))
+
+ IHash
+ (-hash [coll] (caching-hash coll hash-ordered-coll __hash))
+
+ ISequential
+ ISeqable
+ (-seq [coll] coll)
+
+ IEquiv
+ (-equiv [coll other] (equiv-sequential coll other))
+
+ IReduce
+ (-reduce [coll f]
+ (if (== count -1)
+ (loop [ret (f val val)]
+ (if (reduced? ret)
+ @ret
+ (recur (f ret val))))
+ (loop [i 1 ret val]
+ (if (< i count)
+ (let [ret (f ret val)]
+ (if (reduced? ret)
+ @ret
+ (recur (inc i) ret)))
+ ret))))
+ (-reduce [coll f start]
+ (if (== count -1)
+ (loop [ret (f start val)]
+ (if (reduced? ret)
+ @ret
+ (recur (f ret val))))
+ (loop [i 0 ret start]
+ (if (< i count)
+ (let [ret (f ret val)]
+ (if (reduced? ret)
+ @ret
+ (recur (inc i) ret)))
+ ret)))))
+
(defn repeat
"Returns a lazy (infinite!, or length n if supplied) sequence of xs."
- ([x] (lazy-seq (cons x (repeat x))))
- ([n x] (take n (repeat x))))
+ ([x] (Repeat. nil -1 x nil nil))
+ ([n x] (if (pos? n)
+ (Repeat. nil n x nil nil)
+ (.-EMPTY List))))
(defn replicate
"DEPRECATED: Use 'repeat' instead.
@@ -4649,13 +4975,73 @@ reduces them without incurring seq initialization"
([f] (lazy-seq (cons (f) (repeatedly f))))
([n f] (take n (repeatedly f))))
+(def ^:private UNREALIZED-SEED #js {})
+
+(deftype Iterate [meta f prev-seed ^:mutable seed ^:mutable next]
+ Object
+ (toString [coll]
+ (pr-str* coll))
+
+ IPending
+ (-realized? [coll]
+ (not (identical? seed UNREALIZED-SEED)))
+
+ IWithMeta
+ (-with-meta [coll meta] (Iterate. meta f prev-seed seed next))
+
+ IMeta
+ (-meta [coll] meta)
+
+ ISeq
+ (-first [coll]
+ (when (identical? UNREALIZED-SEED seed)
+ (set! seed (f prev-seed)))
+ seed)
+ (-rest [coll]
+ (when (nil? next)
+ (set! next (Iterate. nil f (-first coll) UNREALIZED-SEED nil)))
+ next)
+
+ INext
+ (-next [coll]
+ (-rest coll))
+
+ ICollection
+ (-conj [coll o] (cons o coll))
+
+ IEmptyableCollection
+ (-empty [coll] (-with-meta (.-EMPTY List) meta))
+
+ ISequential
+ ISeqable
+ (-seq [coll] coll)
+
+ IReduce
+ (-reduce [coll rf]
+ (let [first (-first coll)
+ v (f first)]
+ (loop [ret (rf first v) v v]
+ (if (reduced? ret)
+ @ret
+ (let [v (f v)]
+ (recur (rf ret v) v))))))
+ (-reduce [coll rf start]
+ (let [v (-first coll)]
+ (loop [ret (rf start v) v v]
+ (if (reduced? ret)
+ @ret
+ (let [v (f v)]
+ (recur (rf ret v) v)))))))
+
(defn iterate
"Returns a lazy sequence of x, (f x), (f (f x)) etc. f must be free of side-effects"
{:added "1.0"}
- [f x] (cons x (lazy-seq (iterate f (f x)))))
+ [f x] (Iterate. nil f nil x nil))
(defn interleave
"Returns a lazy seq of the first item in each coll, then the second etc."
+ ([] ())
+ ([c1] (lazy-seq c1))
([c1 c2]
(lazy-seq
(let [s1 (seq c1) s2 (seq c2)]
@@ -4716,7 +5102,7 @@ reduces them without incurring seq initialization"
(defn filter
"Returns a lazy sequence of the items in coll for which
- (pred item) returns true. pred must be free of side-effects.
+ (pred item) returns logical true. pred must be free of side-effects.
Returns a transducer when no collection is provided."
([pred]
(fn [rf]
@@ -4745,7 +5131,7 @@ reduces them without incurring seq initialization"
(defn remove
"Returns a lazy sequence of the items in coll for which
- (pred item) returns false. pred must be free of side-effects.
+ (pred item) returns logical false. pred must be free of side-effects.
Returns a transducer when no collection is provided."
([pred] (filter (complement pred)))
([pred coll]
@@ -4782,12 +5168,12 @@ reduces them without incurring seq initialization"
([to from]
(if-not (nil? to)
(if (implements? IEditableCollection to)
- (with-meta (persistent! (reduce -conj! (transient to) from)) (meta to))
+ (-with-meta (persistent! (reduce -conj! (transient to) from)) (meta to))
(reduce -conj to from))
(reduce conj () from)))
([to xform from]
(if (implements? IEditableCollection to)
- (with-meta (persistent! (transduce xform conj! (transient to) from)) (meta to))
+ (-with-meta (persistent! (transduce xform conj! (transient to) from)) (meta to))
(transduce xform conj to from))))
(defn mapv
@@ -4808,7 +5194,7 @@ reduces them without incurring seq initialization"
(defn filterv
"Returns a vector of the items in coll for which
- (pred item) returns true. pred must be free of side-effects."
+ (pred item) returns logical true. pred must be free of side-effects."
[pred coll]
(-> (reduce (fn [v o] (if (pred o) (conj! v o) v))
(transient [])
@@ -5026,9 +5412,28 @@ reduces them without incurring seq initialization"
(unchecked-array-for v i))
v start end)))
+(defn- pv-reduce
+ ([pv f start end]
+ (if (< start end)
+ (pv-reduce pv f (nth pv start) (inc start) end)
+ (f)))
+ ([pv f init start end]
+ (loop [acc init i start arr (unchecked-array-for pv start)]
+ (if (< i end)
+ (let [j (bit-and i 0x01f)
+ arr (if (zero? j) (unchecked-array-for pv i) arr)
+ nacc (f acc (aget arr j))]
+ (if (reduced? nacc)
+ @nacc
+ (recur nacc (inc i) arr)))
+ acc))))
+
(declare tv-editable-root tv-editable-tail TransientVector deref
pr-sequential-writer pr-writer chunked-seq)
+(defprotocol APersistentVector
+ "Marker protocol")
+
(deftype PersistentVector [meta cnt shift root tail ^:mutable __hash]
Object
(toString [coll]
@@ -5091,7 +5496,7 @@ reduces them without incurring seq initialization"
(PersistentVector. meta (inc cnt) new-shift new-root (array o) nil))))
IEmptyableCollection
- (-empty [coll] (with-meta (.-EMPTY PersistentVector) meta))
+ (-empty [coll] (-with-meta (.-EMPTY PersistentVector) meta))
ISequential
IEquiv
@@ -5138,18 +5543,22 @@ reduces them without incurring seq initialization"
(-nth coll k not-found)
not-found))
- IMapEntry
- (-key [coll]
- (-nth coll 0))
- (-val [coll]
- (-nth coll 1))
-
IAssociative
(-assoc [coll k v]
(if (number? k)
(-assoc-n coll k v)
(throw (js/Error. "Vector's key for assoc must be a number."))))
+ (-contains-key? [coll k]
+ (if (integer? k)
+ (and (<= 0 k) (< k cnt))
+ false))
+ IFind
+ (-find [coll n]
+ (when (and (<= 0 n) (< n cnt))
+ (MapEntry. n (aget (unchecked-array-for coll n) (bit-and n 0x01f)) nil)))
+
+ APersistentVector
IVector
(-assoc-n [coll n val]
(cond
@@ -5164,7 +5573,7 @@ reduces them without incurring seq initialization"
IReduce
(-reduce [v f]
- (ci-reduce v f))
+ (pv-reduce v f 0 cnt))
(-reduce [v f init]
(loop [i 0 init init]
(if (< i cnt)
@@ -5212,7 +5621,7 @@ reduces them without incurring seq initialization"
IReversible
(-rseq [coll]
- (if (pos? cnt)
+ (when (pos? cnt)
(RSeq. coll (dec cnt) nil)))
IIterable
@@ -5239,12 +5648,23 @@ reduces them without incurring seq initialization"
(es6-iterable PersistentVector)
+(declare map-entry?)
+
(defn vec
"Creates a new vector containing the contents of coll. JavaScript arrays
will be aliased and should not be modified."
[coll]
- (if (array? coll)
+ (cond
+ (map-entry? coll)
+ [(key coll) (val coll)]
+
+ (vector? coll)
+ (with-meta coll nil)
+
+ (array? coll)
(.fromArray PersistentVector coll true)
+
+ :else
(-persistent!
(reduce -conj!
(-as-transient (.-EMPTY PersistentVector))
@@ -5314,7 +5734,7 @@ reduces them without incurring seq initialization"
IEmptyableCollection
(-empty [coll]
- (with-meta (.-EMPTY PersistentVector) meta))
+ ())
IChunkedSeq
(-chunked-first [coll]
@@ -5336,10 +5756,10 @@ reduces them without incurring seq initialization"
IReduce
(-reduce [coll f]
- (ci-reduce (subvec vec (+ i off) (count vec)) f))
+ (pv-reduce vec f (+ i off) (count vec)))
(-reduce [coll f start]
- (ci-reduce (subvec vec (+ i off) (count vec)) f start)))
+ (pv-reduce vec f start (+ i off) (count vec))))
(es6-iterable ChunkedSeq)
@@ -5388,7 +5808,7 @@ reduces them without incurring seq initialization"
(build-subvec meta (-assoc-n v end o) start (inc end) nil))
IEmptyableCollection
- (-empty [coll] (with-meta (.-EMPTY PersistentVector) meta))
+ (-empty [coll] (-with-meta (.-EMPTY PersistentVector) meta))
ISequential
IEquiv
@@ -5436,6 +5856,13 @@ reduces them without incurring seq initialization"
(-assoc-n coll key val)
(throw (js/Error. "Subvec's key for assoc must be a number."))))
+ IFind
+ (-find [coll n]
+ (when-not (neg? n)
+ (let [idx (+ start n)]
+ (when (< idx end)
+ (MapEntry. n (-lookup v idx) nil)))))
+
IVector
(-assoc-n [coll n val]
(let [v-pos (+ start n)]
@@ -5445,9 +5872,13 @@ reduces them without incurring seq initialization"
IReduce
(-reduce [coll f]
- (ci-reduce coll f))
- (-reduce [coll f start]
- (ci-reduce coll f start))
+ (if (implements? APersistentVector v)
+ (pv-reduce v f start end)
+ (ci-reduce coll f)))
+ (-reduce [coll f init]
+ (if (implements? APersistentVector v)
+ (pv-reduce v f init start end)
+ (ci-reduce coll f init)))
IKVReduce
(-kv-reduce [coll f init]
@@ -5467,19 +5898,24 @@ reduces them without incurring seq initialization"
IIterable
(-iterator [coll]
- (ranged-iterator v start end)))
+ (if (implements? APersistentVector v)
+ (ranged-iterator v start end)
+ (seq-iter coll))))
(es6-iterable Subvec)
(defn- build-subvec [meta v start end __hash]
(if (instance? Subvec v)
(recur meta (.-v v) (+ (.-start v) start) (+ (.-start v) end) __hash)
- (let [c (count v)]
- (when (or (neg? start)
- (neg? end)
- (> start c)
- (> end c))
- (throw (js/Error. "Index out of bounds")))
+ (do
+ (when-not (vector? v)
+ (throw (js/Error. "v must satisfy IVector")))
+ (let [c (count v)]
+ (when (or (neg? start)
+ (neg? end)
+ (> start c)
+ (> end c))
+ (throw (js/Error. "Index out of bounds"))))
(Subvec. meta v start end __hash))))
(defn subvec
@@ -5489,9 +5925,10 @@ reduces them without incurring seq initialization"
the resulting vector shares structure with the original and no
trimming is done."
([v start]
- (subvec v start (count v)))
+ (subvec v start (count v)))
([v start end]
- (build-subvec nil v start end nil)))
+ (assert (and (not (nil? start)) (not (nil? end))))
+ (build-subvec nil v (int start) (int end) nil)))
(defn- tv-ensure-editable [edit node]
(if (identical? edit (.-edit node))
@@ -5726,11 +6163,18 @@ reduces them without incurring seq initialization"
(-empty coll)
(PersistentQueueSeq. meta rear nil nil))))
+ INext
+ (-next [coll]
+ (if-let [f1 (next front)]
+ (PersistentQueueSeq. meta f1 rear nil)
+ (when (some? rear)
+ (PersistentQueueSeq. meta rear nil nil))))
+
ICollection
(-conj [coll o] (cons o coll))
IEmptyableCollection
- (-empty [coll] (with-meta (.-EMPTY List) meta))
+ (-empty [coll] (-with-meta (.-EMPTY List) meta))
ISequential
IEquiv
@@ -5792,7 +6236,7 @@ reduces them without incurring seq initialization"
(PersistentQueue. meta (inc count) (conj front o) [] nil)))
IEmptyableCollection
- (-empty [coll] (with-meta (.-EMPTY PersistentQueue) meta))
+ (-empty [coll] (-with-meta (.-EMPTY PersistentQueue) meta))
ISequential
IEquiv
@@ -5823,17 +6267,24 @@ reduces them without incurring seq initialization"
(def ^:private never-equiv (NeverEquiv.))
-(defn- ^boolean equiv-map
- "Assumes y is a map. Returns true if x equals y, otherwise returns
- false."
+(defn ^boolean equiv-map
+ "Test map equivalence. Returns true if x equals y, otherwise returns false."
[x y]
(boolean
- (when (map? y)
+ (when (and (map? y) (not (record? y)))
; assume all maps are counted
(when (== (count x) (count y))
- (every? (fn [xkv] (= (get y (first xkv) never-equiv)
- (second xkv)))
- x)))))
+ (if (satisfies? IKVReduce x)
+ (reduce-kv
+ (fn [_ k v]
+ (if (= (get y k never-equiv) v)
+ true
+ (reduced false)))
+ true x)
+ (every?
+ (fn [xkv]
+ (= (get y (first xkv) never-equiv) (second xkv)))
+ x))))))
(defn- scan-array [incr k array]
@@ -5867,8 +6318,8 @@ reduces them without incurring seq initialization"
out (transient (.-EMPTY PersistentHashMap))]
(if (< i len)
(let [k (aget ks i)]
- (recur (inc i) (assoc! out k (aget so k))))
- (with-meta (persistent! (assoc! out k v)) mm)))))
+ (recur (inc i) (assoc! out k (gobject/get so k))))
+ (-with-meta (persistent! (assoc! out k v)) mm)))))
;;; ObjMap - DEPRECATED
@@ -5878,7 +6329,7 @@ reduces them without incurring seq initialization"
(loop [i 0]
(when (< i l)
(let [k (aget ks i)]
- (aset new-obj k (aget obj k))
+ (gobject/set new-obj k (gobject/get obj k))
(recur (inc i)))))
new-obj))
@@ -5904,7 +6355,7 @@ reduces them without incurring seq initialization"
entry)))
IEmptyableCollection
- (-empty [coll] (with-meta (.-EMPTY ObjMap) meta))
+ (-empty [coll] (-with-meta (.-EMPTY ObjMap) meta))
IEquiv
(-equiv [coll other] (equiv-map coll other))
@@ -5915,7 +6366,7 @@ reduces them without incurring seq initialization"
ISeqable
(-seq [coll]
(when (pos? (alength keys))
- (map #(vector % (aget strobj %))
+ (map #(vector % (unchecked-get strobj %))
(.sort keys obj-map-compare-keys))))
ICounted
@@ -5926,7 +6377,7 @@ reduces them without incurring seq initialization"
(-lookup [coll k not-found]
(if (and ^boolean (goog/isString k)
(not (nil? (scan-array 1 k keys))))
- (aget strobj k)
+ (unchecked-get strobj k)
not-found))
IAssociative
@@ -5937,11 +6388,11 @@ reduces them without incurring seq initialization"
(obj-map->hash-map coll k v)
(if-not (nil? (scan-array 1 k keys))
(let [new-strobj (obj-clone strobj keys)]
- (aset new-strobj k v)
+ (gobject/set new-strobj k v)
(ObjMap. meta keys new-strobj (inc update-count) nil)) ; overwrite
(let [new-strobj (obj-clone strobj keys) ; append
new-keys (aclone keys)]
- (aset new-strobj k v)
+ (gobject/set new-strobj k v)
(.push new-keys k)
(ObjMap. meta new-keys new-strobj (inc update-count) nil))))
;; non-string key. game over.
@@ -5952,6 +6403,12 @@ reduces them without incurring seq initialization"
true
false))
+ IFind
+ (-find [coll k]
+ (when (and ^boolean (goog/isString k)
+ (not (nil? (scan-array 1 k keys))))
+ (MapEntry. k (unchecked-get strobj k) nil)))
+
IKVReduce
(-kv-reduce [coll f init]
(let [len (alength keys)]
@@ -5959,7 +6416,7 @@ reduces them without incurring seq initialization"
init init]
(if (seq keys)
(let [k (first keys)
- init (f init k (aget strobj k))]
+ init (f init k (unchecked-get strobj k))]
(if (reduced? init)
@init
(recur (rest keys) init)))
@@ -6001,7 +6458,7 @@ reduces them without incurring seq initialization"
(if (< i base-count)
(let [k (nth fields i)]
(set! i (inc i))
- [k (-lookup record k)])
+ (MapEntry. k (-lookup record k) nil))
(.next ext-map-iter)))
(remove [_] (js/Error. "Unsupported operation")))
@@ -6110,6 +6567,106 @@ reduces them without incurring seq initialization"
(declare TransientArrayMap)
+(deftype MapEntry [key val ^:mutable __hash]
+ Object
+ (indexOf [coll x]
+ (-indexOf coll x 0))
+ (indexOf [coll x start]
+ (-indexOf coll x start))
+ (lastIndexOf [coll x]
+ (-lastIndexOf coll x (count coll)))
+ (lastIndexOf [coll x start]
+ (-lastIndexOf coll x start))
+
+ IMapEntry
+ (-key [node] key)
+ (-val [node] val)
+
+ IHash
+ (-hash [coll] (caching-hash coll hash-ordered-coll __hash))
+
+ IEquiv
+ (-equiv [coll other] (equiv-sequential coll other))
+
+ IMeta
+ (-meta [node] nil)
+
+ IWithMeta
+ (-with-meta [node meta]
+ (with-meta [key val] meta))
+
+ IStack
+ (-peek [node] val)
+
+ (-pop [node] [key])
+
+ ICollection
+ (-conj [node o] [key val o])
+
+ IEmptyableCollection
+ (-empty [node] nil)
+
+ ISequential
+ ISeqable
+ (-seq [node] (IndexedSeq. #js [key val] 0 nil))
+
+ IReversible
+ (-rseq [node] (IndexedSeq. #js [val key] 0 nil))
+
+ ICounted
+ (-count [node] 2)
+
+ IIndexed
+ (-nth [node n]
+ (cond (== n 0) key
+ (== n 1) val
+ :else (throw (js/Error. "Index out of bounds"))))
+
+ (-nth [node n not-found]
+ (cond (== n 0) key
+ (== n 1) val
+ :else not-found))
+
+ ILookup
+ (-lookup [node k] (-nth node k nil))
+ (-lookup [node k not-found] (-nth node k not-found))
+
+ IAssociative
+ (-assoc [node k v]
+ (assoc [key val] k v))
+ (-contains-key? [node k]
+ (or (== k 0) (== k 1)))
+
+ IFind
+ (-find [node k]
+ (case k
+ 0 (MapEntry. 0 key nil)
+ 1 (MapEntry. 1 val nil)
+ nil))
+
+ IVector
+ (-assoc-n [node n v]
+ (-assoc-n [key val] n v))
+
+ IReduce
+ (-reduce [node f]
+ (ci-reduce node f))
+
+ (-reduce [node f start]
+ (ci-reduce node f start))
+
+ IFn
+ (-invoke [node k]
+ (-nth node k))
+
+ (-invoke [node k not-found]
+ (-nth node k not-found)))
+
+(defn ^boolean map-entry?
+ "Returns true if x satisfies IMapEntry"
+ [x]
+ (implements? IMapEntry x))
+
(deftype PersistentArrayMapSeq [arr i _meta]
Object
(toString [coll]
@@ -6124,7 +6681,7 @@ reduces them without incurring seq initialization"
(-lastIndexOf coll x (count coll)))
(lastIndexOf [coll x start]
(-lastIndexOf coll x start))
-
+
IMeta
(-meta [coll] _meta)
@@ -6148,14 +6705,14 @@ reduces them without incurring seq initialization"
(cons o coll))
IEmptyableCollection
- (-empty [coll] (with-meta (.-EMPTY List) _meta))
+ (-empty [coll] (-with-meta (.-EMPTY List) _meta))
IHash
(-hash [coll] (hash-ordered-coll coll))
-
+
ISeq
(-first [coll]
- [(aget arr i) (aget arr (inc i))])
+ (MapEntry. (aget arr i) (aget arr (inc i)) nil))
(-rest [coll]
(if (< i (- (alength arr) 2))
@@ -6184,7 +6741,7 @@ reduces them without incurring seq initialization"
(hasNext [_]
(< i cnt))
(next [_]
- (let [ret [(aget arr i) (aget arr (inc i))]]
+ (let [ret (MapEntry. (aget arr i) (aget arr (inc i)) nil)]
(set! i (+ i 2))
ret)))
@@ -6237,7 +6794,7 @@ reduces them without incurring seq initialization"
IEquiv
(-equiv [coll other]
- (if (implements? IMap other)
+ (if (and (map? other) (not (record? other)))
(let [alen (alength arr)
^not-native other other]
(if (== cnt (-count other))
@@ -6251,7 +6808,7 @@ reduces them without incurring seq initialization"
false))
true))
false))
- (equiv-map coll other)))
+ false))
IHash
(-hash [coll] (caching-hash coll hash-unordered-coll __hash))
@@ -6259,7 +6816,7 @@ reduces them without incurring seq initialization"
IIterable
(-iterator [this]
(PersistentArrayMapIterator. arr 0 (* cnt 2)))
-
+
ISeqable
(-seq [coll]
(persistent-array-map-seq arr 0 nil))
@@ -6300,6 +6857,12 @@ reduces them without incurring seq initialization"
(-contains-key? [coll k]
(not (== (array-map-index-of coll k) -1)))
+ IFind
+ (-find [coll k]
+ (let [idx (array-map-index-of coll k)]
+ (when-not (== idx -1)
+ (MapEntry. (aget arr idx) (aget arr (inc idx)) nil))))
+
IMap
(-dissoc [coll k]
(let [idx (array-map-index-of coll k)]
@@ -6331,9 +6894,9 @@ reduces them without incurring seq initialization"
IReduce
(-reduce [coll f]
- (seq-reduce f coll))
+ (iter-reduce coll f))
(-reduce [coll f start]
- (seq-reduce f start coll))
+ (iter-reduce coll f start))
IFn
(-invoke [coll k]
@@ -6426,8 +6989,14 @@ reduces them without incurring seq initialization"
ITransientCollection
(-conj! [tcoll o]
(if editable?
- (if (satisfies? IMapEntry o)
+ (cond
+ (map-entry? o)
(-assoc! tcoll (key o) (val o))
+
+ (vector? o)
+ (-assoc! tcoll (o 0) (o 1))
+
+ :else
(loop [es (seq o) tcoll tcoll]
(if-let [e (first es)]
(recur (next es)
@@ -6468,9 +7037,15 @@ reduces them without incurring seq initialization"
(doto arr .pop .pop)
(set! len (- len 2)))
tcoll)
- (throw (js/Error. "dissoc! after persistent!")))))
+ (throw (js/Error. "dissoc! after persistent!"))))
+
+ IFn
+ (-invoke [tcoll key]
+ (-lookup tcoll key nil))
+ (-invoke [tcoll key not-found]
+ (-lookup tcoll key not-found)))
-(declare TransientHashMap PersistentHashMap)
+(declare TransientHashMap)
(defn- array->transient-hash-map [len arr]
(loop [out (transient (.-EMPTY PersistentHashMap))
@@ -6538,7 +7113,7 @@ reduces them without incurring seq initialization"
(.kv-reduce node f init)
init))))]
(if (reduced? init)
- @init
+ init
(recur (+ i 2) init)))
init))))
@@ -6554,7 +7129,7 @@ reduces them without incurring seq initialization"
node-or-val (aget arr (inc i))
^boolean found
(cond (some? key)
- (set! next-entry [key node-or-val])
+ (set! next-entry (MapEntry. key node-or-val nil))
(some? node-or-val)
(let [new-iter (-iterator node-or-val)]
(if ^boolean (.hasNext new-iter)
@@ -6666,7 +7241,7 @@ reduces them without incurring seq initialization"
key-or-nil (aget arr (* 2 idx))
val-or-node (aget arr (inc (* 2 idx)))]
(cond (nil? key-or-nil) (.inode-find val-or-node (+ shift 5) hash key not-found)
- (key-test key key-or-nil) [key-or-nil val-or-node]
+ (key-test key key-or-nil) (MapEntry. key-or-nil val-or-node nil)
:else not-found)))))
(inode-seq [inode]
@@ -6771,7 +7346,7 @@ reduces them without incurring seq initialization"
(== bitmap bit) nil
:else (.edit-and-remove-pair inode edit bit idx)))
(key-test key key-or-nil)
- (do (aset removed-leaf? 0 true)
+ (do (set! (.-val removed-leaf?) true)
(.edit-and-remove-pair inode edit bit idx))
:else inode)))))
@@ -6909,7 +7484,7 @@ reduces them without incurring seq initialization"
(if-not (nil? node)
(let [init (.kv-reduce node f init)]
(if (reduced? init)
- @init
+ init
(recur (inc i) init)))
(recur (inc i) init)))
init))))
@@ -6964,7 +7539,7 @@ reduces them without incurring seq initialization"
(inode-find [inode shift hash key not-found]
(let [idx (hash-collision-node-find-index arr cnt key)]
(cond (< idx 0) not-found
- (key-test key (aget arr idx)) [(aget arr idx) (aget arr (inc idx))]
+ (key-test key (aget arr idx)) (MapEntry. (aget arr idx) (aget arr (inc idx)) nil)
:else not-found)))
(inode-seq [inode]
@@ -7010,7 +7585,7 @@ reduces them without incurring seq initialization"
(let [idx (hash-collision-node-find-index arr cnt key)]
(if (== idx -1)
inode
- (do (aset removed-leaf? 0 true)
+ (do (set! (.-val removed-leaf?) true)
(if (== cnt 1)
nil
(let [editable (.ensure-editable inode edit)
@@ -7072,13 +7647,13 @@ reduces them without incurring seq initialization"
(-conj [coll o] (cons o coll))
IEmptyableCollection
- (-empty [coll] (with-meta (.-EMPTY List) meta))
+ (-empty [coll] (-with-meta (.-EMPTY List) meta))
ISequential
ISeq
(-first [coll]
(if (nil? s)
- [(aget nodes i) (aget nodes (inc i))]
+ (MapEntry. (aget nodes i) (aget nodes (inc i)) nil)
(first s)))
(-rest [coll]
@@ -7087,6 +7662,12 @@ reduces them without incurring seq initialization"
(create-inode-seq nodes i (next s)))]
(if-not (nil? ret) ret ())))
+ INext
+ (-next [coll]
+ (if (nil? s)
+ (create-inode-seq nodes (+ i 2) nil)
+ (create-inode-seq nodes i (next s))))
+
ISeqable
(-seq [this] this)
@@ -7144,7 +7725,7 @@ reduces them without incurring seq initialization"
(-conj [coll o] (cons o coll))
IEmptyableCollection
- (-empty [coll] (with-meta (.-EMPTY List) meta))
+ (-empty [coll] (-with-meta (.-EMPTY List) meta))
ISequential
ISeq
@@ -7153,6 +7734,10 @@ reduces them without incurring seq initialization"
(let [ret (create-array-node-seq nil nodes i (next s))]
(if-not (nil? ret) ret ())))
+ INext
+ (-next [coll]
+ (create-array-node-seq nil nodes i (next s)))
+
ISeqable
(-seq [this] this)
@@ -7182,8 +7767,6 @@ reduces them without incurring seq initialization"
(recur (inc j))))))
(ArrayNodeSeq. meta nodes i s nil))))
-(declare TransientHashMap)
-
(deftype HashMapIter [nil-val root-iter ^:mutable seen]
Object
(hasNext [_]
@@ -7192,7 +7775,7 @@ reduces them without incurring seq initialization"
(if-not ^boolean seen
(do
(set! seen true)
- [nil nil-val])
+ (MapEntry. nil nil-val nil))
(.next root-iter)))
(remove [_] (js/Error. "Unsupported operation")))
@@ -7261,7 +7844,7 @@ reduces them without incurring seq initialization"
(when (pos? cnt)
(let [s (if-not (nil? root) (.inode-seq root))]
(if has-nil?
- (cons [nil nil-val] s)
+ (cons (MapEntry. nil nil-val nil) s)
s))))
ICounted
@@ -7299,6 +7882,13 @@ reduces them without incurring seq initialization"
:else (not (identical? (.inode-lookup root 0 (hash k) k lookup-sentinel)
lookup-sentinel))))
+ IFind
+ (-find [coll k]
+ (cond
+ (nil? k) (when has-nil? (MapEntry. nil nil-val nil))
+ (nil? root) nil
+ :else (.inode-find root 0 (hash k) k nil)))
+
IMap
(-dissoc [coll k]
(cond (nil? k) (if has-nil?
@@ -7316,7 +7906,7 @@ reduces them without incurring seq initialization"
(let [init (if has-nil? (f init nil nil-val) init)]
(cond
(reduced? init) @init
- (not (nil? root)) (.kv-reduce root f init)
+ (not (nil? root)) (unreduced (.kv-reduce root f init))
:else init)))
IFn
@@ -7372,8 +7962,14 @@ reduces them without incurring seq initialization"
Object
(conj! [tcoll o]
(if edit
- (if (satisfies? IMapEntry o)
+ (cond
+ (map-entry? o)
(.assoc! tcoll (key o) (val o))
+
+ (vector? o)
+ (.assoc! tcoll (o 0) (o 1))
+
+ :else
(loop [es (seq o) tcoll tcoll]
(if-let [e (first es)]
(recur (next es)
@@ -7421,7 +8017,7 @@ reduces them without incurring seq initialization"
(if (identical? node root)
nil
(set! root node))
- (if (aget removed-leaf? 0)
+ (if ^boolean (.-val removed-leaf?)
(set! count (dec count)))
tcoll)))
(throw (js/Error. "dissoc! after persistent!"))))
@@ -7465,7 +8061,13 @@ reduces them without incurring seq initialization"
(-assoc! [tcoll key val] (.assoc! tcoll key val))
ITransientMap
- (-dissoc! [tcoll key] (.without! tcoll key)))
+ (-dissoc! [tcoll key] (.without! tcoll key))
+
+ IFn
+ (-invoke [tcoll key]
+ (-lookup tcoll key))
+ (-invoke [tcoll key not-found]
+ (-lookup tcoll key not-found)))
;;; PersistentTreeMap
@@ -7505,6 +8107,14 @@ reduces them without incurring seq initialization"
(if-not (nil? next-stack)
(PersistentTreeMapSeq. nil next-stack ascending? (dec cnt) nil)
())))
+ INext
+ (-next [this]
+ (let [t (first stack)
+ next-stack (tree-map-seq-push (if ascending? (.-right t) (.-left t))
+ (next stack)
+ ascending?)]
+ (when-not (nil? next-stack)
+ (PersistentTreeMapSeq. nil next-stack ascending? (dec cnt) nil))))
ICounted
(-count [coll]
@@ -7519,7 +8129,7 @@ reduces them without incurring seq initialization"
(-conj [coll o] (cons o coll))
IEmptyableCollection
- (-empty [coll] (with-meta (.-EMPTY List) meta))
+ (-empty [coll] (-with-meta (.-EMPTY List) meta))
IHash
(-hash [coll] (caching-hash coll hash-ordered-coll __hash))
@@ -7632,16 +8242,13 @@ reduces them without incurring seq initialization"
(tree-map-kv-reduce (.-left node) f init)
init)]
(if (reduced? init)
- @init
+ init
(let [init (f init (.-key node) (.-val node))]
(if (reduced? init)
- @init
- (let [init (if-not (nil? (.-right node))
- (tree-map-kv-reduce (.-right node) f init)
- init)]
- (if (reduced? init)
- @init
- init)))))))
+ init
+ (if-not (nil? (.-right node))
+ (tree-map-kv-reduce (.-right node) f init)
+ init))))))
(deftype BlackNode [key val left right ^:mutable __hash]
Object
@@ -7697,7 +8304,7 @@ reduces them without incurring seq initialization"
IWithMeta
(-with-meta [node meta]
- (with-meta [key val] meta))
+ (-with-meta [key val] meta))
IStack
(-peek [node] val)
@@ -7708,11 +8315,14 @@ reduces them without incurring seq initialization"
(-conj [node o] [key val o])
IEmptyableCollection
- (-empty [node] [])
+ (-empty [node] nil)
ISequential
ISeqable
- (-seq [node] (list key val))
+ (-seq [node] (IndexedSeq. #js [key val] 0 nil))
+
+ IReversible
+ (-rseq [node] (IndexedSeq. #js [val key] 0 nil))
ICounted
(-count [node] 2)
@@ -7721,7 +8331,7 @@ reduces them without incurring seq initialization"
(-nth [node n]
(cond (== n 0) key
(== n 1) val
- :else nil))
+ :else (throw (js/Error. "Index out of bounds"))))
(-nth [node n not-found]
(cond (== n 0) key
@@ -7735,6 +8345,15 @@ reduces them without incurring seq initialization"
IAssociative
(-assoc [node k v]
(assoc [key val] k v))
+ (-contains-key? [node k]
+ (or (== k 0) (== k 1)))
+
+ IFind
+ (-find [node k]
+ (case k
+ 0 (MapEntry. 0 key nil)
+ 1 (MapEntry. 1 val nil)
+ nil))
IVector
(-assoc-n [node n v]
@@ -7749,10 +8368,10 @@ reduces them without incurring seq initialization"
IFn
(-invoke [node k]
- (-lookup node k))
+ (-nth node k))
(-invoke [node k not-found]
- (-lookup node k not-found)))
+ (-nth node k not-found)))
(es6-iterable BlackNode)
@@ -7849,7 +8468,7 @@ reduces them without incurring seq initialization"
IWithMeta
(-with-meta [node meta]
- (with-meta [key val] meta))
+ (-with-meta [key val] meta))
IStack
(-peek [node] val)
@@ -7860,11 +8479,14 @@ reduces them without incurring seq initialization"
(-conj [node o] [key val o])
IEmptyableCollection
- (-empty [node] [])
+ (-empty [node] nil)
ISequential
ISeqable
- (-seq [node] (list key val))
+ (-seq [node] (IndexedSeq. #js [key val] 0 nil))
+
+ IReversible
+ (-rseq [node] (IndexedSeq. #js [val key] 0 nil))
ICounted
(-count [node] 2)
@@ -7873,7 +8495,7 @@ reduces them without incurring seq initialization"
(-nth [node n]
(cond (== n 0) key
(== n 1) val
- :else nil))
+ :else (throw (js/Error. "Index out of bounds"))))
(-nth [node n not-found]
(cond (== n 0) key
@@ -7887,6 +8509,15 @@ reduces them without incurring seq initialization"
IAssociative
(-assoc [node k v]
(assoc [key val] k v))
+ (-contains-key? [node k]
+ (or (== k 0) (== k 1)))
+
+ IFind
+ (-find [node k]
+ (case k
+ 0 (MapEntry. 0 key nil)
+ 1 (MapEntry. 1 val nil)
+ nil))
IVector
(-assoc-n [node n v]
@@ -7901,10 +8532,10 @@ reduces them without incurring seq initialization"
IFn
(-invoke [node k]
- (-lookup node k))
+ (-nth node k))
(-invoke [node k not-found]
- (-lookup node k not-found)))
+ (-nth node k not-found)))
(es6-iterable RedNode)
@@ -8082,7 +8713,7 @@ reduces them without incurring seq initialization"
IKVReduce
(-kv-reduce [coll f init]
(if-not (nil? tree)
- (tree-map-kv-reduce tree f init)
+ (unreduced (tree-map-kv-reduce tree f init))
init))
IFn
@@ -8126,6 +8757,10 @@ reduces them without incurring seq initialization"
(-contains-key? [coll k]
(not (nil? (.entry-at coll k))))
+ IFind
+ (-find [coll k]
+ (.entry-at coll k))
+
IMap
(-dissoc [coll k]
(let [found (array nil)
@@ -8181,7 +8816,7 @@ reduces them without incurring seq initialization"
(let [arr (if (and (instance? IndexedSeq keyvals) (zero? (.-i keyvals)))
(.-arr keyvals)
(into-array keyvals))]
- (.createAsIfByAssoc PersistentArrayMap arr true false)))
+ (.createAsIfByAssoc PersistentArrayMap arr)))
(defn obj-map
"keyval => key val
@@ -8192,7 +8827,7 @@ reduces them without incurring seq initialization"
(loop [kvs (seq keyvals)]
(if kvs
(do (.push ks (first kvs))
- (aset obj (first kvs) (second kvs))
+ (gobject/set obj (first kvs) (second kvs))
(recur (nnext kvs)))
(.fromObject ObjMap ks obj)))))
@@ -8248,7 +8883,7 @@ reduces them without incurring seq initialization"
(cons o coll))
IEmptyableCollection
- (-empty [coll] (with-meta (.-EMPTY List) _meta))
+ (-empty [coll] (-with-meta (.-EMPTY List) _meta))
IHash
(-hash [coll] (hash-ordered-coll coll))
@@ -8324,7 +8959,7 @@ reduces them without incurring seq initialization"
(cons o coll))
IEmptyableCollection
- (-empty [coll] (with-meta (.-EMPTY List) _meta))
+ (-empty [coll] (-with-meta (.-EMPTY List) _meta))
IHash
(-hash [coll] (hash-ordered-coll coll))
@@ -8383,7 +9018,7 @@ reduces them without incurring seq initialization"
[f & maps]
(when (some identity maps)
(let [merge-entry (fn [m e]
- (let [k (first e) v (second e)]
+ (let [k (key e) v (val e)]
(if (contains? m k)
(assoc m k (f (get m k) v))
(assoc m k v))))
@@ -8403,7 +9038,7 @@ reduces them without incurring seq initialization"
(assoc ret key entry)
ret)
(next keys)))
- (with-meta ret (meta map)))))
+ (-with-meta ret (meta map)))))
;;; PersistentHashSet
@@ -8415,7 +9050,7 @@ reduces them without incurring seq initialization"
(.hasNext iter))
(next [_]
(if ^boolean (.hasNext iter)
- (aget (.-tail (.next iter)) 0)
+ (.-key (.next iter))
(throw (js/Error. "No such element"))))
(remove [_] (js/Error. "Unsupported operation")))
@@ -8457,15 +9092,20 @@ reduces them without incurring seq initialization"
(PersistentHashSet. meta (assoc hash-map o nil) nil))
IEmptyableCollection
- (-empty [coll] (with-meta (.-EMPTY PersistentHashSet) meta))
+ (-empty [coll] (-with-meta (.-EMPTY PersistentHashSet) meta))
IEquiv
(-equiv [coll other]
(and
(set? other)
(== (count coll) (count other))
- (every? #(contains? coll %)
- other)))
+ ^boolean
+ (try
+ (reduce-kv
+ #(or (contains? other %2) (reduced false))
+ true hash-map)
+ (catch js/Error ex
+ false))))
IHash
(-hash [coll] (caching-hash coll hash-unordered-coll __hash))
@@ -8480,8 +9120,8 @@ reduces them without incurring seq initialization"
(-lookup [coll v]
(-lookup coll v nil))
(-lookup [coll v not-found]
- (if (-contains-key? hash-map v)
- v
+ (if-let [entry (-find hash-map v)]
+ (key entry)
not-found))
ISet
@@ -8613,8 +9253,13 @@ reduces them without incurring seq initialization"
(and
(set? other)
(== (count coll) (count other))
- (every? #(contains? coll %)
- other)))
+ ^boolean
+ (try
+ (reduce-kv
+ #(or (contains? other %2) (reduced false))
+ true tree-map)
+ (catch js/Error ex
+ false))))
IHash
(-hash [coll] (caching-hash coll hash-unordered-coll __hash))
@@ -8674,19 +9319,21 @@ reduces them without incurring seq initialization"
(defn set
"Returns a set of the distinct elements of coll."
[coll]
- (let [in (seq coll)]
- (cond
- (nil? in) #{}
+ (if (set? coll)
+ (with-meta coll nil)
+ (let [in (seq coll)]
+ (cond
+ (nil? in) #{}
- (and (instance? IndexedSeq in) (zero? (.-i in)))
- (.createAsIfByAssoc PersistentHashSet (.-arr in))
+ (and (instance? IndexedSeq in) (zero? (.-i in)))
+ (.createAsIfByAssoc PersistentHashSet (.-arr in))
- :else
- (loop [^not-native in in
- ^not-native out (-as-transient #{})]
- (if-not (nil? in)
- (recur (next in) (-conj! out (-first in)))
- (persistent! out))))))
+ :else
+ (loop [^not-native in in
+ ^not-native out (-as-transient #{})]
+ (if-not (nil? in)
+ (recur (next in) (-conj! out (-first in)))
+ (persistent! out)))))))
(defn hash-set
"Returns a new hash set with supplied keys. Any equal keys are
@@ -8779,14 +9426,18 @@ reduces them without incurring seq initialization"
(persistent! map))))
(defn max-key
- "Returns the x for which (k x), a number, is greatest."
+ "Returns the x for which (k x), a number, is greatest.
+
+ If there are multiple such xs, the last one is returned."
([k x] x)
([k x y] (if (> (k x) (k y)) x y))
([k x y & more]
(reduce #(max-key k %1 %2) (max-key k x y) more)))
(defn min-key
- "Returns the x for which (k x), a number, is least."
+ "Returns the x for which (k x), a number, is least.
+
+ If there are multiple such xs, the last one is returned."
([k x] x)
([k x y] (if (< (k x) (k y)) x y))
([k x y & more]
@@ -8836,7 +9487,7 @@ reduces them without incurring seq initialization"
(defn take-while
"Returns a lazy sequence of successive items from coll while
- (pred item) returns true. pred must be free of side-effects.
+ (pred item) returns logical true. pred must be free of side-effects.
Returns a transducer when no collection is provided."
([pred]
(fn [rf]
@@ -8955,7 +9606,7 @@ reduces them without incurring seq initialization"
(-conj [rng o] (cons o rng))
IEmptyableCollection
- (-empty [rng] (with-meta (.-EMPTY List) meta))
+ (-empty [rng] (-with-meta (.-EMPTY List) meta))
ISequential
IEquiv
@@ -8972,15 +9623,15 @@ reduces them without incurring seq initialization"
IIndexed
(-nth [rng n]
- (if (< n (-count rng))
+ (if (and (<= 0 n) (< n (-count rng)))
(+ start (* n step))
- (if (and (> start end) (zero? step))
+ (if (and (<= 0 n) (> start end) (zero? step))
start
(throw (js/Error. "Index out of bounds")))))
(-nth [rng n not-found]
- (if (< n (-count rng))
+ (if (and (<= 0 n) (< n (-count rng)))
(+ start (* n step))
- (if (and (> start end) (zero? step))
+ (if (and (<= 0 n) (> start end) (zero? step))
start
not-found)))
@@ -9071,7 +9722,7 @@ reduces them without incurring seq initialization"
(let [fst (first s)
fv (f fst)
run (cons fst (take-while #(= fv (f %)) (next s)))]
- (cons run (partition-by f (seq (drop (count run) s)))))))))
+ (cons run (partition-by f (lazy-seq (drop (count run) s)))))))))
(defn frequencies
"Returns a map from distinct items in coll to the number of times
@@ -9141,8 +9792,8 @@ reduces them without incurring seq initialization"
be used to force any effects. Walks through the successive nexts of
the seq, does not retain the head and returns nil."
([coll]
- (when (seq coll)
- (recur (next coll))))
+ (when-let [s (seq coll)]
+ (recur (next s))))
([n coll]
(when (and (seq coll) (pos? n))
(recur (dec n) (next coll)))))
@@ -9200,8 +9851,9 @@ reduces them without incurring seq initialization"
(let [match-data (re-find re s)
match-idx (.search s re)
match-str (if (coll? match-data) (first match-data) match-data)
- post-match (subs s (+ match-idx (count match-str)))]
- (when match-data (lazy-seq (cons match-data (when (seq post-match) (re-seq re post-match)))))))
+ post-idx (+ match-idx (max 1 (count match-str)))
+ post-match (subs s post-idx)]
+ (when match-data (lazy-seq (cons match-data (when (<= post-idx (count s)) (re-seq re post-match)))))))
(defn re-pattern
"Returns an instance of RegExp which has compiled the provided string."
@@ -9242,6 +9894,8 @@ reduces them without incurring seq initialization"
(-write writer s)))
(defn string-print [x]
+ (when (nil? *print-fn*)
+ (throw (js/Error. "No *print-fn* fn set for evaluation environment")))
(*print-fn* x)
nil)
@@ -9262,7 +9916,7 @@ reduces them without incurring seq initialization"
[s]
(str \"
(.replace s (js/RegExp "[\\\\\"\b\f\n\r\t]" "g")
- (fn [match] (aget char-escapes match)))
+ (fn [match] (unchecked-get char-escapes match)))
\"))
(declare print-map)
@@ -9288,17 +9942,27 @@ reduces them without incurring seq initialization"
(.cljs$lang$ctorPrWriter obj obj writer opts)
; Use the new, more efficient, IPrintWithWriter interface when possible.
- (implements? IPrintWithWriter obj)
- (-pr-writer ^not-native obj writer opts)
+ (satisfies? IPrintWithWriter obj)
+ (-pr-writer obj writer opts)
- (or (true? obj) (false? obj) (number? obj))
+ (or (true? obj) (false? obj))
(-write writer (str obj))
+ (number? obj)
+ (-write writer
+ (cond
+ ^boolean (js/isNaN obj) "##NaN"
+ (identical? obj js/Number.POSITIVE_INFINITY) "##Inf"
+ (identical? obj js/Number.NEGATIVE_INFINITY) "##-Inf"
+ :else (str obj)))
+
(object? obj)
(do
(-write writer "#js ")
(print-map
- (map (fn [k] [(keyword k) (aget obj k)]) (js-keys obj))
+ (map (fn [k]
+ (MapEntry. (cond-> k (some? (re-matches #"[A-Za-z_\*\+\?!\-'][\w\*\+\?!\-']*" k)) keyword) (unchecked-get obj k) nil))
+ (js-keys obj))
pr-writer writer opts))
(array? obj)
@@ -9314,7 +9978,11 @@ reduces them without incurring seq initialization"
name (if (or (nil? name) (gstring/isEmpty name))
"Function"
name)]
- (write-all writer "#object[" name " \"" (str obj) "\"]"))
+ (write-all writer "#object[" name
+ (if *print-fn-bodies*
+ (str " \"" (str obj) "\"")
+ "")
+ "]"))
(instance? js/Date obj)
(let [normalize (fn [n len]
@@ -9336,15 +10004,17 @@ reduces them without incurring seq initialization"
(regexp? obj) (write-all writer "#\"" (.-source obj) "\"")
:else
- (if (.. obj -constructor -cljs$lang$ctorStr)
+ (if (some-> obj .-constructor .-cljs$lang$ctorStr)
(write-all writer
"#object[" (.replace (.. obj -constructor -cljs$lang$ctorStr)
(js/RegExp. "/" "g") ".") "]")
- (let [name (.. obj -constructor -name)
- name (if (or (nil? name) (gstring/isEmpty name))
- "Object"
- name)]
- (write-all writer "#object[" name " " (str obj) "]")))))))
+ (let [name (some-> obj .-constructor .-name)
+ name (if (or (nil? name) (gstring/isEmpty name))
+ "Object"
+ name)]
+ (if (nil? (. obj -constructor))
+ (write-all writer "#object[" name "]")
+ (write-all writer "#object[" name " " (str obj) "]"))))))))
(defn- pr-writer
"Prefer this to pr-seq, because it makes the printing function
@@ -9481,7 +10151,8 @@ reduces them without incurring seq initialization"
opts (seq m)))
(defn print-map [m print-one writer opts]
- (let [[ns lift-map] (lift-ns m)]
+ (let [[ns lift-map] (when (map? m)
+ (lift-ns m))]
(if ns
(print-prefix-map (str "#:" ns) lift-map print-one writer opts)
(print-prefix-map nil m print-one writer opts))))
@@ -9490,7 +10161,7 @@ reduces them without incurring seq initialization"
LazySeq
(-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
- LazyTransformer
+ TransformerIterator
(-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
IndexedSeq
@@ -9541,6 +10212,9 @@ reduces them without incurring seq initialization"
RedNode
(-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "[" " " "]" opts coll))
+ MapEntry
+ (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "[" " " "]" opts coll))
+
ObjMap
(-pr-writer [coll writer opts]
(print-map coll pr-writer writer opts))
@@ -9575,6 +10249,15 @@ reduces them without incurring seq initialization"
Range
(-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
+ Cycle
+ (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
+
+ Repeat
+ (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
+
+ Iterate
+ (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
+
ES6IteratorSeq
(-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
@@ -9619,6 +10302,24 @@ reduces them without incurring seq initialization"
(-compare [x y]
(if (vector? y)
(compare-indexed x y)
+ (throw (js/Error. (str "Cannot compare " x " to " y)))))
+
+ MapEntry
+ (-compare [x y]
+ (if (vector? y)
+ (compare-indexed x y)
+ (throw (js/Error. (str "Cannot compare " x " to " y)))))
+
+ BlackNode
+ (-compare [x y]
+ (if (vector? y)
+ (compare-indexed x y)
+ (throw (js/Error. (str "Cannot compare " x " to " y)))))
+
+ RedNode
+ (-compare [x y]
+ (if (vector? y)
+ (compare-indexed x y)
(throw (js/Error. (str "Cannot compare " x " to " y))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Reference Types ;;;;;;;;;;;;;;;;
@@ -9682,11 +10383,6 @@ reduces them without incurring seq initialization"
(set! gensym_counter (atom 0)))
(symbol (str prefix-string (swap! gensym_counter inc)))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Fixtures ;;;;;;;;;;;;;;;;
-
-(def fixture1 1)
-(def fixture2 2)
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Delay ;;;;;;;;;;;;;;;;;;;;
(deftype Delay [^:mutable f ^:mutable value]
@@ -9699,7 +10395,13 @@ reduces them without incurring seq initialization"
IPending
(-realized? [x]
- (not f)))
+ (not f))
+
+ IPrintWithWriter
+ (-pr-writer [x writer opts]
+ (-write writer "#object[cljs.core.Delay ")
+ (pr-writer {:status (if (nil? f) :ready :pending), :val value} writer opts)
+ (-write writer "]")))
(defn ^boolean delay?
"returns true if x is a Delay created with delay"
@@ -9800,6 +10502,10 @@ reduces them without incurring seq initialization"
ISequential
+ IIterable
+ (-iterator [_]
+ (.create TransformerIterator xform (iter coll)))
+
ISeqable
(-seq [_] (seq (sequence xform coll)))
@@ -9836,36 +10542,44 @@ reduces them without incurring seq initialization"
(declare clj->js)
-(defn key->js [k]
- (if (satisfies? IEncodeJS k)
- (-clj->js k)
- (if (or (string? k)
- (number? k)
- (keyword? k)
- (symbol? k))
- (clj->js k)
- (pr-str k))))
+(defn key->js
+ ([k] (key->js k clj->js))
+ ([k primitive-fn]
+ (cond
+ (satisfies? IEncodeJS k) (-clj->js k)
+ (or (string? k)
+ (number? k)
+ (keyword? k)
+ (symbol? k)) (primitive-fn k)
+ :default (pr-str k))))
(defn clj->js
"Recursively transforms ClojureScript values to JavaScript.
sets/vectors/lists become Arrays, Keywords and Symbol become Strings,
- Maps become Objects. Arbitrary keys are encoded to by key->js."
- [x]
- (when-not (nil? x)
- (if (satisfies? IEncodeJS x)
- (-clj->js x)
- (cond
- (keyword? x) (name x)
- (symbol? x) (str x)
- (map? x) (let [m (js-obj)]
- (doseq [[k v] x]
- (aset m (key->js k) (clj->js v)))
- m)
- (coll? x) (let [arr (array)]
- (doseq [x (map clj->js x)]
- (.push arr x))
- arr)
- :else x))))
+ Maps become Objects. Arbitrary keys are encoded to by `key->js`.
+ Options is a key-value pair, where the only valid key is
+ :keyword-fn, which should point to a single-argument function to be
+ called on keyword keys. Default to `name`."
+ [x & {:keys [keyword-fn]
+ :or {keyword-fn name}
+ :as options}]
+ (letfn [(keyfn [k] (key->js k thisfn))
+ (thisfn [x] (cond
+ (nil? x) nil
+ (satisfies? IEncodeJS x) (-clj->js x)
+ (keyword? x) (keyword-fn x)
+ (symbol? x) (str x)
+ (map? x) (let [m (js-obj)]
+ (doseq [[k v] x]
+ (gobject/set m (keyfn k) (thisfn v)))
+ m)
+ (coll? x) (let [arr (array)]
+ (doseq [x (map thisfn x)]
+ (.push arr x))
+ arr)
+ :else x))]
+ (thisfn x)))
+
(defprotocol IEncodeClojure
(-js->clj [x options] "Transforms JavaScript values to Clojure"))
@@ -9887,16 +10601,21 @@ reduces them without incurring seq initialization"
(seq? x)
(doall (map thisfn x))
+ (map-entry? x)
+ (MapEntry. (thisfn (key x)) (thisfn (val x)) nil)
+
(coll? x)
- (into (empty x) (map thisfn x))
+ (into (empty x) (map thisfn) x)
(array? x)
- (vec (map thisfn x))
-
- (identical? (type x) js/Object)
- (into {} (for [k (js-keys x)]
- [(keyfn k) (thisfn (aget x k))]))
+ (persistent!
+ (reduce #(conj! %1 (thisfn %2))
+ (transient []) x))
+ (identical? (type x) js/Object)
+ (persistent!
+ (reduce (fn [r k] (assoc! r (keyfn k) (thisfn (gobject/get x k))))
+ (transient {}) (js-keys x)))
:else x))]
(f x))))
@@ -10105,7 +10824,7 @@ reduces them without incurring seq initialization"
(or (prefers* x y prefer-table) (isa? hierarchy x y)))
(defn- find-and-cache-best-method
- [name dispatch-val hierarchy method-table prefer-table method-cache cached-hierarchy]
+ [name dispatch-val hierarchy method-table prefer-table method-cache cached-hierarchy default-dispatch-val]
(let [best-entry (reduce (fn [be [k _ :as e]]
(if (isa? @hierarchy dispatch-val k)
(let [be2 (if (or (nil? be) (dominates k (first be) prefer-table @hierarchy))
@@ -10113,12 +10832,15 @@ reduces them without incurring seq initialization"
be)]
(when-not (dominates (first be2) k prefer-table @hierarchy)
(throw (js/Error.
- (str "Multiple methods in multimethod '" name
- "' match dispatch value: " dispatch-val " -> " k
- " and " (first be2) ", and neither is preferred"))))
+ (str "Multiple methods in multimethod '" name
+ "' match dispatch value: " dispatch-val " -> " k
+ " and " (first be2) ", and neither is preferred"))))
be2)
be))
- nil @method-table)]
+ nil @method-table)
+ best-entry (if-let [entry (and (nil? best-entry) (@method-table default-dispatch-val))]
+ [default-dispatch-val entry]
+ best-entry)]
(when best-entry
(if (= @cached-hierarchy @hierarchy)
(do
@@ -10127,7 +10849,7 @@ reduces them without incurring seq initialization"
(do
(reset-cache method-cache method-table cached-hierarchy hierarchy)
(find-and-cache-best-method name dispatch-val hierarchy method-table prefer-table
- method-cache cached-hierarchy))))))
+ method-cache cached-hierarchy default-dispatch-val))))))
(defprotocol IMultiFn
(-reset [mf])
@@ -10278,7 +11000,7 @@ reduces them without incurring seq initialization"
(when-not target-fn
(throw-no-method-error name dispatch-val))
(apply target-fn a b c d e f g h i j k l m n o p q r s t rest)))
-
+
IMultiFn
(-reset [mf]
(swap! method-table (fn [mf] {}))
@@ -10302,10 +11024,8 @@ reduces them without incurring seq initialization"
(reset-cache method-cache method-table cached-hierarchy hierarchy))
(if-let [target-fn (@method-cache dispatch-val)]
target-fn
- (if-let [target-fn (find-and-cache-best-method name dispatch-val hierarchy method-table
- prefer-table method-cache cached-hierarchy)]
- target-fn
- (@method-table default-dispatch-val))))
+ (find-and-cache-best-method name dispatch-val hierarchy method-table
+ prefer-table method-cache cached-hierarchy default-dispatch-val)))
(-prefer-method [mf dispatch-val-x dispatch-val-y]
(when (prefers* dispatch-val-x dispatch-val-y prefer-table)
@@ -10322,7 +11042,7 @@ reduces them without incurring seq initialization"
(-prefers [mf] @prefer-table)
(-default-dispatch-val [mf] default-dispatch-val)
(-dispatch-fn [mf] dispatch-fn)
-
+
INamed
(-name [this] (-name name))
(-namespace [this] (-namespace name))
@@ -10397,7 +11117,8 @@ reduces them without incurring seq initialization"
(garray/defaultCompare uuid (.-uuid other))))
(defn uuid [s]
- (UUID. s nil))
+ (assert (string? s))
+ (UUID. (.toLowerCase s) nil))
(defn random-uuid []
(letfn [(hex [] (.toString (rand-int 16) 16))]
@@ -10497,7 +11218,7 @@ reduces them without incurring seq initialization"
[x]
(contains?
'#{if def fn* do let* loop* letfn* throw try catch finally
- recur new set! ns deftype* defrecord* . js* & quote var ns*}
+ recur new set! ns deftype* defrecord* . js* & quote case* var ns*}
x))
(defn test
@@ -10556,7 +11277,7 @@ reduces them without incurring seq initialization"
^{:private true
:jsdoc ["@type {*}"]}
js-reserved-arr
- #js ["abstract" "boolean" "break" "byte" "case"
+ #js ["arguments" "abstract" "await" "boolean" "break" "byte" "case"
"catch" "char" "class" "const" "continue"
"debugger" "default" "delete" "do" "double"
"else" "enum" "export" "extends" "final"
@@ -10568,7 +11289,7 @@ reduces them without incurring seq initialization"
"synchronized" "this" "throw" "throws"
"transient" "try" "typeof" "var" "void"
"volatile" "while" "with" "yield" "methods"
- "null"])
+ "null" "constructor"])
(def
^{:jsdoc ["@type {null|Object}"]}
@@ -10617,7 +11338,7 @@ reduces them without incurring seq initialization"
:else name')]
(if (symbol? name)
(symbol name')
- (str name'))))
+ name')))
(defn- demunge-str [munged-name]
(let [r (js/RegExp. (demunge-pattern) "g")
@@ -10641,7 +11362,40 @@ reduces them without incurring seq initialization"
(let [name' (str name)]
(if (identical? name' "_DOT__DOT_")
".."
- (demunge-str (str name))))))
+ (demunge-str name')))))
+
+(defonce ^{:jsdoc ["@type {*}"] :private true}
+ tapset nil)
+
+(defn- maybe-init-tapset []
+ (when (nil? tapset)
+ (set! tapset (atom #{}))))
+
+(defn add-tap
+ "Adds f, a fn of one argument, to the tap set. This function will be called with
+ anything sent via tap>. Remember f in order to remove-tap"
+ [f]
+ (maybe-init-tapset)
+ (swap! tapset conj f)
+ nil)
+
+(defn remove-tap
+ "Remove f from the tap set."
+ [f]
+ (maybe-init-tapset)
+ (swap! tapset disj f)
+ nil)
+
+(defn ^boolean tap>
+ "Sends x to any taps. Returns the result of *exec-tap-fn*, a Boolean value."
+ [x]
+ (maybe-init-tapset)
+ (*exec-tap-fn*
+ (fn []
+ (doseq [tap @tapset]
+ (try
+ (tap x)
+ (catch js/Error ex))))))
;; -----------------------------------------------------------------------------
;; Bootstrap helpers - incompatible with advanced compilation
@@ -10697,16 +11451,19 @@ reduces them without incurring seq initialization"
; may throw ReferenceError.
(find-ns-obj*
(try
- (js/eval (first segs))
+ (let [ctxt (js/eval (first segs))]
+ (when (and ctxt (object? ctxt))
+ ctxt))
(catch js/ReferenceError e
nil))
(next segs))
- (find-ns-obj* js/global segs))
- "default" (find-ns-obj* goog/global segs)
+ (find-ns-obj* goog/global segs))
+ ("default" "webworker") (find-ns-obj* goog/global segs)
(throw (js/Error. (str "find-ns-obj not supported for target " *target*))))))
(defn ns-interns*
- "Bootstrap only."
+ "Returns a map of the intern mappings for the namespace.
+ Bootstrap only."
[sym]
(let [ns-obj (find-ns-obj sym)
ns (Namespace. ns-obj sym)]
@@ -10718,14 +11475,15 @@ reduces them without incurring seq initialization"
(reduce step {} (js-keys ns-obj)))))
(defn create-ns
- "Bootstrap only."
+ "Create a new namespace named by the symbol. Bootstrap only."
([sym]
(create-ns sym (find-ns-obj sym)))
([sym ns-obj]
(Namespace. ns-obj sym)))
(defn find-ns
- "Bootstrap only."
+ "Returns the namespace named by the symbol or nil if it doesn't exist.
+ Bootstrap only."
[ns]
(when (nil? NS_CACHE)
(set! NS_CACHE (atom {})))
@@ -10739,24 +11497,69 @@ reduces them without incurring seq initialization"
new-ns))))))
(defn find-macros-ns
- "Bootstrap only."
+ "Returns the macros namespace named by the symbol or nil if it doesn't exist.
+ Bootstrap only."
[ns]
(when (nil? NS_CACHE)
(set! NS_CACHE (atom {})))
- (let [the-ns (get @NS_CACHE ns)]
+ (let [ns-str (str ns)
+ ns (if (not ^boolean (gstring/contains ns-str "$macros"))
+ (symbol (str ns-str "$macros"))
+ ns)
+ the-ns (get @NS_CACHE ns)]
(if-not (nil? the-ns)
the-ns
- (let [ns-str (str ns)
- ns (if (not ^boolean (gstring/contains ns-str "$macros"))
- (symbol (str ns-str "$macros"))
- ns)
- ns-obj (find-ns-obj ns)]
+ (let [ns-obj (find-ns-obj ns)]
(when-not (nil? ns-obj)
(let [new-ns (create-ns ns ns-obj)]
(swap! NS_CACHE assoc ns new-ns)
new-ns))))))
(defn ns-name
- "Bootstrap only."
+ "Returns the name of the namespace, a Namespace object.
+ Bootstrap only."
[ns-obj]
(.-name ns-obj))
+
+(defn uri?
+ "Returns true x is a goog.Uri instance."
+ {:added "1.9"}
+ [x]
+ (instance? goog.Uri x))
+
+(defn- maybe-enable-print! []
+ (cond
+ (exists? js/console)
+ (enable-console-print!)
+
+ (or (identical? *target* "nashorn")
+ (identical? *target* "graaljs"))
+ (let [system (.type js/Java "java.lang.System")]
+ (set! *print-newline* false)
+ (set-print-fn!
+ (fn []
+ (let [xs (js-arguments)
+ s (.join (garray/clone xs) "")]
+ (.println (.-out system) s))))
+ (set-print-err-fn!
+ (fn []
+ (let [xs (js-arguments)
+ s (.join (garray/clone xs) "")]
+ (.println (.-error system) s)))))))
+
+(maybe-enable-print!)
+
+(defonce
+ ^{:doc "Runtime environments may provide a way to evaluate ClojureScript
+ forms. Whatever function *eval* is bound to will be passed any forms which
+ should be evaluated." :dynamic true}
+ *eval*
+ (fn [_]
+ (throw (js/Error. "cljs.core/*eval* not bound"))))
+
+(defn eval
+ "Evaluates the form data structure (not text!) and returns the result.
+ Delegates to cljs.core/*eval*. Intended for use in self-hosted ClojureScript,
+ which sets up an implementation of cljs.core/*eval* for that environment."
+ [form]
+ (*eval* form))