diff options
Diffstat (limited to 'assets/viz/1/cljs/core.cljs')
| -rw-r--r-- | assets/viz/1/cljs/core.cljs | 10762 |
1 files changed, 10762 insertions, 0 deletions
diff --git a/assets/viz/1/cljs/core.cljs b/assets/viz/1/cljs/core.cljs new file mode 100644 index 0000000..a87e53b --- /dev/null +++ b/assets/viz/1/cljs/core.cljs @@ -0,0 +1,10762 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +(ns cljs.core + (:require goog.math.Long + goog.math.Integer + [goog.string :as gstring] + [goog.object :as gobject] + [goog.array :as garray]) + (:import [goog.string StringBuffer])) + +;; next line is auto-generated by the build-script - Do not edit! +(def *clojurescript-version* "1.9.473") + +(def *unchecked-if* false) +(def *warn-on-infer* false) + +(defonce PROTOCOL_SENTINEL #js {}) + +(goog-define + ^{:dynamic true + :doc "Var bound to the name value of the compiler build :target option. + For example, if the compiler build :target is :nodejs, *target* will be bound + to \"nodejs\". *target* is a Google Closure define and can be set by compiler + :closure-defines option."} + *target* "default") + +(def + ^{:dynamic true + :doc "Var bound to the current namespace. Only used for bootstrapping." + :jsdoc ["@type {*}"]} + *ns* nil) + +(def + ^{:dynamic true + :jsdoc ["@type {*}"]} + *out* nil) + +(def + ^{:dynamic true} + *assert* true) + +(defonce + ^{: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")))) + +(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")))) + +(defn set-print-fn! + "Set *print-fn* to f." + [f] (set! *print-fn* f)) + +(defn set-print-err-fn! + "Set *print-err-fn* to f." + [f] (set! *print-err-fn* f)) + +(def + ^{:dynamic true + :doc "When set to true, output will be flushed whenever a newline is printed. + + Defaults to true."} + *flush-on-newline* true) + +(def + ^{:dynamic true + :doc "When set to logical false will drop newlines from printing calls. + This is to work around the implicit newlines emitted by standard JavaScript + console objects."} + *print-newline* true) + +(def + ^{:dynamic true + :doc "When set to logical false, strings and characters will be printed with + non-alphanumeric characters converted to the appropriate escape sequences. + + Defaults to true"} + *print-readably* true) + +(def + ^{:dynamic true + :doc "If set to logical true, when printing an object, its metadata will also + be printed in a form that can be read back by the reader. + + Defaults to false."} + *print-meta* false) + +(def + ^{:dynamic true + :doc "When set to logical true, objects will be printed in a way that preserves + their type when read in later. + + Defaults to false."} + *print-dup* false) + +(def + ^{:dynamic true + :doc "*print-namespace-maps* controls whether the printer will print + namespace map literal syntax. + + Defaults to false, but the REPL binds it to true."} + *print-namespace-maps* false) + +(def + ^{:dynamic true + :doc "*print-length* controls how many items of each collection the + printer will print. If it is bound to logical false, there is no + limit. Otherwise, it must be bound to an integer indicating the maximum + number of items of each collection to print. If a collection contains + more items, the printer will print items up to the limit followed by + '...' to represent the remaining items. The root binding is nil + indicating no limit." + :jsdoc ["@type {null|number}"]} + *print-length* nil) + +(def + ^{:dynamic true + :doc "*print-level* controls how many levels deep the printer will + print nested objects. If it is bound to logical false, there is no + limit. Otherwise, it must be bound to an integer indicating the maximum + level to print. Each argument to print is at level 0; if an argument is a + collection, its items are at level 1; and so on. If an object is a + collection and is at a level greater than or equal to the value bound to + *print-level*, the printer prints '#' to represent it. The root binding + is nil indicating no limit." + :jsdoc ["@type {null|number}"]} + *print-level* nil) + +(defonce + ^{:dynamic true + :jsdoc ["@type {*}"]} + *loaded-libs* nil) + +(defn- pr-opts [] + {:flush-on-newline *flush-on-newline* + :readably *print-readably* + :meta *print-meta* + :dup *print-dup* + :print-length *print-length*}) + +(declare into-array) + +(defn enable-console-print! + "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)))) + nil) + +(def + ^{:doc "bound in a repl thread to the most recent value printed"} + *1) + +(def + ^{:doc "bound in a repl thread to the second most recent value printed"} + *2) + +(def + ^{:doc "bound in a repl thread to the third most recent value printed"} + *3) + +(def + ^{:doc "bound in a repl thread to the most recent exception caught by the repl"} + *e) + +(defn truth_ + "Internal - do not use!" + [x] + (cljs.core/truth_ x)) + +(def not-native nil) + +(declare instance? Keyword) + +(defn ^boolean identical? + "Tests if 2 arguments are the same object" + [x y] + (cljs.core/identical? x y)) + +(defn ^boolean nil? + "Returns true if x is nil, false otherwise." + [x] + (coercive-= x nil)) + +(defn ^boolean array? + "Returns true if x is a JavaScript array." + [x] + (if (identical? *target* "nodejs") + (.isArray js/Array x) + (instance? js/Array x))) + +(defn ^boolean number? + "Returns true if x is a JavaScript number." + [x] + (cljs.core/number? x)) + +(defn ^boolean not + "Returns true if x is logical false, false otherwise." + [x] + (cond + (nil? x) true + (false? x) true + :else false)) + +(defn ^boolean some? + "Returns true if x is not nil, false otherwise." + [x] (not (nil? x))) + +(defn ^boolean object? + "Returns true if x's constructor is Object" + [x] + (if-not (nil? x) + (identical? (.-constructor x) js/Object) + false)) + +(defn ^boolean string? + "Returns true if x is a JavaScript string." + [x] + (goog/isString x)) + +(defn ^boolean char? + "Returns true if x is a JavaScript string of length one." + [x] + (and (string? x) (== 1 (.-length x)))) + +(defn ^boolean any? + "Returns true if given any argument." + [x] true) + +(set! *unchecked-if* true) +(defn ^boolean native-satisfies? + "Internal - do not use!" + [p x] + (let [x (if (nil? x) nil x)] + (cond + (aget p (goog/typeOf x)) true + (aget p "_") true + :else false))) +(set! *unchecked-if* false) + +(defn is_proto_ + [x] + (identical? (.-prototype (.-constructor x)) x)) + +(def + ^{:doc "When compiled for a command-line target, whatever function + *main-cli-fn* is set to will be called with the command-line + argv as arguments"} + *main-cli-fn* nil) + +(defn type + "Return x's constructor." + [x] + (when-not (nil? x) + (.-constructor x))) + +(defn missing-protocol [proto obj] + (let [ty (type obj) + ty (if (and ty (.-cljs$lang$type ty)) + (.-cljs$lang$ctorStr ty) + (goog/typeOf obj))] + (js/Error. + (.join (array "No protocol method " proto + " defined for type " ty ": " obj) "")))) + +(defn type->str [ty] + (if-let [s (.-cljs$lang$ctorStr ty)] + s + (str ty))) + +;; INTERNAL - do not use, only for Node.js +(defn load-file [file] + (when-not js/COMPILED + (cljs.core/load-file* file))) + +(if (and (exists? js/Symbol) + (identical? (goog/typeOf js/Symbol) "function")) + (def ITER_SYMBOL (.-iterator js/Symbol)) + (def ITER_SYMBOL "@@iterator")) + +(def ^{:jsdoc ["@enum {string}"]} + CHAR_MAP + #js {"-" "_" + ":" "_COLON_" + "+" "_PLUS_" + ">" "_GT_" + "<" "_LT_" + "=" "_EQ_" + "~" "_TILDE_" + "!" "_BANG_" + "@" "_CIRCA_" + "#" "_SHARP_" + "'" "_SINGLEQUOTE_" + "\\\"" "_DOUBLEQUOTE_" + "%" "_PERCENT_" + "^" "_CARET_" + "&" "_AMPERSAND_" + "*" "_STAR_" + "|" "_BAR_" + "{" "_LBRACE_" + "}" "_RBRACE_" + "[" "_LBRACK_" + "]" "_RBRACK_" + "/" "_SLASH_" + "\\\\" "_BSLASH_" + "?" "_QMARK_"}) + +(def ^{:jsdoc ["@enum {string}"]} + DEMUNGE_MAP + #js {"_" "-" + "_COLON_" ":" + "_PLUS_" "+" + "_GT_" ">" + "_LT_" "<" + "_EQ_" "=" + "_TILDE_" "~" + "_BANG_" "!" + "_CIRCA_" "@" + "_SHARP_" "#" + "_SINGLEQUOTE_" "'" + "_DOUBLEQUOTE_" "\\\"" + "_PERCENT_" "%" + "_CARET_" "^" + "_AMPERSAND_" "&" + "_STAR_" "*" + "_BAR_" "|" + "_LBRACE_" "{" + "_RBRACE_" "}" + "_LBRACK_" "[" + "_RBRACK_" "]" + "_SLASH_" "/" + "_BSLASH_" "\\\\" + "_QMARK_" "?"}) + +(def DEMUNGE_PATTERN nil) + +(defn system-time + "Returns highest resolution time offered by host in milliseconds." + [] + (cond + (and (exists? js/performance) + (not (nil? (. js/performance -now)))) + (.now js/performance) + + (and (exists? js/process) + (not (nil? (. js/process -hrtime)))) + (let [t (.hrtime js/process)] + (/ (+ (* (aget t 0) 1e9) (aget t 1)) 1e6)) + + :else (.getTime (js/Date.)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; arrays ;;;;;;;;;;;;;;;; + +(declare apply) + +(defn ^array make-array + "Construct a JavaScript array of the specified dimensions. Accepts ignored + type argument for compatibility with Clojure. Note that there is no efficient + way to allocate multi-dimensional arrays in JavaScript; as such, this function + will run in polynomial time when called with 3 or more arguments." + ([size] + (js/Array. size)) + ([type size] + (make-array size)) + ([type size & more-sizes] + (let [dims more-sizes + dimarray (make-array size)] + (dotimes [i (alength dimarray)] + (aset dimarray i (apply make-array nil dims))) + dimarray))) + +(defn aclone + "Returns a javascript array, cloned from the passed in array" + [arr] + (let [len (alength arr) + new-arr (make-array len)] + (dotimes [i len] + (aset new-arr i (aget arr i))) + new-arr)) + +(defn ^array array + "Creates a new javascript array. +@param {...*} var_args" ;;array is a special case, don't emulate this doc string + [var-args] ;; [& items] + (let [a (js/Array. (alength (cljs.core/js-arguments)))] + (loop [i 0] + (if (< i (alength a)) + (do + (aset a i (aget (cljs.core/js-arguments) i)) + (recur (inc i))) + a)))) + +(defn aget + "Returns the value at the index." + ([array i] + (cljs.core/aget array i)) + ([array i & idxs] + (apply aget (aget array i) idxs))) + +(defn aset + "Sets the value at the index." + ([array i val] + (cljs.core/aset array i val)) + ([array idx idx2 & idxv] + (apply aset (aget array idx) idx2 idxv))) + +(defn ^number alength + "Returns the length of the array. Works on arrays of all types." + [array] + (cljs.core/alength array)) + +(declare reduce) + +(defn ^array into-array + "Returns an array with components set to the values in aseq. Optional type + argument accepted for compatibility with Clojure." + ([aseq] + (into-array nil aseq)) + ([type aseq] + (reduce (fn [a x] (.push a x) a) (array) aseq))) + +(defn js-invoke + "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))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;; core protocols ;;;;;;;;;;;;; + +(defprotocol Fn + "Marker protocol") + +(defprotocol IFn + "Protocol for adding the ability to invoke an object as a function. + For example, a vector can also be used to look up a value: + ([1 2 3 4] 1) => 2" + (-invoke + [this] + [this a] + [this a b] + [this a b c] + [this a b c d] + [this a b c d e] + [this a b c d e f] + [this a b c d e f g] + [this a b c d e f g h] + [this a b c d e f g h i] + [this a b c d e f g h i j] + [this a b c d e f g h i j k] + [this a b c d e f g h i j k l] + [this a b c d e f g h i j k l m] + [this a b c d e f g h i j k l m n] + [this a b c d e f g h i j k l m n o] + [this a b c d e f g h i j k l m n o p] + [this a b c d e f g h i j k l m n o p q] + [this a b c d e f g h i j k l m n o p q r] + [this a b c d e f g h i j k l m n o p q r s] + [this a b c d e f g h i j k l m n o p q r s t] + [this a b c d e f g h i j k l m n o p q r s t rest])) + +(defprotocol ICloneable + "Protocol for cloning a value." + (^clj -clone [value] + "Creates a clone of value.")) + +(defprotocol ICounted + "Protocol for adding the ability to count a collection in constant time." + (^number -count [coll] + "Calculates the count of coll in constant time. Used by cljs.core/count.")) + +(defprotocol IEmptyableCollection + "Protocol for creating an empty collection." + (-empty [coll] + "Returns an empty collection of the same category as coll. Used + by cljs.core/empty.")) + +(defprotocol ICollection + "Protocol for adding to a collection." + (^clj -conj [coll o] + "Returns a new collection of coll with o added to it. The new item + should be added to the most efficient place, e.g. + (conj [1 2 3 4] 5) => [1 2 3 4 5] + (conj '(2 3 4 5) 1) => '(1 2 3 4 5)")) + +#_(defprotocol IOrdinal + (-index [coll])) + +(defprotocol IIndexed + "Protocol for collections to provide indexed-based access to their items." + (-nth [coll n] [coll n not-found] + "Returns the value at the index n in the collection coll. + Returns not-found if index n is out of bounds and not-found is supplied.")) + +(defprotocol ASeq + "Marker protocol indicating an array sequence.") + +(defprotocol ISeq + "Protocol for collections to provide access to their items as sequences." + (-first [coll] + "Returns the first item in the collection coll. Used by cljs.core/first.") + (^clj -rest [coll] + "Returns a new collection of coll without the first item. It should + always return a seq, e.g. + (rest []) => () + (rest nil) => ()")) + +(defprotocol INext + "Protocol for accessing the next items of a collection." + (^clj-or-nil -next [coll] + "Returns a new collection of coll without the first item. In contrast to + rest, it should return nil if there are no more items, e.g. + (next []) => nil + (next nil) => nil")) + +(defprotocol ILookup + "Protocol for looking up a value in a data structure." + (-lookup [o k] [o k not-found] + "Use k to look up a value in o. If not-found is supplied and k is not + a valid value that can be used for look up, not-found is returned.")) + +(defprotocol IAssociative + "Protocol for adding associativity to collections." + (^boolean -contains-key? [coll k] + "Returns true if k is a key in coll.") + #_(-entry-at [coll k]) + (^clj -assoc [coll k v] + "Returns a new collection of coll with a mapping from key k to + value v added to it.")) + +(defprotocol IMap + "Protocol for adding mapping functionality to collections." + #_(-assoc-ex [coll k v]) + (^clj -dissoc [coll k] + "Returns a new collection of coll without the mapping for key k.")) + +(defprotocol IMapEntry + "Protocol for examining a map entry." + (-key [coll] + "Returns the key of the map entry.") + (-val [coll] + "Returns the value of the map entry.")) + +(defprotocol ISet + "Protocol for adding set functionality to a collection." + (^clj -disjoin [coll v] + "Returns a new collection of coll that does not contain v.")) + +(defprotocol IStack + "Protocol for collections to provide access to their items as stacks. The top + of the stack should be accessed in the most efficient way for the different + data structures." + (-peek [coll] + "Returns the item from the top of the stack. Is used by cljs.core/peek.") + (^clj -pop [coll] + "Returns a new stack without the item on top of the stack. Is used + by cljs.core/pop.")) + +(defprotocol IVector + "Protocol for adding vector functionality to collections." + (^clj -assoc-n [coll n val] + "Returns a new vector with value val added at position n.")) + +(defprotocol IDeref + "Protocol for adding dereference functionality to a reference." + (-deref [o] + "Returns the value of the reference o.")) + +(defprotocol IDerefWithTimeout + (-deref-with-timeout [o msec timeout-val])) + +(defprotocol IMeta + "Protocol for accessing the metadata of an object." + (^clj-or-nil -meta [o] + "Returns the metadata of object o.")) + +(defprotocol IWithMeta + "Protocol for adding metadata to an object." + (^clj -with-meta [o meta] + "Returns a new object with value of o and metadata meta added to it.")) + +(defprotocol IReduce + "Protocol for seq types that can reduce themselves. + Called by cljs.core/reduce." + (-reduce [coll f] [coll f start] + "f should be a function of 2 arguments. If start is not supplied, + returns the result of applying f to the first 2 items in coll, then + applying f to that result and the 3rd item, etc.")) + +(defprotocol IKVReduce + "Protocol for associative types that can reduce themselves + via a function of key and val. Called by cljs.core/reduce-kv." + (-kv-reduce [coll f init] + "Reduces an associative collection and returns the result. f should be + a function that takes three arguments.")) + +(defprotocol IEquiv + "Protocol for adding value comparison functionality to a type." + (^boolean -equiv [o other] + "Returns true if o and other are equal, false otherwise.")) + +(defprotocol IHash + "Protocol for adding hashing functionality to a type." + (-hash [o] + "Returns the hash code of o.")) + +(defprotocol ISeqable + "Protocol for adding the ability to a type to be transformed into a sequence." + (^clj-or-nil -seq [o] + "Returns a seq of o, or nil if o is empty.")) + +(defprotocol ISequential + "Marker interface indicating a persistent collection of sequential items") + +(defprotocol IList + "Marker interface indicating a persistent list") + +(defprotocol IRecord + "Marker interface indicating a record object") + +(defprotocol IReversible + "Protocol for reversing a seq." + (^clj -rseq [coll] + "Returns a seq of the items in coll in reversed order.")) + +(defprotocol ISorted + "Protocol for a collection which can represent their items + in a sorted manner. " + (^clj -sorted-seq [coll ascending?] + "Returns a sorted seq from coll in either ascending or descending order.") + (^clj -sorted-seq-from [coll k ascending?] + "Returns a sorted seq from coll in either ascending or descending order. + If ascending is true, the result should contain all items which are > or >= + than k. If ascending is false, the result should contain all items which + are < or <= than k, e.g. + (-sorted-seq-from (sorted-set 1 2 3 4 5) 3 true) => (3 4 5) + (-sorted-seq-from (sorted-set 1 2 3 4 5) 3 false) => (3 2 1)") + (-entry-key [coll entry] + "Returns the key for entry.") + (-comparator [coll] + "Returns the comparator for coll.")) + +(defprotocol IWriter + "Protocol for writing. Currently only implemented by StringBufferWriter." + (-write [writer s] + "Writes s with writer and returns the result.") + (-flush [writer] + "Flush writer.")) + +(defprotocol IPrintWithWriter + "The old IPrintable protocol's implementation consisted of building a giant + list of strings to concatenate. This involved lots of concat calls, + intermediate vectors, and lazy-seqs, and was very slow in some older JS + engines. IPrintWithWriter implements printing via the IWriter protocol, so it + be implemented efficiently in terms of e.g. a StringBuffer append." + (-pr-writer [o writer opts])) + +(defprotocol IPending + "Protocol for types which can have a deferred realization. Currently only + implemented by Delay and LazySeq." + (^boolean -realized? [x] + "Returns true if a value for x has been produced, false otherwise.")) + +(defprotocol IWatchable + "Protocol for types that can be watched. Currently only implemented by Atom." + (-notify-watches [this oldval newval] + "Calls all watchers with this, oldval and newval.") + (-add-watch [this key f] + "Adds a watcher function f to this. Keys must be unique per reference, + and can be used to remove the watch with -remove-watch.") + (-remove-watch [this key] + "Removes watcher that corresponds to key from this.")) + +(defprotocol IEditableCollection + "Protocol for collections which can transformed to transients." + (^clj -as-transient [coll] + "Returns a new, transient version of the collection, in constant time.")) + +(defprotocol ITransientCollection + "Protocol for adding basic functionality to transient collections." + (^clj -conj! [tcoll val] + "Adds value val to tcoll and returns tcoll.") + (^clj -persistent! [tcoll] + "Creates a persistent data structure from tcoll and returns it.")) + +(defprotocol ITransientAssociative + "Protocol for adding associativity to transient collections." + (^clj -assoc! [tcoll key val] + "Returns a new transient collection of tcoll with a mapping from key to + val added to it.")) + +(defprotocol ITransientMap + "Protocol for adding mapping functionality to transient collections." + (^clj -dissoc! [tcoll key] + "Returns a new transient collection of tcoll without the mapping for key.")) + +(defprotocol ITransientVector + "Protocol for adding vector functionality to transient collections." + (^clj -assoc-n! [tcoll n val] + "Returns tcoll with value val added at position n.") + (^clj -pop! [tcoll] + "Returns tcoll with the last item removed from it.")) + +(defprotocol ITransientSet + "Protocol for adding set functionality to a transient collection." + (^clj -disjoin! [tcoll v] + "Returns tcoll without v.")) + +(defprotocol IComparable + "Protocol for values that can be compared." + (^number -compare [x y] + "Returns a negative number, zero, or a positive number when x is logically + 'less than', 'equal to', or 'greater than' y.")) + +(defprotocol IChunk + "Protocol for accessing the items of a chunk." + (-drop-first [coll] + "Return a new chunk of coll with the first item removed.")) + +(defprotocol IChunkedSeq + "Protocol for accessing a collection as sequential chunks." + (-chunked-first [coll] + "Returns the first chunk in coll.") + (-chunked-rest [coll] + "Return a new collection of coll with the first chunk removed.")) + +(defprotocol IChunkedNext + "Protocol for accessing the chunks of a collection." + (-chunked-next [coll] + "Returns a new collection of coll without the first chunk.")) + +(defprotocol INamed + "Protocol for adding a name." + (^string -name [x] + "Returns the name String of x.") + (^string -namespace [x] + "Returns the namespace String of x.")) + +(defprotocol IAtom + "Marker protocol indicating an atom.") + +(defprotocol IReset + "Protocol for adding resetting functionality." + (-reset! [o new-value] + "Sets the value of o to new-value.")) + +(defprotocol ISwap + "Protocol for adding swapping functionality." + (-swap! [o f] [o f a] [o f a b] [o f a b xs] + "Swaps the value of o to be (apply f current-value-of-atom args).")) + +(defprotocol IVolatile + "Protocol for adding volatile functionality." + (-vreset! [o new-value] + "Sets the value of volatile o to new-value without regard for the + current value. Returns new-value.")) + +(defprotocol IIterable + "Protocol for iterating over a collection." + (-iterator [coll] + "Returns an iterator for coll.")) + +;; Printing support + +(deftype StringBufferWriter [sb] + IWriter + (-write [_ s] (.append sb s)) + (-flush [_] nil)) + +(defn pr-str* + "Support so that collections can implement toString without + loading all the printing machinery." + [^not-native obj] + (let [sb (StringBuffer.) + writer (StringBufferWriter. sb)] + (-pr-writer obj writer (pr-opts)) + (-flush writer) + (str sb))) + +;;;;;;;;;;;;;;;;;;; Murmur3 ;;;;;;;;;;;;;;; + +;;http://hg.openjdk.java.net/jdk7u/jdk7u6/jdk/file/8c2c5d63a17e/src/share/classes/java/lang/Integer.java +(defn ^number int-rotate-left [x n] + (bit-or + (bit-shift-left x n) + (unsigned-bit-shift-right x (- n)))) + +;; http://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Math/imul +(if (and (exists? Math/imul) + (not (zero? (Math/imul 0xffffffff 5)))) + (defn ^number imul [a b] (Math/imul a b)) + (defn ^number imul [a b] + (let [ah (bit-and (unsigned-bit-shift-right a 16) 0xffff) + al (bit-and a 0xffff) + bh (bit-and (unsigned-bit-shift-right b 16) 0xffff) + bl (bit-and b 0xffff)] + (bit-or + (+ (* al bl) + (unsigned-bit-shift-right + (bit-shift-left (+ (* ah bl) (* al bh)) 16) 0)) 0)))) + +;; http://smhasher.googlecode.com/svn/trunk/MurmurHash3.cpp +(def m3-seed 0) +(def m3-C1 (int 0xcc9e2d51)) +(def m3-C2 (int 0x1b873593)) + +(defn ^number m3-mix-K1 [k1] + (-> (int k1) (imul m3-C1) (int-rotate-left 15) (imul m3-C2))) + +(defn ^number m3-mix-H1 [h1 k1] + (int (-> (int h1) (bit-xor (int k1)) (int-rotate-left 13) (imul 5) (+ (int 0xe6546b64))))) + +(defn ^number m3-fmix [h1 len] + (as-> (int h1) h1 + (bit-xor h1 len) + (bit-xor h1 (unsigned-bit-shift-right h1 16)) + (imul h1 (int 0x85ebca6b)) + (bit-xor h1 (unsigned-bit-shift-right h1 13)) + (imul h1 (int 0xc2b2ae35)) + (bit-xor h1 (unsigned-bit-shift-right h1 16)))) + +(defn ^number m3-hash-int [in] + (if (zero? in) + in + (let [k1 (m3-mix-K1 in) + h1 (m3-mix-H1 m3-seed k1)] + (m3-fmix h1 4)))) + +(defn ^number m3-hash-unencoded-chars [in] + (let [h1 (loop [i 1 h1 m3-seed] + (if (< i (alength 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)] + (m3-fmix h1 (imul 2 (alength in))))) + +;;;;;;;;;;;;;;;;;;; symbols ;;;;;;;;;;;;;;; + +(declare list Symbol = compare) + +;; Simple caching of string hashcode +(def string-hash-cache (js-obj)) +(def string-hash-cache-count 0) + +;;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)] + (if (pos? len) + (loop [i 0 hash 0] + (if (< i len) + (recur (inc i) (+ (imul 31 hash) (.charCodeAt s i))) + hash)) + 0)) + 0)) + +(defn add-to-string-hash-cache [k] + (let [h (hash-string* k)] + (aset string-hash-cache k h) + (set! string-hash-cache-count (inc string-hash-cache-count)) + h)) + +(defn hash-string [k] + (when (> string-hash-cache-count 255) + (set! string-hash-cache (js-obj)) + (set! string-hash-cache-count 0)) + (if (nil? k) + 0 + (let [h (aget string-hash-cache k)] + (if (number? h) + h + (add-to-string-hash-cache k))))) + +(defn hash + "Returns the hash code of its argument. Note this is the hash code + consistent with =." + [o] + (cond + (implements? IHash o) + (-hash ^not-native o) + + (number? o) + (if (js/isFinite o) + (js-mod (Math/floor o) 2147483647) + (case o + Infinity + 2146435072 + -Infinity + -1048576 + 2146959360)) + + ;; note: mirrors Clojure's behavior on the JVM, where the hashCode is + ;; 1231 for true and 1237 for false + ;; http://docs.oracle.com/javase/7/docs/api/java/lang/Boolean.html#hashCode%28%29 + (true? o) 1231 + + (false? o) 1237 + + (string? o) + (m3-hash-int (hash-string o)) + + (instance? js/Date o) + (.valueOf o) + + (nil? o) 0 + + :else + (-hash o))) + +(defn hash-combine [seed hash] + ; a la boost + (bit-xor seed + (+ hash 0x9e3779b9 + (bit-shift-left seed 6) + (bit-shift-right seed 2)))) + +(defn ^boolean instance? + "Evaluates x and tests if it is an instance of the type + c. Returns true or false" + [c x] + (cljs.core/instance? c x)) + +(defn ^boolean symbol? + "Return true if x is a Symbol" + [x] + (instance? Symbol x)) + +(defn- hash-symbol [sym] + (hash-combine + (m3-hash-unencoded-chars (.-name sym)) + (hash-string (.-ns sym)))) + +(defn- compare-symbols [a b] + (cond + (identical? (.-str a) (.-str b)) 0 + (and (not (.-ns a)) (.-ns b)) -1 + (.-ns a) (if-not (.-ns b) + 1 + (let [nsc (garray/defaultCompare (.-ns a) (.-ns b))] + (if (== 0 nsc) + (garray/defaultCompare (.-name a) (.-name b)) + nsc))) + :default (garray/defaultCompare (.-name a) (.-name b)))) + +(declare get) + +(deftype Symbol [ns name str ^:mutable _hash _meta] + Object + (toString [_] str) + (equiv [this other] (-equiv this other)) + + IEquiv + (-equiv [_ other] + (if (instance? Symbol other) + (identical? str (.-str other)) + false)) + + IFn + (-invoke [sym coll] + (get coll sym)) + (-invoke [sym coll not-found] + (get coll sym not-found)) + + IMeta + (-meta [_] _meta) + + IWithMeta + (-with-meta [_ new-meta] (Symbol. ns name str _hash new-meta)) + + IHash + (-hash [sym] + (caching-hash sym hash-symbol _hash)) + + INamed + (-name [_] name) + (-namespace [_] ns) + + IPrintWithWriter + (-pr-writer [o writer _] (-write writer str))) + +(defn symbol + "Returns a Symbol with the given namespace and name." + ([name] + (if (symbol? name) + name + (let [idx (.indexOf name "/")] + (if (< idx 1) + (symbol nil name) + (symbol (.substring name 0 idx) + (.substring name (inc idx) (. name -length))))))) + ([ns name] + (let [sym-str (if-not (nil? ns) + (str ns "/" name) + name)] + (Symbol. ns name sym-str nil nil)))) + +(deftype Var [val sym _meta] + Object + (isMacro [_] + (. (val) -cljs$lang$macro)) + (toString [_] + (str "#'" sym)) + IDeref + (-deref [_] (val)) + IMeta + (-meta [_] _meta) + IWithMeta + (-with-meta [_ new-meta] + (Var. val sym new-meta)) + IEquiv + (-equiv [this other] + (if (instance? Var other) + (= (.-sym this) (.-sym other)) + false)) + IHash + (-hash [_] + (hash-symbol sym)) + Fn + IFn + (-invoke [_] + ((val))) + (-invoke [_ a] + ((val) a)) + (-invoke [_ a b] + ((val) a b)) + (-invoke [_ a b c] + ((val) a b c)) + (-invoke [_ a b c d] + ((val) a b c d)) + (-invoke [_ a b c d e] + ((val) a b c d e)) + (-invoke [_ a b c d e f] + ((val) a b c d e f)) + (-invoke [_ a b c d e f g] + ((val) a b c d e f g)) + (-invoke [_ a b c d e f g h] + ((val) a b c d e f g h)) + (-invoke [_ a b c d e f g h i] + ((val) a b c d e f g h i)) + (-invoke [_ a b c d e f g h i j] + ((val) a b c d e f g h i j)) + (-invoke [_ a b c d e f g h i j k] + ((val) a b c d e f g h i j k)) + (-invoke [_ a b c d e f g h i j k l] + ((val) a b c d e f g h i j k l)) + (-invoke [_ a b c d e f g h i j k l m] + ((val) a b c d e f g h i j k l m)) + (-invoke [_ a b c d e f g h i j k l m n] + ((val) a b c d e f g h i j k l m n)) + (-invoke [_ a b c d e f g h i j k l m n o] + ((val) a b c d e f g h i j k l m n o)) + (-invoke [_ a b c d e f g h i j k l m n o p] + ((val) a b c d e f g h i j k l m n o p)) + (-invoke [_ a b c d e f g h i j k l m n o p q] + ((val) a b c d e f g h i j k l m n o p q)) + (-invoke [_ a b c d e f g h i j k l m n o p q r] + ((val) a b c d e f g h i j k l m n o p q r)) + (-invoke [_ a b c d e f g h i j k l m n o p q r s] + ((val) a b c d e f g h i j k l m n o p q r s)) + (-invoke [_ a b c d e f g h i j k l m n o p q r s t] + ((val) a b c d e f g h i j k l m n o p q r s t)) + (-invoke [_ a b c d e f g h i j k l m n o p q r s t rest] + (apply (val) a b c d e f g h i j k l m n o p q r s t rest))) + +(defn ^boolean var? + "Returns true if v is of type cljs.core.Var" + [v] + (instance? cljs.core.Var v)) + +;;;;;;;;;;;;;;;;;;; fundamentals ;;;;;;;;;;;;;;; + +(declare array-seq prim-seq IndexedSeq) + +(defn ^boolean iterable? + "Return true if x implements IIterable protocol." + [x] + (satisfies? IIterable x)) + +(defn clone + "Clone the supplied value which must implement ICloneable." + [value] + (-clone value)) + +(defn ^boolean cloneable? + "Return true if x implements ICloneable protocol." + [value] + (satisfies? ICloneable value)) + +(defn ^seq seq + "Returns a seq on the collection. If the collection is + empty, returns nil. (seq nil) returns nil. seq also works on + Strings." + [coll] + (when-not (nil? coll) + (cond + (implements? ISeqable coll) + (-seq ^not-native coll) + + (array? coll) + (when-not (zero? (alength coll)) + (IndexedSeq. coll 0 nil)) + + (string? coll) + (when-not (zero? (alength coll)) + (IndexedSeq. coll 0 nil)) + + (native-satisfies? ISeqable coll) + (-seq coll) + + :else (throw (js/Error. (str coll " is not ISeqable")))))) + +(defn first + "Returns the first item in the collection. Calls seq on its + argument. If coll is nil, returns nil." + [coll] + (when-not (nil? coll) + (if (implements? ISeq coll) + (-first ^not-native coll) + (let [s (seq coll)] + (when-not (nil? s) + (-first s)))))) + +(defn ^seq rest + "Returns a possibly empty seq of the items after the first. Calls seq on its + argument." + [coll] + (if-not (nil? coll) + (if (implements? ISeq coll) + (-rest ^not-native coll) + (let [s (seq coll)] + (if s + (-rest ^not-native s) + ()))) + ())) + +(defn ^seq next + "Returns a seq of the items after the first. Calls seq on its + argument. If there are no more items, returns nil" + [coll] + (when-not (nil? coll) + (if (implements? INext coll) + (-next ^not-native coll) + (seq (rest coll))))) + +(defn ^boolean = + "Equality. Returns true if x equals y, false if not. Compares + numbers and collections in a type-independent manner. Clojure's immutable data + structures define -equiv (and thus =) as a value, not an identity, + comparison." + ([x] true) + ([x y] + (if (nil? x) + (nil? y) + (or (identical? x y) + ^boolean (-equiv x y)))) + ([x y & more] + (if (= x y) + (if (next more) + (recur y (first more) (next more)) + (= y (first more))) + false))) + +;; EXPERIMENTAL: subject to change +(deftype ES6Iterator [^:mutable s] + Object + (next [_] + (if-not (nil? s) + (let [x (first s)] + (set! s (next s)) + #js {:value x :done false}) + #js {:value nil :done true}))) + +(defn es6-iterator + "EXPERIMENTAL: Return a ES2015 compatible iterator for coll." + [coll] + (ES6Iterator. (seq coll))) + +(declare es6-iterator-seq) + +(deftype ES6IteratorSeq [value iter ^:mutable _rest] + ISeqable + (-seq [this] this) + ISeq + (-first [_] value) + (-rest [_] + (when (nil? _rest) + (set! _rest (es6-iterator-seq iter))) + _rest)) + +(defn es6-iterator-seq + "EXPERIMENTAL: Given an ES2015 compatible iterator return a seq." + [iter] + (let [v (.next iter)] + (if (.-done v) + () + (ES6IteratorSeq. (.-value v) iter nil)))) + +;;;;;;;;;;;;;;;;;;; Murmur3 Helpers ;;;;;;;;;;;;;;;; + +(defn ^number mix-collection-hash + "Mix final collection hash for ordered or unordered collections. + hash-basis is the combined collection hash, count is the number + of elements included in the basis. Note this is the hash code + consistent with =, different from .hashCode. + See http://clojure.org/data_structures#hash for full algorithms." + [hash-basis count] + (let [h1 m3-seed + k1 (m3-mix-K1 hash-basis) + h1 (m3-mix-H1 h1 k1)] + (m3-fmix h1 count))) + +(defn ^number hash-ordered-coll + "Returns the hash code, consistent with =, for an external ordered + collection implementing Iterable. + See http://clojure.org/data_structures#hash for full algorithms." + [coll] + (loop [n 0 hash-code 1 coll (seq coll)] + (if-not (nil? coll) + (recur (inc n) (bit-or (+ (imul 31 hash-code) (hash (first coll))) 0) + (next coll)) + (mix-collection-hash hash-code n)))) + +(def ^:private empty-ordered-hash + (mix-collection-hash 1 0)) + +(defn ^number hash-unordered-coll + "Returns the hash code, consistent with =, for an external unordered + collection implementing Iterable. For maps, the iterator should + return map entries whose hash is computed as + (hash-ordered-coll [k v]). + See http://clojure.org/data_structures#hash for full algorithms." + [coll] + (loop [n 0 hash-code 0 coll (seq coll)] + (if-not (nil? coll) + (recur (inc n) (bit-or (+ hash-code (hash (first coll))) 0) (next coll)) + (mix-collection-hash hash-code n)))) + +(def ^:private empty-unordered-hash + (mix-collection-hash 0 0)) + +;;;;;;;;;;;;;;;;;;; protocols on primitives ;;;;;;;; +(declare hash-map list equiv-sequential) + +(extend-type nil + ICounted + (-count [_] 0)) + +;; TODO: we should remove this and handle date equality checking +;; by some other means, probably by adding a new primitive type +;; case to the hash table lookup - David + +(extend-type js/Date + IEquiv + (-equiv [o other] + (and (instance? js/Date other) + (== (.valueOf o) (.valueOf other)))) + + IComparable + (-compare [this other] + (if (instance? js/Date other) + (garray/defaultCompare (.valueOf this) (.valueOf other)) + (throw (js/Error. (str "Cannot compare " this " to " other)))))) + +(defprotocol Inst + (inst-ms* [inst])) + +(extend-protocol Inst + js/Date + (inst-ms* [inst] (.getTime inst))) + +(defn inst-ms + "Return the number of milliseconds since January 1, 1970, 00:00:00 GMT" + [inst] + (inst-ms* inst)) + +(defn ^boolean inst? + "Return true if x satisfies Inst" + [x] + (satisfies? Inst x)) + +(extend-type number + IEquiv + (-equiv [x o] (identical? x o))) + +(declare with-meta) + +(extend-type function + Fn + IMeta + (-meta [_] nil)) + +(extend-type default + IHash + (-hash [o] + (goog/getUid o))) + +;;this is primitive because & emits call to array-seq +(defn inc + "Returns a number one greater than num." + [x] (cljs.core/+ x 1)) + +(declare deref) + +(deftype Reduced [val] + IDeref + (-deref [o] val)) + +(defn reduced + "Wraps x in a way such that a reduce will terminate with the value x" + [x] + (Reduced. x)) + +(defn ^boolean reduced? + "Returns true if x is the result of a call to reduced" + [r] + (instance? Reduced r)) + +(defn ensure-reduced + "If x is already reduced?, returns it, else returns (reduced x)" + [x] + (if (reduced? x) x (reduced x))) + +(defn unreduced + "If x is reduced?, returns (deref x), else returns x" + [x] + (if (reduced? x) (deref x) x)) + +;; generic to all refs +;; (but currently hard-coded to atom!) +(defn deref + "Also reader macro: @var/@atom/@delay. Returns the + most-recently-committed value of ref. When applied to a var + or atom, returns its current state. When applied to a delay, forces + it if not already forced. See also - realized?." + [o] + (-deref o)) + +(defn- ci-reduce + "Accepts any collection which satisfies the ICount and IIndexed protocols and +reduces them without incurring seq initialization" + ([cicoll f] + (let [cnt (-count cicoll)] + (if (zero? cnt) + (f) + (loop [val (-nth cicoll 0), n 1] + (if (< n cnt) + (let [nval (f val (-nth cicoll n))] + (if (reduced? nval) + @nval + (recur nval (inc n)))) + val))))) + ([cicoll f val] + (let [cnt (-count cicoll)] + (loop [val val, n 0] + (if (< n cnt) + (let [nval (f val (-nth cicoll n))] + (if (reduced? nval) + @nval + (recur nval (inc n)))) + val)))) + ([cicoll f val idx] + (let [cnt (-count cicoll)] + (loop [val val, n idx] + (if (< n cnt) + (let [nval (f val (-nth cicoll n))] + (if (reduced? nval) + @nval + (recur nval (inc n)))) + val))))) + +(defn- array-reduce + ([arr f] + (let [cnt (alength arr)] + (if (zero? (alength arr)) + (f) + (loop [val (aget arr 0), n 1] + (if (< n cnt) + (let [nval (f val (aget arr n))] + (if (reduced? nval) + @nval + (recur nval (inc n)))) + val))))) + ([arr f val] + (let [cnt (alength arr)] + (loop [val val, n 0] + (if (< n cnt) + (let [nval (f val (aget arr n))] + (if (reduced? nval) + @nval + (recur nval (inc n)))) + val)))) + ([arr f val idx] + (let [cnt (alength arr)] + (loop [val val, n idx] + (if (< n cnt) + (let [nval (f val (aget arr n))] + (if (reduced? nval) + @nval + (recur nval (inc n)))) + val))))) + +(declare hash-coll cons drop count nth RSeq List) + +(defn ^boolean counted? + "Returns true if coll implements count in constant time" + [x] (satisfies? ICounted x)) + +(defn ^boolean indexed? + "Returns true if coll implements nth in constant time" + [x] (satisfies? IIndexed x)) + +(defn- -indexOf + ([coll x] + (-indexOf coll x 0)) + ([coll x start] + (let [len (count coll)] + (if (>= start len) + -1 + (loop [idx (cond + (pos? start) start + (neg? start) (max 0 (+ start len)) + :else start)] + (if (< idx len) + (if (= (nth coll idx) x) + idx + (recur (inc idx))) + -1)))))) + +(defn- -lastIndexOf + ([coll x] + (-lastIndexOf coll x (count coll))) + ([coll x start] + (let [len (count coll)] + (if (zero? len) + -1 + (loop [idx (cond + (pos? start) (min (dec len) start) + (neg? start) (+ len start) + :else start)] + (if (>= idx 0) + (if (= (nth coll idx) x) + idx + (recur (dec idx))) + -1)))))) + +(deftype IndexedSeqIterator [arr ^:mutable i] + Object + (hasNext [_] + (< i (alength arr))) + (next [_] + (let [ret (aget arr i)] + (set! i (inc i)) + ret))) + +(deftype IndexedSeq [arr i meta] + 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 coll))) + (lastIndexOf [coll x start] + (-lastIndexOf coll x start)) + + ICloneable + (-clone [_] (IndexedSeq. arr i meta)) + + ISeqable + (-seq [this] + (when (< i (alength arr)) + this)) + + IMeta + (-meta [coll] meta) + IWithMeta + (-with-meta [coll new-meta] + (IndexedSeq. arr i new-meta)) + + ASeq + ISeq + (-first [_] (aget arr i)) + (-rest [_] (if (< (inc i) (alength arr)) + (IndexedSeq. arr (inc i) nil) + (list))) + + INext + (-next [_] (if (< (inc i) (alength arr)) + (IndexedSeq. arr (inc i) nil) + nil)) + + ICounted + (-count [_] + (max 0 (- (alength arr) i))) + + IIndexed + (-nth [coll n] + (let [i (+ n i)] + (if (and (<= 0 i) (< i (alength arr))) + (aget arr i) + (throw (js/Error. "Index out of bounds"))))) + (-nth [coll n not-found] + (let [i (+ n i)] + (if (and (<= 0 i) (< i (alength arr))) + (aget arr i) + not-found))) + + ISequential + IEquiv + (-equiv [coll other] (equiv-sequential coll other)) + + IIterable + (-iterator [coll] + (IndexedSeqIterator. arr i)) + + ICollection + (-conj [coll o] (cons o coll)) + + IEmptyableCollection + (-empty [coll] (.-EMPTY List)) + + IReduce + (-reduce [coll f] + (array-reduce arr f (aget arr i) (inc i))) + (-reduce [coll f start] + (array-reduce arr f start i)) + + IHash + (-hash [coll] (hash-ordered-coll coll)) + + IReversible + (-rseq [coll] + (let [c (-count coll)] + (if (pos? c) + (RSeq. coll (dec c) nil))))) + +(es6-iterable IndexedSeq) + +(defn prim-seq + "Create seq from a primitive JavaScript Array-like." + ([prim] + (prim-seq prim 0)) + ([prim i] + (when (< i (alength prim)) + (IndexedSeq. prim i nil)))) + +(defn array-seq + "Create a seq from a JavaScript array." + ([array] + (prim-seq array 0)) + ([array i] + (prim-seq array i))) + +(declare with-meta seq-reduce) + +(deftype RSeq [ci i meta] + 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 coll))) + (lastIndexOf [coll x start] + (-lastIndexOf coll x start)) + + ICloneable + (-clone [_] (RSeq. ci i meta)) + + IMeta + (-meta [coll] meta) + IWithMeta + (-with-meta [coll new-meta] + (RSeq. ci i new-meta)) + + ISeqable + (-seq [coll] coll) + + ISequential + IEquiv + (-equiv [coll other] (equiv-sequential coll other)) + + ISeq + (-first [coll] + (-nth ci i)) + (-rest [coll] + (if (pos? i) + (RSeq. ci (dec i) nil) + ())) + + INext + (-next [coll] + (when (pos? i) + (RSeq. ci (dec i) nil))) + + ICounted + (-count [coll] (inc i)) + + ICollection + (-conj [coll o] + (cons o coll)) + + IEmptyableCollection + (-empty [coll] (with-meta (.-EMPTY List) meta)) + + IHash + (-hash [coll] (hash-ordered-coll coll)) + + IReduce + (-reduce [col f] (seq-reduce f col)) + (-reduce [col f start] (seq-reduce f start col))) + +(es6-iterable RSeq) + +(defn second + "Same as (first (next x))" + [coll] + (first (next coll))) + +(defn ffirst + "Same as (first (first x))" + [coll] + (first (first coll))) + +(defn nfirst + "Same as (next (first x))" + [coll] + (next (first coll))) + +(defn fnext + "Same as (first (next x))" + [coll] + (first (next coll))) + +(defn nnext + "Same as (next (next x))" + [coll] + (next (next coll))) + +(defn last + "Return the last item in coll, in linear time" + [s] + (let [sn (next s)] + (if-not (nil? sn) + (recur sn) + (first s)))) + +(extend-type default + IEquiv + (-equiv [x o] (identical? x o))) + +(defn conj + "conj[oin]. Returns a new collection with the xs + 'added'. (conj nil item) returns (item). The 'addition' may + happen at different 'places' depending on the concrete type." + ([] []) + ([coll] coll) + ([coll x] + (if-not (nil? coll) + (-conj coll x) + (list x))) + ([coll x & xs] + (if xs + (recur (conj coll x) (first xs) (next xs)) + (conj coll x)))) + +(defn empty + "Returns an empty collection of the same category as coll, or nil" + [coll] + (when-not (nil? coll) + (-empty coll))) + +(defn- accumulating-seq-count [coll] + (loop [s (seq coll) acc 0] + (if (counted? s) ; assumes nil is counted, which it currently is + (+ acc (-count s)) + (recur (next s) (inc acc))))) + +(defn count + "Returns the number of items in the collection. (count nil) returns + 0. Also works on strings, arrays, and Maps" + [coll] + (if-not (nil? coll) + (cond + (implements? ICounted coll) + (-count ^not-native coll) + + (array? coll) + (alength coll) + + (string? coll) + (alength coll) + + (implements? ISeqable coll) + (accumulating-seq-count coll) + + :else (-count coll)) + 0)) + +(defn- linear-traversal-nth + ([coll n] + (cond + (nil? coll) (throw (js/Error. "Index out of bounds")) + (zero? n) (if (seq coll) + (first coll) + (throw (js/Error. "Index out of bounds"))) + (indexed? coll) (-nth coll n) + (seq coll) (recur (next coll) (dec n)) + :else (throw (js/Error. "Index out of bounds")))) + ([coll n not-found] + (cond + (nil? coll) not-found + (zero? n) (if (seq coll) + (first coll) + not-found) + (indexed? coll) (-nth coll n not-found) + (seq coll) (recur (next coll) (dec n) not-found) + :else not-found))) + +(defn nth + "Returns the value at the index. get returns nil if index out of + bounds, nth throws an exception unless not-found is supplied. nth + also works for strings, arrays, regex Matchers and Lists, and, + in O(n) time, for sequences." + ([coll n] + (cond + (not (number? n)) + (throw (js/Error. "Index argument to nth must be a number")) + + (nil? coll) + coll + + (implements? IIndexed coll) + (-nth ^not-native coll n) + + (array? coll) + (if (and (>= n 0) (< n (.-length coll))) + (aget coll n) + (throw (js/Error. "Index out of bounds"))) + + (string? coll) + (if (and (>= n 0) (< n (.-length coll))) + (.charAt coll n) + (throw (js/Error. "Index out of bounds"))) + + (implements? ISeq coll) + (linear-traversal-nth coll n) + + (native-satisfies? IIndexed coll) + (-nth coll n) + + :else + (throw (js/Error. (str "nth not supported on this type " + (type->str (type coll))))))) + ([coll n not-found] + (cond + (not (number? n)) + (throw (js/Error. "Index argument to nth must be a number.")) + + (nil? coll) + not-found + + (implements? IIndexed coll) + (-nth ^not-native coll n not-found) + + (array? coll) + (if (and (>= n 0) (< n (.-length coll))) + (aget coll n) + not-found) + + (string? coll) + (if (and (>= n 0) (< n (.-length coll))) + (.charAt coll n) + not-found) + + (implements? ISeq coll) + (linear-traversal-nth coll n not-found) + + (native-satisfies? IIndexed coll) + (-nth coll n) + + :else + (throw (js/Error. (str "nth not supported on this type " + (type->str (type coll)))))))) + +(defn nthrest + "Returns the nth rest of coll, coll when n is 0." + [coll n] + (loop [n n xs coll] + (if (and (pos? n) (seq xs)) + (recur (dec n) (rest xs)) + xs))) + +(defn get + "Returns the value mapped to key, not-found or nil if key not present." + ([o k] + (when-not (nil? o) + (cond + (implements? ILookup o) + (-lookup ^not-native o k) + + (array? o) + (when (and (some? k) (< k (.-length o))) + (aget o (int k))) + + (string? o) + (when (and (some? k) (< k (.-length o))) + (.charAt o (int k))) + + (native-satisfies? ILookup o) + (-lookup o k) + + :else nil))) + ([o k not-found] + (if-not (nil? o) + (cond + (implements? ILookup o) + (-lookup ^not-native o k not-found) + + (array? o) + (if (and (some? k) (>= k 0) (< k (.-length o))) + (aget o (int k)) + not-found) + + (string? o) + (if (and (some? k) (>= k 0) (< k (.-length o))) + (.charAt o (int k)) + not-found) + + (native-satisfies? ILookup o) + (-lookup o k not-found) + + :else not-found) + not-found))) + +(declare PersistentHashMap) + +(defn assoc + "assoc[iate]. When applied to a map, returns a new map of the + same (hashed/sorted) type, that contains the mapping of key(s) to + val(s). When applied to a vector, returns a new vector that + contains val at index." + ([coll k v] + (if-not (nil? coll) + (-assoc coll k v) + (hash-map k v))) + ([coll k v & kvs] + (let [ret (assoc coll k v)] + (if kvs + (recur ret (first kvs) (second kvs) (nnext kvs)) + ret)))) + +(defn dissoc + "dissoc[iate]. Returns a new map of the same (hashed/sorted) type, + that does not contain a mapping for key(s)." + ([coll] coll) + ([coll k] + (when-not (nil? coll) + (-dissoc coll k))) + ([coll k & ks] + (when-not (nil? coll) + (let [ret (dissoc coll k)] + (if ks + (recur ret (first ks) (next ks)) + ret))))) + +(defn ^boolean fn? + "Return true if f is a JavaScript function or satisfies the Fn protocol." + [f] + (or ^boolean (goog/isFunction f) (satisfies? Fn f))) + +(deftype MetaFn [afn meta] + IMeta + (-meta [_] meta) + IWithMeta + (-with-meta [_ new-meta] + (MetaFn. afn new-meta)) + Fn + IFn + (-invoke [_] + (afn)) + (-invoke [_ a] + (afn a)) + (-invoke [_ a b] + (afn a b)) + (-invoke [_ a b c] + (afn a b c)) + (-invoke [_ a b c d] + (afn a b c d)) + (-invoke [_ a b c d e] + (afn a b c d e)) + (-invoke [_ a b c d e f] + (afn a b c d e f)) + (-invoke [_ a b c d e f g] + (afn a b c d e f g)) + (-invoke [_ a b c d e f g h] + (afn a b c d e f g h)) + (-invoke [_ a b c d e f g h i] + (afn a b c d e f g h i)) + (-invoke [_ a b c d e f g h i j] + (afn a b c d e f g h i j)) + (-invoke [_ a b c d e f g h i j k] + (afn a b c d e f g h i j k)) + (-invoke [_ a b c d e f g h i j k l] + (afn a b c d e f g h i j k l)) + (-invoke [_ a b c d e f g h i j k l m] + (afn a b c d e f g h i j k l m)) + (-invoke [_ a b c d e f g h i j k l m n] + (afn a b c d e f g h i j k l m n)) + (-invoke [_ a b c d e f g h i j k l m n o] + (afn a b c d e f g h i j k l m n o)) + (-invoke [_ a b c d e f g h i j k l m n o p] + (afn a b c d e f g h i j k l m n o p)) + (-invoke [_ a b c d e f g h i j k l m n o p q] + (afn a b c d e f g h i j k l m n o p q)) + (-invoke [_ a b c d e f g h i j k l m n o p q r] + (afn a b c d e f g h i j k l m n o p q r)) + (-invoke [_ a b c d e f g h i j k l m n o p q r s] + (afn a b c d e f g h i j k l m n o p q r s)) + (-invoke [_ a b c d e f g h i j k l m n o p q r s t] + (afn a b c d e f g h i j k l m n o p q r s t)) + (-invoke [_ a b c d e f g h i j k l m n o p q r s t rest] + (apply afn a b c d e f g h i j k l m n o p q r s t rest))) + +(defn with-meta + "Returns an object of the same type and value as obj, with + map m as its metadata." + [o meta] + (if ^boolean (goog/isFunction o) + (MetaFn. o meta) + (when-not (nil? o) + (-with-meta o meta)))) + +(defn meta + "Returns the metadata of obj, returns nil if there is no metadata." + [o] + (when (and (not (nil? o)) + (satisfies? IMeta o)) + (-meta o))) + +(defn peek + "For a list or queue, same as first, for a vector, same as, but much + more efficient than, last. If the collection is empty, returns nil." + [coll] + (when-not (nil? coll) + (-peek coll))) + +(defn pop + "For a list or queue, returns a new list/queue without the first + item, for a vector, returns a new vector without the last item. + Note - not the same as next/butlast." + [coll] + (when-not (nil? coll) + (-pop coll))) + +(defn disj + "disj[oin]. Returns a new set of the same (hashed/sorted) type, that + does not contain key(s)." + ([coll] coll) + ([coll k] + (when-not (nil? coll) + (-disjoin coll k))) + ([coll k & ks] + (when-not (nil? coll) + (let [ret (disj coll k)] + (if ks + (recur ret (first ks) (next ks)) + ret))))) + +(defn ^boolean empty? + "Returns true if coll has no items - same as (not (seq coll)). + Please use the idiom (seq x) rather than (not (empty? x))" + [coll] (or (nil? coll) + (not (seq coll)))) + +(defn ^boolean coll? + "Returns true if x satisfies ICollection" + [x] + (if (nil? x) + false + (satisfies? ICollection x))) + +(defn ^boolean set? + "Returns true if x satisfies ISet" + [x] + (if (nil? x) + false + (satisfies? ISet x))) + +(defn ^boolean associative? + "Returns true if coll implements Associative" + [x] (satisfies? IAssociative x)) + +(defn ^boolean sequential? + "Returns true if coll satisfies ISequential" + [x] (satisfies? ISequential x)) + +(defn ^boolean sorted? + "Returns true if coll satisfies ISorted" + [x] (satisfies? ISorted x)) + +(defn ^boolean reduceable? + "Returns true if coll satisfies IReduce" + [x] (satisfies? IReduce x)) + +(defn ^boolean map? + "Return true if x satisfies IMap" + [x] + (if (nil? x) + false + (satisfies? IMap x))) + +(defn ^boolean record? + "Return true if x satisfies IRecord" + [x] + (satisfies? IRecord x)) + +(defn ^boolean vector? + "Return true if x satisfies IVector" + [x] (satisfies? IVector x)) + +(declare ChunkedCons ChunkedSeq) + +(defn ^boolean chunked-seq? + "Return true if x is satisfies IChunkedSeq." + [x] (implements? IChunkedSeq x)) + +;;;;;;;;;;;;;;;;;;;; js primitives ;;;;;;;;;;;; +(defn js-obj + "Create JavaSript object from an even number arguments representing + interleaved keys and values." + ([] + (cljs.core/js-obj)) + ([& keyvals] + (apply gobject/create keyvals))) + +(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)) + +(defn js-delete + "Delete a property from a JavaScript object." + [obj key] + (cljs.core/js-delete obj key)) + +(defn- array-copy + ([from i to j len] + (loop [i i j j len len] + (if (zero? len) + to + (do (aset to j (aget from i)) + (recur (inc i) (inc j) (dec len))))))) + +(defn- array-copy-downward + ([from i to j len] + (loop [i (+ i (dec len)) j (+ j (dec len)) len len] + (if (zero? len) + to + (do (aset to j (aget from i)) + (recur (dec i) (dec j) (dec len))))))) + +;;;;;;;;;;;;;;;; preds ;;;;;;;;;;;;;;;;;; + +(def ^:private lookup-sentinel (js-obj)) + +(defn ^boolean false? + "Returns true if x is the value false, false otherwise." + [x] (cljs.core/false? x)) + +(defn ^boolean true? + "Returns true if x is the value true, false otherwise." + [x] (cljs.core/true? x)) + +(defn ^boolean boolean? + "Return true if x is a Boolean" + [x] (or (cljs.core/true? x) (cljs.core/false? x))) + +(defn ^boolean undefined? + "Returns true if x identical to the JavaScript undefined value." + [x] + (cljs.core/undefined? x)) + +(defn ^boolean seq? + "Return true if s satisfies ISeq" + [s] + (if (nil? s) + false + (satisfies? ISeq s))) + +(defn ^boolean seqable? + "Return true if the seq function is supported for s" + [s] + (or + (satisfies? ISeqable s) + (array? s) + (string? s))) + +(defn ^boolean boolean + "Coerce to boolean" + [x] + (cond + (nil? x) false + (false? x) false + :else true)) + +(defn ^boolean ifn? + "Returns true if f returns true for fn? or satisfies IFn." + [f] + (or (fn? f) (satisfies? IFn f))) + +(defn ^boolean integer? + "Returns true if n is a JavaScript number with no decimal part." + [n] + (and (number? n) + (not ^boolean (js/isNaN n)) + (not (identical? n js/Infinity)) + (== (js/parseFloat n) (js/parseInt n 10)))) + +(defn ^boolean int? + "Return true if x satisfies integer? or is an instance of goog.math.Integer + or goog.math.Long." + [x] + (or (integer? x) + (instance? goog.math.Integer x) + (instance? goog.math.Long x))) + +(defn ^boolean pos-int? + "Return true if x satisfies int? and is positive." + [x] + (cond + (integer? x) (pos? x) + + (instance? goog.math.Integer x) + (and (not (.isNegative x)) + (not (.isZero x))) + + (instance? goog.math.Long x) + (and (not (.isNegative x)) + (not (.isZero x))) + + :else false)) + +(defn ^boolean neg-int? + "Return true if x satisfies int? and is positive." + [x] + (cond + (integer? x) (neg? x) + + (instance? goog.math.Integer x) + (.isNegative x) + + (instance? goog.math.Long x) + (.isNegative x) + + :else false)) + +(defn ^boolean nat-int? + "Return true if x satisfies int? and is a natural integer value." + [x] + (cond + (integer? x) + (or (not (neg? x)) (zero? x)) + + (instance? goog.math.Integer x) + (or (not (.isNegative x)) (.isZero x)) + + (instance? goog.math.Long x) + (or (not (.isNegative x)) (.isZero x)) + + :else false)) + +(defn ^boolean float? + "Returns true for JavaScript numbers, false otherwise." + [x] + (number? x)) + +(defn ^boolean double? + "Returns true for JavaScript numbers, false otherwise." + [x] + (number? x)) + +(defn ^boolean infinite? + "Returns true for Infinity and -Infinity values." + [x] + (or (identical? x js/Number.POSITIVE_INFINITY) + (identical? x js/Number.NEGATIVE_INFINITY))) + +(defn ^boolean contains? + "Returns true if key is present in the given collection, otherwise + returns false. Note that for numerically indexed collections like + vectors and arrays, this tests if the numeric key is within the + range of indexes. 'contains?' operates constant or logarithmic time; + it will not perform a linear search for a value. See also 'some'." + [coll v] + (if (identical? (get coll v lookup-sentinel) lookup-sentinel) + false + true)) + +(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)])) + +(defn ^boolean distinct? + "Returns true if no two of the arguments are =" + ([x] true) + ([x y] (not (= x y))) + ([x y & more] + (if (not (= x y)) + (loop [s #{x y} xs more] + (let [x (first xs) + etc (next xs)] + (if xs + (if (contains? s x) + false + (recur (conj s x) etc)) + true))) + false))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Seq fns ;;;;;;;;;;;;;;;; + +(defn ^number compare + "Comparator. Returns a negative number, zero, or a positive number + when x is logically 'less than', 'equal to', or 'greater than' + y. Uses IComparable if available and google.array.defaultCompare for objects + of the same type and special-cases nil to be less than any other object." + [x y] + (cond + (identical? x y) 0 + + (nil? x) -1 + + (nil? y) 1 + + (number? x) (if (number? y) + (garray/defaultCompare x y) + (throw (js/Error. (str "Cannot compare " x " to " y)))) + + (satisfies? IComparable x) + (-compare x y) + + :else + (if (and (or (string? x) (array? x) (true? x) (false? x)) + (identical? (type x) (type y))) + (garray/defaultCompare x y) + (throw (js/Error. (str "Cannot compare " x " to " y)))))) + +(defn ^:private compare-indexed + "Compare indexed collection." + ([xs ys] + (let [xl (count xs) + yl (count ys)] + (cond + (< xl yl) -1 + (> xl yl) 1 + (== xl 0) 0 + :else (compare-indexed xs ys xl 0)))) + ([xs ys len n] + (let [d (compare (nth xs n) (nth ys n))] + (if (and (zero? d) (< (+ n 1) len)) + (recur xs ys len (inc n)) + d)))) + +(defn ^:private fn->comparator + "Given a fn that might be boolean valued or a comparator, + return a fn that is a comparator." + [f] + (if (= f compare) + compare + (fn [x y] + (let [r (f x y)] + (if (number? r) + r + (if r + -1 + (if (f y x) 1 0))))))) + +(declare to-array) + +(defn sort + "Returns a sorted sequence of the items in coll. Comp can be + boolean-valued comparison function, or a -/0/+ valued comparator. + Comp defaults to compare." + ([coll] + (sort compare coll)) + ([comp coll] + (if (seq coll) + (let [a (to-array coll)] + ;; matching Clojure's stable sort, though docs don't promise it + (garray/stableSort a (fn->comparator comp)) + (seq a)) + ()))) + +(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. + Comp defaults to compare." + ([keyfn coll] + (sort-by keyfn compare coll)) + ([keyfn comp coll] + (sort (fn [x y] ((fn->comparator comp) (keyfn x) (keyfn y))) coll))) + +; simple reduce based on seqs, used as default +(defn- seq-reduce + ([f coll] + (if-let [s (seq coll)] + (reduce f (first s) (next s)) + (f))) + ([f val coll] + (loop [val val, coll (seq coll)] + (if coll + (let [nval (f val (first coll))] + (if (reduced? nval) + @nval + (recur nval (next coll)))) + val)))) + +(declare vec) + +(defn shuffle + "Return a random permutation of coll" + [coll] + (let [a (to-array coll)] + (garray/shuffle a) + (vec a))) + +(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 + applying f to that result and the 3rd item, etc. If coll contains no + items, f must accept no arguments as well, and reduce returns the + result of calling f with no arguments. If coll has only 1 item, it + is returned and f is not called. If val is supplied, returns the + result of applying f to val and the first item in coll, then + applying f to that result and the 2nd item, etc. If coll contains no + items, returns val and f is not called." + ([f coll] + (cond + (implements? IReduce coll) + (-reduce ^not-native coll f) + + (array? coll) + (array-reduce coll f) + + (string? coll) + (array-reduce coll f) + + (native-satisfies? IReduce coll) + (-reduce coll f) + + :else + (seq-reduce f coll))) + ([f val coll] + (cond + (implements? IReduce coll) + (-reduce ^not-native coll f val) + + (array? coll) + (array-reduce coll f val) + + (string? coll) + (array-reduce coll f val) + + (native-satisfies? IReduce coll) + (-reduce coll f val) + + :else + (seq-reduce f val coll)))) + +(defn reduce-kv + "Reduces an associative collection. f should be a function of 3 + arguments. Returns the result of applying f to init, the first key + and the first value in coll, then applying f to that result and the + 2nd key and value, etc. If coll contains no entries, returns init + and f is not called. Note that reduce-kv is supported on vectors, + where the keys will be the ordinals." + ([f init coll] + (if-not (nil? coll) + (-kv-reduce coll f init) + init))) + +(defn identity + "Returns its argument." + [x] x) + +(defn completing + "Takes a reducing function f of 2 args and returns a fn suitable for + transduce by adding an arity-1 signature that calls cf (default - + identity) on the result argument." + ([f] (completing f identity)) + ([f cf] + (fn + ([] (f)) + ([x] (cf x)) + ([x y] (f x y))))) + +(defn transduce + "reduce with a transformation of f (xf). If init is not + supplied, (f) will be called to produce it. f should be a reducing + step function that accepts both 1 and 2 arguments, if it accepts + only 2 you can add the arity-1 with 'completing'. Returns the result + of applying (the transformed) xf to init and the first item in coll, + then applying xf to that result and the 2nd item, etc. If coll + contains no items, returns init and f is not called. Note that + certain transforms may inject or skip items." + ([xform f coll] (transduce xform f (f) coll)) + ([xform f init coll] + (let [f (xform f) + ret (reduce f init coll)] + (f ret)))) + +;;; Math - variadic forms will not work until the following implemented: +;;; first, next, reduce + +(defn ^number + + "Returns the sum of nums. (+) returns 0." + ([] 0) + ([x] x) + ([x y] (cljs.core/+ x y)) + ([x y & more] + (reduce + (cljs.core/+ x y) more))) + +(defn ^number - + "If no ys are supplied, returns the negation of x, else subtracts + the ys from x and returns the result." + ([x] (cljs.core/- x)) + ([x y] (cljs.core/- x y)) + ([x y & more] (reduce - (cljs.core/- x y) more))) + +(defn ^number * + "Returns the product of nums. (*) returns 1." + ([] 1) + ([x] x) + ([x y] (cljs.core/* x y)) + ([x y & more] (reduce * (cljs.core/* x y) more))) + +(declare divide) + +(defn ^number / + "If no denominators are supplied, returns 1/numerator, + else returns numerator divided by all of the denominators." + ([x] (/ 1 x)) + ([x y] (cljs.core/divide x y)) ;; FIXME: waiting on cljs.core// + ([x y & more] (reduce / (/ x y) more))) + +(defn ^boolean < + "Returns non-nil if nums are in monotonically increasing order, + otherwise false." + ([x] true) + ([x y] (cljs.core/< x y)) + ([x y & more] + (if (cljs.core/< x y) + (if (next more) + (recur y (first more) (next more)) + (cljs.core/< y (first more))) + false))) + +(defn ^boolean <= + "Returns non-nil if nums are in monotonically non-decreasing order, + otherwise false." + ([x] true) + ([x y] (cljs.core/<= x y)) + ([x y & more] + (if (cljs.core/<= x y) + (if (next more) + (recur y (first more) (next more)) + (cljs.core/<= y (first more))) + false))) + +(defn ^boolean > + "Returns non-nil if nums are in monotonically decreasing order, + otherwise false." + ([x] true) + ([x y] (cljs.core/> x y)) + ([x y & more] + (if (cljs.core/> x y) + (if (next more) + (recur y (first more) (next more)) + (cljs.core/> y (first more))) + false))) + +(defn ^boolean >= + "Returns non-nil if nums are in monotonically non-increasing order, + otherwise false." + ([x] true) + ([x y] (cljs.core/>= x y)) + ([x y & more] + (if (cljs.core/>= x y) + (if (next more) + (recur y (first more) (next more)) + (cljs.core/>= y (first more))) + false))) + +(defn dec + "Returns a number one less than num." + [x] (- x 1)) + +(defn ^number max + "Returns the greatest of the nums." + ([x] x) + ([x y] (cljs.core/max x y)) + ([x y & more] + (reduce max (cljs.core/max x y) more))) + +(defn ^number min + "Returns the least of the nums." + ([x] x) + ([x y] (cljs.core/min x y)) + ([x y & more] + (reduce min (cljs.core/min x y) more))) + +(defn ^number byte [x] x) + +(defn char + "Coerce to char" + [x] + (cond + (number? x) (.fromCharCode js/String x) + (and (string? x) (== (.-length x) 1)) x + :else (throw (js/Error. "Argument to char must be a character or number")))) + +(defn ^number short [x] x) +(defn ^number float [x] x) +(defn ^number double [x] x) + +(defn ^number unchecked-byte [x] x) +(defn ^number unchecked-char [x] x) +(defn ^number unchecked-short [x] x) +(defn ^number unchecked-float [x] x) +(defn ^number unchecked-double [x] x) + +(defn ^number unchecked-add + "Returns the sum of nums. (+) returns 0." + ([] 0) + ([x] x) + ([x y] (cljs.core/unchecked-add x y)) + ([x y & more] (reduce unchecked-add (cljs.core/unchecked-add x y) more))) + +(defn ^number unchecked-add-int + "Returns the sum of nums. (+) returns 0." + ([] 0) + ([x] x) + ([x y] (cljs.core/unchecked-add-int x y)) + ([x y & more] (reduce unchecked-add-int (cljs.core/unchecked-add-int x y) more))) + +(defn unchecked-dec + "Returns a number one less than x, an int." + [x] + (cljs.core/unchecked-dec x)) + +(defn unchecked-dec-int + "Returns a number one less than x, an int." + [x] + (cljs.core/unchecked-dec-int x)) + +(defn ^number unchecked-divide-int + "If no denominators are supplied, returns 1/numerator, + else returns numerator divided by all of the denominators." + ([x] (unchecked-divide-int 1 x)) + ([x y] (cljs.core/divide x y)) ;; FIXME: waiting on cljs.core// + ([x y & more] (reduce unchecked-divide-int (unchecked-divide-int x y) more))) + +(defn unchecked-inc [x] + (cljs.core/unchecked-inc x)) + +(defn unchecked-inc-int [x] + (cljs.core/unchecked-inc-int x)) + +(defn ^number unchecked-multiply + "Returns the product of nums. (*) returns 1." + ([] 1) + ([x] x) + ([x y] (cljs.core/unchecked-multiply x y)) + ([x y & more] (reduce unchecked-multiply (cljs.core/unchecked-multiply x y) more))) + +(defn ^number unchecked-multiply-int + "Returns the product of nums. (*) returns 1." + ([] 1) + ([x] x) + ([x y] (cljs.core/unchecked-multiply-int x y)) + ([x y & more] (reduce unchecked-multiply-int (cljs.core/unchecked-multiply-int x y) more))) + +(defn unchecked-negate [x] + (cljs.core/unchecked-negate x)) + +(defn unchecked-negate-int [x] + (cljs.core/unchecked-negate-int x)) + +(declare mod) + +(defn unchecked-remainder-int [x n] + (cljs.core/unchecked-remainder-int x n)) + +(defn ^number unchecked-subtract + "If no ys are supplied, returns the negation of x, else subtracts + the ys from x and returns the result." + ([x] (cljs.core/unchecked-subtract x)) + ([x y] (cljs.core/unchecked-subtract x y)) + ([x y & more] (reduce unchecked-subtract (cljs.core/unchecked-subtract x y) more))) + +(defn ^number unchecked-subtract-int + "If no ys are supplied, returns the negation of x, else subtracts + the ys from x and returns the result." + ([x] (cljs.core/unchecked-subtract-int x)) + ([x y] (cljs.core/unchecked-subtract-int x y)) + ([x y & more] (reduce unchecked-subtract-int (cljs.core/unchecked-subtract-int x y) more))) + +(defn- ^number fix [q] + (if (>= q 0) + (Math/floor q) + (Math/ceil q))) + +(defn int + "Coerce to int by stripping decimal places." + [x] + (bit-or x 0)) + +(defn unchecked-int + "Coerce to int by stripping decimal places." + [x] + (fix x)) + +(defn long + "Coerce to long by stripping decimal places. Identical to `int'." + [x] + (fix x)) + +(defn unchecked-long + "Coerce to long by stripping decimal places. Identical to `int'." + [x] + (fix x)) + +(defn booleans [x] x) +(defn bytes [x] x) +(defn chars [x] x) +(defn shorts [x] x) +(defn ints [x] x) +(defn floats [x] x) +(defn doubles [x] x) +(defn longs [x] x) + +(defn js-mod + "Modulus of num and div with original javascript behavior. i.e. bug for negative numbers" + [n d] + (cljs.core/js-mod n d)) + +(defn mod + "Modulus of num and div. Truncates toward negative infinity." + [n d] + (js-mod (+ (js-mod n d) d) d)) + +(defn quot + "quot[ient] of dividing numerator by denominator." + [n d] + (let [rem (js-mod n d)] + (fix (/ (- n rem) d)))) + +(defn rem + "remainder of dividing numerator by denominator." + [n d] + (let [q (quot n d)] + (- n (* d q)))) + +(defn bit-xor + "Bitwise exclusive or" + ([x y] (cljs.core/bit-xor x y)) + ([x y & more] + (reduce bit-xor (cljs.core/bit-xor x y) more))) + +(defn bit-and + "Bitwise and" + ([x y] (cljs.core/bit-and x y)) + ([x y & more] + (reduce bit-and (cljs.core/bit-and x y) more))) + +(defn bit-or + "Bitwise or" + ([x y] (cljs.core/bit-or x y)) + ([x y & more] + (reduce bit-or (cljs.core/bit-or x y) more))) + +(defn bit-and-not + "Bitwise and with complement" + ([x y] (cljs.core/bit-and-not x y)) + ([x y & more] + (reduce bit-and-not (cljs.core/bit-and-not x y) more))) + +(defn bit-clear + "Clear bit at index n" + [x n] + (cljs.core/bit-clear x n)) + +(defn bit-flip + "Flip bit at index n" + [x n] + (cljs.core/bit-flip x n)) + +(defn bit-not + "Bitwise complement" + [x] (cljs.core/bit-not x)) + +(defn bit-set + "Set bit at index n" + [x n] + (cljs.core/bit-set x n)) + +(defn ^boolean bit-test + "Test bit at index n" + [x n] + (cljs.core/bit-test x n)) + +(defn bit-shift-left + "Bitwise shift left" + [x n] (cljs.core/bit-shift-left x n)) + +(defn bit-shift-right + "Bitwise shift right" + [x n] (cljs.core/bit-shift-right x n)) + +(defn bit-shift-right-zero-fill + "DEPRECATED: Bitwise shift right with zero fill" + [x n] (cljs.core/bit-shift-right-zero-fill x n)) + +(defn unsigned-bit-shift-right + "Bitwise shift right with zero fill" + [x n] (cljs.core/unsigned-bit-shift-right x n)) + +(defn bit-count + "Counts the number of bits set in n" + [v] + (let [v (- v (bit-and (bit-shift-right v 1) 0x55555555)) + v (+ (bit-and v 0x33333333) (bit-and (bit-shift-right v 2) 0x33333333))] + (bit-shift-right (* (bit-and (+ v (bit-shift-right v 4)) 0xF0F0F0F) 0x1010101) 24))) + +(defn ^boolean == + "Returns non-nil if nums all have the equivalent + value, otherwise false. Behavior on non nums is + undefined." + ([x] true) + ([x y] (-equiv x y)) + ([x y & more] + (if (== x y) + (if (next more) + (recur y (first more) (next more)) + (== y (first more))) + false))) + +(defn ^boolean pos? + "Returns true if num is greater than zero, else false" + [x] (cljs.core/pos? x)) + +(defn ^boolean zero? + "Returns true if num is zero, else false" + [x] + (cljs.core/zero? x)) + +(defn ^boolean neg? + "Returns true if num is less than zero, else false" + [x] (cljs.core/neg? x)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; protocols for host types ;;;;;; + +(defn nthnext + "Returns the nth next of coll, (seq coll) when n is 0." + [coll n] + (loop [n n xs (seq coll)] + (if (and xs (pos? n)) + (recur (dec n) (next xs)) + xs))) + +;;;;;;;;;;;;;;;;;;;;;;;;;; basics ;;;;;;;;;;;;;;;;;; + +(defn str + "With no args, returns the empty string. With one arg x, returns + x.toString(). (str nil) returns the empty string. With more than + one arg, returns the concatenation of the str values of the args." + ([] "") + ([x] (if (nil? x) + "" + (.join #js [x] ""))) + ([x & ys] + (loop [sb (StringBuffer. (str x)) more ys] + (if more + (recur (. sb (append (str (first more)))) (next more)) + (.toString sb))))) + +(defn subs + "Returns the substring of s beginning at start inclusive, and ending + at end (defaults to length of string), exclusive." + ([s start] (.substring s start)) + ([s start end] (.substring s start end))) + +(declare map name) + +(defn- equiv-sequential + "Assumes x is sequential. Returns true if x equals y, otherwise + returns false." + [x y] + (boolean + (when (sequential? y) + (if (and (counted? x) (counted? y) + (not (== (count x) (count y)))) + false + (loop [xs (seq x) ys (seq y)] + (cond (nil? xs) (nil? ys) + (nil? ys) false + (= (first xs) (first ys)) (recur (next xs) (next ys)) + :else false)))))) + +(defn- hash-coll [coll] + (if (seq coll) + (loop [res (hash (first coll)) s (next coll)] + (if (nil? s) + res + (recur (hash-combine res (hash (first s))) (next s)))) + 0)) + +(declare key val) + +(defn- hash-imap [m] + ;; a la clojure.lang.APersistentMap + (loop [h 0 s (seq m)] + (if s + (let [e (first s)] + (recur (js-mod (+ h (bit-xor (hash (key e)) (hash (val e)))) + 4503599627370496) + (next s))) + h))) + +(defn- hash-iset [s] + ;; a la clojure.lang.APersistentSet + (loop [h 0 s (seq s)] + (if s + (let [e (first s)] + (recur (js-mod (+ h (hash e)) 4503599627370496) + (next s))) + h))) + +(declare name chunk-first chunk-rest) + +(defn- extend-object! + "Takes a JavaScript object and a map of names to functions and + attaches said functions as methods on the object. Any references to + JavaScript's implicit this (via the this-as macro) will resolve to the + object that the function is attached." + [obj fn-map] + (doseq [[key-name f] fn-map] + (let [str-name (name key-name)] + (aset obj str-name f))) + obj) + +;;;;;;;;;;;;;;;; cons ;;;;;;;;;;;;;;;; +(deftype List [meta first rest count ^: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)) + + IList + + ICloneable + (-clone [_] (List. meta first rest count __hash)) + + IWithMeta + (-with-meta [coll meta] (List. meta first rest count __hash)) + + IMeta + (-meta [coll] meta) + + ASeq + ISeq + (-first [coll] first) + (-rest [coll] + (if (== count 1) + () + rest)) + + INext + (-next [coll] + (if (== count 1) + nil + rest)) + + IStack + (-peek [coll] first) + (-pop [coll] (-rest coll)) + + ICollection + (-conj [coll o] (List. meta o coll (inc count) nil)) + + IEmptyableCollection + (-empty [coll] (-with-meta (.-EMPTY List) meta)) + + ISequential + IEquiv + (-equiv [coll other] (equiv-sequential coll other)) + + IHash + (-hash [coll] (caching-hash coll hash-ordered-coll __hash)) + + ISeqable + (-seq [coll] coll) + + ICounted + (-count [coll] count) + + IReduce + (-reduce [coll f] (seq-reduce f coll)) + (-reduce [coll f start] (seq-reduce f start coll))) + +(defn ^boolean list? + "Returns true if x implements IList" + [x] + (satisfies? IList x)) + +(es6-iterable List) + +(deftype EmptyList [meta] + 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 coll))) + (lastIndexOf [coll x start] + (-lastIndexOf coll x start)) + + IList + + ICloneable + (-clone [_] (EmptyList. meta)) + + IWithMeta + (-with-meta [coll meta] (EmptyList. meta)) + + IMeta + (-meta [coll] meta) + + ISeq + (-first [coll] nil) + (-rest [coll] ()) + + INext + (-next [coll] nil) + + IStack + (-peek [coll] nil) + (-pop [coll] (throw (js/Error. "Can't pop empty list"))) + + ICollection + (-conj [coll o] (List. meta o nil 1 nil)) + + IEmptyableCollection + (-empty [coll] coll) + + ISequential + IEquiv + (-equiv [coll other] + (if (or (list? other) + (sequential? other)) + (nil? (seq other)) + false)) + + IHash + (-hash [coll] empty-ordered-hash) + + ISeqable + (-seq [coll] nil) + + ICounted + (-count [coll] 0) + + IReduce + (-reduce [coll f] (seq-reduce f coll)) + (-reduce [coll f start] (seq-reduce f start coll))) + +(set! (.-EMPTY List) (EmptyList. nil)) + +(es6-iterable EmptyList) + +(defn ^boolean reversible? + "Returns true if coll satisfies? IReversible." + [coll] + (satisfies? IReversible coll)) + +(defn ^seq rseq + "Returns, in constant time, a seq of the items in rev (which + can be a vector or sorted-map), in reverse order. If rev is empty returns nil" + [rev] + (-rseq rev)) + +(defn reverse + "Returns a seq of the items in coll in reverse order. Not lazy." + [coll] + (if (reversible? coll) + (rseq coll) + (reduce conj () coll))) + +(defn list + "Creates a new list containing the items." + [& xs] + (let [arr (if (and (instance? IndexedSeq xs) (zero? (.-i xs))) + (.-arr xs) + (let [arr (array)] + (loop [^not-native xs xs] + (if-not (nil? xs) + (do + (.push arr (-first xs)) + (recur (-next xs))) + arr))))] + (loop [i (alength arr) ^not-native r ()] + (if (> i 0) + (recur (dec i) (-conj r (aget arr (dec i)))) + r)))) + +(deftype Cons [meta first rest ^: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 coll))) + (lastIndexOf [coll x start] + (-lastIndexOf coll x start)) + + IList + + ICloneable + (-clone [_] (Cons. meta first rest __hash)) + + IWithMeta + (-with-meta [coll meta] (Cons. meta first rest __hash)) + + IMeta + (-meta [coll] meta) + + ASeq + ISeq + (-first [coll] first) + (-rest [coll] (if (nil? rest) () rest)) + + INext + (-next [coll] + (if (nil? rest) nil (seq rest))) + + ICollection + (-conj [coll o] (Cons. nil o coll nil)) + + IEmptyableCollection + (-empty [coll] (with-meta (.-EMPTY List) meta)) + + ISequential + IEquiv + (-equiv [coll other] (equiv-sequential coll other)) + + IHash + (-hash [coll] (caching-hash coll hash-ordered-coll __hash)) + + ISeqable + (-seq [coll] coll) + + IReduce + (-reduce [coll f] (seq-reduce f coll)) + (-reduce [coll f start] (seq-reduce f start coll))) + +(es6-iterable Cons) + +(defn cons + "Returns a new seq where x is the first element and coll is the rest." + [x coll] + (if (or (nil? coll) + (implements? ISeq coll)) + (Cons. nil x coll nil) + (Cons. nil x (seq coll) nil))) + +(defn hash-keyword [k] + (int (+ (hash-symbol k) 0x9e3779b9))) + +(defn- compare-keywords [a b] + (cond + (identical? (.-fqn a) (.-fqn b)) 0 + (and (not (.-ns a)) (.-ns b)) -1 + (.-ns a) (if-not (.-ns b) + 1 + (let [nsc (garray/defaultCompare (.-ns a) (.-ns b))] + (if (== 0 nsc) + (garray/defaultCompare (.-name a) (.-name b)) + nsc))) + :default (garray/defaultCompare (.-name a) (.-name b)))) + +(deftype Keyword [ns name fqn ^:mutable _hash] + Object + (toString [_] (str ":" fqn)) + (equiv [this other] + (-equiv this other)) + + IEquiv + (-equiv [_ other] + (if (instance? Keyword other) + (identical? fqn (.-fqn other)) + false)) + IFn + (-invoke [kw coll] + (get coll kw)) + (-invoke [kw coll not-found] + (get coll kw not-found)) + + IHash + (-hash [this] + (caching-hash this hash-keyword _hash)) + + INamed + (-name [_] name) + (-namespace [_] ns) + + IPrintWithWriter + (-pr-writer [o writer _] (-write writer (str ":" fqn)))) + +(defn ^boolean keyword? + "Return true if x is a Keyword" + [x] + (instance? Keyword x)) + +(defn ^boolean keyword-identical? + "Efficient test to determine that two keywords are identical." + [x y] + (if (identical? x y) + true + (if (and (keyword? x) (keyword? y)) + (identical? (.-fqn x) (.-fqn y)) + false))) + +(defn ^boolean symbol-identical? + "Efficient test to determine that two symbols are identical." + [x y] + (if (identical? x y) + true + (if (and (symbol? x) (symbol? y)) + (identical? (.-str x) (.-str y)) + false))) + +(defn namespace + "Returns the namespace String of a symbol or keyword, or nil if not present." + [x] + (if (implements? INamed x) + (-namespace ^not-native x) + (throw (js/Error. (str "Doesn't support namespace: " x))))) + +(defn ^boolean ident? + "Return true if x is a symbol or keyword" + [x] (or (keyword? x) (symbol? x))) + +(defn ^boolean simple-ident? + "Return true if x is a symbol or keyword without a namespace" + [x] (and (ident? x) (nil? (namespace x)))) + +(defn ^boolean qualified-ident? + "Return true if x is a symbol or keyword with a namespace" + [x] (and (ident? x) (namespace x) true)) + +(defn ^boolean simple-symbol? + "Return true if x is a symbol without a namespace" + [x] (and (symbol? x) (nil? (namespace x)))) + +(defn ^boolean qualified-symbol? + "Return true if x is a symbol with a namespace" + [x] (and (symbol? x) (namespace x) true)) + +(defn ^boolean simple-keyword? + "Return true if x is a keyword without a namespace" + [x] (and (keyword? x) (nil? (namespace x)))) + +(defn ^boolean qualified-keyword? + "Return true if x is a keyword with a namespace" + [x] (and (keyword? x) (namespace x) true)) + +(defn keyword + "Returns a Keyword with the given namespace and name. Do not use : + in the keyword strings, it will be added automatically." + ([name] (cond + (keyword? name) name + (symbol? name) (Keyword. + (cljs.core/namespace name) + (cljs.core/name name) (.-str name) nil) + (string? name) (let [parts (.split name "/")] + (if (== (alength parts) 2) + (Keyword. (aget parts 0) (aget parts 1) name nil) + (Keyword. nil (aget parts 0) name nil))))) + ([ns name] + (let [ns (cond + (keyword? ns) (cljs.core/name ns) + (symbol? ns) (cljs.core/name ns) + :else ns) + name (cond + (keyword? name) (cljs.core/name name) + (symbol? name) (cljs.core/name name) + :else name)] + (Keyword. ns name (str (when ns (str ns "/")) name) nil)))) + + +(deftype LazySeq [meta ^:mutable fn ^:mutable s ^:mutable __hash] + Object + (toString [coll] + (pr-str* coll)) + (equiv [this other] + (-equiv this other)) + (sval [coll] + (if (nil? fn) + s + (do + (set! s (fn)) + (set! fn nil) + s))) + (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)) + + IPending + (-realized? [coll] + (not fn)) + + IWithMeta + (-with-meta [coll meta] (LazySeq. meta fn s __hash)) + + IMeta + (-meta [coll] meta) + + ISeq + (-first [coll] + (-seq coll) + (when-not (nil? s) + (first s))) + (-rest [coll] + (-seq coll) + (if-not (nil? s) + (rest s) + ())) + + INext + (-next [coll] + (-seq coll) + (when-not (nil? s) + (next s))) + + ICollection + (-conj [coll o] (cons o coll)) + + IEmptyableCollection + (-empty [coll] (with-meta (.-EMPTY List) meta)) + + ISequential + IEquiv + (-equiv [coll other] (equiv-sequential coll other)) + + IHash + (-hash [coll] (caching-hash coll hash-ordered-coll __hash)) + + ISeqable + (-seq [coll] + (.sval coll) + (when-not (nil? s) + (loop [ls s] + (if (instance? LazySeq ls) + (recur (.sval ls)) + (do (set! s ls) + (seq s)))))) + + IReduce + (-reduce [coll f] (seq-reduce f coll)) + (-reduce [coll f start] (seq-reduce f start coll))) + +(es6-iterable LazySeq) + +(declare ArrayChunk) + +(deftype ChunkBuffer [^:mutable buf ^:mutable end] + Object + (add [_ o] + (aset buf end o) + (set! end (inc end))) + + (chunk [_ o] + (let [ret (ArrayChunk. buf 0 end)] + (set! buf nil) + ret)) + + ICounted + (-count [_] end)) + +(defn chunk-buffer [capacity] + (ChunkBuffer. (make-array capacity) 0)) + +(deftype ArrayChunk [arr off end] + ICounted + (-count [_] (- end off)) + + IIndexed + (-nth [coll i] + (aget arr (+ off i))) + (-nth [coll i not-found] + (if (and (>= i 0) (< i (- end off))) + (aget arr (+ off i)) + not-found)) + + IChunk + (-drop-first [coll] + (if (== off end) + (throw (js/Error. "-drop-first of empty chunk")) + (ArrayChunk. arr (inc off) end))) + + IReduce + (-reduce [coll f] + (array-reduce arr f (aget arr off) (inc off))) + (-reduce [coll f start] + (array-reduce arr f start off))) + +(defn array-chunk + ([arr] + (ArrayChunk. arr 0 (alength arr))) + ([arr off] + (ArrayChunk. arr off (alength arr))) + ([arr off end] + (ArrayChunk. arr off end))) + +(deftype ChunkedCons [chunk more meta ^: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 coll))) + (lastIndexOf [coll x start] + (-lastIndexOf coll x start)) + + IWithMeta + (-with-meta [coll m] + (ChunkedCons. chunk more m __hash)) + + IMeta + (-meta [coll] meta) + + ISequential + IEquiv + (-equiv [coll other] (equiv-sequential coll other)) + + ISeqable + (-seq [coll] coll) + + ASeq + ISeq + (-first [coll] (-nth chunk 0)) + (-rest [coll] + (if (> (-count chunk) 1) + (ChunkedCons. (-drop-first chunk) more meta nil) + (if (nil? more) + () + more))) + + INext + (-next [coll] + (if (> (-count chunk) 1) + (ChunkedCons. (-drop-first chunk) more meta nil) + (let [more (-seq more)] + (when-not (nil? more) + more)))) + + IChunkedSeq + (-chunked-first [coll] chunk) + (-chunked-rest [coll] + (if (nil? more) + () + more)) + + IChunkedNext + (-chunked-next [coll] + (if (nil? more) + nil + more)) + + ICollection + (-conj [this o] + (cons o this)) + + IEmptyableCollection + (-empty [coll] (with-meta (.-EMPTY List) meta)) + + IHash + (-hash [coll] (caching-hash coll hash-ordered-coll __hash))) + +(es6-iterable ChunkedCons) + +(defn chunk-cons [chunk rest] + (if (zero? (-count chunk)) + rest + (ChunkedCons. chunk rest nil nil))) + +(defn chunk-append [b x] + (.add b x)) + +(defn chunk [b] + (.chunk b)) + +(defn chunk-first [s] + (-chunked-first s)) + +(defn chunk-rest [s] + (-chunked-rest s)) + +(defn chunk-next [s] + (if (implements? IChunkedNext s) + (-chunked-next s) + (seq (-chunked-rest s)))) + +;;;;;;;;;;;;;;;; + +(defn to-array + "Naive impl of to-array as a start." + [s] + (let [ary (array)] + (loop [s s] + (if (seq s) + (do (. ary push (first s)) + (recur (next s))) + ary)))) + +(defn to-array-2d + "Returns a (potentially-ragged) 2-dimensional array + containing the contents of coll." + [coll] + (let [ret (make-array (count coll))] + (loop [i 0 xs (seq coll)] + (when xs + (aset ret i (to-array (first xs))) + (recur (inc i) (next xs)))) + ret)) + +(defn int-array + "Creates an array of ints. Does not coerce array, provided for compatibility + with Clojure." + ([size-or-seq] + (if (number? size-or-seq) + (int-array size-or-seq nil) + (into-array size-or-seq))) + ([size init-val-or-seq] + (let [a (make-array size)] + (if (seq? init-val-or-seq) + (let [s (seq init-val-or-seq)] + (loop [i 0 s s] + (if (and s (< i size)) + (do + (aset a i (first s)) + (recur (inc i) (next s))) + a))) + (do + (dotimes [i size] + (aset a i init-val-or-seq)) + a))))) + +(defn long-array + "Creates an array of longs. Does not coerce array, provided for compatibility + with Clojure." + ([size-or-seq] + (if (number? size-or-seq) + (long-array size-or-seq nil) + (into-array size-or-seq))) + ([size init-val-or-seq] + (let [a (make-array size)] + (if (seq? init-val-or-seq) + (let [s (seq init-val-or-seq)] + (loop [i 0 s s] + (if (and s (< i size)) + (do + (aset a i (first s)) + (recur (inc i) (next s))) + a))) + (do + (dotimes [i size] + (aset a i init-val-or-seq)) + a))))) + +(defn double-array + "Creates an array of doubles. Does not coerce array, provided for compatibility + with Clojure." + ([size-or-seq] + (if (number? size-or-seq) + (double-array size-or-seq nil) + (into-array size-or-seq))) + ([size init-val-or-seq] + (let [a (make-array size)] + (if (seq? init-val-or-seq) + (let [s (seq init-val-or-seq)] + (loop [i 0 s s] + (if (and s (< i size)) + (do + (aset a i (first s)) + (recur (inc i) (next s))) + a))) + (do + (dotimes [i size] + (aset a i init-val-or-seq)) + a))))) + +(defn object-array + "Creates an array of objects. Does not coerce array, provided for compatibility + with Clojure." + ([size-or-seq] + (if (number? size-or-seq) + (object-array size-or-seq nil) + (into-array size-or-seq))) + ([size init-val-or-seq] + (let [a (make-array size)] + (if (seq? init-val-or-seq) + (let [s (seq init-val-or-seq)] + (loop [i 0 s s] + (if (and s (< i size)) + (do + (aset a i (first s)) + (recur (inc i) (next s))) + a))) + (do + (dotimes [i size] + (aset a i init-val-or-seq)) + a))))) + +(defn bounded-count + "If coll is counted? returns its count, else will count at most the first n + elements of coll using its seq" + {:added "1.9"} + [n coll] + (if (counted? coll) + (count coll) + (loop [i 0 s (seq coll)] + (if (and (not (nil? s)) (< i n)) + (recur (inc i) (next s)) + i)))) + +(defn spread + [arglist] + (cond + (nil? arglist) nil + (nil? (next arglist)) (seq (first arglist)) + :else (cons (first arglist) + (spread (next arglist))))) + +(defn concat + "Returns a lazy seq representing the concatenation of the elements in the supplied colls." + ([] (lazy-seq nil)) + ([x] (lazy-seq x)) + ([x y] + (lazy-seq + (let [s (seq x)] + (if s + (if (chunked-seq? s) + (chunk-cons (chunk-first s) (concat (chunk-rest s) y)) + (cons (first s) (concat (rest s) y))) + y)))) + ([x y & zs] + (let [cat (fn cat [xys zs] + (lazy-seq + (let [xys (seq xys)] + (if xys + (if (chunked-seq? xys) + (chunk-cons (chunk-first xys) + (cat (chunk-rest xys) zs)) + (cons (first xys) (cat (rest xys) zs))) + (when zs + (cat (first zs) (next zs)))))))] + (cat (concat x y) zs)))) + +(defn list* + "Creates a new list containing the items prepended to the rest, the + last of which will be treated as a sequence." + ([args] (seq args)) + ([a args] (cons a args)) + ([a b args] (cons a (cons b args))) + ([a b c args] (cons a (cons b (cons c args)))) + ([a b c d & more] + (cons a (cons b (cons c (cons d (spread more))))))) + + +;;; Transients + +(defn transient + "Returns a new, transient version of the collection, in constant time." + [coll] + (-as-transient coll)) + +(defn persistent! + "Returns a new, persistent version of the transient collection, in + constant time. The transient collection cannot be used after this + call, any such use will throw an exception." + [tcoll] + (-persistent! tcoll)) + +(defn conj! + "Adds val to the transient collection, and return tcoll. The 'addition' + may happen at different 'places' depending on the concrete type." + ([] (transient [])) + ([tcoll] tcoll) + ([tcoll val] + (-conj! tcoll val)) + ([tcoll val & vals] + (let [ntcoll (-conj! tcoll val)] + (if vals + (recur ntcoll (first vals) (next vals)) + ntcoll)))) + +(defn assoc! + "When applied to a transient map, adds mapping of key(s) to + val(s). When applied to a transient vector, sets the val at index. + Note - index must be <= (count vector). Returns coll." + ([tcoll key val] + (-assoc! tcoll key val)) + ([tcoll key val & kvs] + (let [ntcoll (-assoc! tcoll key val)] + (if kvs + (recur ntcoll (first kvs) (second kvs) (nnext kvs)) + ntcoll)))) + +(defn dissoc! + "Returns a transient map that doesn't contain a mapping for key(s)." + ([tcoll key] + (-dissoc! tcoll key)) + ([tcoll key & ks] + (let [ntcoll (-dissoc! tcoll key)] + (if ks + (recur ntcoll (first ks) (next ks)) + ntcoll)))) + +(defn pop! + "Removes the last item from a transient vector. If + the collection is empty, throws an exception. Returns tcoll" + [tcoll] + (-pop! tcoll)) + +(defn disj! + "disj[oin]. Returns a transient set of the same (hashed/sorted) type, that + does not contain key(s)." + ([tcoll val] + (-disjoin! tcoll val)) + ([tcoll val & vals] + (let [ntcoll (-disjoin! tcoll val)] + (if vals + (recur ntcoll (first vals) (next vals)) + ntcoll)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; apply ;;;;;;;;;;;;;;;; + +;; see core.clj +(gen-apply-to) + +(set! *unchecked-if* true) +(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))))) + ([f x args] + (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))))) + ([f x y args] + (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))))) + ([f x y z args] + (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))))) + ([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)))))) +(set! *unchecked-if* false) + +(defn vary-meta + "Returns an object of the same type and value as obj, with + (apply f (meta obj) args) as its metadata." + ([obj f] + (with-meta obj (f (meta obj)))) + ([obj f a] + (with-meta obj (f (meta obj) a))) + ([obj f a b] + (with-meta obj (f (meta obj) a b))) + ([obj f a b c] + (with-meta obj (f (meta obj) a b c))) + ([obj f a b c d] + (with-meta obj (f (meta obj) a b c d))) + ([obj f a b c d & args] + (with-meta obj (apply f (meta obj) a b c d args)))) + +(defn ^boolean not= + "Same as (not (= obj1 obj2))" + ([x] false) + ([x y] (not (= x y))) + ([x y & more] + (not (apply = x y more)))) + +(defn not-empty + "If coll is empty, returns nil, else coll" + [coll] (when (seq coll) coll)) + +(defn nil-iter [] + (reify + Object + (hasNext [_] false) + (next [_] (js/Error. "No such element")) + (remove [_] (js/Error. "Unsupported operation")))) + +(deftype StringIter [s ^:mutable i] + Object + (hasNext [_] (< i (alength s))) + (next [_] + (let [ret (.charAt s i)] + (set! i (inc i)) + ret)) + (remove [_] (js/Error. "Unsupported operation"))) + +(defn string-iter [x] + (StringIter. x 0)) + +(deftype ArrayIter [arr ^:mutable i] + Object + (hasNext [_] (< i (alength arr))) + (next [_] + (let [ret (aget arr i)] + (set! i (inc i)) + ret)) + (remove [_] (js/Error. "Unsupported operation"))) + +(defn array-iter [x] + (ArrayIter. x 0)) + +(def INIT #js {}) +(def START #js {}) + +(deftype SeqIter [^:mutable _seq ^:mutable _next] + Object + (hasNext [_] + (if (identical? _seq INIT) + (do + (set! _seq START) + (set! _next (seq _next))) + (if (identical? _seq _next) + (set! _next (next _seq)))) + (not (nil? _next))) + (next [this] + (if-not ^boolean (.hasNext this) + (throw (js/Error. "No such element")) + (do + (set! _seq _next) + (first _next)))) + (remove [_] (js/Error. "Unsupported operation"))) + +(defn seq-iter [coll] + (SeqIter. INIT coll)) + +(defn iter [coll] + (cond + (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) + +(defn lazy-transformer [stepper] + (LazyTransformer. stepper nil nil nil)) + +(deftype Stepper [xform iter] + 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] + Object + (hasNext [_] + (loop [iters (seq iters)] + (if-not (nil? iters) + (let [iter (first iters)] + (if-not ^boolean (.hasNext iter) + false + (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] + 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)))) + +(defn sequence + "Coerces coll to a (possibly empty) sequence, if it is not already + one. Will not force a lazy seq. (sequence nil) yields (), When a + transducer is supplied, returns a lazy sequence of applications of + the transform to the items in coll(s), i.e. to the set of first + items of each coll, followed by the set of second + items in each coll, until any one of the colls is exhausted. Any + remaining items in other colls are ignored. The transform should accept + number-of-colls arguments" + ([coll] + (if (seq? coll) + coll + (or (seq coll) ()))) + ([xform coll] + (.create LazyTransformer xform coll)) + ([xform coll & colls] + (.createMulti LazyTransformer xform (to-array (cons coll colls))))) + +(defn ^boolean every? + "Returns true if (pred x) is logical true for every x in coll, else + false." + [pred coll] + (cond + (nil? (seq coll)) true + (pred (first coll)) (recur pred (next coll)) + :else false)) + +(defn ^boolean not-every? + "Returns false if (pred x) is logical true for every x in + coll, else true." + [pred coll] (not (every? pred coll))) + +(defn some + "Returns the first logical true value of (pred x) for any x in coll, + else nil. One common idiom is to use a set as pred, for example + this will return :fred if :fred is in the sequence, otherwise nil: + (some #{:fred} coll)" + [pred coll] + (when (seq coll) + (or (pred (first coll)) (recur pred (next coll))))) + +(defn ^boolean not-any? + "Returns false if (pred x) is logical true for any x in coll, + else true." + [pred coll] (not (some pred coll))) + +(defn ^boolean even? + "Returns true if n is even, throws an exception if n is not an integer" + [n] (if (integer? n) + (zero? (bit-and n 1)) + (throw (js/Error. (str "Argument must be an integer: " n))))) + +(defn ^boolean odd? + "Returns true if n is odd, throws an exception if n is not an integer" + [n] (not (even? n))) + +(defn ^boolean 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] + (fn + ([] (not (f))) + ([x] (not (f x))) + ([x y] (not (f x y))) + ([x y & zs] (not (apply f x y zs))))) + +(defn constantly + "Returns a function that takes any number of arguments and returns x." + [x] (fn [& args] x)) + +(defn comp + "Takes a set of functions and returns a fn that is the composition + of those fns. The returned fn takes a variable number of args, + applies the rightmost of fns to the args, the next + fn (right-to-left) to the result, etc." + ([] identity) + ([f] f) + ([f g] + (fn + ([] (f (g))) + ([x] (f (g x))) + ([x y] (f (g x y))) + ([x y z] (f (g x y z))) + ([x y z & args] (f (apply g x y z args))))) + ([f g h] + (fn + ([] (f (g (h)))) + ([x] (f (g (h x)))) + ([x y] (f (g (h x y)))) + ([x y z] (f (g (h x y z)))) + ([x y z & args] (f (g (apply h x y z args)))))) + ([f1 f2 f3 & fs] + (let [fs (reverse (list* f1 f2 f3 fs))] + (fn [& args] + (loop [ret (apply (first fs) args) fs (next fs)] + (if fs + (recur ((first fs) ret) (next fs)) + ret)))))) + +(defn partial + "Takes a function f and fewer than the normal arguments to f, and + returns a fn that takes a variable number of additional args. When + called, the returned function calls f with args + additional args." + ([f] f) + ([f arg1] + (fn + ([] (f arg1)) + ([x] (f arg1 x)) + ([x y] (f arg1 x y)) + ([x y z] (f arg1 x y z)) + ([x y z & args] (apply f arg1 x y z args)))) + ([f arg1 arg2] + (fn + ([] (f arg1 arg2)) + ([x] (f arg1 arg2 x)) + ([x y] (f arg1 arg2 x y)) + ([x y z] (f arg1 arg2 x y z)) + ([x y z & args] (apply f arg1 arg2 x y z args)))) + ([f arg1 arg2 arg3] + (fn + ([] (f arg1 arg2 arg3)) + ([x] (f arg1 arg2 arg3 x)) + ([x y] (f arg1 arg2 arg3 x y)) + ([x y z] (f arg1 arg2 arg3 x y z)) + ([x y z & args] (apply f arg1 arg2 arg3 x y z args)))) + ([f arg1 arg2 arg3 & more] + (fn [& args] (apply f arg1 arg2 arg3 (concat more args))))) + +(defn fnil + "Takes a function f, and returns a function that calls f, replacing + a nil first argument to f with the supplied value x. Higher arity + versions can replace arguments in the second and third + positions (y, z). Note that the function f can take any number of + arguments, not just the one(s) being nil-patched." + ([f x] + (fn + ([a] (f (if (nil? a) x a))) + ([a b] (f (if (nil? a) x a) b)) + ([a b c] (f (if (nil? a) x a) b c)) + ([a b c & ds] (apply f (if (nil? a) x a) b c ds)))) + ([f x y] + (fn + ([a b] (f (if (nil? a) x a) (if (nil? b) y b))) + ([a b c] (f (if (nil? a) x a) (if (nil? b) y b) c)) + ([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) c ds)))) + ([f x y z] + (fn + ([a b] (f (if (nil? a) x a) (if (nil? b) y b))) + ([a b c] (f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c))) + ([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c) ds))))) + +(declare volatile!) + +(defn map-indexed + "Returns a lazy sequence consisting of the result of applying f to 0 + and the first item of coll, followed by applying f to 1 and the second + item in coll, etc, until coll is exhausted. Thus function f should + accept 2 arguments, index and item. Returns a stateful transducer when + no collection is provided." + ([f] + (fn [rf] + (let [i (volatile! -1)] + (fn + ([] (rf)) + ([result] (rf result)) + ([result input] + (rf result (f (vswap! i inc) input))))))) + ([f coll] + (letfn [(mapi [idx coll] + (lazy-seq + (when-let [s (seq coll)] + (if (chunked-seq? s) + (let [c (chunk-first s) + size (count c) + b (chunk-buffer size)] + (dotimes [i size] + (chunk-append b (f (+ idx i) (-nth c i)))) + (chunk-cons (chunk b) (mapi (+ idx size) (chunk-rest s)))) + (cons (f idx (first s)) (mapi (inc idx) (rest s)))))))] + (mapi 0 coll)))) + +(defn keep + "Returns a lazy sequence of the non-nil results of (f item). Note, + this means false return values will be included. f must be free of + side-effects. Returns a transducer when no collection is provided." + ([f] + (fn [rf] + (fn + ([] (rf)) + ([result] (rf result)) + ([result input] + (let [v (f input)] + (if (nil? v) + result + (rf result v))))))) + ([f coll] + (lazy-seq + (when-let [s (seq coll)] + (if (chunked-seq? s) + (let [c (chunk-first s) + size (count c) + b (chunk-buffer size)] + (dotimes [i size] + (let [x (f (-nth c i))] + (when-not (nil? x) + (chunk-append b x)))) + (chunk-cons (chunk b) (keep f (chunk-rest s)))) + (let [x (f (first s))] + (if (nil? x) + (keep f (rest s)) + (cons x (keep f (rest s)))))))))) + +;; ============================================================================= +;; Atom + +(deftype Atom [state meta validator watches] + Object + (equiv [this other] + (-equiv this other)) + + IAtom + + IEquiv + (-equiv [o other] (identical? o other)) + + IDeref + (-deref [_] state) + + IMeta + (-meta [_] meta) + + IWatchable + (-notify-watches [this oldval newval] + (doseq [[key f] watches] + (f key this oldval newval))) + (-add-watch [this key f] + (set! (.-watches this) (assoc watches key f)) + this) + (-remove-watch [this key] + (set! (.-watches this) (dissoc watches key))) + + IHash + (-hash [this] (goog/getUid this))) + +(defn atom + "Creates and returns an Atom with an initial value of x and zero or + more options (in any order): + + :meta metadata-map + + :validator validate-fn + + If metadata-map is supplied, it will be come the metadata on the + atom. validate-fn must be nil or a side-effect-free fn of one + argument, which will be passed the intended new state on any state + change. If the new state is unacceptable, the validate-fn should + return false or throw an Error. If either of these error conditions + occur, then the value of the atom will not change." + ([x] (Atom. x nil nil nil)) + ([x & {:keys [meta validator]}] (Atom. x meta validator nil))) + +(declare pr-str) + +(defn reset! + "Sets the value of atom to newval without regard for the + current value. Returns new-value." + [a new-value] + (if (instance? Atom a) + (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)) + new-value)) + (-reset! a 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))) + ([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))) + ([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 compare-and-set! + "Atomically sets the value of atom to newval if and only if the + current value of the atom is equal to oldval. Returns true if + set happened, else false." + [^not-native a oldval newval] + (if (= (-deref a) oldval) + (do (reset! a newval) true) + false)) + +(defn set-validator! + "Sets the validator-fn for an atom. validator-fn must be nil or a + side-effect-free fn of one argument, which will be passed the intended + new state on any state change. If the new state is unacceptable, the + validator-fn should return false or throw an Error. If the current state + is not acceptable to the new validator, an Error will be thrown and the + validator will not be changed." + [iref val] + (set! (.-validator iref) val)) + +(defn get-validator + "Gets the validator-fn for a var/ref/agent/atom." + [iref] + (.-validator iref)) + +(deftype Volatile [^:mutable state] + IVolatile + (-vreset! [_ new-state] + (set! state new-state)) + + IDeref + (-deref [_] state)) + +(defn volatile! + "Creates and returns a Volatile with an initial value of val." + [val] + (Volatile. val)) + +(defn ^boolean volatile? + "Returns true if x is a volatile." + [x] (instance? Volatile x)) + +(defn vreset! + "Sets the value of volatile to newval without regard for the + current value. Returns newval." + [vol newval] (-vreset! vol newval)) + +(defn keep-indexed + "Returns a lazy sequence of the non-nil results of (f index item). Note, + this means false return values will be included. f must be free of + side-effects. Returns a stateful transducer when no collection is + provided." + ([f] + (fn [rf] + (let [ia (volatile! -1)] + (fn + ([] (rf)) + ([result] (rf result)) + ([result input] + (let [i (vswap! ia inc) + v (f i input)] + (if (nil? v) + result + (rf result v)))))))) + ([f coll] + (letfn [(keepi [idx coll] + (lazy-seq + (when-let [s (seq coll)] + (if (chunked-seq? s) + (let [c (chunk-first s) + size (count c) + b (chunk-buffer size)] + (dotimes [i size] + (let [x (f (+ idx i) (-nth c i))] + (when-not (nil? x) + (chunk-append b x)))) + (chunk-cons (chunk b) (keepi (+ idx size) (chunk-rest s)))) + (let [x (f idx (first s))] + (if (nil? x) + (keepi (inc idx) (rest s)) + (cons x (keepi (inc idx) (rest s)))))))))] + (keepi 0 coll)))) + +(defn every-pred + "Takes a set of predicates and returns a function f that returns true if all of its + composing predicates return a logical true value against all of its arguments, else it returns + false. Note that f is short-circuiting in that it will stop execution on the first + argument that triggers a logical false result against the original predicates." + ([p] + (fn ep1 + ([] true) + ([x] (boolean (p x))) + ([x y] (boolean (and (p x) (p y)))) + ([x y z] (boolean (and (p x) (p y) (p z)))) + ([x y z & args] (boolean (and (ep1 x y z) + (every? p args)))))) + ([p1 p2] + (fn ep2 + ([] true) + ([x] (boolean (and (p1 x) (p2 x)))) + ([x y] (boolean (and (p1 x) (p1 y) (p2 x) (p2 y)))) + ([x y z] (boolean (and (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z)))) + ([x y z & args] (boolean (and (ep2 x y z) + (every? #(and (p1 %) (p2 %)) args)))))) + ([p1 p2 p3] + (fn ep3 + ([] true) + ([x] (boolean (and (p1 x) (p2 x) (p3 x)))) + ([x y] (boolean (and (p1 x) (p2 x) (p3 x) (p1 y) (p2 y) (p3 y)))) + ([x y z] (boolean (and (p1 x) (p2 x) (p3 x) (p1 y) (p2 y) (p3 y) (p1 z) (p2 z) (p3 z)))) + ([x y z & args] (boolean (and (ep3 x y z) + (every? #(and (p1 %) (p2 %) (p3 %)) args)))))) + ([p1 p2 p3 & ps] + (let [ps (list* p1 p2 p3 ps)] + (fn epn + ([] true) + ([x] (every? #(% x) ps)) + ([x y] (every? #(and (% x) (% y)) ps)) + ([x y z] (every? #(and (% x) (% y) (% z)) ps)) + ([x y z & args] (boolean (and (epn x y z) + (every? #(every? % args) ps)))))))) + +(defn some-fn + "Takes a set of predicates and returns a function f that returns the first logical true value + returned by one of its composing predicates against any of its arguments, else it returns + logical false. Note that f is short-circuiting in that it will stop execution on the first + argument that triggers a logical true result against the original predicates." + ([p] + (fn sp1 + ([] nil) + ([x] (p x)) + ([x y] (or (p x) (p y))) + ([x y z] (or (p x) (p y) (p z))) + ([x y z & args] (or (sp1 x y z) + (some p args))))) + ([p1 p2] + (fn sp2 + ([] nil) + ([x] (or (p1 x) (p2 x))) + ([x y] (or (p1 x) (p1 y) (p2 x) (p2 y))) + ([x y z] (or (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z))) + ([x y z & args] (or (sp2 x y z) + (some #(or (p1 %) (p2 %)) args))))) + ([p1 p2 p3] + (fn sp3 + ([] nil) + ([x] (or (p1 x) (p2 x) (p3 x))) + ([x y] (or (p1 x) (p2 x) (p3 x) (p1 y) (p2 y) (p3 y))) + ([x y z] (or (p1 x) (p2 x) (p3 x) (p1 y) (p2 y) (p3 y) (p1 z) (p2 z) (p3 z))) + ([x y z & args] (or (sp3 x y z) + (some #(or (p1 %) (p2 %) (p3 %)) args))))) + ([p1 p2 p3 & ps] + (let [ps (list* p1 p2 p3 ps)] + (fn spn + ([] nil) + ([x] (some #(% x) ps)) + ([x y] (some #(or (% x) (% y)) ps)) + ([x y z] (some #(or (% x) (% y) (% z)) ps)) + ([x y z & args] (or (spn x y z) + (some #(some % args) ps))))))) + +(defn map + "Returns a lazy sequence consisting of the result of applying f to + the set of first items of each coll, followed by applying f to the + set of second items in each coll, until any one of the colls is + exhausted. Any remaining items in other colls are ignored. Function + f should accept number-of-colls arguments. Returns a transducer when + no collection is provided." + ([f] + (fn [rf] + (fn + ([] (rf)) + ([result] (rf result)) + ([result input] + (rf result (f input))) + ([result input & inputs] + (rf result (apply f input inputs)))))) + ([f coll] + (lazy-seq + (when-let [s (seq coll)] + (if (chunked-seq? s) + (let [c (chunk-first s) + size (count c) + b (chunk-buffer size)] + (dotimes [i size] + (chunk-append b (f (-nth c i)))) + (chunk-cons (chunk b) (map f (chunk-rest s)))) + (cons (f (first s)) (map f (rest s))))))) + ([f c1 c2] + (lazy-seq + (let [s1 (seq c1) s2 (seq c2)] + (when (and s1 s2) + (cons (f (first s1) (first s2)) + (map f (rest s1) (rest s2))))))) + ([f c1 c2 c3] + (lazy-seq + (let [s1 (seq c1) s2 (seq c2) s3 (seq c3)] + (when (and s1 s2 s3) + (cons (f (first s1) (first s2) (first s3)) + (map f (rest s1) (rest s2) (rest s3))))))) + ([f c1 c2 c3 & colls] + (let [step (fn step [cs] + (lazy-seq + (let [ss (map seq cs)] + (when (every? identity ss) + (cons (map first ss) (step (map rest ss)))))))] + (map #(apply f %) (step (conj colls c3 c2 c1)))))) + +(defn take + "Returns a lazy sequence of the first n items in coll, or all items if + there are fewer than n. Returns a stateful transducer when + no collection is provided." + ([n] + {:pre [(number? n)]} + (fn [rf] + (let [na (volatile! n)] + (fn + ([] (rf)) + ([result] (rf result)) + ([result input] + (let [n @na + nn (vswap! na dec) + result (if (pos? n) + (rf result input) + result)] + (if (not (pos? nn)) + (ensure-reduced result) + result))))))) + ([n coll] + {:pre [(number? n)]} + (lazy-seq + (when (pos? n) + (when-let [s (seq coll)] + (cons (first s) (take (dec n) (rest s)))))))) + +(defn drop + "Returns a lazy sequence of all but the first n items in coll. + Returns a stateful transducer when no collection is provided." + ([n] + {:pre [(number? n)]} + (fn [rf] + (let [na (volatile! n)] + (fn + ([] (rf)) + ([result] (rf result)) + ([result input] + (let [n @na] + (vswap! na dec) + (if (pos? n) + result + (rf result input)))))))) + ([n coll] + {:pre [(number? n)]} + (let [step (fn [n coll] + (let [s (seq coll)] + (if (and (pos? n) s) + (recur (dec n) (rest s)) + s)))] + (lazy-seq (step n coll))))) + +(defn drop-last + "Return a lazy sequence of all but the last n (default 1) items in coll" + ([s] (drop-last 1 s)) + ([n s] (map (fn [x _] x) s (drop n s)))) + +(defn take-last + "Returns a seq of the last n items in coll. Depending on the type + of coll may be no better than linear time. For vectors, see also subvec." + [n coll] + (loop [s (seq coll), lead (seq (drop n coll))] + (if lead + (recur (next s) (next lead)) + s))) + +(defn drop-while + "Returns a lazy sequence of the items in coll starting from the + first item for which (pred item) returns logical false. Returns a + stateful transducer when no collection is provided." + ([pred] + (fn [rf] + (let [da (volatile! true)] + (fn + ([] (rf)) + ([result] (rf result)) + ([result input] + (let [drop? @da] + (if (and drop? (pred input)) + result + (do + (vreset! da nil) + (rf result input))))))))) + ([pred coll] + (let [step (fn [pred coll] + (let [s (seq coll)] + (if (and s (pred (first s))) + (recur pred (rest s)) + s)))] + (lazy-seq (step pred coll))))) + +(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))))) + +(defn split-at + "Returns a vector of [(take n coll) (drop n coll)]" + [n coll] + [(take n coll) (drop n coll)]) + +(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)))) + +(defn replicate + "DEPRECATED: Use 'repeat' instead. + Returns a lazy seq of n xs." + [n x] (take n (repeat x))) + +(defn repeatedly + "Takes a function of no args, presumably with side effects, and + returns an infinite (or length n if supplied) lazy sequence of calls + to it" + ([f] (lazy-seq (cons (f) (repeatedly f)))) + ([n f] (take n (repeatedly f)))) + +(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))))) + +(defn interleave + "Returns a lazy seq of the first item in each coll, then the second etc." + ([c1 c2] + (lazy-seq + (let [s1 (seq c1) s2 (seq c2)] + (when (and s1 s2) + (cons (first s1) (cons (first s2) + (interleave (rest s1) (rest s2)))))))) + ([c1 c2 & colls] + (lazy-seq + (let [ss (map seq (conj colls c2 c1))] + (when (every? identity ss) + (concat (map first ss) (apply interleave (map rest ss)))))))) + +(defn interpose + "Returns a lazy seq of the elements of coll separated by sep. + Returns a stateful transducer when no collection is provided." + ([sep] + (fn [rf] + (let [started (volatile! false)] + (fn + ([] (rf)) + ([result] (rf result)) + ([result input] + (if @started + (let [sepr (rf result sep)] + (if (reduced? sepr) + sepr + (rf sepr input))) + (do + (vreset! started true) + (rf result input)))))))) + ([sep coll] (drop 1 (interleave (repeat sep) coll)))) + + + +(defn- flatten1 + "Take a collection of collections, and return a lazy seq + of items from the inner collection" + [colls] + (let [cat (fn cat [coll colls] + (lazy-seq + (if-let [coll (seq coll)] + (cons (first coll) (cat (rest coll) colls)) + (when (seq colls) + (cat (first colls) (rest colls))))))] + (cat nil colls))) + +(declare cat) + +(defn mapcat + "Returns the result of applying concat to the result of applying map + to f and colls. Thus function f should return a collection. Returns + a transducer when no collections are provided" + {:added "1.0" + :static true} + ([f] (comp (map f) cat)) + ([f & colls] + (apply concat (apply map f colls)))) + +(defn filter + "Returns a lazy sequence of the items in coll for which + (pred item) returns true. pred must be free of side-effects. + Returns a transducer when no collection is provided." + ([pred] + (fn [rf] + (fn + ([] (rf)) + ([result] (rf result)) + ([result input] + (if (pred input) + (rf result input) + result))))) + ([pred coll] + (lazy-seq + (when-let [s (seq coll)] + (if (chunked-seq? s) + (let [c (chunk-first s) + size (count c) + b (chunk-buffer size)] + (dotimes [i size] + (when (pred (-nth c i)) + (chunk-append b (-nth c i)))) + (chunk-cons (chunk b) (filter pred (chunk-rest s)))) + (let [f (first s) r (rest s)] + (if (pred f) + (cons f (filter pred r)) + (filter pred r)))))))) + +(defn remove + "Returns a lazy sequence of the items in coll for which + (pred item) returns false. pred must be free of side-effects. + Returns a transducer when no collection is provided." + ([pred] (filter (complement pred))) + ([pred coll] + (filter (complement pred) coll))) + +(defn tree-seq + "Returns a lazy sequence of the nodes in a tree, via a depth-first walk. + branch? must be a fn of one arg that returns true if passed a node + that can have children (but may not). children must be a fn of one + arg that returns a sequence of the children. Will only be called on + nodes for which branch? returns true. Root is the root node of the + tree." + [branch? children root] + (let [walk (fn walk [node] + (lazy-seq + (cons node + (when (branch? node) + (mapcat walk (children node))))))] + (walk root))) + +(defn flatten + "Takes any nested combination of sequential things (lists, vectors, + etc.) and returns their contents as a single, flat sequence. + (flatten nil) returns nil." + [x] + (filter #(not (sequential? %)) + (rest (tree-seq sequential? seq x)))) + +(defn into + "Returns a new coll consisting of to-coll with all of the items of + from-coll conjoined. A transducer may be supplied." + ([] []) + ([to] to) + ([to from] + (if-not (nil? to) + (if (implements? IEditableCollection 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)) + (transduce xform conj to from)))) + +(defn mapv + "Returns a vector consisting of the result of applying f to the + set of first items of each coll, followed by applying f to the set + of second items in each coll, until any one of the colls is + exhausted. Any remaining items in other colls are ignored. Function + f should accept number-of-colls arguments." + ([f coll] + (-> (reduce (fn [v o] (conj! v (f o))) (transient []) coll) + persistent!)) + ([f c1 c2] + (into [] (map f c1 c2))) + ([f c1 c2 c3] + (into [] (map f c1 c2 c3))) + ([f c1 c2 c3 & colls] + (into [] (apply map f c1 c2 c3 colls)))) + +(defn filterv + "Returns a vector of the items in coll for which + (pred item) returns true. pred must be free of side-effects." + [pred coll] + (-> (reduce (fn [v o] (if (pred o) (conj! v o) v)) + (transient []) + coll) + persistent!)) + +(defn partition + "Returns a lazy sequence of lists of n items each, at offsets step + apart. If step is not supplied, defaults to n, i.e. the partitions + do not overlap. If a pad collection is supplied, use its elements as + necessary to complete last partition up to n items. In case there are + not enough padding elements, return a partition with less than n items." + ([n coll] + (partition n n coll)) + ([n step coll] + (lazy-seq + (when-let [s (seq coll)] + (let [p (take n s)] + (when (== n (count p)) + (cons p (partition n step (drop step s)))))))) + ([n step pad coll] + (lazy-seq + (when-let [s (seq coll)] + (let [p (take n s)] + (if (== n (count p)) + (cons p (partition n step pad (drop step s))) + (list (take n (concat p pad))))))))) + +(defn get-in + "Returns the value in a nested associative structure, + where ks is a sequence of keys. Returns nil if the key is not present, + or the not-found value if supplied." + {:added "1.2" + :static true} + ([m ks] + (reduce get m ks)) + ([m ks not-found] + (loop [sentinel lookup-sentinel + m m + ks (seq ks)] + (if-not (nil? ks) + (let [m (get m (first ks) sentinel)] + (if (identical? sentinel m) + not-found + (recur sentinel m (next ks)))) + m)))) + +(defn assoc-in + "Associates a value in a nested associative structure, where ks is a + sequence of keys and v is the new value and returns a new nested structure. + If any levels do not exist, hash-maps will be created." + [m [k & ks] v] + (if ks + (assoc m k (assoc-in (get m k) ks v)) + (assoc m k v))) + +(defn update-in + "'Updates' a value in a nested associative structure, where ks is a + sequence of keys and f is a function that will take the old value + and any supplied args and return the new value, and returns a new + nested structure. If any levels do not exist, hash-maps will be + created." + ([m [k & ks] f] + (if ks + (assoc m k (update-in (get m k) ks f)) + (assoc m k (f (get m k))))) + ([m [k & ks] f a] + (if ks + (assoc m k (update-in (get m k) ks f a)) + (assoc m k (f (get m k) a)))) + ([m [k & ks] f a b] + (if ks + (assoc m k (update-in (get m k) ks f a b)) + (assoc m k (f (get m k) a b)))) + ([m [k & ks] f a b c] + (if ks + (assoc m k (update-in (get m k) ks f a b c)) + (assoc m k (f (get m k) a b c)))) + ([m [k & ks] f a b c & args] + (if ks + (assoc m k (apply update-in (get m k) ks f a b c args)) + (assoc m k (apply f (get m k) a b c args))))) + +(defn update + "'Updates' a value in an associative structure, where k is a + key and f is a function that will take the old value + and any supplied args and return the new value, and returns a new + structure. If the key does not exist, nil is passed as the old value." + ([m k f] + (assoc m k (f (get m k)))) + ([m k f x] + (assoc m k (f (get m k) x))) + ([m k f x y] + (assoc m k (f (get m k) x y))) + ([m k f x y z] + (assoc m k (f (get m k) x y z))) + ([m k f x y z & more] + (assoc m k (apply f (get m k) x y z more)))) + +;;; PersistentVector + +(deftype VectorNode [edit arr]) + +(defn- pv-fresh-node [edit] + (VectorNode. edit (make-array 32))) + +(defn- pv-aget [node idx] + (aget (.-arr node) idx)) + +(defn- pv-aset [node idx val] + (aset (.-arr node) idx val)) + +(defn- pv-clone-node [node] + (VectorNode. (.-edit node) (aclone (.-arr node)))) + +(defn- tail-off [pv] + (let [cnt (.-cnt pv)] + (if (< cnt 32) + 0 + (bit-shift-left (bit-shift-right-zero-fill (dec cnt) 5) 5)))) + +(defn- new-path [edit level node] + (loop [ll level + ret node] + (if (zero? ll) + ret + (let [embed ret + r (pv-fresh-node edit) + _ (pv-aset r 0 embed)] + (recur (- ll 5) r))))) + +(defn- push-tail [pv level parent tailnode] + (let [ret (pv-clone-node parent) + subidx (bit-and (bit-shift-right-zero-fill (dec (.-cnt pv)) level) 0x01f)] + (if (== 5 level) + (do + (pv-aset ret subidx tailnode) + ret) + (let [child (pv-aget parent subidx)] + (if-not (nil? child) + (let [node-to-insert (push-tail pv (- level 5) child tailnode)] + (pv-aset ret subidx node-to-insert) + ret) + (let [node-to-insert (new-path nil (- level 5) tailnode)] + (pv-aset ret subidx node-to-insert) + ret)))))) + +(defn- vector-index-out-of-bounds [i cnt] + (throw (js/Error. (str "No item " i " in vector of length " cnt)))) + +(defn- first-array-for-longvec [pv] + ;; invariants: (count pv) > 32. + (loop [node (.-root pv) + level (.-shift pv)] + (if (pos? level) + (recur (pv-aget node 0) (- level 5)) + (.-arr node)))) + +(defn- unchecked-array-for [pv i] + ;; invariant: i is a valid index of pv (use array-for if unknown). + (if (>= i (tail-off pv)) + (.-tail pv) + (loop [node (.-root pv) + level (.-shift pv)] + (if (pos? level) + (recur (pv-aget node (bit-and (bit-shift-right-zero-fill i level) 0x01f)) + (- level 5)) + (.-arr node))))) + +(defn- array-for [pv i] + (if (and (<= 0 i) (< i (.-cnt pv))) + (unchecked-array-for pv i) + (vector-index-out-of-bounds i (.-cnt pv)))) + +(defn- do-assoc [pv level node i val] + (let [ret (pv-clone-node node)] + (if (zero? level) + (do + (pv-aset ret (bit-and i 0x01f) val) + ret) + (let [subidx (bit-and (bit-shift-right-zero-fill i level) 0x01f)] + (pv-aset ret subidx (do-assoc pv (- level 5) (pv-aget node subidx) i val)) + ret)))) + +(defn- pop-tail [pv level node] + (let [subidx (bit-and (bit-shift-right-zero-fill (- (.-cnt pv) 2) level) 0x01f)] + (cond + (> level 5) (let [new-child (pop-tail pv (- level 5) (pv-aget node subidx))] + (if (and (nil? new-child) (zero? subidx)) + nil + (let [ret (pv-clone-node node)] + (pv-aset ret subidx new-child) + ret))) + (zero? subidx) nil + :else (let [ret (pv-clone-node node)] + (pv-aset ret subidx nil) + ret)))) + +(deftype RangedIterator [^:mutable i ^:mutable base ^:mutable arr v start end] + Object + (hasNext [this] + (< i end)) + (next [this] + (when (== (- i base) 32) + (set! arr (unchecked-array-for v i)) + (set! base (+ base 32))) + (let [ret (aget arr (bit-and i 0x01f))] + (set! i (inc i)) + ret))) + +(defn ranged-iterator [v start end] + (let [i start] + (RangedIterator. i (- i (js-mod i 32)) + (when (< start (count v)) + (unchecked-array-for v i)) + v start end))) + +(declare tv-editable-root tv-editable-tail TransientVector deref + pr-sequential-writer pr-writer chunked-seq) + +(deftype PersistentVector [meta cnt shift root tail ^: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 coll))) + (lastIndexOf [coll x start] + (-lastIndexOf coll x start)) + + ICloneable + (-clone [_] (PersistentVector. meta cnt shift root tail __hash)) + + IWithMeta + (-with-meta [coll meta] (PersistentVector. meta cnt shift root tail __hash)) + + IMeta + (-meta [coll] meta) + + IStack + (-peek [coll] + (when (> cnt 0) + (-nth coll (dec cnt)))) + (-pop [coll] + (cond + (zero? cnt) (throw (js/Error. "Can't pop empty vector")) + (== 1 cnt) (-with-meta (.-EMPTY PersistentVector) meta) + (< 1 (- cnt (tail-off coll))) + (PersistentVector. meta (dec cnt) shift root (.slice tail 0 -1) nil) + :else (let [new-tail (unchecked-array-for coll (- cnt 2)) + nr (pop-tail coll shift root) + new-root (if (nil? nr) (.-EMPTY-NODE PersistentVector) nr) + cnt-1 (dec cnt)] + (if (and (< 5 shift) (nil? (pv-aget new-root 1))) + (PersistentVector. meta cnt-1 (- shift 5) (pv-aget new-root 0) new-tail nil) + (PersistentVector. meta cnt-1 shift new-root new-tail nil))))) + + ICollection + (-conj [coll o] + (if (< (- cnt (tail-off coll)) 32) + (let [len (alength tail) + new-tail (make-array (inc len))] + (dotimes [i len] + (aset new-tail i (aget tail i))) + (aset new-tail len o) + (PersistentVector. meta (inc cnt) shift root new-tail nil)) + (let [root-overflow? (> (bit-shift-right-zero-fill cnt 5) (bit-shift-left 1 shift)) + new-shift (if root-overflow? (+ shift 5) shift) + new-root (if root-overflow? + (let [n-r (pv-fresh-node nil)] + (pv-aset n-r 0 root) + (pv-aset n-r 1 (new-path nil shift (VectorNode. nil tail))) + n-r) + (push-tail coll shift root (VectorNode. nil tail)))] + (PersistentVector. meta (inc cnt) new-shift new-root (array o) nil)))) + + IEmptyableCollection + (-empty [coll] (with-meta (.-EMPTY PersistentVector) meta)) + + ISequential + IEquiv + (-equiv [coll other] + (if (instance? PersistentVector other) + (if (== cnt (count other)) + (let [me-iter (-iterator coll) + you-iter (-iterator other)] + (loop [] + (if ^boolean (.hasNext me-iter) + (let [x (.next me-iter) + y (.next you-iter)] + (if (= x y) + (recur) + false)) + true))) + false) + (equiv-sequential coll other))) + + IHash + (-hash [coll] (caching-hash coll hash-ordered-coll __hash)) + + ISeqable + (-seq [coll] + (cond + (zero? cnt) nil + (<= cnt 32) (IndexedSeq. tail 0 nil) + :else (chunked-seq coll (first-array-for-longvec coll) 0 0))) + + ICounted + (-count [coll] cnt) + + IIndexed + (-nth [coll n] + (aget (array-for coll n) (bit-and n 0x01f))) + (-nth [coll n not-found] + (if (and (<= 0 n) (< n cnt)) + (aget (unchecked-array-for coll n) (bit-and n 0x01f)) + not-found)) + + ILookup + (-lookup [coll k] (-lookup coll k nil)) + (-lookup [coll k not-found] (if (number? k) + (-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.")))) + + IVector + (-assoc-n [coll n val] + (cond + (and (<= 0 n) (< n cnt)) + (if (<= (tail-off coll) n) + (let [new-tail (aclone tail)] + (aset new-tail (bit-and n 0x01f) val) + (PersistentVector. meta cnt shift root new-tail nil)) + (PersistentVector. meta cnt shift (do-assoc coll shift root n val) tail nil)) + (== n cnt) (-conj coll val) + :else (throw (js/Error. (str "Index " n " out of bounds [0," cnt "]"))))) + + IReduce + (-reduce [v f] + (ci-reduce v f)) + (-reduce [v f init] + (loop [i 0 init init] + (if (< i cnt) + (let [arr (unchecked-array-for v i) + len (alength arr) + init (loop [j 0 init init] + (if (< j len) + (let [init (f init (aget arr j))] + (if (reduced? init) + init + (recur (inc j) init))) + init))] + (if (reduced? init) + @init + (recur (+ i len) init))) + init))) + + IKVReduce + (-kv-reduce [v f init] + (loop [i 0 init init] + (if (< i cnt) + (let [arr (unchecked-array-for v i) + len (alength arr) + init (loop [j 0 init init] + (if (< j len) + (let [init (f init (+ j i) (aget arr j))] + (if (reduced? init) + init + (recur (inc j) init))) + init))] + (if (reduced? init) + @init + (recur (+ i len) init))) + init))) + + IFn + (-invoke [coll k] + (-nth coll k)) + (-invoke [coll k not-found] + (-nth coll k not-found)) + + IEditableCollection + (-as-transient [coll] + (TransientVector. cnt shift (tv-editable-root root) (tv-editable-tail tail))) + + IReversible + (-rseq [coll] + (if (pos? cnt) + (RSeq. coll (dec cnt) nil))) + + IIterable + (-iterator [this] + (ranged-iterator this 0 cnt))) + +(set! (.-EMPTY-NODE PersistentVector) (VectorNode. nil (make-array 32))) + +(set! (.-EMPTY PersistentVector) + (PersistentVector. nil 0 5 (.-EMPTY-NODE PersistentVector) (array) empty-ordered-hash)) + +(set! (.-fromArray PersistentVector) + (fn [xs ^boolean no-clone] + (let [l (alength xs) + xs (if no-clone xs (aclone xs))] + (if (< l 32) + (PersistentVector. nil l 5 (.-EMPTY-NODE PersistentVector) xs nil) + (let [node (.slice xs 0 32) + v (PersistentVector. nil 32 5 (.-EMPTY-NODE PersistentVector) node nil)] + (loop [i 32 out (-as-transient v)] + (if (< i l) + (recur (inc i) (conj! out (aget xs i))) + (persistent! out)))))))) + +(es6-iterable PersistentVector) + +(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) + (.fromArray PersistentVector coll true) + (-persistent! + (reduce -conj! + (-as-transient (.-EMPTY PersistentVector)) + coll)))) + +(defn vector + "Creates a new vector containing the args." + [& args] + (if (and (instance? IndexedSeq args) (zero? (.-i args))) + (.fromArray PersistentVector (.-arr args) true) + (vec args))) + +(declare subvec) + +(deftype ChunkedSeq [vec node i off meta ^: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 coll))) + (lastIndexOf [coll x start] + (-lastIndexOf coll x start)) + + IWithMeta + (-with-meta [coll m] + (chunked-seq vec node i off m)) + IMeta + (-meta [coll] meta) + + ISeqable + (-seq [coll] coll) + + ISequential + IEquiv + (-equiv [coll other] (equiv-sequential coll other)) + + ASeq + ISeq + (-first [coll] + (aget node off)) + (-rest [coll] + (if (< (inc off) (alength node)) + (let [s (chunked-seq vec node i (inc off))] + (if (nil? s) + () + s)) + (-chunked-rest coll))) + + INext + (-next [coll] + (if (< (inc off) (alength node)) + (let [s (chunked-seq vec node i (inc off))] + (if (nil? s) + nil + s)) + (-chunked-next coll))) + + ICollection + (-conj [coll o] + (cons o coll)) + + IEmptyableCollection + (-empty [coll] + (with-meta (.-EMPTY PersistentVector) meta)) + + IChunkedSeq + (-chunked-first [coll] + (array-chunk node off)) + (-chunked-rest [coll] + (let [end (+ i (alength node))] + (if (< end (-count vec)) + (chunked-seq vec (unchecked-array-for vec end) end 0) + ()))) + + IChunkedNext + (-chunked-next [coll] + (let [end (+ i (alength node))] + (when (< end (-count vec)) + (chunked-seq vec (unchecked-array-for vec end) end 0)))) + + IHash + (-hash [coll] (caching-hash coll hash-ordered-coll __hash)) + + IReduce + (-reduce [coll f] + (ci-reduce (subvec vec (+ i off) (count vec)) f)) + + (-reduce [coll f start] + (ci-reduce (subvec vec (+ i off) (count vec)) f start))) + +(es6-iterable ChunkedSeq) + +(defn chunked-seq + ([vec i off] (ChunkedSeq. vec (array-for vec i) i off nil nil)) + ([vec node i off] (ChunkedSeq. vec node i off nil nil)) + ([vec node i off meta] + (ChunkedSeq. vec node i off meta nil))) + +(declare build-subvec) + +(deftype Subvec [meta v start end ^: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 coll))) + (lastIndexOf [coll x start] + (-lastIndexOf coll x start)) + + ICloneable + (-clone [_] (Subvec. meta v start end __hash)) + + IWithMeta + (-with-meta [coll meta] (build-subvec meta v start end __hash)) + + IMeta + (-meta [coll] meta) + + IStack + (-peek [coll] + (-nth v (dec end))) + (-pop [coll] + (if (== start end) + (throw (js/Error. "Can't pop empty vector")) + (build-subvec meta v start (dec end) nil))) + + ICollection + (-conj [coll o] + (build-subvec meta (-assoc-n v end o) start (inc end) nil)) + + IEmptyableCollection + (-empty [coll] (with-meta (.-EMPTY PersistentVector) meta)) + + ISequential + IEquiv + (-equiv [coll other] (equiv-sequential coll other)) + + IHash + (-hash [coll] (caching-hash coll hash-ordered-coll __hash)) + + ISeqable + (-seq [coll] + (let [subvec-seq (fn subvec-seq [i] + (when-not (== i end) + (cons (-nth v i) + (lazy-seq + (subvec-seq (inc i))))))] + (subvec-seq start))) + + IReversible + (-rseq [coll] + (if-not (== start end) + (RSeq. coll (dec (- end start)) nil))) + + ICounted + (-count [coll] (- end start)) + + IIndexed + (-nth [coll n] + (if (or (neg? n) (<= end (+ start n))) + (vector-index-out-of-bounds n (- end start)) + (-nth v (+ start n)))) + (-nth [coll n not-found] + (if (or (neg? n) (<= end (+ start n))) + not-found + (-nth v (+ start n) not-found))) + + ILookup + (-lookup [coll k] (-lookup coll k nil)) + (-lookup [coll k not-found] (if (number? k) + (-nth coll k not-found) + not-found)) + + IAssociative + (-assoc [coll key val] + (if (number? key) + (-assoc-n coll key val) + (throw (js/Error. "Subvec's key for assoc must be a number.")))) + + IVector + (-assoc-n [coll n val] + (let [v-pos (+ start n)] + (if (or (neg? n) (<= (inc end) v-pos)) + (throw (js/Error. (str "Index " n " out of bounds [0," (-count coll) "]"))) + (build-subvec meta (assoc v v-pos val) start (max end (inc v-pos)) nil)))) + + IReduce + (-reduce [coll f] + (ci-reduce coll f)) + (-reduce [coll f start] + (ci-reduce coll f start)) + + IKVReduce + (-kv-reduce [coll f init] + (loop [i start j 0 init init] + (if (< i end) + (let [init (f init j (-nth v i))] + (if (reduced? init) + @init + (recur (inc i) (inc j) init))) + init))) + + IFn + (-invoke [coll k] + (-nth coll k)) + (-invoke [coll k not-found] + (-nth coll k not-found)) + + IIterable + (-iterator [coll] + (ranged-iterator v start end))) + +(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"))) + (Subvec. meta v start end __hash)))) + +(defn subvec + "Returns a persistent vector of the items in vector from + start (inclusive) to end (exclusive). If end is not supplied, + defaults to (count vector). This operation is O(1) and very fast, as + the resulting vector shares structure with the original and no + trimming is done." + ([v start] + (subvec v start (count v))) + ([v start end] + (build-subvec nil v start end nil))) + +(defn- tv-ensure-editable [edit node] + (if (identical? edit (.-edit node)) + node + (VectorNode. edit (aclone (.-arr node))))) + +(defn- tv-editable-root [node] + (VectorNode. (js-obj) (aclone (.-arr node)))) + +(defn- tv-editable-tail [tl] + (let [ret (make-array 32)] + (array-copy tl 0 ret 0 (alength tl)) + ret)) + +(defn- tv-push-tail [tv level parent tail-node] + (let [ret (tv-ensure-editable (.. tv -root -edit) parent) + subidx (bit-and (bit-shift-right-zero-fill (dec (.-cnt tv)) level) 0x01f)] + (pv-aset ret subidx + (if (== level 5) + tail-node + (let [child (pv-aget ret subidx)] + (if-not (nil? child) + (tv-push-tail tv (- level 5) child tail-node) + (new-path (.. tv -root -edit) (- level 5) tail-node))))) + ret)) + +(defn- tv-pop-tail [tv level node] + (let [node (tv-ensure-editable (.. tv -root -edit) node) + subidx (bit-and (bit-shift-right-zero-fill (- (.-cnt tv) 2) level) 0x01f)] + (cond + (> level 5) (let [new-child (tv-pop-tail + tv (- level 5) (pv-aget node subidx))] + (if (and (nil? new-child) (zero? subidx)) + nil + (do (pv-aset node subidx new-child) + node))) + (zero? subidx) nil + :else (do (pv-aset node subidx nil) + node)))) + +(defn- unchecked-editable-array-for [tv i] + ;; invariant: i is a valid index of tv. + (if (>= i (tail-off tv)) + (.-tail tv) + (let [root (.-root tv)] + (loop [node root + level (.-shift tv)] + (if (pos? level) + (recur (tv-ensure-editable + (.-edit root) + (pv-aget node + (bit-and (bit-shift-right-zero-fill i level) + 0x01f))) + (- level 5)) + (.-arr node)))))) + +(deftype TransientVector [^:mutable cnt + ^:mutable shift + ^:mutable root + ^:mutable tail] + ITransientCollection + (-conj! [tcoll o] + (if ^boolean (.-edit root) + (if (< (- cnt (tail-off tcoll)) 32) + (do (aset tail (bit-and cnt 0x01f) o) + (set! cnt (inc cnt)) + tcoll) + (let [tail-node (VectorNode. (.-edit root) tail) + new-tail (make-array 32)] + (aset new-tail 0 o) + (set! tail new-tail) + (if (> (bit-shift-right-zero-fill cnt 5) + (bit-shift-left 1 shift)) + (let [new-root-array (make-array 32) + new-shift (+ shift 5)] + (aset new-root-array 0 root) + (aset new-root-array 1 (new-path (.-edit root) shift tail-node)) + (set! root (VectorNode. (.-edit root) new-root-array)) + (set! shift new-shift) + (set! cnt (inc cnt)) + tcoll) + (let [new-root (tv-push-tail tcoll shift root tail-node)] + (set! root new-root) + (set! cnt (inc cnt)) + tcoll)))) + (throw (js/Error. "conj! after persistent!")))) + + (-persistent! [tcoll] + (if ^boolean (.-edit root) + (do (set! (.-edit root) nil) + (let [len (- cnt (tail-off tcoll)) + trimmed-tail (make-array len)] + (array-copy tail 0 trimmed-tail 0 len) + (PersistentVector. nil cnt shift root trimmed-tail nil))) + (throw (js/Error. "persistent! called twice")))) + + ITransientAssociative + (-assoc! [tcoll key val] + (if (number? key) + (-assoc-n! tcoll key val) + (throw (js/Error. "TransientVector's key for assoc! must be a number.")))) + + ITransientVector + (-assoc-n! [tcoll n val] + (if ^boolean (.-edit root) + (cond + (and (<= 0 n) (< n cnt)) + (if (<= (tail-off tcoll) n) + (do (aset tail (bit-and n 0x01f) val) + tcoll) + (let [new-root + ((fn go [level node] + (let [node (tv-ensure-editable (.-edit root) node)] + (if (zero? level) + (do (pv-aset node (bit-and n 0x01f) val) + node) + (let [subidx (bit-and (bit-shift-right-zero-fill n level) + 0x01f)] + (pv-aset node subidx + (go (- level 5) (pv-aget node subidx))) + node)))) + shift root)] + (set! root new-root) + tcoll)) + (== n cnt) (-conj! tcoll val) + :else + (throw + (js/Error. + (str "Index " n " out of bounds for TransientVector of length" cnt)))) + (throw (js/Error. "assoc! after persistent!")))) + + (-pop! [tcoll] + (if ^boolean (.-edit root) + (cond + (zero? cnt) (throw (js/Error. "Can't pop empty vector")) + (== 1 cnt) (do (set! cnt 0) tcoll) + (pos? (bit-and (dec cnt) 0x01f)) (do (set! cnt (dec cnt)) tcoll) + :else + (let [new-tail (unchecked-editable-array-for tcoll (- cnt 2)) + new-root (let [nr (tv-pop-tail tcoll shift root)] + (if-not (nil? nr) + nr + (VectorNode. (.-edit root) (make-array 32))))] + (if (and (< 5 shift) (nil? (pv-aget new-root 1))) + (let [new-root (tv-ensure-editable (.-edit root) (pv-aget new-root 0))] + (set! root new-root) + (set! shift (- shift 5)) + (set! cnt (dec cnt)) + (set! tail new-tail) + tcoll) + (do (set! root new-root) + (set! cnt (dec cnt)) + (set! tail new-tail) + tcoll)))) + (throw (js/Error. "pop! after persistent!")))) + + ICounted + (-count [coll] + (if ^boolean (.-edit root) + cnt + (throw (js/Error. "count after persistent!")))) + + IIndexed + (-nth [coll n] + (if ^boolean (.-edit root) + (aget (array-for coll n) (bit-and n 0x01f)) + (throw (js/Error. "nth after persistent!")))) + + (-nth [coll n not-found] + (if (and (<= 0 n) (< n cnt)) + (-nth coll n) + not-found)) + + ILookup + (-lookup [coll k] (-lookup coll k nil)) + + (-lookup [coll k not-found] (if (number? k) + (-nth coll k not-found) + not-found)) + + IFn + (-invoke [coll k] + (-lookup coll k)) + + (-invoke [coll k not-found] + (-lookup coll k not-found))) + +;;; PersistentQueue ;;; + +(deftype PersistentQueueIter [^:mutable fseq riter] + Object + (hasNext [_] + (or (and (some? fseq) (seq fseq)) (and (some? riter) (.hasNext riter)))) + (next [_] + (cond + (some? fseq) + (let [ret (first fseq)] + (set! fseq (next fseq)) + ret) + (and (some? riter) ^boolean (.hasNext riter)) + (.next riter) + :else (throw (js/Error. "No such element")))) + (remove [_] (js/Error. "Unsupported operation"))) + +(deftype PersistentQueueSeq [meta front rear ^: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 coll))) + (lastIndexOf [coll x start] + (-lastIndexOf coll x start)) + + IWithMeta + (-with-meta [coll meta] (PersistentQueueSeq. meta front rear __hash)) + + IMeta + (-meta [coll] meta) + + ISeq + (-first [coll] (first front)) + (-rest [coll] + (if-let [f1 (next front)] + (PersistentQueueSeq. meta f1 rear nil) + (if (nil? rear) + (-empty coll) + (PersistentQueueSeq. meta rear nil nil)))) + + ICollection + (-conj [coll o] (cons o coll)) + + IEmptyableCollection + (-empty [coll] (with-meta (.-EMPTY List) meta)) + + ISequential + IEquiv + (-equiv [coll other] (equiv-sequential coll other)) + + IHash + (-hash [coll] (caching-hash coll hash-ordered-coll __hash)) + + ISeqable + (-seq [coll] coll)) + +(es6-iterable PersistentQueueSeq) + +(deftype PersistentQueue [meta count front rear ^: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 coll))) + (lastIndexOf [coll x start] + (-lastIndexOf coll x start)) + + ICloneable + (-clone [coll] (PersistentQueue. meta count front rear __hash)) + + IIterable + (-iterator [coll] + (PersistentQueueIter. front (-iterator rear))) + + IWithMeta + (-with-meta [coll meta] (PersistentQueue. meta count front rear __hash)) + + IMeta + (-meta [coll] meta) + + ISeq + (-first [coll] (first front)) + (-rest [coll] (rest (seq coll))) + + IStack + (-peek [coll] (first front)) + (-pop [coll] + (if front + (if-let [f1 (next front)] + (PersistentQueue. meta (dec count) f1 rear nil) + (PersistentQueue. meta (dec count) (seq rear) [] nil)) + coll)) + + ICollection + (-conj [coll o] + (if front + (PersistentQueue. meta (inc count) front (conj (or rear []) o) nil) + (PersistentQueue. meta (inc count) (conj front o) [] nil))) + + IEmptyableCollection + (-empty [coll] (with-meta (.-EMPTY PersistentQueue) meta)) + + ISequential + IEquiv + (-equiv [coll other] (equiv-sequential coll other)) + + IHash + (-hash [coll] (caching-hash coll hash-ordered-coll __hash)) + + ISeqable + (-seq [coll] + (let [rear (seq rear)] + (if (or front rear) + (PersistentQueueSeq. nil front (seq rear) nil)))) + + ICounted + (-count [coll] count)) + +(set! (.-EMPTY PersistentQueue) (PersistentQueue. nil 0 nil [] empty-ordered-hash)) + +(es6-iterable PersistentQueue) + +(deftype NeverEquiv [] + Object + (equiv [this other] + (-equiv this other)) + IEquiv + (-equiv [o other] false)) + +(def ^:private never-equiv (NeverEquiv.)) + +(defn- ^boolean equiv-map + "Assumes y is a map. Returns true if x equals y, otherwise returns + false." + [x y] + (boolean + (when (map? y) + ; assume all maps are counted + (when (== (count x) (count y)) + (every? (fn [xkv] (= (get y (first xkv) never-equiv) + (second xkv))) + x))))) + + +(defn- scan-array [incr k array] + (let [len (alength array)] + (loop [i 0] + (when (< i len) + (if (identical? k (aget array i)) + i + (recur (+ i incr))))))) + +; The keys field is an array of all keys of this map, in no particular +; order. Any string, keyword, or symbol key is used as a property name +; to store the value in strobj. If a key is assoc'ed when that same +; key already exists in strobj, the old value is overwritten. If a +; non-string key is assoc'ed, return a HashMap object instead. + +(defn- obj-map-compare-keys [a b] + (let [a (hash a) + b (hash b)] + (cond + (< a b) -1 + (> a b) 1 + :else 0))) + +(defn- obj-map->hash-map [m k v] + (let [ks (.-keys m) + len (alength ks) + so (.-strobj m) + mm (meta m)] + (loop [i 0 + 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))))) + +;;; ObjMap - DEPRECATED + +(defn- obj-clone [obj ks] + (let [new-obj (js-obj) + l (alength ks)] + (loop [i 0] + (when (< i l) + (let [k (aget ks i)] + (aset new-obj k (aget obj k)) + (recur (inc i))))) + new-obj)) + +(deftype ObjMap [meta keys strobj update-count ^:mutable __hash] + Object + (toString [coll] + (pr-str* coll)) + (equiv [this other] + (-equiv this other)) + + IWithMeta + (-with-meta [coll meta] (ObjMap. meta keys strobj update-count __hash)) + + IMeta + (-meta [coll] meta) + + ICollection + (-conj [coll entry] + (if (vector? entry) + (-assoc coll (-nth entry 0) (-nth entry 1)) + (reduce -conj + coll + entry))) + + IEmptyableCollection + (-empty [coll] (with-meta (.-EMPTY ObjMap) meta)) + + IEquiv + (-equiv [coll other] (equiv-map coll other)) + + IHash + (-hash [coll] (caching-hash coll hash-unordered-coll __hash)) + + ISeqable + (-seq [coll] + (when (pos? (alength keys)) + (map #(vector % (aget strobj %)) + (.sort keys obj-map-compare-keys)))) + + ICounted + (-count [coll] (alength keys)) + + ILookup + (-lookup [coll k] (-lookup coll k nil)) + (-lookup [coll k not-found] + (if (and ^boolean (goog/isString k) + (not (nil? (scan-array 1 k keys)))) + (aget strobj k) + not-found)) + + IAssociative + (-assoc [coll k v] + (if ^boolean (goog/isString k) + (if (or (> update-count (.-HASHMAP_THRESHOLD ObjMap)) + (>= (alength keys) (.-HASHMAP_THRESHOLD ObjMap))) + (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) + (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) + (.push new-keys k) + (ObjMap. meta new-keys new-strobj (inc update-count) nil)))) + ;; non-string key. game over. + (obj-map->hash-map coll k v))) + (-contains-key? [coll k] + (if (and ^boolean (goog/isString k) + (not (nil? (scan-array 1 k keys)))) + true + false)) + + IKVReduce + (-kv-reduce [coll f init] + (let [len (alength keys)] + (loop [keys (.sort keys obj-map-compare-keys) + init init] + (if (seq keys) + (let [k (first keys) + init (f init k (aget strobj k))] + (if (reduced? init) + @init + (recur (rest keys) init))) + init)))) + + IMap + (-dissoc [coll k] + (if (and ^boolean (goog/isString k) + (not (nil? (scan-array 1 k keys)))) + (let [new-keys (aclone keys) + new-strobj (obj-clone strobj keys)] + (.splice new-keys (scan-array 1 k new-keys) 1) + (js-delete new-strobj k) + (ObjMap. meta new-keys new-strobj (inc update-count) nil)) + coll)) ; key not found, return coll unchanged + + IFn + (-invoke [coll k] + (-lookup coll k)) + (-invoke [coll k not-found] + (-lookup coll k not-found)) + + IEditableCollection + (-as-transient [coll] + (transient (into (hash-map) coll)))) + +(set! (.-EMPTY ObjMap) (ObjMap. nil (array) (js-obj) 0 empty-unordered-hash)) + +(set! (.-HASHMAP_THRESHOLD ObjMap) 8) + +(set! (.-fromObject ObjMap) (fn [ks obj] (ObjMap. nil ks obj 0 nil))) + +;; Record Iterator +(deftype RecordIter [^:mutable i record base-count fields ext-map-iter] + Object + (hasNext [_] + (or (< i base-count) (.hasNext ext-map-iter))) + (next [_] + (if (< i base-count) + (let [k (nth fields i)] + (set! i (inc i)) + [k (-lookup record k)]) + (.next ext-map-iter))) + (remove [_] (js/Error. "Unsupported operation"))) + +;; EXPERIMENTAL: subject to change +(deftype ES6EntriesIterator [^:mutable s] + Object + (next [_] + (if-not (nil? s) + (let [[k v] (first s)] + (set! s (next s)) + #js {:value #js [k v] :done false}) + #js {:value nil :done true}))) + +(defn es6-entries-iterator [coll] + (ES6EntriesIterator. (seq coll))) + +;; EXPERIMENTAL: subject to change +(deftype ES6SetEntriesIterator [^:mutable s] + Object + (next [_] + (if-not (nil? s) + (let [x (first s)] + (set! s (next s)) + #js {:value #js [x x] :done false}) + #js {:value nil :done true}))) + +(defn es6-set-entries-iterator [coll] + (ES6SetEntriesIterator. (seq coll))) + +;;; PersistentArrayMap + +(defn- array-index-of-nil? [arr] + (let [len (alength arr)] + (loop [i 0] + (cond + (<= len i) -1 + (nil? (aget arr i)) i + :else (recur (+ i 2)))))) + +(defn- array-index-of-keyword? [arr k] + (let [len (alength arr) + kstr (.-fqn k)] + (loop [i 0] + (cond + (<= len i) -1 + (and (keyword? (aget arr i)) + (identical? kstr (.-fqn (aget arr i)))) i + :else (recur (+ i 2)))))) + +(defn- array-index-of-symbol? [arr k] + (let [len (alength arr) + kstr (.-str k)] + (loop [i 0] + (cond + (<= len i) -1 + (and (symbol? (aget arr i)) + (identical? kstr (.-str (aget arr i)))) i + :else (recur (+ i 2)))))) + +(defn- array-index-of-identical? [arr k] + (let [len (alength arr)] + (loop [i 0] + (cond + (<= len i) -1 + (identical? k (aget arr i)) i + :else (recur (+ i 2)))))) + +(defn- array-index-of-equiv? [arr k] + (let [len (alength arr)] + (loop [i 0] + (cond + (<= len i) -1 + (= k (aget arr i)) i + :else (recur (+ i 2)))))) + +(defn array-index-of [arr k] + (cond + (keyword? k) (array-index-of-keyword? arr k) + + (or ^boolean (goog/isString k) (number? k)) + (array-index-of-identical? arr k) + + (symbol? k) (array-index-of-symbol? arr k) + + (nil? k) + (array-index-of-nil? arr) + + :else (array-index-of-equiv? arr k))) + +(defn- array-map-index-of [m k] + (array-index-of (.-arr m) k)) + +(defn- array-extend-kv [arr k v] + (let [l (alength arr) + narr (make-array (+ l 2))] + (loop [i 0] + (when (< i l) + (aset narr i (aget arr i)) + (recur (inc i)))) + (aset narr l k) + (aset narr (inc l) v) + narr)) + +(defn- array-map-extend-kv [m k v] + (array-extend-kv (.-arr m) k v)) + +(declare TransientArrayMap) + +(deftype PersistentArrayMapSeq [arr i _meta] + 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 coll))) + (lastIndexOf [coll x start] + (-lastIndexOf coll x start)) + + IMeta + (-meta [coll] _meta) + + IWithMeta + (-with-meta [coll new-meta] + (PersistentArrayMapSeq. arr i new-meta)) + + ICounted + (-count [coll] + (/ (- (alength arr) i) 2)) + + ISeqable + (-seq [coll] coll) + + ISequential + IEquiv + (-equiv [coll other] (equiv-sequential coll other)) + + ICollection + (-conj [coll o] + (cons o coll)) + + IEmptyableCollection + (-empty [coll] (with-meta (.-EMPTY List) _meta)) + + IHash + (-hash [coll] (hash-ordered-coll coll)) + + ISeq + (-first [coll] + [(aget arr i) (aget arr (inc i))]) + + (-rest [coll] + (if (< i (- (alength arr) 2)) + (PersistentArrayMapSeq. arr (+ i 2) _meta) + ())) + + INext + (-next [coll] + (when (< i (- (alength arr) 2)) + (PersistentArrayMapSeq. arr (+ i 2) _meta))) + + IReduce + (-reduce [coll f] (seq-reduce f coll)) + (-reduce [coll f start] (seq-reduce f start coll))) + +(es6-iterable PersistentArrayMapSeq) + +(defn persistent-array-map-seq [arr i _meta] + (when (<= i (- (alength arr) 2)) + (PersistentArrayMapSeq. arr i _meta))) + +(declare keys vals) + +(deftype PersistentArrayMapIterator [arr ^:mutable i cnt] + Object + (hasNext [_] + (< i cnt)) + (next [_] + (let [ret [(aget arr i) (aget arr (inc i))]] + (set! i (+ i 2)) + ret))) + +(deftype PersistentArrayMap [meta cnt arr ^:mutable __hash] + Object + (toString [coll] + (pr-str* coll)) + (equiv [this other] + (-equiv this other)) + + ;; EXPERIMENTAL: subject to change + (keys [coll] + (es6-iterator (keys coll))) + (entries [coll] + (es6-entries-iterator (seq coll))) + (values [coll] + (es6-iterator (vals coll))) + (has [coll k] + (contains? coll k)) + (get [coll k not-found] + (-lookup coll k not-found)) + (forEach [coll f] + (doseq [[k v] coll] + (f v k))) + + ICloneable + (-clone [_] (PersistentArrayMap. meta cnt arr __hash)) + + IWithMeta + (-with-meta [coll meta] (PersistentArrayMap. meta cnt arr __hash)) + + IMeta + (-meta [coll] meta) + + ICollection + (-conj [coll entry] + (if (vector? entry) + (-assoc coll (-nth entry 0) (-nth entry 1)) + (loop [ret coll es (seq entry)] + (if (nil? es) + ret + (let [e (first es)] + (if (vector? e) + (recur (-assoc ret (-nth e 0) (-nth e 1)) + (next es)) + (throw (js/Error. "conj on a map takes map entries or seqables of map entries")))))))) + + IEmptyableCollection + (-empty [coll] (-with-meta (.-EMPTY PersistentArrayMap) meta)) + + IEquiv + (-equiv [coll other] + (if (implements? IMap other) + (let [alen (alength arr) + ^not-native other other] + (if (== cnt (-count other)) + (loop [i 0] + (if (< i alen) + (let [v (-lookup other (aget arr i) lookup-sentinel)] + (if-not (identical? v lookup-sentinel) + (if (= (aget arr (inc i)) v) + (recur (+ i 2)) + false) + false)) + true)) + false)) + (equiv-map coll other))) + + IHash + (-hash [coll] (caching-hash coll hash-unordered-coll __hash)) + + IIterable + (-iterator [this] + (PersistentArrayMapIterator. arr 0 (* cnt 2))) + + ISeqable + (-seq [coll] + (persistent-array-map-seq arr 0 nil)) + + ICounted + (-count [coll] cnt) + + ILookup + (-lookup [coll k] + (-lookup coll k nil)) + + (-lookup [coll k not-found] + (let [idx (array-map-index-of coll k)] + (if (== idx -1) + not-found + (aget arr (inc idx))))) + + IAssociative + (-assoc [coll k v] + (let [idx (array-map-index-of coll k)] + (cond + (== idx -1) + (if (< cnt (.-HASHMAP-THRESHOLD PersistentArrayMap)) + (let [arr (array-map-extend-kv coll k v)] + (PersistentArrayMap. meta (inc cnt) arr nil)) + (-> (into (.-EMPTY PersistentHashMap) coll) + (-assoc k v) + (-with-meta meta))) + + (identical? v (aget arr (inc idx))) + coll + + :else + (let [arr (doto (aclone arr) + (aset (inc idx) v))] + (PersistentArrayMap. meta cnt arr nil))))) + + (-contains-key? [coll k] + (not (== (array-map-index-of coll k) -1))) + + IMap + (-dissoc [coll k] + (let [idx (array-map-index-of coll k)] + (if (>= idx 0) + (let [len (alength arr) + new-len (- len 2)] + (if (zero? new-len) + (-empty coll) + (let [new-arr (make-array new-len)] + (loop [s 0 d 0] + (cond + (>= s len) (PersistentArrayMap. meta (dec cnt) new-arr nil) + (= k (aget arr s)) (recur (+ s 2) d) + :else (do (aset new-arr d (aget arr s)) + (aset new-arr (inc d) (aget arr (inc s))) + (recur (+ s 2) (+ d 2)))))))) + coll))) + + IKVReduce + (-kv-reduce [coll f init] + (let [len (alength arr)] + (loop [i 0 init init] + (if (< i len) + (let [init (f init (aget arr i) (aget arr (inc i)))] + (if (reduced? init) + @init + (recur (+ i 2) init))) + init)))) + + IReduce + (-reduce [coll f] + (seq-reduce f coll)) + (-reduce [coll f start] + (seq-reduce f start coll)) + + IFn + (-invoke [coll k] + (-lookup coll k)) + + (-invoke [coll k not-found] + (-lookup coll k not-found)) + + IEditableCollection + (-as-transient [coll] + (TransientArrayMap. (js-obj) (alength arr) (aclone arr)))) + +(set! (.-EMPTY PersistentArrayMap) (PersistentArrayMap. nil 0 (array) empty-unordered-hash)) + +(set! (.-HASHMAP-THRESHOLD PersistentArrayMap) 8) + +(set! (.-fromArray PersistentArrayMap) + (fn [arr ^boolean no-clone ^boolean no-check] + (as-> (if no-clone arr (aclone arr)) arr + (if no-check + arr + (let [ret (array)] + (loop [i 0] + (when (< i (alength arr)) + (let [k (aget arr i) + v (aget arr (inc i)) + idx (array-index-of ret k)] + (when (== idx -1) + (.push ret k) + (.push ret v))) + (recur (+ i 2)))) + ret)) + (let [cnt (/ (alength arr) 2)] + (PersistentArrayMap. nil cnt arr nil))))) + +(set! (.-createWithCheck PersistentArrayMap) + (fn [arr] + (let [ret (array)] + (loop [i 0] + (when (< i (alength arr)) + (let [k (aget arr i) + v (aget arr (inc i)) + idx (array-index-of ret k)] + (if (== idx -1) + (doto ret (.push k) (.push v)) + (throw (js/Error. (str "Duplicate key: " k))))) + (recur (+ i 2)))) + (let [cnt (/ (alength arr) 2)] + (PersistentArrayMap. nil cnt arr nil))))) + +(set! (.-createAsIfByAssoc PersistentArrayMap) + (fn [arr] + (let [ret (array)] + (loop [i 0] + (when (< i (alength arr)) + (let [k (aget arr i) + v (aget arr (inc i)) + idx (array-index-of ret k)] + (if (== idx -1) + (doto ret (.push k) (.push v)) + (aset ret (inc idx) v))) + (recur (+ i 2)))) + (PersistentArrayMap. nil (/ (alength ret) 2) ret nil)))) + +(es6-iterable PersistentArrayMap) + +(declare array->transient-hash-map) + +(deftype TransientArrayMap [^:mutable editable? + ^:mutable len + arr] + ICounted + (-count [tcoll] + (if editable? + (quot len 2) + (throw (js/Error. "count after persistent!")))) + + ILookup + (-lookup [tcoll k] + (-lookup tcoll k nil)) + + (-lookup [tcoll k not-found] + (if editable? + (let [idx (array-map-index-of tcoll k)] + (if (== idx -1) + not-found + (aget arr (inc idx)))) + (throw (js/Error. "lookup after persistent!")))) + + ITransientCollection + (-conj! [tcoll o] + (if editable? + (if (satisfies? IMapEntry o) + (-assoc! tcoll (key o) (val o)) + (loop [es (seq o) tcoll tcoll] + (if-let [e (first es)] + (recur (next es) + (-assoc! tcoll (key e) (val e))) + tcoll))) + (throw (js/Error. "conj! after persistent!")))) + + (-persistent! [tcoll] + (if editable? + (do (set! editable? false) + (PersistentArrayMap. nil (quot len 2) arr nil)) + (throw (js/Error. "persistent! called twice")))) + + ITransientAssociative + (-assoc! [tcoll key val] + (if editable? + (let [idx (array-map-index-of tcoll key)] + (if (== idx -1) + (if (<= (+ len 2) (* 2 (.-HASHMAP-THRESHOLD PersistentArrayMap))) + (do (set! len (+ len 2)) + (.push arr key) + (.push arr val) + tcoll) + (assoc! (array->transient-hash-map len arr) key val)) + (if (identical? val (aget arr (inc idx))) + tcoll + (do (aset arr (inc idx) val) + tcoll)))) + (throw (js/Error. "assoc! after persistent!")))) + + ITransientMap + (-dissoc! [tcoll key] + (if editable? + (let [idx (array-map-index-of tcoll key)] + (when (>= idx 0) + (aset arr idx (aget arr (- len 2))) + (aset arr (inc idx) (aget arr (dec len))) + (doto arr .pop .pop) + (set! len (- len 2))) + tcoll) + (throw (js/Error. "dissoc! after persistent!"))))) + +(declare TransientHashMap PersistentHashMap) + +(defn- array->transient-hash-map [len arr] + (loop [out (transient (.-EMPTY PersistentHashMap)) + i 0] + (if (< i len) + (recur (assoc! out (aget arr i) (aget arr (inc i))) (+ i 2)) + out))) + +;;; PersistentHashMap + +(deftype Box [^:mutable val]) + +(declare create-inode-seq create-array-node-seq reset! create-node atom deref) + +(defn ^boolean key-test [key other] + (cond + (identical? key other) true + (keyword-identical? key other) true + :else (= key other))) + +(defn- mask [hash shift] + (bit-and (bit-shift-right-zero-fill hash shift) 0x01f)) + +(defn- clone-and-set + ([arr i a] + (doto (aclone arr) + (aset i a))) + ([arr i a j b] + (doto (aclone arr) + (aset i a) + (aset j b)))) + +(defn- remove-pair [arr i] + (let [new-arr (make-array (- (alength arr) 2))] + (array-copy arr 0 new-arr 0 (* 2 i)) + (array-copy arr (* 2 (inc i)) new-arr (* 2 i) (- (alength new-arr) (* 2 i))) + new-arr)) + +(defn- bitmap-indexed-node-index [bitmap bit] + (bit-count (bit-and bitmap (dec bit)))) + +(defn- bitpos [hash shift] + (bit-shift-left 1 (mask hash shift))) + +(defn- edit-and-set + ([inode edit i a] + (let [editable (.ensure-editable inode edit)] + (aset (.-arr editable) i a) + editable)) + ([inode edit i a j b] + (let [editable (.ensure-editable inode edit)] + (aset (.-arr editable) i a) + (aset (.-arr editable) j b) + editable))) + +(defn- inode-kv-reduce [arr f init] + (let [len (alength arr)] + (loop [i 0 init init] + (if (< i len) + (let [init (let [k (aget arr i)] + (if-not (nil? k) + (f init k (aget arr (inc i))) + (let [node (aget arr (inc i))] + (if-not (nil? node) + (.kv-reduce node f init) + init))))] + (if (reduced? init) + @init + (recur (+ i 2) init))) + init)))) + +(declare ArrayNode) + + (deftype NodeIterator [arr ^:mutable i ^:mutable next-entry ^:mutable next-iter] + Object + (advance [this] + (let [len (alength arr)] + (loop [] + (if (< i len) + (let [key (aget arr i) + node-or-val (aget arr (inc i)) + ^boolean found + (cond (some? key) + (set! next-entry [key node-or-val]) + (some? node-or-val) + (let [new-iter (-iterator node-or-val)] + (if ^boolean (.hasNext new-iter) + (set! next-iter new-iter) + false)) + :else false)] + (set! i (+ i 2)) + (if found true (recur))) + false)))) + (hasNext [this] + (or (some? next-entry) (some? next-iter) (.advance this))) + (next [this] + (cond + (some? next-entry) + (let [ret next-entry] + (set! next-entry nil) + ret) + (some? next-iter) + (let [ret (.next next-iter)] + (when-not ^boolean (.hasNext next-iter) + (set! next-iter nil)) + ret) + ^boolean (.advance this) + (.next this) + :else (throw (js/Error. "No such element")))) + (remove [_] (js/Error. "Unsupported operation"))) + +(deftype BitmapIndexedNode [edit ^:mutable bitmap ^:mutable arr] + Object + (inode-assoc [inode shift hash key val added-leaf?] + (let [bit (bitpos hash shift) + idx (bitmap-indexed-node-index bitmap bit)] + (if (zero? (bit-and bitmap bit)) + (let [n (bit-count bitmap)] + (if (>= n 16) + (let [nodes (make-array 32) + jdx (mask hash shift)] + (aset nodes jdx (.inode-assoc (.-EMPTY BitmapIndexedNode) (+ shift 5) hash key val added-leaf?)) + (loop [i 0 j 0] + (if (< i 32) + (if (zero? (bit-and (bit-shift-right-zero-fill bitmap i) 1)) + (recur (inc i) j) + (do (aset nodes i + (if-not (nil? (aget arr j)) + (.inode-assoc (.-EMPTY BitmapIndexedNode) + (+ shift 5) (cljs.core/hash (aget arr j)) (aget arr j) (aget arr (inc j)) added-leaf?) + (aget arr (inc j)))) + (recur (inc i) (+ j 2)))))) + (ArrayNode. nil (inc n) nodes)) + (let [new-arr (make-array (* 2 (inc n)))] + (array-copy arr 0 new-arr 0 (* 2 idx)) + (aset new-arr (* 2 idx) key) + (aset new-arr (inc (* 2 idx)) val) + (array-copy arr (* 2 idx) new-arr (* 2 (inc idx)) (* 2 (- n idx))) + (set! (.-val added-leaf?) true) + (BitmapIndexedNode. nil (bit-or bitmap bit) new-arr)))) + (let [key-or-nil (aget arr (* 2 idx)) + val-or-node (aget arr (inc (* 2 idx)))] + (cond (nil? key-or-nil) + (let [n (.inode-assoc val-or-node (+ shift 5) hash key val added-leaf?)] + (if (identical? n val-or-node) + inode + (BitmapIndexedNode. nil bitmap (clone-and-set arr (inc (* 2 idx)) n)))) + + (key-test key key-or-nil) + (if (identical? val val-or-node) + inode + (BitmapIndexedNode. nil bitmap (clone-and-set arr (inc (* 2 idx)) val))) + + :else + (do (set! (.-val added-leaf?) true) + (BitmapIndexedNode. nil bitmap + (clone-and-set arr (* 2 idx) nil (inc (* 2 idx)) + (create-node (+ shift 5) key-or-nil val-or-node hash key val))))))))) + + (inode-without [inode shift hash key] + (let [bit (bitpos hash shift)] + (if (zero? (bit-and bitmap bit)) + inode + (let [idx (bitmap-indexed-node-index bitmap bit) + key-or-nil (aget arr (* 2 idx)) + val-or-node (aget arr (inc (* 2 idx)))] + (cond (nil? key-or-nil) + (let [n (.inode-without val-or-node (+ shift 5) hash key)] + (cond (identical? n val-or-node) inode + (not (nil? n)) (BitmapIndexedNode. nil bitmap (clone-and-set arr (inc (* 2 idx)) n)) + (== bitmap bit) nil + :else (BitmapIndexedNode. nil (bit-xor bitmap bit) (remove-pair arr idx)))) + (key-test key key-or-nil) + (BitmapIndexedNode. nil (bit-xor bitmap bit) (remove-pair arr idx)) + :else inode))))) + + (inode-lookup [inode shift hash key not-found] + (let [bit (bitpos hash shift)] + (if (zero? (bit-and bitmap bit)) + not-found + (let [idx (bitmap-indexed-node-index bitmap bit) + key-or-nil (aget arr (* 2 idx)) + val-or-node (aget arr (inc (* 2 idx)))] + (cond (nil? key-or-nil) (.inode-lookup val-or-node (+ shift 5) hash key not-found) + (key-test key key-or-nil) val-or-node + :else not-found))))) + + (inode-find [inode shift hash key not-found] + (let [bit (bitpos hash shift)] + (if (zero? (bit-and bitmap bit)) + not-found + (let [idx (bitmap-indexed-node-index bitmap bit) + 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] + :else not-found))))) + + (inode-seq [inode] + (create-inode-seq arr)) + + (ensure-editable [inode e] + (if (identical? e edit) + inode + (let [n (bit-count bitmap) + new-arr (make-array (if (neg? n) 4 (* 2 (inc n))))] + (array-copy arr 0 new-arr 0 (* 2 n)) + (BitmapIndexedNode. e bitmap new-arr)))) + + (edit-and-remove-pair [inode e bit i] + (if (== bitmap bit) + nil + (let [editable (.ensure-editable inode e) + earr (.-arr editable) + len (alength earr)] + (set! (.-bitmap editable) (bit-xor bit (.-bitmap editable))) + (array-copy earr (* 2 (inc i)) + earr (* 2 i) + (- len (* 2 (inc i)))) + (aset earr (- len 2) nil) + (aset earr (dec len) nil) + editable))) + + (inode-assoc! [inode edit shift hash key val added-leaf?] + (let [bit (bitpos hash shift) + idx (bitmap-indexed-node-index bitmap bit)] + (if (zero? (bit-and bitmap bit)) + (let [n (bit-count bitmap)] + (cond + (< (* 2 n) (alength arr)) + (let [editable (.ensure-editable inode edit) + earr (.-arr editable)] + (set! (.-val added-leaf?) true) + (array-copy-downward earr (* 2 idx) + earr (* 2 (inc idx)) + (* 2 (- n idx))) + (aset earr (* 2 idx) key) + (aset earr (inc (* 2 idx)) val) + (set! (.-bitmap editable) (bit-or (.-bitmap editable) bit)) + editable) + + (>= n 16) + (let [nodes (make-array 32) + jdx (mask hash shift)] + (aset nodes jdx (.inode-assoc! (.-EMPTY BitmapIndexedNode) edit (+ shift 5) hash key val added-leaf?)) + (loop [i 0 j 0] + (if (< i 32) + (if (zero? (bit-and (bit-shift-right-zero-fill bitmap i) 1)) + (recur (inc i) j) + (do (aset nodes i + (if-not (nil? (aget arr j)) + (.inode-assoc! (.-EMPTY BitmapIndexedNode) + edit (+ shift 5) (cljs.core/hash (aget arr j)) (aget arr j) (aget arr (inc j)) added-leaf?) + (aget arr (inc j)))) + (recur (inc i) (+ j 2)))))) + (ArrayNode. edit (inc n) nodes)) + + :else + (let [new-arr (make-array (* 2 (+ n 4)))] + (array-copy arr 0 new-arr 0 (* 2 idx)) + (aset new-arr (* 2 idx) key) + (aset new-arr (inc (* 2 idx)) val) + (array-copy arr (* 2 idx) new-arr (* 2 (inc idx)) (* 2 (- n idx))) + (set! (.-val added-leaf?) true) + (let [editable (.ensure-editable inode edit)] + (set! (.-arr editable) new-arr) + (set! (.-bitmap editable) (bit-or (.-bitmap editable) bit)) + editable)))) + (let [key-or-nil (aget arr (* 2 idx)) + val-or-node (aget arr (inc (* 2 idx)))] + (cond (nil? key-or-nil) + (let [n (.inode-assoc! val-or-node edit (+ shift 5) hash key val added-leaf?)] + (if (identical? n val-or-node) + inode + (edit-and-set inode edit (inc (* 2 idx)) n))) + + (key-test key key-or-nil) + (if (identical? val val-or-node) + inode + (edit-and-set inode edit (inc (* 2 idx)) val)) + + :else + (do (set! (.-val added-leaf?) true) + (edit-and-set inode edit (* 2 idx) nil (inc (* 2 idx)) + (create-node edit (+ shift 5) key-or-nil val-or-node hash key val)))))))) + + (inode-without! [inode edit shift hash key removed-leaf?] + (let [bit (bitpos hash shift)] + (if (zero? (bit-and bitmap bit)) + inode + (let [idx (bitmap-indexed-node-index bitmap bit) + key-or-nil (aget arr (* 2 idx)) + val-or-node (aget arr (inc (* 2 idx)))] + (cond (nil? key-or-nil) + (let [n (.inode-without! val-or-node edit (+ shift 5) hash key removed-leaf?)] + (cond (identical? n val-or-node) inode + (not (nil? n)) (edit-and-set inode edit (inc (* 2 idx)) n) + (== bitmap bit) nil + :else (.edit-and-remove-pair inode edit bit idx))) + (key-test key key-or-nil) + (do (aset removed-leaf? 0 true) + (.edit-and-remove-pair inode edit bit idx)) + :else inode))))) + + (kv-reduce [inode f init] + (inode-kv-reduce arr f init)) + + IIterable + (-iterator [coll] + (NodeIterator. arr 0 nil nil))) + +(set! (.-EMPTY BitmapIndexedNode) (BitmapIndexedNode. nil 0 (make-array 0))) + +(defn- pack-array-node [array-node edit idx] + (let [arr (.-arr array-node) + len (alength arr) + new-arr (make-array (* 2 (dec (.-cnt array-node))))] + (loop [i 0 j 1 bitmap 0] + (if (< i len) + (if (and (not (== i idx)) + (not (nil? (aget arr i)))) + (do (aset new-arr j (aget arr i)) + (recur (inc i) (+ j 2) (bit-or bitmap (bit-shift-left 1 i)))) + (recur (inc i) j bitmap)) + (BitmapIndexedNode. edit bitmap new-arr))))) + +(deftype ArrayNodeIterator [arr ^:mutable i ^:mutable next-iter] + Object + (hasNext [this] + (let [len (alength arr)] + (loop [] + (if-not (and (some? next-iter) ^boolean (.hasNext next-iter)) + (if (< i len) + (let [node (aget arr i)] + (set! i (inc i)) + (when (some? node) + (set! next-iter (-iterator node))) + (recur)) + false) + true)))) + (next [this] + (if ^boolean (.hasNext this) + (.next next-iter) + (throw (js/Error. "No such element")))) + (remove [_] (js/Error. "Unsupported operation"))) + +(deftype ArrayNode [edit ^:mutable cnt ^:mutable arr] + Object + (inode-assoc [inode shift hash key val added-leaf?] + (let [idx (mask hash shift) + node (aget arr idx)] + (if (nil? node) + (ArrayNode. nil (inc cnt) (clone-and-set arr idx (.inode-assoc (.-EMPTY BitmapIndexedNode) (+ shift 5) hash key val added-leaf?))) + (let [n (.inode-assoc node (+ shift 5) hash key val added-leaf?)] + (if (identical? n node) + inode + (ArrayNode. nil cnt (clone-and-set arr idx n))))))) + + (inode-without [inode shift hash key] + (let [idx (mask hash shift) + node (aget arr idx)] + (if-not (nil? node) + (let [n (.inode-without node (+ shift 5) hash key)] + (cond + (identical? n node) + inode + + (nil? n) + (if (<= cnt 8) + (pack-array-node inode nil idx) + (ArrayNode. nil (dec cnt) (clone-and-set arr idx n))) + + :else + (ArrayNode. nil cnt (clone-and-set arr idx n)))) + inode))) + + (inode-lookup [inode shift hash key not-found] + (let [idx (mask hash shift) + node (aget arr idx)] + (if-not (nil? node) + (.inode-lookup node (+ shift 5) hash key not-found) + not-found))) + + (inode-find [inode shift hash key not-found] + (let [idx (mask hash shift) + node (aget arr idx)] + (if-not (nil? node) + (.inode-find node (+ shift 5) hash key not-found) + not-found))) + + (inode-seq [inode] + (create-array-node-seq arr)) + + (ensure-editable [inode e] + (if (identical? e edit) + inode + (ArrayNode. e cnt (aclone arr)))) + + (inode-assoc! [inode edit shift hash key val added-leaf?] + (let [idx (mask hash shift) + node (aget arr idx)] + (if (nil? node) + (let [editable (edit-and-set inode edit idx (.inode-assoc! (.-EMPTY BitmapIndexedNode) edit (+ shift 5) hash key val added-leaf?))] + (set! (.-cnt editable) (inc (.-cnt editable))) + editable) + (let [n (.inode-assoc! node edit (+ shift 5) hash key val added-leaf?)] + (if (identical? n node) + inode + (edit-and-set inode edit idx n)))))) + + (inode-without! [inode edit shift hash key removed-leaf?] + (let [idx (mask hash shift) + node (aget arr idx)] + (if (nil? node) + inode + (let [n (.inode-without! node edit (+ shift 5) hash key removed-leaf?)] + (cond + (identical? n node) + inode + + (nil? n) + (if (<= cnt 8) + (pack-array-node inode edit idx) + (let [editable (edit-and-set inode edit idx n)] + (set! (.-cnt editable) (dec (.-cnt editable))) + editable)) + + :else + (edit-and-set inode edit idx n)))))) + + (kv-reduce [inode f init] + (let [len (alength arr)] ; actually 32 + (loop [i 0 init init] + (if (< i len) + (let [node (aget arr i)] + (if-not (nil? node) + (let [init (.kv-reduce node f init)] + (if (reduced? init) + @init + (recur (inc i) init))) + (recur (inc i) init))) + init)))) + + IIterable + (-iterator [coll] + (ArrayNodeIterator. arr 0 nil))) + +(defn- hash-collision-node-find-index [arr cnt key] + (let [lim (* 2 cnt)] + (loop [i 0] + (if (< i lim) + (if (key-test key (aget arr i)) + i + (recur (+ i 2))) + -1)))) + +(deftype HashCollisionNode [edit + ^:mutable collision-hash + ^:mutable cnt + ^:mutable arr] + Object + (inode-assoc [inode shift hash key val added-leaf?] + (if (== hash collision-hash) + (let [idx (hash-collision-node-find-index arr cnt key)] + (if (== idx -1) + (let [len (* 2 cnt) + new-arr (make-array (+ len 2))] + (array-copy arr 0 new-arr 0 len) + (aset new-arr len key) + (aset new-arr (inc len) val) + (set! (.-val added-leaf?) true) + (HashCollisionNode. nil collision-hash (inc cnt) new-arr)) + (if (= (aget arr (inc idx)) val) + inode + (HashCollisionNode. nil collision-hash cnt (clone-and-set arr (inc idx) val))))) + (.inode-assoc (BitmapIndexedNode. nil (bitpos collision-hash shift) (array nil inode)) + shift hash key val added-leaf?))) + + (inode-without [inode shift hash key] + (let [idx (hash-collision-node-find-index arr cnt key)] + (cond (== idx -1) inode + (== cnt 1) nil + :else (HashCollisionNode. nil collision-hash (dec cnt) (remove-pair arr (quot idx 2)))))) + + (inode-lookup [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 (inc idx)) + :else not-found))) + + (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))] + :else not-found))) + + (inode-seq [inode] + (create-inode-seq arr)) + + (ensure-editable [inode e] + (if (identical? e edit) + inode + (let [new-arr (make-array (* 2 (inc cnt)))] + (array-copy arr 0 new-arr 0 (* 2 cnt)) + (HashCollisionNode. e collision-hash cnt new-arr)))) + + (ensure-editable-array [inode e count array] + (if (identical? e edit) + (do (set! arr array) + (set! cnt count) + inode) + (HashCollisionNode. edit collision-hash count array))) + + (inode-assoc! [inode edit shift hash key val added-leaf?] + (if (== hash collision-hash) + (let [idx (hash-collision-node-find-index arr cnt key)] + (if (== idx -1) + (if (> (alength arr) (* 2 cnt)) + (let [editable (edit-and-set inode edit (* 2 cnt) key (inc (* 2 cnt)) val)] + (set! (.-val added-leaf?) true) + (set! (.-cnt editable) (inc (.-cnt editable))) + editable) + (let [len (alength arr) + new-arr (make-array (+ len 2))] + (array-copy arr 0 new-arr 0 len) + (aset new-arr len key) + (aset new-arr (inc len) val) + (set! (.-val added-leaf?) true) + (.ensure-editable-array inode edit (inc cnt) new-arr))) + (if (identical? (aget arr (inc idx)) val) + inode + (edit-and-set inode edit (inc idx) val)))) + (.inode-assoc! (BitmapIndexedNode. edit (bitpos collision-hash shift) (array nil inode nil nil)) + edit shift hash key val added-leaf?))) + + (inode-without! [inode edit shift hash key removed-leaf?] + (let [idx (hash-collision-node-find-index arr cnt key)] + (if (== idx -1) + inode + (do (aset removed-leaf? 0 true) + (if (== cnt 1) + nil + (let [editable (.ensure-editable inode edit) + earr (.-arr editable)] + (aset earr idx (aget earr (- (* 2 cnt) 2))) + (aset earr (inc idx) (aget earr (dec (* 2 cnt)))) + (aset earr (dec (* 2 cnt)) nil) + (aset earr (- (* 2 cnt) 2) nil) + (set! (.-cnt editable) (dec (.-cnt editable))) + editable)))))) + + (kv-reduce [inode f init] + (inode-kv-reduce arr f init)) + + IIterable + (-iterator [coll] + (NodeIterator. arr 0 nil nil))) + +(defn- create-node + ([shift key1 val1 key2hash key2 val2] + (let [key1hash (hash key1)] + (if (== key1hash key2hash) + (HashCollisionNode. nil key1hash 2 (array key1 val1 key2 val2)) + (let [added-leaf? (Box. false)] + (-> (.-EMPTY BitmapIndexedNode) + (.inode-assoc shift key1hash key1 val1 added-leaf?) + (.inode-assoc shift key2hash key2 val2 added-leaf?)))))) + ([edit shift key1 val1 key2hash key2 val2] + (let [key1hash (hash key1)] + (if (== key1hash key2hash) + (HashCollisionNode. nil key1hash 2 (array key1 val1 key2 val2)) + (let [added-leaf? (Box. false)] + (-> (.-EMPTY BitmapIndexedNode) + (.inode-assoc! edit shift key1hash key1 val1 added-leaf?) + (.inode-assoc! edit shift key2hash key2 val2 added-leaf?))))))) + +(deftype NodeSeq [meta nodes i s ^: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 coll))) + (lastIndexOf [coll x start] + (-lastIndexOf coll x start)) + + IMeta + (-meta [coll] meta) + + IWithMeta + (-with-meta [coll meta] (NodeSeq. meta nodes i s __hash)) + + ICollection + (-conj [coll o] (cons o coll)) + + IEmptyableCollection + (-empty [coll] (with-meta (.-EMPTY List) meta)) + + ISequential + ISeq + (-first [coll] + (if (nil? s) + [(aget nodes i) (aget nodes (inc i))] + (first s))) + + (-rest [coll] + (let [ret (if (nil? s) + (create-inode-seq nodes (+ i 2) nil) + (create-inode-seq nodes i (next s)))] + (if-not (nil? ret) ret ()))) + + ISeqable + (-seq [this] this) + + IEquiv + (-equiv [coll other] (equiv-sequential coll other)) + + IHash + (-hash [coll] (caching-hash coll hash-ordered-coll __hash)) + + IReduce + (-reduce [coll f] (seq-reduce f coll)) + (-reduce [coll f start] (seq-reduce f start coll))) + +(es6-iterable NodeSeq) + +(defn- create-inode-seq + ([nodes] + (create-inode-seq nodes 0 nil)) + ([nodes i s] + (if (nil? s) + (let [len (alength nodes)] + (loop [j i] + (if (< j len) + (if-not (nil? (aget nodes j)) + (NodeSeq. nil nodes j nil nil) + (if-let [node (aget nodes (inc j))] + (if-let [node-seq (.inode-seq node)] + (NodeSeq. nil nodes (+ j 2) node-seq nil) + (recur (+ j 2))) + (recur (+ j 2))))))) + (NodeSeq. nil nodes i s nil)))) + +(deftype ArrayNodeSeq [meta nodes i s ^: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 coll))) + (lastIndexOf [coll x start] + (-lastIndexOf coll x start)) + + IMeta + (-meta [coll] meta) + + IWithMeta + (-with-meta [coll meta] (ArrayNodeSeq. meta nodes i s __hash)) + + ICollection + (-conj [coll o] (cons o coll)) + + IEmptyableCollection + (-empty [coll] (with-meta (.-EMPTY List) meta)) + + ISequential + ISeq + (-first [coll] (first s)) + (-rest [coll] + (let [ret (create-array-node-seq nil nodes i (next s))] + (if-not (nil? ret) ret ()))) + + ISeqable + (-seq [this] this) + + IEquiv + (-equiv [coll other] (equiv-sequential coll other)) + + IHash + (-hash [coll] (caching-hash coll hash-ordered-coll __hash)) + + IReduce + (-reduce [coll f] (seq-reduce f coll)) + (-reduce [coll f start] (seq-reduce f start coll))) + +(es6-iterable ArrayNodeSeq) + +(defn- create-array-node-seq + ([nodes] (create-array-node-seq nil nodes 0 nil)) + ([meta nodes i s] + (if (nil? s) + (let [len (alength nodes)] + (loop [j i] + (if (< j len) + (if-let [nj (aget nodes j)] + (if-let [ns (.inode-seq nj)] + (ArrayNodeSeq. meta nodes (inc j) ns nil) + (recur (inc j))) + (recur (inc j)))))) + (ArrayNodeSeq. meta nodes i s nil)))) + +(declare TransientHashMap) + +(deftype HashMapIter [nil-val root-iter ^:mutable seen] + Object + (hasNext [_] + (or (not ^boolean seen) ^boolean (.hasNext root-iter))) + (next [_] + (if-not ^boolean seen + (do + (set! seen true) + [nil nil-val]) + (.next root-iter))) + (remove [_] (js/Error. "Unsupported operation"))) + +(deftype PersistentHashMap [meta cnt root ^boolean has-nil? nil-val ^:mutable __hash] + Object + (toString [coll] + (pr-str* coll)) + (equiv [this other] + (-equiv this other)) + + ;; EXPERIMENTAL: subject to change + (keys [coll] + (es6-iterator (keys coll))) + (entries [coll] + (es6-entries-iterator (seq coll))) + (values [coll] + (es6-iterator (vals coll))) + (has [coll k] + (contains? coll k)) + (get [coll k not-found] + (-lookup coll k not-found)) + (forEach [coll f] + (doseq [[k v] coll] + (f v k))) + + ICloneable + (-clone [_] (PersistentHashMap. meta cnt root has-nil? nil-val __hash)) + + IIterable + (-iterator [coll] + (let [root-iter (if ^boolean root (-iterator root) (nil-iter))] + (if has-nil? + (HashMapIter. nil-val root-iter false) + root-iter))) + + IWithMeta + (-with-meta [coll meta] (PersistentHashMap. meta cnt root has-nil? nil-val __hash)) + + IMeta + (-meta [coll] meta) + + ICollection + (-conj [coll entry] + (if (vector? entry) + (-assoc coll (-nth entry 0) (-nth entry 1)) + (loop [ret coll es (seq entry)] + (if (nil? es) + ret + (let [e (first es)] + (if (vector? e) + (recur (-assoc ret (-nth e 0) (-nth e 1)) + (next es)) + (throw (js/Error. "conj on a map takes map entries or seqables of map entries")))))))) + + IEmptyableCollection + (-empty [coll] (-with-meta (.-EMPTY PersistentHashMap) meta)) + + IEquiv + (-equiv [coll other] (equiv-map coll other)) + + IHash + (-hash [coll] (caching-hash coll hash-unordered-coll __hash)) + + ISeqable + (-seq [coll] + (when (pos? cnt) + (let [s (if-not (nil? root) (.inode-seq root))] + (if has-nil? + (cons [nil nil-val] s) + s)))) + + ICounted + (-count [coll] cnt) + + ILookup + (-lookup [coll k] + (-lookup coll k nil)) + + (-lookup [coll k not-found] + (cond (nil? k) (if has-nil? + nil-val + not-found) + (nil? root) not-found + :else (.inode-lookup root 0 (hash k) k not-found))) + + IAssociative + (-assoc [coll k v] + (if (nil? k) + (if (and has-nil? (identical? v nil-val)) + coll + (PersistentHashMap. meta (if has-nil? cnt (inc cnt)) root true v nil)) + (let [added-leaf? (Box. false) + new-root (-> (if (nil? root) + (.-EMPTY BitmapIndexedNode) + root) + (.inode-assoc 0 (hash k) k v added-leaf?))] + (if (identical? new-root root) + coll + (PersistentHashMap. meta (if ^boolean (.-val added-leaf?) (inc cnt) cnt) new-root has-nil? nil-val nil))))) + + (-contains-key? [coll k] + (cond (nil? k) has-nil? + (nil? root) false + :else (not (identical? (.inode-lookup root 0 (hash k) k lookup-sentinel) + lookup-sentinel)))) + + IMap + (-dissoc [coll k] + (cond (nil? k) (if has-nil? + (PersistentHashMap. meta (dec cnt) root false nil nil) + coll) + (nil? root) coll + :else + (let [new-root (.inode-without root 0 (hash k) k)] + (if (identical? new-root root) + coll + (PersistentHashMap. meta (dec cnt) new-root has-nil? nil-val nil))))) + + IKVReduce + (-kv-reduce [coll f init] + (let [init (if has-nil? (f init nil nil-val) init)] + (cond + (reduced? init) @init + (not (nil? root)) (.kv-reduce root f init) + :else init))) + + IFn + (-invoke [coll k] + (-lookup coll k)) + + (-invoke [coll k not-found] + (-lookup coll k not-found)) + + IEditableCollection + (-as-transient [coll] + (TransientHashMap. (js-obj) root cnt has-nil? nil-val))) + +(set! (.-EMPTY PersistentHashMap) (PersistentHashMap. nil 0 nil false nil empty-unordered-hash)) + +(set! (.-fromArray PersistentHashMap) + (fn [arr ^boolean no-clone] + (let [arr (if no-clone arr (aclone arr)) + len (alength arr)] + (loop [i 0 ret (transient (.-EMPTY PersistentHashMap))] + (if (< i len) + (recur (+ i 2) + (-assoc! ret (aget arr i) (aget arr (inc i)))) + (-persistent! ret)))))) + +(set! (.-fromArrays PersistentHashMap) + (fn [ks vs] + (let [len (alength ks)] + (loop [i 0 ^not-native out (transient (.-EMPTY PersistentHashMap))] + (if (< i len) + (recur (inc i) (-assoc! out (aget ks i) (aget vs i))) + (persistent! out)))))) + +(set! (.-createWithCheck PersistentHashMap) + (fn [arr] + (let [len (alength arr) + ret (transient (.-EMPTY PersistentHashMap))] + (loop [i 0] + (when (< i len) + (-assoc! ret (aget arr i) (aget arr (inc i))) + (if (not= (-count ret) (inc (/ i 2))) + (throw (js/Error. (str "Duplicate key: " (aget arr i)))) + (recur (+ i 2))))) + (-persistent! ret)))) + +(es6-iterable PersistentHashMap) + +(deftype TransientHashMap [^:mutable ^boolean edit + ^:mutable root + ^:mutable count + ^:mutable ^boolean has-nil? + ^:mutable nil-val] + Object + (conj! [tcoll o] + (if edit + (if (satisfies? IMapEntry o) + (.assoc! tcoll (key o) (val o)) + (loop [es (seq o) tcoll tcoll] + (if-let [e (first es)] + (recur (next es) + (.assoc! tcoll (key e) (val e))) + tcoll))) + (throw (js/Error. "conj! after persistent")))) + + (assoc! [tcoll k v] + (if edit + (if (nil? k) + (do (if (identical? nil-val v) + nil + (set! nil-val v)) + (if has-nil? + nil + (do (set! count (inc count)) + (set! has-nil? true))) + tcoll) + (let [added-leaf? (Box. false) + node (-> (if (nil? root) + (.-EMPTY BitmapIndexedNode) + root) + (.inode-assoc! edit 0 (hash k) k v added-leaf?))] + (if (identical? node root) + nil + (set! root node)) + (if ^boolean (.-val added-leaf?) + (set! count (inc count))) + tcoll)) + (throw (js/Error. "assoc! after persistent!")))) + + (without! [tcoll k] + (if edit + (if (nil? k) + (if has-nil? + (do (set! has-nil? false) + (set! nil-val nil) + (set! count (dec count)) + tcoll) + tcoll) + (if (nil? root) + tcoll + (let [removed-leaf? (Box. false) + node (.inode-without! root edit 0 (hash k) k removed-leaf?)] + (if (identical? node root) + nil + (set! root node)) + (if (aget removed-leaf? 0) + (set! count (dec count))) + tcoll))) + (throw (js/Error. "dissoc! after persistent!")))) + + (persistent! [tcoll] + (if edit + (do (set! edit nil) + (PersistentHashMap. nil count root has-nil? nil-val nil)) + (throw (js/Error. "persistent! called twice")))) + + ICounted + (-count [coll] + (if edit + count + (throw (js/Error. "count after persistent!")))) + + ILookup + (-lookup [tcoll k] + (if (nil? k) + (if has-nil? + nil-val) + (if (nil? root) + nil + (.inode-lookup root 0 (hash k) k)))) + + (-lookup [tcoll k not-found] + (if (nil? k) + (if has-nil? + nil-val + not-found) + (if (nil? root) + not-found + (.inode-lookup root 0 (hash k) k not-found)))) + + ITransientCollection + (-conj! [tcoll val] (.conj! tcoll val)) + + (-persistent! [tcoll] (.persistent! tcoll)) + + ITransientAssociative + (-assoc! [tcoll key val] (.assoc! tcoll key val)) + + ITransientMap + (-dissoc! [tcoll key] (.without! tcoll key))) + +;;; PersistentTreeMap + +(defn- tree-map-seq-push [node stack ^boolean ascending?] + (loop [t node stack stack] + (if-not (nil? t) + (recur (if ascending? (.-left t) (.-right t)) + (conj stack t)) + stack))) + +(deftype PersistentTreeMapSeq [meta stack ^boolean ascending? cnt ^: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 coll))) + (lastIndexOf [coll x start] + (-lastIndexOf coll x start)) + + ISeqable + (-seq [this] this) + + ISequential + ISeq + (-first [this] (peek stack)) + (-rest [this] + (let [t (first stack) + next-stack (tree-map-seq-push (if ascending? (.-right t) (.-left t)) + (next stack) + ascending?)] + (if-not (nil? next-stack) + (PersistentTreeMapSeq. nil next-stack ascending? (dec cnt) nil) + ()))) + + ICounted + (-count [coll] + (if (neg? cnt) + (inc (count (next coll))) + cnt)) + + IEquiv + (-equiv [coll other] (equiv-sequential coll other)) + + 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)) + + IMeta + (-meta [coll] meta) + + IWithMeta + (-with-meta [coll meta] + (PersistentTreeMapSeq. meta stack ascending? cnt __hash)) + + IReduce + (-reduce [coll f] (seq-reduce f coll)) + (-reduce [coll f start] (seq-reduce f start coll))) + +(es6-iterable PersistentTreeMapSeq) + +(defn- create-tree-map-seq [tree ascending? cnt] + (PersistentTreeMapSeq. nil (tree-map-seq-push tree nil ascending?) ascending? cnt nil)) + +(declare RedNode BlackNode) + +(defn- balance-left [key val ins right] + (if (instance? RedNode ins) + (cond + (instance? RedNode (.-left ins)) + (RedNode. (.-key ins) (.-val ins) + (.blacken (.-left ins)) + (BlackNode. key val (.-right ins) right nil) + nil) + + (instance? RedNode (.-right ins)) + (RedNode. (.. ins -right -key) (.. ins -right -val) + (BlackNode. (.-key ins) (.-val ins) + (.-left ins) + (.. ins -right -left) + nil) + (BlackNode. key val + (.. ins -right -right) + right + nil) + nil) + + :else + (BlackNode. key val ins right nil)) + (BlackNode. key val ins right nil))) + +(defn- balance-right [key val left ins] + (if (instance? RedNode ins) + (cond + (instance? RedNode (.-right ins)) + (RedNode. (.-key ins) (.-val ins) + (BlackNode. key val left (.-left ins) nil) + (.blacken (.-right ins)) + nil) + + (instance? RedNode (.-left ins)) + (RedNode. (.. ins -left -key) (.. ins -left -val) + (BlackNode. key val left (.. ins -left -left) nil) + (BlackNode. (.-key ins) (.-val ins) + (.. ins -left -right) + (.-right ins) + nil) + nil) + + :else + (BlackNode. key val left ins nil)) + (BlackNode. key val left ins nil))) + +(defn- balance-left-del [key val del right] + (cond + (instance? RedNode del) + (RedNode. key val (.blacken del) right nil) + + (instance? BlackNode right) + (balance-right key val del (.redden right)) + + (and (instance? RedNode right) (instance? BlackNode (.-left right))) + (RedNode. (.. right -left -key) (.. right -left -val) + (BlackNode. key val del (.. right -left -left) nil) + (balance-right (.-key right) (.-val right) + (.. right -left -right) + (.redden (.-right right))) + nil) + + :else + (throw (js/Error. "red-black tree invariant violation")))) + +(defn- balance-right-del [key val left del] + (cond + (instance? RedNode del) + (RedNode. key val left (.blacken del) nil) + + (instance? BlackNode left) + (balance-left key val (.redden left) del) + + (and (instance? RedNode left) (instance? BlackNode (.-right left))) + (RedNode. (.. left -right -key) (.. left -right -val) + (balance-left (.-key left) (.-val left) + (.redden (.-left left)) + (.. left -right -left)) + (BlackNode. key val (.. left -right -right) del nil) + nil) + + :else + (throw (js/Error. "red-black tree invariant violation")))) + +(defn- tree-map-kv-reduce [node f init] + (let [init (if-not (nil? (.-left node)) + (tree-map-kv-reduce (.-left node) f init) + init)] + (if (reduced? 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))))))) + +(deftype BlackNode [key val left right ^:mutable __hash] + Object + (add-left [node ins] + (.balance-left ins node)) + + (add-right [node ins] + (.balance-right ins node)) + + (remove-left [node del] + (balance-left-del key val del right)) + + (remove-right [node del] + (balance-right-del key val left del)) + + (blacken [node] node) + + (redden [node] (RedNode. key val left right nil)) + + (balance-left [node parent] + (BlackNode. (.-key parent) (.-val parent) node (.-right parent) nil)) + + (balance-right [node parent] + (BlackNode. (.-key parent) (.-val parent) (.-left parent) node nil)) + + (replace [node key val left right] + (BlackNode. key val left right nil)) + + (kv-reduce [node f init] + (tree-map-kv-reduce node f init)) + + (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] []) + + ISequential + ISeqable + (-seq [node] (list key val)) + + ICounted + (-count [node] 2) + + IIndexed + (-nth [node n] + (cond (== n 0) key + (== n 1) val + :else nil)) + + (-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)) + + 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] + (-lookup node k)) + + (-invoke [node k not-found] + (-lookup node k not-found))) + +(es6-iterable BlackNode) + +(deftype RedNode [key val left right ^:mutable __hash] + Object + (add-left [node ins] + (RedNode. key val ins right nil)) + + (add-right [node ins] + (RedNode. key val left ins nil)) + + (remove-left [node del] + (RedNode. key val del right nil)) + + (remove-right [node del] + (RedNode. key val left del nil)) + + (blacken [node] + (BlackNode. key val left right nil)) + + (redden [node] + (throw (js/Error. "red-black tree invariant violation"))) + + (balance-left [node parent] + (cond + (instance? RedNode left) + (RedNode. key val + (.blacken left) + (BlackNode. (.-key parent) (.-val parent) right (.-right parent) nil) + nil) + + (instance? RedNode right) + (RedNode. (.-key right) (.-val right) + (BlackNode. key val left (.-left right) nil) + (BlackNode. (.-key parent) (.-val parent) + (.-right right) + (.-right parent) + nil) + nil) + + :else + (BlackNode. (.-key parent) (.-val parent) node (.-right parent) nil))) + + (balance-right [node parent] + (cond + (instance? RedNode right) + (RedNode. key val + (BlackNode. (.-key parent) (.-val parent) + (.-left parent) + left + nil) + (.blacken right) + nil) + + (instance? RedNode left) + (RedNode. (.-key left) (.-val left) + (BlackNode. (.-key parent) (.-val parent) + (.-left parent) + (.-left left) + nil) + (BlackNode. key val (.-right left) right nil) + nil) + + :else + (BlackNode. (.-key parent) (.-val parent) (.-left parent) node nil))) + + (replace [node key val left right] + (RedNode. key val left right nil)) + + (kv-reduce [node f init] + (tree-map-kv-reduce node f init)) + + (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] []) + + ISequential + ISeqable + (-seq [node] (list key val)) + + ICounted + (-count [node] 2) + + IIndexed + (-nth [node n] + (cond (== n 0) key + (== n 1) val + :else nil)) + + (-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)) + + 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] + (-lookup node k)) + + (-invoke [node k not-found] + (-lookup node k not-found))) + +(es6-iterable RedNode) + +(defn- tree-map-add [comp tree k v found] + (if (nil? tree) + (RedNode. k v nil nil nil) + (let [c (comp k (.-key tree))] + (cond + (zero? c) + (do (aset found 0 tree) + nil) + + (neg? c) + (let [ins (tree-map-add comp (.-left tree) k v found)] + (if-not (nil? ins) + (.add-left tree ins))) + + :else + (let [ins (tree-map-add comp (.-right tree) k v found)] + (if-not (nil? ins) + (.add-right tree ins))))))) + +(defn- tree-map-append [left right] + (cond + (nil? left) + right + + (nil? right) + left + + (instance? RedNode left) + (if (instance? RedNode right) + (let [app (tree-map-append (.-right left) (.-left right))] + (if (instance? RedNode app) + (RedNode. (.-key app) (.-val app) + (RedNode. (.-key left) (.-val left) + (.-left left) + (.-left app) + nil) + (RedNode. (.-key right) (.-val right) + (.-right app) + (.-right right) + nil) + nil) + (RedNode. (.-key left) (.-val left) + (.-left left) + (RedNode. (.-key right) (.-val right) app (.-right right) nil) + nil))) + (RedNode. (.-key left) (.-val left) + (.-left left) + (tree-map-append (.-right left) right) + nil)) + + (instance? RedNode right) + (RedNode. (.-key right) (.-val right) + (tree-map-append left (.-left right)) + (.-right right) + nil) + + :else + (let [app (tree-map-append (.-right left) (.-left right))] + (if (instance? RedNode app) + (RedNode. (.-key app) (.-val app) + (BlackNode. (.-key left) (.-val left) + (.-left left) + (.-left app) + nil) + (BlackNode. (.-key right) (.-val right) + (.-right app) + (.-right right) + nil) + nil) + (balance-left-del (.-key left) (.-val left) + (.-left left) + (BlackNode. (.-key right) (.-val right) + app + (.-right right) + nil)))))) + +(defn- tree-map-remove [comp tree k found] + (if-not (nil? tree) + (let [c (comp k (.-key tree))] + (cond + (zero? c) + (do (aset found 0 tree) + (tree-map-append (.-left tree) (.-right tree))) + + (neg? c) + (let [del (tree-map-remove comp (.-left tree) k found)] + (if (or (not (nil? del)) (not (nil? (aget found 0)))) + (if (instance? BlackNode (.-left tree)) + (balance-left-del (.-key tree) (.-val tree) del (.-right tree)) + (RedNode. (.-key tree) (.-val tree) del (.-right tree) nil)))) + + :else + (let [del (tree-map-remove comp (.-right tree) k found)] + (if (or (not (nil? del)) (not (nil? (aget found 0)))) + (if (instance? BlackNode (.-right tree)) + (balance-right-del (.-key tree) (.-val tree) (.-left tree) del) + (RedNode. (.-key tree) (.-val tree) (.-left tree) del nil)))))))) + +(defn- tree-map-replace [comp tree k v] + (let [tk (.-key tree) + c (comp k tk)] + (cond (zero? c) (.replace tree tk v (.-left tree) (.-right tree)) + (neg? c) (.replace tree tk (.-val tree) (tree-map-replace comp (.-left tree) k v) (.-right tree)) + :else (.replace tree tk (.-val tree) (.-left tree) (tree-map-replace comp (.-right tree) k v))))) + +(declare key) + +(deftype PersistentTreeMap [comp tree cnt meta ^:mutable __hash] + Object + (toString [coll] + (pr-str* coll)) + (equiv [this other] + (-equiv this other)) + + ;; EXPERIMENTAL: subject to change + (keys [coll] + (es6-iterator (keys coll))) + (entries [coll] + (es6-entries-iterator (seq coll))) + (values [coll] + (es6-iterator (vals coll))) + (has [coll k] + (contains? coll k)) + (get [coll k not-found] + (-lookup coll k not-found)) + (forEach [coll f] + (doseq [[k v] coll] + (f v k))) + + (entry-at [coll k] + (loop [t tree] + (if-not (nil? t) + (let [c (comp k (.-key t))] + (cond (zero? c) t + (neg? c) (recur (.-left t)) + :else (recur (.-right t))))))) + + ICloneable + (-clone [_] (PersistentTreeMap. comp tree cnt meta __hash)) + + IWithMeta + (-with-meta [coll meta] (PersistentTreeMap. comp tree cnt meta __hash)) + + IMeta + (-meta [coll] meta) + + ICollection + (-conj [coll entry] + (if (vector? entry) + (-assoc coll (-nth entry 0) (-nth entry 1)) + (loop [ret coll es (seq entry)] + (if (nil? es) + ret + (let [e (first es)] + (if (vector? e) + (recur (-assoc ret (-nth e 0) (-nth e 1)) + (next es)) + (throw (js/Error. "conj on a map takes map entries or seqables of map entries")))))))) + + IEmptyableCollection + (-empty [coll] (PersistentTreeMap. comp nil 0 meta 0)) + + IEquiv + (-equiv [coll other] (equiv-map coll other)) + + IHash + (-hash [coll] (caching-hash coll hash-unordered-coll __hash)) + + ICounted + (-count [coll] cnt) + + IKVReduce + (-kv-reduce [coll f init] + (if-not (nil? tree) + (tree-map-kv-reduce tree f init) + init)) + + IFn + (-invoke [coll k] + (-lookup coll k)) + + (-invoke [coll k not-found] + (-lookup coll k not-found)) + + ISeqable + (-seq [coll] + (if (pos? cnt) + (create-tree-map-seq tree true cnt))) + + IReversible + (-rseq [coll] + (if (pos? cnt) + (create-tree-map-seq tree false cnt))) + + ILookup + (-lookup [coll k] + (-lookup coll k nil)) + + (-lookup [coll k not-found] + (let [n (.entry-at coll k)] + (if-not (nil? n) + (.-val n) + not-found))) + + IAssociative + (-assoc [coll k v] + (let [found (array nil) + t (tree-map-add comp tree k v found)] + (if (nil? t) + (let [found-node (nth found 0)] + (if (= v (.-val found-node)) + coll + (PersistentTreeMap. comp (tree-map-replace comp tree k v) cnt meta nil))) + (PersistentTreeMap. comp (.blacken t) (inc cnt) meta nil)))) + + (-contains-key? [coll k] + (not (nil? (.entry-at coll k)))) + + IMap + (-dissoc [coll k] + (let [found (array nil) + t (tree-map-remove comp tree k found)] + (if (nil? t) + (if (nil? (nth found 0)) + coll + (PersistentTreeMap. comp nil 0 meta nil)) + (PersistentTreeMap. comp (.blacken t) (dec cnt) meta nil)))) + + ISorted + (-sorted-seq [coll ascending?] + (if (pos? cnt) + (create-tree-map-seq tree ascending? cnt))) + + (-sorted-seq-from [coll k ascending?] + (if (pos? cnt) + (loop [stack nil t tree] + (if-not (nil? t) + (let [c (comp k (.-key t))] + (cond + (zero? c) (PersistentTreeMapSeq. nil (conj stack t) ascending? -1 nil) + ascending? (if (neg? c) + (recur (conj stack t) (.-left t)) + (recur stack (.-right t))) + :else (if (pos? c) + (recur (conj stack t) (.-right t)) + (recur stack (.-left t))))) + (when-not (nil? stack) + (PersistentTreeMapSeq. nil stack ascending? -1 nil)))))) + + (-entry-key [coll entry] (key entry)) + + (-comparator [coll] comp)) + +(set! (.-EMPTY PersistentTreeMap) (PersistentTreeMap. compare nil 0 nil empty-unordered-hash)) + +(es6-iterable PersistentTreeMap) + +(defn hash-map + "keyval => key val + Returns a new hash map with supplied mappings." + [& keyvals] + (loop [in (seq keyvals), out (transient (.-EMPTY PersistentHashMap))] + (if in + (recur (nnext in) (assoc! out (first in) (second in))) + (persistent! out)))) + +(defn array-map + "keyval => key val + Returns a new array map with supplied mappings." + [& keyvals] + (let [arr (if (and (instance? IndexedSeq keyvals) (zero? (.-i keyvals))) + (.-arr keyvals) + (into-array keyvals))] + (.createAsIfByAssoc PersistentArrayMap arr true false))) + +(defn obj-map + "keyval => key val + Returns a new object map with supplied mappings." + [& keyvals] + (let [ks (array) + obj (js-obj)] + (loop [kvs (seq keyvals)] + (if kvs + (do (.push ks (first kvs)) + (aset obj (first kvs) (second kvs)) + (recur (nnext kvs))) + (.fromObject ObjMap ks obj))))) + +(defn sorted-map + "keyval => key val + Returns a new sorted map with supplied mappings." + ([& keyvals] + (loop [in (seq keyvals) out (.-EMPTY PersistentTreeMap)] + (if in + (recur (nnext in) (assoc out (first in) (second in))) + out)))) + +(defn sorted-map-by + "keyval => key val + Returns a new sorted map with supplied mappings, using the supplied comparator." + ([comparator & keyvals] + (loop [in (seq keyvals) + out (PersistentTreeMap. (fn->comparator comparator) nil 0 nil 0)] + (if in + (recur (nnext in) (assoc out (first in) (second in))) + out)))) + +(deftype KeySeq [^not-native mseq _meta] + 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 coll))) + (lastIndexOf [coll x start] + (-lastIndexOf coll x start)) + + IMeta + (-meta [coll] _meta) + + IWithMeta + (-with-meta [coll new-meta] (KeySeq. mseq new-meta)) + + ISeqable + (-seq [coll] coll) + + ISequential + IEquiv + (-equiv [coll other] (equiv-sequential coll other)) + + ICollection + (-conj [coll o] + (cons o coll)) + + IEmptyableCollection + (-empty [coll] (with-meta (.-EMPTY List) _meta)) + + IHash + (-hash [coll] (hash-ordered-coll coll)) + + ISeq + (-first [coll] + (let [^not-native me (-first mseq)] + (-key me))) + + (-rest [coll] + (let [nseq (if (satisfies? INext mseq) + (-next mseq) + (next mseq))] + (if-not (nil? nseq) + (KeySeq. nseq _meta) + ()))) + + INext + (-next [coll] + (let [nseq (if (satisfies? INext mseq) + (-next mseq) + (next mseq))] + (when-not (nil? nseq) + (KeySeq. nseq _meta)))) + + IReduce + (-reduce [coll f] (seq-reduce f coll)) + (-reduce [coll f start] (seq-reduce f start coll))) + +(es6-iterable KeySeq) + +(defn keys + "Returns a sequence of the map's keys." + [hash-map] + (when-let [mseq (seq hash-map)] + (KeySeq. mseq nil))) + +(defn key + "Returns the key of the map entry." + [map-entry] + (-key map-entry)) + +(deftype ValSeq [^not-native mseq _meta] + 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 coll))) + (lastIndexOf [coll x start] + (-lastIndexOf coll x start)) + + IMeta + (-meta [coll] _meta) + + IWithMeta + (-with-meta [coll new-meta] (ValSeq. mseq new-meta)) + + ISeqable + (-seq [coll] coll) + + ISequential + IEquiv + (-equiv [coll other] (equiv-sequential coll other)) + + ICollection + (-conj [coll o] + (cons o coll)) + + IEmptyableCollection + (-empty [coll] (with-meta (.-EMPTY List) _meta)) + + IHash + (-hash [coll] (hash-ordered-coll coll)) + + ISeq + (-first [coll] + (let [^not-native me (-first mseq)] + (-val me))) + + (-rest [coll] + (let [nseq (if (satisfies? INext mseq) + (-next mseq) + (next mseq))] + (if-not (nil? nseq) + (ValSeq. nseq _meta) + ()))) + + INext + (-next [coll] + (let [nseq (if (satisfies? INext mseq) + (-next mseq) + (next mseq))] + (when-not (nil? nseq) + (ValSeq. nseq _meta)))) + + IReduce + (-reduce [coll f] (seq-reduce f coll)) + (-reduce [coll f start] (seq-reduce f start coll))) + +(es6-iterable ValSeq) + +(defn vals + "Returns a sequence of the map's values." + [hash-map] + (when-let [mseq (seq hash-map)] + (ValSeq. mseq nil))) + +(defn val + "Returns the value in the map entry." + [map-entry] + (-val map-entry)) + +(defn merge + "Returns a map that consists of the rest of the maps conj-ed onto + the first. If a key occurs in more than one map, the mapping from + the latter (left-to-right) will be the mapping in the result." + [& maps] + (when (some identity maps) + (reduce #(conj (or %1 {}) %2) maps))) + +(defn merge-with + "Returns a map that consists of the rest of the maps conj-ed onto + the first. If a key occurs in more than one map, the mapping(s) + from the latter (left-to-right) will be combined with the mapping in + the result by calling (f val-in-result val-in-latter)." + [f & maps] + (when (some identity maps) + (let [merge-entry (fn [m e] + (let [k (first e) v (second e)] + (if (contains? m k) + (assoc m k (f (get m k) v)) + (assoc m k v)))) + merge2 (fn [m1 m2] + (reduce merge-entry (or m1 {}) (seq m2)))] + (reduce merge2 maps)))) + +(defn select-keys + "Returns a map containing only those entries in map whose key is in keys" + [map keyseq] + (loop [ret {} keys (seq keyseq)] + (if keys + (let [key (first keys) + entry (get map key ::not-found)] + (recur + (if (not= entry ::not-found) + (assoc ret key entry) + ret) + (next keys))) + (with-meta ret (meta map))))) + +;;; PersistentHashSet + +(declare TransientHashSet) + +(deftype HashSetIter [iter] + Object + (hasNext [_] + (.hasNext iter)) + (next [_] + (if ^boolean (.hasNext iter) + (aget (.-tail (.next iter)) 0) + (throw (js/Error. "No such element")))) + (remove [_] (js/Error. "Unsupported operation"))) + +(deftype PersistentHashSet [meta hash-map ^:mutable __hash] + Object + (toString [coll] + (pr-str* coll)) + (equiv [this other] + (-equiv this other)) + + ;; EXPERIMENTAL: subject to change + (keys [coll] + (es6-iterator (seq coll))) + (entries [coll] + (es6-set-entries-iterator (seq coll))) + (values [coll] + (es6-iterator (seq coll))) + (has [coll k] + (contains? coll k)) + (forEach [coll f] + (doseq [[k v] coll] + (f v k))) + + ICloneable + (-clone [_] (PersistentHashSet. meta hash-map __hash)) + + IIterable + (-iterator [coll] + (HashSetIter. (-iterator hash-map))) + + IWithMeta + (-with-meta [coll meta] (PersistentHashSet. meta hash-map __hash)) + + IMeta + (-meta [coll] meta) + + ICollection + (-conj [coll o] + (PersistentHashSet. meta (assoc hash-map o nil) nil)) + + IEmptyableCollection + (-empty [coll] (with-meta (.-EMPTY PersistentHashSet) meta)) + + IEquiv + (-equiv [coll other] + (and + (set? other) + (== (count coll) (count other)) + (every? #(contains? coll %) + other))) + + IHash + (-hash [coll] (caching-hash coll hash-unordered-coll __hash)) + + ISeqable + (-seq [coll] (keys hash-map)) + + ICounted + (-count [coll] (-count hash-map)) + + ILookup + (-lookup [coll v] + (-lookup coll v nil)) + (-lookup [coll v not-found] + (if (-contains-key? hash-map v) + v + not-found)) + + ISet + (-disjoin [coll v] + (PersistentHashSet. meta (-dissoc hash-map v) nil)) + + IFn + (-invoke [coll k] + (-lookup coll k)) + (-invoke [coll k not-found] + (-lookup coll k not-found)) + + IEditableCollection + (-as-transient [coll] (TransientHashSet. (-as-transient hash-map)))) + +(set! (.-EMPTY PersistentHashSet) + (PersistentHashSet. nil (.-EMPTY PersistentArrayMap) empty-unordered-hash)) + +(set! (.-fromArray PersistentHashSet) + (fn [items ^boolean no-clone] + (let [len (alength items)] + (if (<= len (.-HASHMAP-THRESHOLD PersistentArrayMap)) + (let [arr (if no-clone items (aclone items))] + (loop [i 0 + out (transient (.-EMPTY PersistentArrayMap))] + (if (< i len) + (recur (inc i) (-assoc! out (aget items i) nil)) + (PersistentHashSet. nil (-persistent! out) nil)))) + (loop [i 0 + out (transient (.-EMPTY PersistentHashSet))] + (if (< i len) + (recur (inc i) (-conj! out (aget items i))) + (-persistent! out))))))) + +(set! (.-createWithCheck PersistentHashSet) + (fn [items] + (let [len (alength items) + t (-as-transient (.-EMPTY PersistentHashSet))] + (dotimes [i len] + (-conj! t (aget items i)) + (when-not (= (count t) (inc i)) + (throw (js/Error. (str "Duplicate key: " (aget items i)))))) + (-persistent! t)))) + +(set! (.-createAsIfByAssoc PersistentHashSet) + (fn [items] + (let [len (alength items) + t (-as-transient (.-EMPTY PersistentHashSet))] + (dotimes [i len] (-conj! t (aget items i))) + (-persistent! t)))) + +(es6-iterable PersistentHashSet) + +(deftype TransientHashSet [^:mutable transient-map] + ITransientCollection + (-conj! [tcoll o] + (set! transient-map (assoc! transient-map o nil)) + tcoll) + + (-persistent! [tcoll] + (PersistentHashSet. nil (persistent! transient-map) nil)) + + ITransientSet + (-disjoin! [tcoll v] + (set! transient-map (dissoc! transient-map v)) + tcoll) + + ICounted + (-count [tcoll] (count transient-map)) + + ILookup + (-lookup [tcoll v] + (-lookup tcoll v nil)) + + (-lookup [tcoll v not-found] + (if (identical? (-lookup transient-map v lookup-sentinel) lookup-sentinel) + not-found + v)) + + IFn + (-invoke [tcoll k] + (if (identical? (-lookup transient-map k lookup-sentinel) lookup-sentinel) + nil + k)) + + (-invoke [tcoll k not-found] + (if (identical? (-lookup transient-map k lookup-sentinel) lookup-sentinel) + not-found + k))) + +(deftype PersistentTreeSet [meta tree-map ^:mutable __hash] + Object + (toString [coll] + (pr-str* coll)) + (equiv [this other] + (-equiv this other)) + + ;; EXPERIMENTAL: subject to change + (keys [coll] + (es6-iterator (seq coll))) + (entries [coll] + (es6-set-entries-iterator (seq coll))) + (values [coll] + (es6-iterator (seq coll))) + (has [coll k] + (contains? coll k)) + (forEach [coll f] + (doseq [[k v] coll] + (f v k))) + + ICloneable + (-clone [_] (PersistentTreeSet. meta tree-map __hash)) + + IWithMeta + (-with-meta [coll meta] (PersistentTreeSet. meta tree-map __hash)) + + IMeta + (-meta [coll] meta) + + ICollection + (-conj [coll o] + (PersistentTreeSet. meta (assoc tree-map o nil) nil)) + + IEmptyableCollection + (-empty [coll] (PersistentTreeSet. meta (-empty tree-map) 0)) + + IEquiv + (-equiv [coll other] + (and + (set? other) + (== (count coll) (count other)) + (every? #(contains? coll %) + other))) + + IHash + (-hash [coll] (caching-hash coll hash-unordered-coll __hash)) + + ISeqable + (-seq [coll] (keys tree-map)) + + ISorted + (-sorted-seq [coll ascending?] + (map key (-sorted-seq tree-map ascending?))) + + (-sorted-seq-from [coll k ascending?] + (map key (-sorted-seq-from tree-map k ascending?))) + + (-entry-key [coll entry] entry) + + (-comparator [coll] (-comparator tree-map)) + + IReversible + (-rseq [coll] + (if (pos? (count tree-map)) + (map key (rseq tree-map)))) + + ICounted + (-count [coll] (count tree-map)) + + ILookup + (-lookup [coll v] + (-lookup coll v nil)) + (-lookup [coll v not-found] + (let [n (.entry-at tree-map v)] + (if-not (nil? n) + (.-key n) + not-found))) + + ISet + (-disjoin [coll v] + (PersistentTreeSet. meta (dissoc tree-map v) nil)) + + IFn + (-invoke [coll k] + (-lookup coll k)) + (-invoke [coll k not-found] + (-lookup coll k not-found))) + +(set! (.-EMPTY PersistentTreeSet) + (PersistentTreeSet. nil (.-EMPTY PersistentTreeMap) empty-unordered-hash)) + +(es6-iterable PersistentTreeSet) + +(defn set-from-indexed-seq [iseq] + (let [arr (.-arr iseq) + ret (areduce arr i ^not-native res (-as-transient #{}) + (-conj! res (aget arr i)))] + (-persistent! ^not-native ret))) + +(defn set + "Returns a set of the distinct elements of coll." + [coll] + (let [in (seq coll)] + (cond + (nil? 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)))))) + +(defn hash-set + "Returns a new hash set with supplied keys. Any equal keys are + handled as if by repeated uses of conj." + ([] #{}) + ([& keys] (set keys))) + +(defn sorted-set + "Returns a new sorted set with supplied keys." + ([& keys] + (reduce -conj (.-EMPTY PersistentTreeSet) keys))) + +(defn sorted-set-by + "Returns a new sorted set with supplied keys, using the supplied comparator." + ([comparator & keys] + (reduce -conj + (PersistentTreeSet. nil (sorted-map-by comparator) 0) + keys))) + +(defn replace + "Given a map of replacement pairs and a vector/collection, returns a + vector/seq with any elements = a key in smap replaced with the + corresponding val in smap. Returns a transducer when no collection + is provided." + ([smap] + (map #(if-let [e (find smap %)] (val e) %))) + ([smap coll] + (if (vector? coll) + (let [n (count coll)] + (reduce (fn [v i] + (if-let [e (find smap (nth v i))] + (assoc v i (second e)) + v)) + coll (take n (iterate inc 0)))) + (map #(if-let [e (find smap %)] (second e) %) coll)))) + +(defn distinct + "Returns a lazy sequence of the elements of coll with duplicates removed. + Returns a stateful transducer when no collection is provided." + ([] + (fn [rf] + (let [seen (volatile! #{})] + (fn + ([] (rf)) + ([result] (rf result)) + ([result input] + (if (contains? @seen input) + result + (do (vswap! seen conj input) + (rf result input)))))))) + ([coll] + (let [step (fn step [xs seen] + (lazy-seq + ((fn [[f :as xs] seen] + (when-let [s (seq xs)] + (if (contains? seen f) + (recur (rest s) seen) + (cons f (step (rest s) (conj seen f)))))) + xs seen)))] + (step coll #{})))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defn butlast + "Return a seq of all but the last item in coll, in linear time" + [s] + (loop [ret [] s s] + (if (next s) + (recur (conj ret (first s)) (next s)) + (seq ret)))) + +(defn name + "Returns the name String of a string, symbol or keyword." + [x] + (if (implements? INamed x) + (-name ^not-native x) + (if (string? x) + x + (throw (js/Error. (str "Doesn't support name: " x)))))) + +(defn zipmap + "Returns a map with the keys mapped to the corresponding vals." + [keys vals] + (loop [map (transient {}) + ks (seq keys) + vs (seq vals)] + (if (and ks vs) + (recur (assoc! map (first ks) (first vs)) + (next ks) + (next vs)) + (persistent! map)))) + +(defn max-key + "Returns the x for which (k x), a number, is greatest." + ([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." + ([k x] x) + ([k x y] (if (< (k x) (k y)) x y)) + ([k x y & more] + (reduce #(min-key k %1 %2) (min-key k x y) more))) + +(deftype ArrayList [^:mutable arr] + Object + (add [_ x] (.push arr x)) + (size [_] (alength arr)) + (clear [_] (set! arr (array))) + (isEmpty [_] (zero? (alength arr))) + (toArray [_] arr)) + +(defn array-list [] + (ArrayList. (array))) + +(defn partition-all + "Returns a lazy sequence of lists like partition, but may include + partitions with fewer than n items at the end. Returns a stateful + transducer when no collection is provided." + ([n] + (fn [rf] + (let [a (array-list)] + (fn + ([] (rf)) + ([result] + (let [result (if (.isEmpty a) + result + (let [v (vec (.toArray a))] + ;;clear first! + (.clear a) + (unreduced (rf result v))))] + (rf result))) + ([result input] + (.add a input) + (if (== n (.size a)) + (let [v (vec (.toArray a))] + (.clear a) + (rf result v)) + result)))))) + ([n coll] + (partition-all n n coll)) + ([n step coll] + (lazy-seq + (when-let [s (seq coll)] + (cons (take n s) (partition-all n step (drop step s))))))) + +(defn take-while + "Returns a lazy sequence of successive items from coll while + (pred item) returns true. pred must be free of side-effects. + Returns a transducer when no collection is provided." + ([pred] + (fn [rf] + (fn + ([] (rf)) + ([result] (rf result)) + ([result input] + (if (pred input) + (rf result input) + (reduced result)))))) + ([pred coll] + (lazy-seq + (when-let [s (seq coll)] + (when (pred (first s)) + (cons (first s) (take-while pred (rest s)))))))) + +(defn mk-bound-fn + [sc test key] + (fn [e] + (let [comp (-comparator sc)] + (test (comp (-entry-key sc e) key) 0)))) + +(defn subseq + "sc must be a sorted collection, test(s) one of <, <=, > or + >=. Returns a seq of those entries with keys ek for + which (test (.. sc comparator (compare ek key)) 0) is true" + ([sc test key] + (let [include (mk-bound-fn sc test key)] + (if (#{> >=} test) + (when-let [[e :as s] (-sorted-seq-from sc key true)] + (if (include e) s (next s))) + (take-while include (-sorted-seq sc true))))) + ([sc start-test start-key end-test end-key] + (when-let [[e :as s] (-sorted-seq-from sc start-key true)] + (take-while (mk-bound-fn sc end-test end-key) + (if ((mk-bound-fn sc start-test start-key) e) s (next s)))))) + +(defn rsubseq + "sc must be a sorted collection, test(s) one of <, <=, > or + >=. Returns a reverse seq of those entries with keys ek for + which (test (.. sc comparator (compare ek key)) 0) is true" + ([sc test key] + (let [include (mk-bound-fn sc test key)] + (if (#{< <=} test) + (when-let [[e :as s] (-sorted-seq-from sc key false)] + (if (include e) s (next s))) + (take-while include (-sorted-seq sc false))))) + ([sc start-test start-key end-test end-key] + (when-let [[e :as s] (-sorted-seq-from sc end-key false)] + (take-while (mk-bound-fn sc start-test start-key) + (if ((mk-bound-fn sc end-test end-key) e) s (next s)))))) + +(deftype RangeIterator [^:mutable i end step] + Object + (hasNext [_] + (if (pos? step) + (< i end) + (> i end))) + (next [_] + (let [ret i] + (set! i (+ i step)) + ret))) + +(deftype Range [meta start end step ^: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 coll))) + (lastIndexOf [coll x start] + (-lastIndexOf coll x start)) + + ICloneable + (-clone [_] (Range. meta start end step __hash)) + + IWithMeta + (-with-meta [rng meta] (Range. meta start end step __hash)) + + IMeta + (-meta [rng] meta) + + ISeqable + (-seq [rng] + (cond + (pos? step) (when (< start end) rng) + (neg? step) (when (> start end) rng) + :else (when-not (== start end) rng))) + + ISeq + (-first [rng] + (when-not (nil? (-seq rng)) start)) + (-rest [rng] + (if-not (nil? (-seq rng)) + (Range. meta (+ start step) end step nil) + ())) + + IIterable + (-iterator [_] + (RangeIterator. start end step)) + + INext + (-next [rng] + (if (pos? step) + (when (< (+ start step) end) + (Range. meta (+ start step) end step nil)) + (when (> (+ start step) end) + (Range. meta (+ start step) end step nil)))) + + ICollection + (-conj [rng o] (cons o rng)) + + IEmptyableCollection + (-empty [rng] (with-meta (.-EMPTY List) meta)) + + ISequential + IEquiv + (-equiv [rng other] (equiv-sequential rng other)) + + IHash + (-hash [rng] (caching-hash rng hash-ordered-coll __hash)) + + ICounted + (-count [rng] + (if-not (-seq rng) + 0 + (Math/ceil (/ (- end start) step)))) + + IIndexed + (-nth [rng n] + (if (< n (-count rng)) + (+ start (* n step)) + (if (and (> start end) (zero? step)) + start + (throw (js/Error. "Index out of bounds"))))) + (-nth [rng n not-found] + (if (< n (-count rng)) + (+ start (* n step)) + (if (and (> start end) (zero? step)) + start + not-found))) + + IReduce + (-reduce [rng f] (ci-reduce rng f)) + (-reduce [rng f init] + (loop [i start ret init] + (if (if (pos? step) (< i end) (> i end)) + (let [ret (f ret i)] + (if (reduced? ret) + @ret + (recur (+ i step) ret))) + ret)))) + +(es6-iterable Range) + +(defn range + "Returns a lazy seq of nums from start (inclusive) to end + (exclusive), by step, where start defaults to 0, step to 1, + and end to infinity." + ([] (range 0 (.-MAX_VALUE js/Number) 1)) + ([end] (range 0 end 1)) + ([start end] (range start end 1)) + ([start end step] (Range. nil start end step nil))) + +(defn take-nth + "Returns a lazy seq of every nth item in coll. Returns a stateful + transducer when no collection is provided." + ([n] + {:pre [(number? n)]} + (fn [rf] + (let [ia (volatile! -1)] + (fn + ([] (rf)) + ([result] (rf result)) + ([result input] + (let [i (vswap! ia inc)] + (if (zero? (rem i n)) + (rf result input) + result))))))) + ([n coll] + {:pre [(number? n)]} + (lazy-seq + (when-let [s (seq coll)] + (cons (first s) (take-nth n (drop n s))))))) + +(defn split-with + "Returns a vector of [(take-while pred coll) (drop-while pred coll)]" + [pred coll] + [(take-while pred coll) (drop-while pred coll)]) + +(defn partition-by + "Applies f to each value in coll, splitting it each time f returns a + new value. Returns a lazy seq of partitions. Returns a stateful + transducer when no collection is provided." + ([f] + (fn [rf] + (let [a (array-list) + pa (volatile! ::none)] + (fn + ([] (rf)) + ([result] + (let [result (if (.isEmpty a) + result + (let [v (vec (.toArray a))] + ;;clear first! + (.clear a) + (unreduced (rf result v))))] + (rf result))) + ([result input] + (let [pval @pa + val (f input)] + (vreset! pa val) + (if (or (keyword-identical? pval ::none) + (= val pval)) + (do + (.add a input) + result) + (let [v (vec (.toArray a))] + (.clear a) + (let [ret (rf result v)] + (when-not (reduced? ret) + (.add a input)) + ret))))))))) + ([f coll] + (lazy-seq + (when-let [s (seq coll)] + (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))))))))) + +(defn frequencies + "Returns a map from distinct items in coll to the number of times + they appear." + [coll] + (persistent! + (reduce (fn [counts x] + (assoc! counts x (inc (get counts x 0)))) + (transient {}) coll))) + +(defn reductions + "Returns a lazy seq of the intermediate values of the reduction (as + per reduce) of coll by f, starting with init." + ([f coll] + (lazy-seq + (if-let [s (seq coll)] + (reductions f (first s) (rest s)) + (list (f))))) + ([f init coll] + (if (reduced? init) + (list @init) + (cons init + (lazy-seq + (when-let [s (seq coll)] + (reductions f (f init (first s)) (rest s)))))))) + +(defn juxt + "Takes a set of functions and returns a fn that is the juxtaposition + of those fns. The returned fn takes a variable number of args, and + returns a vector containing the result of applying each fn to the + args (left-to-right). + ((juxt a b c) x) => [(a x) (b x) (c x)]" + ([f] + (fn + ([] (vector (f))) + ([x] (vector (f x))) + ([x y] (vector (f x y))) + ([x y z] (vector (f x y z))) + ([x y z & args] (vector (apply f x y z args))))) + ([f g] + (fn + ([] (vector (f) (g))) + ([x] (vector (f x) (g x))) + ([x y] (vector (f x y) (g x y))) + ([x y z] (vector (f x y z) (g x y z))) + ([x y z & args] (vector (apply f x y z args) (apply g x y z args))))) + ([f g h] + (fn + ([] (vector (f) (g) (h))) + ([x] (vector (f x) (g x) (h x))) + ([x y] (vector (f x y) (g x y) (h x y))) + ([x y z] (vector (f x y z) (g x y z) (h x y z))) + ([x y z & args] (vector (apply f x y z args) (apply g x y z args) (apply h x y z args))))) + ([f g h & fs] + (let [fs (list* f g h fs)] + (fn + ([] (reduce #(conj %1 (%2)) [] fs)) + ([x] (reduce #(conj %1 (%2 x)) [] fs)) + ([x y] (reduce #(conj %1 (%2 x y)) [] fs)) + ([x y z] (reduce #(conj %1 (%2 x y z)) [] fs)) + ([x y z & args] (reduce #(conj %1 (apply %2 x y z args)) [] fs)))))) + +(defn dorun + "When lazy sequences are produced via functions that have side + effects, any effects other than those needed to produce the first + element in the seq do not occur until the seq is consumed. dorun can + 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)))) + ([n coll] + (when (and (seq coll) (pos? n)) + (recur (dec n) (next coll))))) + +(defn doall + "When lazy sequences are produced via functions that have side + effects, any effects other than those needed to produce the first + element in the seq do not occur until the seq is consumed. doall can + be used to force any effects. Walks through the successive nexts of + the seq, retains the head and returns it, thus causing the entire + seq to reside in memory at one time." + ([coll] + (dorun coll) + coll) + ([n coll] + (dorun n coll) + coll)) + +;;;;;;;;;;;;;;;;;;;;;;;;; Regular Expressions ;;;;;;;;;; + +(defn ^boolean regexp? + "Returns true if x is a JavaScript RegExp instance." + [x] + (instance? js/RegExp x)) + +(defn re-matches + "Returns the result of (re-find re s) if re fully matches s." + [re s] + (if (string? s) + (let [matches (.exec re s)] + (when (= (first matches) s) + (if (== (count matches) 1) + (first matches) + (vec matches)))) + (throw (js/TypeError. "re-matches must match against a string.")))) + + +(defn re-find + "Returns the first regex match, if any, of s to re, using + re.exec(s). Returns a vector, containing first the matching + substring, then any capturing groups if the regular expression contains + capturing groups." + [re s] + (if (string? s) + (let [matches (.exec re s)] + (when-not (nil? matches) + (if (== (count matches) 1) + (first matches) + (vec matches)))) + (throw (js/TypeError. "re-find must match against a string.")))) + +(defn re-seq + "Returns a lazy sequence of successive matches of re in s." + [re s] + (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))))))) + +(defn re-pattern + "Returns an instance of RegExp which has compiled the provided string." + [s] + (if (instance? js/RegExp s) + s + (let [[prefix flags] (re-find #"^\(\?([idmsux]*)\)" s) + pattern (subs s (count prefix))] + (js/RegExp. pattern (or flags ""))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Printing ;;;;;;;;;;;;;;;; + +(defn pr-sequential-writer [writer print-one begin sep end opts coll] + (binding [*print-level* (when-not (nil? *print-level*) (dec *print-level*))] + (if (and (not (nil? *print-level*)) (neg? *print-level*)) + (-write writer "#") + (do + (-write writer begin) + (if (zero? (:print-length opts)) + (when (seq coll) + (-write writer (or (:more-marker opts) "..."))) + (do + (when (seq coll) + (print-one (first coll) writer opts)) + (loop [coll (next coll) n (dec (:print-length opts))] + (if (and coll (or (nil? n) (not (zero? n)))) + (do + (-write writer sep) + (print-one (first coll) writer opts) + (recur (next coll) (dec n))) + (when (and (seq coll) (zero? n)) + (-write writer sep) + (-write writer (or (:more-marker opts) "..."))))))) + (-write writer end))))) + +(defn write-all [writer & ss] + (doseq [s ss] + (-write writer s))) + +(defn string-print [x] + (*print-fn* x) + nil) + +(defn flush [] ;stub + nil) + +(def ^:private char-escapes + (js-obj + "\"" "\\\"" + "\\" "\\\\" + "\b" "\\b" + "\f" "\\f" + "\n" "\\n" + "\r" "\\r" + "\t" "\\t")) + +(defn ^:private quote-string + [s] + (str \" + (.replace s (js/RegExp "[\\\\\"\b\f\n\r\t]" "g") + (fn [match] (aget char-escapes match))) + \")) + +(declare print-map) + +(defn ^boolean print-meta? [opts obj] + (and (boolean (get opts :meta)) + (implements? IMeta obj) + (not (nil? (meta obj))))) + +(defn- pr-writer-impl + [obj writer opts] + (cond + (nil? obj) (-write writer "nil") + :else + (do + (when (print-meta? opts obj) + (-write writer "^") + (pr-writer (meta obj) writer opts) + (-write writer " ")) + (cond + ;; handle CLJS ctors + ^boolean (.-cljs$lang$type obj) + (.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) + + (or (true? obj) (false? obj) (number? obj)) + (-write writer (str obj)) + + (object? obj) + (do + (-write writer "#js ") + (print-map + (map (fn [k] [(keyword k) (aget obj k)]) (js-keys obj)) + pr-writer writer opts)) + + (array? obj) + (pr-sequential-writer writer pr-writer "#js [" " " "]" opts obj) + + ^boolean (goog/isString obj) + (if (:readably opts) + (-write writer (quote-string obj)) + (-write writer obj)) + + ^boolean (goog/isFunction obj) + (let [name (.-name obj) + name (if (or (nil? name) (gstring/isEmpty name)) + "Function" + name)] + (write-all writer "#object[" name " \"" (str obj) "\"]")) + + (instance? js/Date obj) + (let [normalize (fn [n len] + (loop [ns (str n)] + (if (< (count ns) len) + (recur (str "0" ns)) + ns)))] + (write-all writer + "#inst \"" + (str (.getUTCFullYear obj)) "-" + (normalize (inc (.getUTCMonth obj)) 2) "-" + (normalize (.getUTCDate obj) 2) "T" + (normalize (.getUTCHours obj) 2) ":" + (normalize (.getUTCMinutes obj) 2) ":" + (normalize (.getUTCSeconds obj) 2) "." + (normalize (.getUTCMilliseconds obj) 3) "-" + "00:00\"")) + + (regexp? obj) (write-all writer "#\"" (.-source obj) "\"") + + :else + (if (.. 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) "]"))))))) + +(defn- pr-writer + "Prefer this to pr-seq, because it makes the printing function + configurable, allowing efficient implementations such as appending + to a StringBuffer." + [obj writer opts] + (if-let [alt-impl (:alt-impl opts)] + (alt-impl obj writer (assoc opts :fallback-impl pr-writer-impl)) + (pr-writer-impl obj writer opts))) + +(defn pr-seq-writer [objs writer opts] + (pr-writer (first objs) writer opts) + (doseq [obj (next objs)] + (-write writer " ") + (pr-writer obj writer opts))) + +(defn- pr-sb-with-opts [objs opts] + (let [sb (StringBuffer.) + writer (StringBufferWriter. sb)] + (pr-seq-writer objs writer opts) + (-flush writer) + sb)) + +(defn pr-str-with-opts + "Prints a sequence of objects to a string, observing all the + options given in opts" + [objs opts] + (if (empty? objs) + "" + (str (pr-sb-with-opts objs opts)))) + +(defn prn-str-with-opts + "Same as pr-str-with-opts followed by (newline)" + [objs opts] + (if (empty? objs) + "\n" + (let [sb (pr-sb-with-opts objs opts)] + (.append sb \newline) + (str sb)))) + +(defn- pr-with-opts + "Prints a sequence of objects using string-print, observing all + the options given in opts" + [objs opts] + (string-print (pr-str-with-opts objs opts))) + +(defn newline + "Prints a newline using *print-fn*" + ([] (newline nil)) + ([opts] + (string-print "\n") + (when (get opts :flush-on-newline) + (flush)))) + +(defn pr-str + "pr to a string, returning it. Fundamental entrypoint to IPrintWithWriter." + [& objs] + (pr-str-with-opts objs (pr-opts))) + +(defn prn-str + "Same as pr-str followed by (newline)" + [& objs] + (prn-str-with-opts objs (pr-opts))) + +(defn pr + "Prints the object(s) using string-print. Prints the + object(s), separated by spaces if there is more than one. + By default, pr and prn print in a way that objects can be + read by the reader" + [& objs] + (pr-with-opts objs (pr-opts))) + +(def ^{:doc + "Prints the object(s) using string-print. + print and println produce output for human consumption."} + print + (fn cljs-core-print [& objs] + (pr-with-opts objs (assoc (pr-opts) :readably false)))) + +(defn print-str + "print to a string, returning it" + [& objs] + (pr-str-with-opts objs (assoc (pr-opts) :readably false))) + +(defn println + "Same as print followed by (newline)" + [& objs] + (pr-with-opts objs (assoc (pr-opts) :readably false)) + (when *print-newline* + (newline (pr-opts)))) + +(defn println-str + "println to a string, returning it" + [& objs] + (prn-str-with-opts objs (assoc (pr-opts) :readably false))) + +(defn prn + "Same as pr followed by (newline)." + [& objs] + (pr-with-opts objs (pr-opts)) + (when *print-newline* + (newline (pr-opts)))) + +(defn- strip-ns + [named] + (if (symbol? named) + (symbol nil (name named)) + (keyword nil (name named)))) + +(defn- lift-ns + "Returns [lifted-ns lifted-map] or nil if m can't be lifted." + [m] + (when *print-namespace-maps* + (loop [ns nil + [[k v :as entry] & entries] (seq m) + lm (empty m)] + (if entry + (when (or (keyword? k) (symbol? k)) + (if ns + (when (= ns (namespace k)) + (recur ns entries (assoc lm (strip-ns k) v))) + (when-let [new-ns (namespace k)] + (recur new-ns entries (assoc lm (strip-ns k) v))))) + [ns lm])))) + +(defn print-prefix-map [prefix m print-one writer opts] + (pr-sequential-writer + writer + (fn [e w opts] + (do (print-one (key e) w opts) + (-write w \space) + (print-one (val e) w opts))) + (str prefix "{") ", " "}" + opts (seq m))) + +(defn print-map [m print-one writer opts] + (let [[ns lift-map] (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)))) + +(extend-protocol IPrintWithWriter + LazySeq + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) + + LazyTransformer + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) + + IndexedSeq + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) + + RSeq + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) + + PersistentQueue + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "#queue [" " " "]" opts (seq coll))) + + PersistentQueueSeq + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) + + PersistentTreeMapSeq + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) + + NodeSeq + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) + + ArrayNodeSeq + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) + + List + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) + + Cons + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) + + EmptyList + (-pr-writer [coll writer opts] (-write writer "()")) + + PersistentVector + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "[" " " "]" opts coll)) + + ChunkedCons + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) + + ChunkedSeq + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) + + Subvec + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "[" " " "]" opts coll)) + + BlackNode + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "[" " " "]" opts coll)) + + RedNode + (-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)) + + KeySeq + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) + + ValSeq + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) + + PersistentArrayMapSeq + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) + + PersistentArrayMap + (-pr-writer [coll writer opts] + (print-map coll pr-writer writer opts)) + + PersistentHashMap + (-pr-writer [coll writer opts] + (print-map coll pr-writer writer opts)) + + PersistentTreeMap + (-pr-writer [coll writer opts] + (print-map coll pr-writer writer opts)) + + PersistentHashSet + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "#{" " " "}" opts coll)) + + PersistentTreeSet + (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "#{" " " "}" opts coll)) + + Range + (-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)) + + Atom + (-pr-writer [a writer opts] + (-write writer "#object [cljs.core.Atom ") + (pr-writer {:val (.-state a)} writer opts) + (-write writer "]")) + + Volatile + (-pr-writer [a writer opts] + (-write writer "#object [cljs.core.Volatile ") + (pr-writer {:val (.-state a)} writer opts) + (-write writer "]")) + + Var + (-pr-writer [a writer opts] + (-write writer "#'") + (pr-writer (.-sym a) writer opts))) + +;; IComparable +(extend-protocol IComparable + Symbol + (-compare [x y] + (if (symbol? y) + (compare-symbols x y) + (throw (js/Error. (str "Cannot compare " x " to " y))))) + + Keyword + (-compare [x y] + (if (keyword? y) + (compare-keywords x y) + (throw (js/Error. (str "Cannot compare " x " to " y))))) + + Subvec + (-compare [x y] + (if (vector? y) + (compare-indexed x y) + (throw (js/Error. (str "Cannot compare " x " to " y))))) + + PersistentVector + (-compare [x y] + (if (vector? y) + (compare-indexed x y) + (throw (js/Error. (str "Cannot compare " x " to " y)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Reference Types ;;;;;;;;;;;;;;;; + +(defn alter-meta! + "Atomically sets the metadata for a namespace/var/ref/agent/atom to be: + + (apply f its-current-meta args) + + f must be free of side-effects" + [iref f & args] + (set! (.-meta iref) (apply f (.-meta iref) args))) + +(defn reset-meta! + "Atomically resets the metadata for an atom" + [iref m] + (set! (.-meta iref) m)) + +(defn add-watch + "Adds a watch function to an atom reference. The watch fn must be a + fn of 4 args: a key, the reference, its old-state, its + new-state. Whenever the reference's state might have been changed, + any registered watches will have their functions called. The watch + fn will be called synchronously. Note that an atom's state + may have changed again prior to the fn call, so use old/new-state + rather than derefing the reference. Keys must be unique per + reference, and can be used to remove the watch with remove-watch, + but are otherwise considered opaque by the watch mechanism. Bear in + mind that regardless of the result or action of the watch fns the + atom's value will change. Example: + + (def a (atom 0)) + (add-watch a :inc (fn [k r o n] (assert (== 0 n)))) + (swap! a inc) + ;; Assertion Error + (deref a) + ;=> 1" + [iref key f] + (-add-watch iref key f) + iref) + +(defn remove-watch + "Removes a watch (set by add-watch) from a reference" + [iref key] + (-remove-watch iref key) + iref) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; gensym ;;;;;;;;;;;;;;;; +;; Internal - do not use! +(def + ^{:jsdoc ["@type {*}"]} + gensym_counter nil) + +(defn gensym + "Returns a new symbol with a unique name. If a prefix string is + supplied, the name is prefix# where # is some unique number. If + prefix is not supplied, the prefix is 'G__'." + ([] (gensym "G__")) + ([prefix-string] + (when (nil? gensym_counter) + (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] + IDeref + (-deref [_] + (when f + (set! value (f)) + (set! f nil)) + value) + + IPending + (-realized? [x] + (not f))) + +(defn ^boolean delay? + "returns true if x is a Delay created with delay" + [x] (instance? Delay x)) + +(defn force + "If x is a Delay, returns the (possibly cached) value of its expression, else returns x" + [x] + (if (delay? x) + (deref x) + x)) + +(defn ^boolean realized? + "Returns true if a value has been produced for a delay or lazy sequence." + [x] + (-realized? x)) + +(defn- preserving-reduced + [rf] + #(let [ret (rf %1 %2)] + (if (reduced? ret) + (reduced ret) + ret))) + +(defn cat + "A transducer which concatenates the contents of each input, which must be a + collection, into the reduction." + {:added "1.7"} + [rf] + (let [rf1 (preserving-reduced rf)] + (fn + ([] (rf)) + ([result] (rf result)) + ([result input] + (reduce rf1 result input))))) + +(defn halt-when + "Returns a transducer that ends transduction when pred returns true + for an input. When retf is supplied it must be a fn of 2 arguments - + it will be passed the (completed) result so far and the input that + triggered the predicate, and its return value (if it does not throw + an exception) will be the return value of the transducer. If retf + is not supplied, the input that triggered the predicate will be + returned. If the predicate never returns true the transduction is + unaffected." + {:added "1.9"} + ([pred] (halt-when pred nil)) + ([pred retf] + (fn [rf] + (fn + ([] (rf)) + ([result] + (if (and (map? result) (contains? result ::halt)) + (::halt result) + (rf result))) + ([result input] + (if (pred input) + (reduced {::halt (if retf (retf (rf result) input) input)}) + (rf result input))))))) + +(defn dedupe + "Returns a lazy sequence removing consecutive duplicates in coll. + Returns a transducer when no collection is provided." + ([] + (fn [rf] + (let [pa (volatile! ::none)] + (fn + ([] (rf)) + ([result] (rf result)) + ([result input] + (let [prior @pa] + (vreset! pa input) + (if (= prior input) + result + (rf result input)))))))) + ([coll] (sequence (dedupe) coll))) + +(declare rand) + +(defn random-sample + "Returns items from coll with random probability of prob (0.0 - + 1.0). Returns a transducer when no collection is provided." + ([prob] + (filter (fn [_] (< (rand) prob)))) + ([prob coll] + (filter (fn [_] (< (rand) prob)) coll))) + +(deftype Eduction [xform coll] + 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)) + + ISequential + + ISeqable + (-seq [_] (seq (sequence xform coll))) + + IReduce + (-reduce [_ f] (transduce xform (completing f) coll)) + (-reduce [_ f init] (transduce xform (completing f) init coll)) + + IPrintWithWriter + (-pr-writer [coll writer opts] + (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))) + +(es6-iterable Eduction) + +(defn eduction + "Returns a reducible/iterable application of the transducers + to the items in coll. Transducers are applied in order as if + combined with comp. Note that these applications will be + performed every time reduce/iterator is called." + {:arglists '([xform* coll])} + [& xforms] + (Eduction. (apply comp (butlast xforms)) (last xforms))) + +(defn run! + "Runs the supplied procedure (via reduce), for purposes of side + effects, on successive items in the collection. Returns nil" + [proc coll] + (reduce #(proc %2) nil coll) + nil) + +(defprotocol IEncodeJS + (-clj->js [x] "Recursively transforms clj values to JavaScript") + (-key->js [x] "Transforms map keys to valid JavaScript keys. Arbitrary keys are + encoded to their string representation via (pr-str x)")) + +(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 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)))) + +(defprotocol IEncodeClojure + (-js->clj [x options] "Transforms JavaScript values to Clojure")) + +(defn js->clj + "Recursively transforms JavaScript arrays into ClojureScript + vectors, and JavaScript objects into ClojureScript maps. With + option ':keywordize-keys true' will convert object fields from + strings to keywords." + ([x] (js->clj x :keywordize-keys false)) + ([x & opts] + (let [{:keys [keywordize-keys]} opts + keyfn (if keywordize-keys keyword str) + f (fn thisfn [x] + (cond + (satisfies? IEncodeClojure x) + (-js->clj x (apply array-map opts)) + + (seq? x) + (doall (map thisfn x)) + + (coll? 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))])) + + :else x))] + (f x)))) + +(defn memoize + "Returns a memoized version of a referentially transparent function. The + memoized version of the function keeps a cache of the mapping from arguments + to results and, when calls with the same arguments are repeated often, has + higher performance at the expense of higher memory use." + [f] + (let [mem (atom {})] + (fn [& args] + (let [v (get @mem args lookup-sentinel)] + (if (identical? v lookup-sentinel) + (let [ret (apply f args)] + (swap! mem assoc args ret) + ret) + v))))) + +(defn trampoline + "trampoline can be used to convert algorithms requiring mutual + recursion without stack consumption. Calls f with supplied args, if + any. If f returns a fn, calls that fn with no arguments, and + continues to repeat, until the return value is not a fn, then + returns that non-fn value. Note that if you want to return a fn as a + final value, you must wrap it in some data structure and unpack it + after trampoline returns." + ([f] + (let [ret (f)] + (if (fn? ret) + (recur ret) + ret))) + ([f & args] + (trampoline #(apply f args)))) + +(defn rand + "Returns a random floating point number between 0 (inclusive) and + n (default 1) (exclusive)." + ([] (rand 1)) + ([n] (* (Math/random) n))) + +(defn rand-int + "Returns a random integer between 0 (inclusive) and n (exclusive)." + [n] (Math/floor (* (Math/random) n))) + +(defn rand-nth + "Return a random element of the (sequential) collection. Will have + the same performance characteristics as nth for the given + collection." + [coll] + (nth coll (rand-int (count coll)))) + +(defn group-by + "Returns a map of the elements of coll keyed by the result of + f on each element. The value at each key will be a vector of the + corresponding elements, in the order they appeared in coll." + [f coll] + (persistent! + (reduce + (fn [ret x] + (let [k (f x)] + (assoc! ret k (conj (get ret k []) x)))) + (transient {}) coll))) + +(defn make-hierarchy + "Creates a hierarchy object for use with derive, isa? etc." + [] {:parents {} :descendants {} :ancestors {}}) + +(def + ^{:private true + :jsdoc ["@type {*}"]} + -global-hierarchy nil) + +(defn- get-global-hierarchy [] + (when (nil? -global-hierarchy) + (set! -global-hierarchy (atom (make-hierarchy)))) + -global-hierarchy) + +(defn- swap-global-hierarchy! [f & args] + (apply swap! (get-global-hierarchy) f args)) + +(defn ^boolean isa? + "Returns true if (= child parent), or child is directly or indirectly derived from + parent, either via a JavaScript type inheritance relationship or a + relationship established via derive. h must be a hierarchy obtained + from make-hierarchy, if not supplied defaults to the global + hierarchy" + ([child parent] (isa? @(get-global-hierarchy) child parent)) + ([h child parent] + (or (= child parent) + ;; (and (class? parent) (class? child) + ;; (. ^Class parent isAssignableFrom child)) + (contains? ((:ancestors h) child) parent) + ;;(and (class? child) (some #(contains? ((:ancestors h) %) parent) (supers child))) + (and (vector? parent) (vector? child) + (== (count parent) (count child)) + (loop [ret true i 0] + (if (or (not ret) (== i (count parent))) + ret + (recur (isa? h (child i) (parent i)) (inc i)))))))) + +(defn parents + "Returns the immediate parents of tag, either via a JavaScript type + inheritance relationship or a relationship established via derive. h + must be a hierarchy obtained from make-hierarchy, if not supplied + defaults to the global hierarchy" + ([tag] (parents @(get-global-hierarchy) tag)) + ([h tag] (not-empty (get (:parents h) tag)))) + +(defn ancestors + "Returns the immediate and indirect parents of tag, either via a JavaScript type + inheritance relationship or a relationship established via derive. h + must be a hierarchy obtained from make-hierarchy, if not supplied + defaults to the global hierarchy" + ([tag] (ancestors @(get-global-hierarchy) tag)) + ([h tag] (not-empty (get (:ancestors h) tag)))) + +(defn descendants + "Returns the immediate and indirect children of tag, through a + relationship established via derive. h must be a hierarchy obtained + from make-hierarchy, if not supplied defaults to the global + hierarchy. Note: does not work on JavaScript type inheritance + relationships." + ([tag] (descendants @(get-global-hierarchy) tag)) + ([h tag] (not-empty (get (:descendants h) tag)))) + +(defn derive + "Establishes a parent/child relationship between parent and + tag. Parent must be a namespace-qualified symbol or keyword and + child can be either a namespace-qualified symbol or keyword or a + class. h must be a hierarchy obtained from make-hierarchy, if not + supplied defaults to, and modifies, the global hierarchy." + ([tag parent] + (assert (namespace parent)) + ;; (assert (or (class? tag) (and (instance? cljs.core.Named tag) (namespace tag)))) + (swap-global-hierarchy! derive tag parent) nil) + ([h tag parent] + (assert (not= tag parent)) + ;; (assert (or (class? tag) (instance? clojure.lang.Named tag))) + ;; (assert (instance? clojure.lang.INamed tag)) + ;; (assert (instance? clojure.lang.INamed parent)) + (let [tp (:parents h) + td (:descendants h) + ta (:ancestors h) + tf (fn [m source sources target targets] + (reduce (fn [ret k] + (assoc ret k + (reduce conj (get targets k #{}) (cons target (targets target))))) + m (cons source (sources source))))] + (or + (when-not (contains? (tp tag) parent) + (when (contains? (ta tag) parent) + (throw (js/Error. (str tag "already has" parent "as ancestor")))) + (when (contains? (ta parent) tag) + (throw (js/Error. (str "Cyclic derivation:" parent "has" tag "as ancestor")))) + {:parents (assoc (:parents h) tag (conj (get tp tag #{}) parent)) + :ancestors (tf (:ancestors h) tag td parent ta) + :descendants (tf (:descendants h) parent ta tag td)}) + h)))) + +(defn underive + "Removes a parent/child relationship between parent and + tag. h must be a hierarchy obtained from make-hierarchy, if not + supplied defaults to, and modifies, the global hierarchy." + ([tag parent] + (swap-global-hierarchy! underive tag parent) + nil) + ([h tag parent] + (let [parentMap (:parents h) + childsParents (if (parentMap tag) + (disj (parentMap tag) parent) #{}) + newParents (if (not-empty childsParents) + (assoc parentMap tag childsParents) + (dissoc parentMap tag)) + deriv-seq (flatten (map #(cons (first %) (interpose (first %) (second %))) + (seq newParents)))] + (if (contains? (parentMap tag) parent) + (reduce #(apply derive %1 %2) (make-hierarchy) + (partition 2 deriv-seq)) + h)))) + +(defn- reset-cache + [method-cache method-table cached-hierarchy hierarchy] + (swap! method-cache (fn [_] (deref method-table))) + (swap! cached-hierarchy (fn [_] (deref hierarchy)))) + +(defn- prefers* + [x y prefer-table] + (let [xprefs (@prefer-table x)] + (or + (when (and xprefs (xprefs y)) + true) + (loop [ps (parents y)] + (when (pos? (count ps)) + (when (prefers* x (first ps) prefer-table) + true) + (recur (rest ps)))) + (loop [ps (parents x)] + (when (pos? (count ps)) + (when (prefers* (first ps) y prefer-table) + true) + (recur (rest ps)))) + false))) + +(defn- dominates + [x y prefer-table hierarchy] + (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] + (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)) + e + 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")))) + be2) + be)) + nil @method-table)] + (when best-entry + (if (= @cached-hierarchy @hierarchy) + (do + (swap! method-cache assoc dispatch-val (second best-entry)) + (second best-entry)) + (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)))))) + +(defprotocol IMultiFn + (-reset [mf]) + (-add-method [mf dispatch-val method]) + (-remove-method [mf dispatch-val]) + (-prefer-method [mf dispatch-val dispatch-val-y]) + (-get-method [mf dispatch-val]) + (-methods [mf]) + (-prefers [mf]) + (-default-dispatch-val [mf]) + (-dispatch-fn [mf])) + +(defn- throw-no-method-error [name dispatch-val] + (throw (js/Error. (str "No method in multimethod '" name "' for dispatch value: " dispatch-val)))) + +(deftype MultiFn [name dispatch-fn default-dispatch-val hierarchy + method-table prefer-table method-cache cached-hierarchy] + IFn + (-invoke [mf] + (let [dispatch-val (dispatch-fn) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn))) + (-invoke [mf a] + (let [dispatch-val (dispatch-fn a) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a))) + (-invoke [mf a b] + (let [dispatch-val (dispatch-fn a b) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b))) + (-invoke [mf a b c] + (let [dispatch-val (dispatch-fn a b c) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c))) + (-invoke [mf a b c d] + (let [dispatch-val (dispatch-fn a b c d) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c d))) + (-invoke [mf a b c d e] + (let [dispatch-val (dispatch-fn a b c d e) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c d e))) + (-invoke [mf a b c d e f] + (let [dispatch-val (dispatch-fn a b c d e f) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c d e f))) + (-invoke [mf a b c d e f g] + (let [dispatch-val (dispatch-fn a b c d e f g) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c d e f g))) + (-invoke [mf a b c d e f g h] + (let [dispatch-val (dispatch-fn a b c d e f g h) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c d e f g h))) + (-invoke [mf a b c d e f g h i] + (let [dispatch-val (dispatch-fn a b c d e f g h i) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c d e f g h i))) + (-invoke [mf a b c d e f g h i j] + (let [dispatch-val (dispatch-fn a b c d e f g h i j) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c d e f g h i j))) + (-invoke [mf a b c d e f g h i j k] + (let [dispatch-val (dispatch-fn a b c d e f g h i j k) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c d e f g h i j k))) + (-invoke [mf a b c d e f g h i j k l] + (let [dispatch-val (dispatch-fn a b c d e f g h i j k l) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c d e f g h i j k l))) + (-invoke [mf a b c d e f g h i j k l m] + (let [dispatch-val (dispatch-fn a b c d e f g h i j k l m) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c d e f g h i j k l m))) + (-invoke [mf a b c d e f g h i j k l m n] + (let [dispatch-val (dispatch-fn a b c d e f g h i j k l m n) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c d e f g h i j k l m n))) + (-invoke [mf a b c d e f g h i j k l m n o] + (let [dispatch-val (dispatch-fn a b c d e f g h i j k l m n o) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c d e f g h i j k l m n o))) + (-invoke [mf a b c d e f g h i j k l m n o p] + (let [dispatch-val (dispatch-fn a b c d e f g h i j k l m n o p) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c d e f g h i j k l m n o p))) + (-invoke [mf a b c d e f g h i j k l m n o p q] + (let [dispatch-val (dispatch-fn a b c d e f g h i j k l m n o p q) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c d e f g h i j k l m n o p q))) + (-invoke [mf a b c d e f g h i j k l m n o p q r] + (let [dispatch-val (dispatch-fn a b c d e f g h i j k l m n o p q r) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c d e f g h i j k l m n o p q r))) + (-invoke [mf a b c d e f g h i j k l m n o p q r s] + (let [dispatch-val (dispatch-fn a b c d e f g h i j k l m n o p q r s) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c d e f g h i j k l m n o p q r s))) + (-invoke [mf a b c d e f g h i j k l m n o p q r s t] + (let [dispatch-val (dispatch-fn a b c d e f g h i j k l m n o p q r s t) + target-fn (-get-method mf dispatch-val)] + (when-not target-fn + (throw-no-method-error name dispatch-val)) + (target-fn a b c d e f g h i j k l m n o p q r s t))) + (-invoke [mf a b c d e f g h i j k l m n o p q r s t rest] + (let [dispatch-val (apply dispatch-fn a b c d e f g h i j k l m n o p q r s t rest) + target-fn (-get-method mf dispatch-val)] + (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] {})) + (swap! method-cache (fn [mf] {})) + (swap! prefer-table (fn [mf] {})) + (swap! cached-hierarchy (fn [mf] nil)) + mf) + + (-add-method [mf dispatch-val method] + (swap! method-table assoc dispatch-val method) + (reset-cache method-cache method-table cached-hierarchy hierarchy) + mf) + + (-remove-method [mf dispatch-val] + (swap! method-table dissoc dispatch-val) + (reset-cache method-cache method-table cached-hierarchy hierarchy) + mf) + + (-get-method [mf dispatch-val] + (when-not (= @cached-hierarchy @hierarchy) + (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)))) + + (-prefer-method [mf dispatch-val-x dispatch-val-y] + (when (prefers* dispatch-val-x dispatch-val-y prefer-table) + (throw (js/Error. (str "Preference conflict in multimethod '" name "': " dispatch-val-y + " is already preferred to " dispatch-val-x)))) + (swap! prefer-table + (fn [old] + (assoc old dispatch-val-x + (conj (get old dispatch-val-x #{}) + dispatch-val-y)))) + (reset-cache method-cache method-table cached-hierarchy hierarchy)) + + (-methods [mf] @method-table) + (-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)) + + IHash + (-hash [this] (goog/getUid this))) + +(defn remove-all-methods + "Removes all of the methods of multimethod." + [multifn] + (-reset multifn)) + +(defn remove-method + "Removes the method of multimethod associated with dispatch-value." + [multifn dispatch-val] + (-remove-method multifn dispatch-val)) + +(defn prefer-method + "Causes the multimethod to prefer matches of dispatch-val-x over dispatch-val-y + when there is a conflict" + [multifn dispatch-val-x dispatch-val-y] + (-prefer-method multifn dispatch-val-x dispatch-val-y)) + +(defn methods + "Given a multimethod, returns a map of dispatch values -> dispatch fns" + [multifn] (-methods multifn)) + +(defn get-method + "Given a multimethod and a dispatch value, returns the dispatch fn + that would apply to that value, or nil if none apply and no default" + [multifn dispatch-val] (-get-method multifn dispatch-val)) + +(defn prefers + "Given a multimethod, returns a map of preferred value -> set of other values" + [multifn] (-prefers multifn)) + +(defn default-dispatch-val + "Given a multimethod, return it's default-dispatch-val." + [multifn] (-default-dispatch-val multifn)) + +(defn dispatch-fn + "Given a multimethod, return it's dispatch-fn." + [multifn] (-dispatch-fn multifn)) + +;; UUID +(defprotocol IUUID "A marker protocol for UUIDs") + +(deftype UUID [uuid ^:mutable __hash] + IUUID + + Object + (toString [_] uuid) + (equiv [this other] + (-equiv this other)) + + IEquiv + (-equiv [_ other] + (and (instance? UUID other) (identical? uuid (.-uuid other)))) + + IPrintWithWriter + (-pr-writer [_ writer _] + (-write writer (str "#uuid \"" uuid "\""))) + + IHash + (-hash [this] + (when (nil? __hash) + (set! __hash (hash uuid))) + __hash) + + IComparable + (-compare [_ other] + (garray/defaultCompare uuid (.-uuid other)))) + +(defn uuid [s] + (UUID. s nil)) + +(defn random-uuid [] + (letfn [(hex [] (.toString (rand-int 16) 16))] + (let [rhex (.toString (bit-or 0x8 (bit-and 0x3 (rand-int 16))) 16)] + (uuid + (str (hex) (hex) (hex) (hex) + (hex) (hex) (hex) (hex) "-" + (hex) (hex) (hex) (hex) "-" + "4" (hex) (hex) (hex) "-" + rhex (hex) (hex) (hex) "-" + (hex) (hex) (hex) (hex) + (hex) (hex) (hex) (hex) + (hex) (hex) (hex) (hex)))))) + +(defn ^boolean uuid? + [x] (implements? IUUID x)) + +;;; ExceptionInfo + +(defn- pr-writer-ex-info [obj writer opts] + (-write writer "#error {:message ") + (pr-writer (.-message obj) writer opts) + (when (.-data obj) + (-write writer ", :data ") + (pr-writer (.-data obj) writer opts)) + (when (.-cause obj) + (-write writer ", :cause ") + (pr-writer (.-cause obj) writer opts)) + (-write writer "}")) + +(defn ^{:jsdoc ["@constructor"]} + ExceptionInfo [message data cause] + (let [e (js/Error. message)] + (this-as this + (set! (.-message this) message) + (set! (.-data this) data) + (set! (.-cause this) cause) + (do + (set! (.-name this) (.-name e)) + ;; non-standard + (set! (.-description this) (.-description e)) + (set! (.-number this) (.-number e)) + (set! (.-fileName this) (.-fileName e)) + (set! (.-lineNumber this) (.-lineNumber e)) + (set! (.-columnNumber this) (.-columnNumber e)) + (set! (.-stack this) (.-stack e))) + this))) + +(set! (.. ExceptionInfo -prototype -__proto__) js/Error.prototype) + +(extend-type ExceptionInfo + IPrintWithWriter + (-pr-writer [obj writer opts] + (pr-writer-ex-info obj writer opts))) + +(set! (.. ExceptionInfo -prototype -toString) + (fn [] + (this-as this (pr-str* this)))) + +(defn ex-info + "Create an instance of ExceptionInfo, an Error type that carries a + map of additional data." + ([msg data] (ex-info msg data nil)) + ([msg data cause] + (ExceptionInfo. msg data cause))) + +(defn ex-data + "Returns exception data (a map) if ex is an ExceptionInfo. + Otherwise returns nil." + [ex] + (when (instance? ExceptionInfo ex) + (.-data ex))) + +(defn ex-message + "Returns the message attached to the given Error / ExceptionInfo object. + For non-Errors returns nil." + [ex] + (when (instance? js/Error ex) + (.-message ex))) + +(defn ex-cause + "Returns exception cause (an Error / ExceptionInfo) if ex is an + ExceptionInfo. + Otherwise returns nil." + [ex] + (when (instance? ExceptionInfo ex) + (.-cause ex))) + +(defn comparator + "Returns an JavaScript compatible comparator based upon pred." + [pred] + (fn [x y] + (cond (pred x y) -1 (pred y x) 1 :else 0))) + +(defn ^boolean special-symbol? + "Returns true if x names a special form" + [x] + (contains? + '#{if def fn* do let* loop* letfn* throw try catch finally + recur new set! ns deftype* defrecord* . js* & quote var ns*} + x)) + +(defn test + "test [v] finds fn at key :test in var metadata and calls it, + presuming failure will throw exception" + [v] + (let [f (.-cljs$lang$test v)] + (if f + (do (f) :ok) + :no-test))) + + +(deftype TaggedLiteral [tag form] + Object + (toString [coll] + (pr-str* coll)) + + IEquiv + (-equiv [this other] + (and (instance? TaggedLiteral other) + (= tag (.-tag other)) + (= form (.-form other)))) + + IHash + (-hash [this] + (+ (* 31 (hash tag)) + (hash form))) + + ILookup + (-lookup [this v] + (-lookup this v nil)) + (-lookup [this v not-found] + (case v + :tag tag + :form form + not-found)) + + IPrintWithWriter + (-pr-writer [o writer opts] + (-write writer (str "#" tag " ")) + (pr-writer form writer opts))) + +(defn ^boolean tagged-literal? + "Return true if the value is the data representation of a tagged literal" + [value] + (instance? TaggedLiteral value)) + +(defn tagged-literal + "Construct a data representation of a tagged literal from a + tag symbol and a form." + [tag form] + {:pre [(symbol? tag)]} + (TaggedLiteral. tag form)) + +(def + ^{:private true + :jsdoc ["@type {*}"]} + js-reserved-arr + #js ["abstract" "boolean" "break" "byte" "case" + "catch" "char" "class" "const" "continue" + "debugger" "default" "delete" "do" "double" + "else" "enum" "export" "extends" "final" + "finally" "float" "for" "function" "goto" "if" + "implements" "import" "in" "instanceof" "int" + "interface" "let" "long" "native" "new" + "package" "private" "protected" "public" + "return" "short" "static" "super" "switch" + "synchronized" "this" "throw" "throws" + "transient" "try" "typeof" "var" "void" + "volatile" "while" "with" "yield" "methods" + "null"]) + +(def + ^{:jsdoc ["@type {null|Object}"]} + js-reserved nil) + +(defn- js-reserved? [x] + (when (nil? js-reserved) + (set! js-reserved + (reduce #(do (gobject/set %1 %2 true) %1) + #js {} js-reserved-arr))) + (.hasOwnProperty js-reserved x)) + +(defn- demunge-pattern [] + (when-not DEMUNGE_PATTERN + (set! DEMUNGE_PATTERN + (let [ks (sort (fn [a b] (- (. b -length) (. a -length))) + (js-keys DEMUNGE_MAP))] + (loop [ks ks ret ""] + (if (seq ks) + (recur + (next ks) + (str + (cond-> ret + (not (identical? ret "")) (str "|")) + (first ks))) + (str ret "|\\$")))))) + DEMUNGE_PATTERN) + +(defn- munge-str [name] + (let [sb (StringBuffer.)] + (loop [i 0] + (if (< i (. name -length)) + (let [c (.charAt name i) + sub (gobject/get CHAR_MAP c)] + (if-not (nil? sub) + (.append sb sub) + (.append sb c)) + (recur (inc i))))) + (.toString sb))) + +(defn munge [name] + (let [name' (munge-str (str name)) + name' (cond + (identical? name' "..") "_DOT__DOT_" + (js-reserved? name') (str name' "$") + :else name')] + (if (symbol? name) + (symbol name') + (str name')))) + +(defn- demunge-str [munged-name] + (let [r (js/RegExp. (demunge-pattern) "g") + munged-name (if (gstring/endsWith munged-name "$") + (.substring munged-name 0 (dec (. munged-name -length))) + munged-name)] + (loop [ret "" last-match-end 0] + (if-let [match (.exec r munged-name)] + (let [[x] match] + (recur + (str ret + (.substring munged-name last-match-end + (- (. r -lastIndex) (. x -length))) + (if (identical? x "$") "/" (gobject/get DEMUNGE_MAP x))) + (. r -lastIndex))) + (str ret + (.substring munged-name last-match-end (.-length munged-name))))))) + +(defn demunge [name] + ((if (symbol? name) symbol str) + (let [name' (str name)] + (if (identical? name' "_DOT__DOT_") + ".." + (demunge-str (str name)))))) + +;; ----------------------------------------------------------------------------- +;; Bootstrap helpers - incompatible with advanced compilation + +(defn- ns-lookup + "Bootstrap only." + [ns-obj k] + (fn [] (gobject/get ns-obj k))) + +;; Bootstrap only +(deftype Namespace [obj name] + Object + (findInternedVar [this sym] + (let [k (munge (str sym))] + (when ^boolean (gobject/containsKey obj k) + (let [var-sym (symbol (str name) (str sym)) + var-meta {:ns this}] + (Var. (ns-lookup obj k) var-sym var-meta))))) + (getName [_] name) + (toString [_] + (str name)) + IEquiv + (-equiv [_ other] + (if (instance? Namespace other) + (= name (.-name other)) + false)) + IHash + (-hash [_] + (hash name))) + +(def + ^{:doc "Bootstrap only." :jsdoc ["@type {*}"]} + NS_CACHE nil) + +(defn- find-ns-obj* + "Bootstrap only." + [ctxt xs] + (cond + (nil? ctxt) nil + (nil? xs) ctxt + :else (recur (gobject/get ctxt (first xs)) (next xs)))) + +(defn find-ns-obj + "Bootstrap only." + [ns] + (let [munged-ns (munge (str ns)) + segs (.split munged-ns ".")] + (case *target* + "nodejs" (if ^boolean js/COMPILED + ; Under simple optimizations on nodejs, namespaces will be in module + ; rather than global scope and must be accessed by a direct call to eval. + ; The first segment may refer to an undefined variable, so its evaluation + ; may throw ReferenceError. + (find-ns-obj* + (try + (js/eval (first segs)) + (catch js/ReferenceError e + nil)) + (next segs)) + (find-ns-obj* js/global segs)) + "default" (find-ns-obj* goog/global segs) + (throw (js/Error. (str "find-ns-obj not supported for target " *target*)))))) + +(defn ns-interns* + "Bootstrap only." + [sym] + (let [ns-obj (find-ns-obj sym) + ns (Namespace. ns-obj sym)] + (letfn [(step [ret k] + (let [var-sym (symbol (demunge k))] + (assoc ret + var-sym (Var. #(gobject/get ns-obj k) + (symbol (str sym) (str var-sym)) {:ns ns}))))] + (reduce step {} (js-keys ns-obj))))) + +(defn create-ns + "Bootstrap only." + ([sym] + (create-ns sym (find-ns-obj sym))) + ([sym ns-obj] + (Namespace. ns-obj sym))) + +(defn find-ns + "Bootstrap only." + [ns] + (when (nil? NS_CACHE) + (set! NS_CACHE (atom {}))) + (let [the-ns (get @NS_CACHE ns)] + (if-not (nil? the-ns) + the-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 find-macros-ns + "Bootstrap only." + [ns] + (when (nil? NS_CACHE) + (set! NS_CACHE (atom {}))) + (let [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)] + (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." + [ns-obj] + (.-name ns-obj)) |