; 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.293")
(def *unchecked-if* 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-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)]
(when (< i (alength arr))
(aget arr i))))
(-nth [coll n not-found]
(let [i (+ n i)]
(if (< 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 (< k (.-length o))
(aget o (int k)))
(string? o)
(when (and (some? k) (< k (.-length o)))
(aget 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 (< k (.-length o))
(aget o (int k))
not-found)
(string? o)
(if (< k (.-length o))
(aget 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 s satisfies ISeqable"
[s]
(satisfies? ISeqable 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 (.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 (.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 (.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)]
(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)))
(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- 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)))))
(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 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))))))
(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))]
(.fromArray cljs.core/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)))))))
(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)))
(set-from-indexed-seq 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 print-map [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)))
"{" ", " "}"
opts (seq m)))
(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 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))