diff options
| author | Brian Picciano <mediocregopher@gmail.com> | 2018-11-13 00:24:09 -0500 |
|---|---|---|
| committer | Brian Picciano <mediocregopher@gmail.com> | 2018-11-13 00:24:09 -0500 |
| commit | 2b4757367470d8e36bc00901dac567e375796ed4 (patch) | |
| tree | 72368624006c21d28228a100ee88590c7bf95e58 /assets/viz/2/cljs/core.cljs | |
| parent | 5ed62d23b4bbbf7717de4adfa0eaf2af19365408 (diff) | |
update viz 2 to use the newest version, which has some performance improvements and is easier to read the code for. also update the description
Diffstat (limited to 'assets/viz/2/cljs/core.cljs')
| -rw-r--r-- | assets/viz/2/cljs/core.cljs | 1843 |
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)) |