Permalink
10763 lines (9217 sloc) 303 KB
; 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*)
(def *unchecked-if* false)
(def *warn-on-infer* false)
(defonce PROTOCOL_SENTINEL #js {})
(goog-define
^{:dynamic true
:doc "Var bound to the name value of the compiler build :target option.
For example, if the compiler build :target is :nodejs, *target* will be bound
to \"nodejs\". *target* is a Google Closure define and can be set by compiler
:closure-defines option."}
*target* "default")
(def
^{:dynamic true
:doc "Var bound to the current namespace. Only used for bootstrapping."
:jsdoc ["@type {*}"]}
*ns* nil)
(def
^{:dynamic true
:jsdoc ["@type {*}"]}
*out* nil)
(def
^{:dynamic true}
*assert* true)
(defonce
^{:doc "Each runtime environment provides a different way to print output.
Whatever function *print-fn* is bound to will be passed any
Strings which should be printed." :dynamic true}
*print-fn*
(fn [_]
(throw (js/Error. "No *print-fn* fn set for evaluation environment"))))
(defonce
^{:doc "Each runtime environment provides a different way to print error output.
Whatever function *print-err-fn* is bound to will be passed any
Strings which should be printed." :dynamic true}
*print-err-fn*
(fn [_]
(throw (js/Error. "No *print-err-fn* fn set for evaluation environment"))))
(defn set-print-fn!
"Set *print-fn* to f."
[f] (set! *print-fn* f))
(defn set-print-err-fn!
"Set *print-err-fn* to f."
[f] (set! *print-err-fn* f))
(def
^{:dynamic true
:doc "When set to true, output will be flushed whenever a newline is printed.
Defaults to true."}
*flush-on-newline* true)
(def
^{:dynamic true
:doc "When set to logical false will drop newlines from printing calls.
This is to work around the implicit newlines emitted by standard JavaScript
console objects."}
*print-newline* true)
(def
^{:dynamic true
:doc "When set to logical false, strings and characters will be printed with
non-alphanumeric characters converted to the appropriate escape sequences.
Defaults to true"}
*print-readably* true)
(def
^{:dynamic true
:doc "If set to logical true, when printing an object, its metadata will also
be printed in a form that can be read back by the reader.
Defaults to false."}
*print-meta* false)
(def
^{:dynamic true
:doc "When set to logical true, objects will be printed in a way that preserves
their type when read in later.
Defaults to false."}
*print-dup* false)
(def
^{:dynamic true
:doc "*print-namespace-maps* controls whether the printer will print
namespace map literal syntax.
Defaults to false, but the REPL binds it to true."}
*print-namespace-maps* false)
(def
^{:dynamic true
:doc "*print-length* controls how many items of each collection the
printer will print. If it is bound to logical false, there is no
limit. Otherwise, it must be bound to an integer indicating the maximum
number of items of each collection to print. If a collection contains
more items, the printer will print items up to the limit followed by
'...' to represent the remaining items. The root binding is nil
indicating no limit."
:jsdoc ["@type {null|number}"]}
*print-length* nil)
(def
^{:dynamic true
:doc "*print-level* controls how many levels deep the printer will
print nested objects. If it is bound to logical false, there is no
limit. Otherwise, it must be bound to an integer indicating the maximum
level to print. Each argument to print is at level 0; if an argument is a
collection, its items are at level 1; and so on. If an object is a
collection and is at a level greater than or equal to the value bound to
*print-level*, the printer prints '#' to represent it. The root binding
is nil indicating no limit."
:jsdoc ["@type {null|number}"]}
*print-level* nil)
(defonce
^{:dynamic true
:jsdoc ["@type {*}"]}
*loaded-libs* nil)
(defn- pr-opts []
{:flush-on-newline *flush-on-newline*
:readably *print-readably*
:meta *print-meta*
:dup *print-dup*
:print-length *print-length*})
(declare into-array)
(defn enable-console-print!
"Set *print-fn* to console.log"
[]
(set! *print-newline* false)
(set! *print-fn*
(fn [& args]
(.apply (.-log js/console) js/console (into-array args))))
(set! *print-err-fn*
(fn [& args]
(.apply (.-error js/console) js/console (into-array args))))
nil)
(def
^{:doc "bound in a repl thread to the most recent value printed"}
*1)
(def
^{:doc "bound in a repl thread to the second most recent value printed"}
*2)
(def
^{:doc "bound in a repl thread to the third most recent value printed"}
*3)
(def
^{:doc "bound in a repl thread to the most recent exception caught by the repl"}
*e)
(defn truth_
"Internal - do not use!"
[x]
(cljs.core/truth_ x))
(def not-native nil)
(declare instance? Keyword)
(defn ^boolean identical?
"Tests if 2 arguments are the same object"
[x y]
(cljs.core/identical? x y))
(defn ^boolean nil?
"Returns true if x is nil, false otherwise."
[x]
(coercive-= x nil))
(defn ^boolean array?
"Returns true if x is a JavaScript array."
[x]
(if (identical? *target* "nodejs")
(.isArray js/Array x)
(instance? js/Array x)))
(defn ^boolean number?
"Returns true if x is a JavaScript number."
[x]
(cljs.core/number? x))
(defn ^boolean not
"Returns true if x is logical false, false otherwise."
[x]
(cond
(nil? x) true
(false? x) true
:else false))
(defn ^boolean some?
"Returns true if x is not nil, false otherwise."
[x] (not (nil? x)))
(defn ^boolean object?
"Returns true if x's constructor is Object"
[x]
(if-not (nil? x)
(identical? (.-constructor x) js/Object)
false))
(defn ^boolean string?
"Returns true if x is a JavaScript string."
[x]
(goog/isString x))
(defn ^boolean char?
"Returns true if x is a JavaScript string of length one."
[x]
(and (string? x) (== 1 (.-length x))))
(defn ^boolean any?
"Returns true if given any argument."
[x] true)
(set! *unchecked-if* true)
(defn ^boolean native-satisfies?
"Internal - do not use!"
[p x]
(let [x (if (nil? x) nil x)]
(cond
(aget p (goog/typeOf x)) true
(aget p "_") true
:else false)))
(set! *unchecked-if* false)
(defn is_proto_
[x]
(identical? (.-prototype (.-constructor x)) x))
(def
^{:doc "When compiled for a command-line target, whatever function
*main-cli-fn* is set to will be called with the command-line
argv as arguments"}
*main-cli-fn* nil)
(defn type
"Return x's constructor."
[x]
(when-not (nil? x)
(.-constructor x)))
(defn missing-protocol [proto obj]
(let [ty (type obj)
ty (if (and ty (.-cljs$lang$type ty))
(.-cljs$lang$ctorStr ty)
(goog/typeOf obj))]
(js/Error.
(.join (array "No protocol method " proto
" defined for type " ty ": " obj) ""))))
(defn type->str [ty]
(if-let [s (.-cljs$lang$ctorStr ty)]
s
(str ty)))
;; INTERNAL - do not use, only for Node.js
(defn load-file [file]
(when-not js/COMPILED
(cljs.core/load-file* file)))
(if (and (exists? js/Symbol)
(identical? (goog/typeOf js/Symbol) "function"))
(def ITER_SYMBOL (.-iterator js/Symbol))
(def ITER_SYMBOL "@@iterator"))
(def ^{:jsdoc ["@enum {string}"]}
CHAR_MAP
#js {"-" "_"
":" "_COLON_"
"+" "_PLUS_"
">" "_GT_"
"<" "_LT_"
"=" "_EQ_"
"~" "_TILDE_"
"!" "_BANG_"
"@" "_CIRCA_"
"#" "_SHARP_"
"'" "_SINGLEQUOTE_"
"\\\"" "_DOUBLEQUOTE_"
"%" "_PERCENT_"
"^" "_CARET_"
"&" "_AMPERSAND_"
"*" "_STAR_"
"|" "_BAR_"
"{" "_LBRACE_"
"}" "_RBRACE_"
"[" "_LBRACK_"
"]" "_RBRACK_"
"/" "_SLASH_"
"\\\\" "_BSLASH_"
"?" "_QMARK_"})
(def ^{:jsdoc ["@enum {string}"]}
DEMUNGE_MAP
#js {"_" "-"
"_COLON_" ":"
"_PLUS_" "+"
"_GT_" ">"
"_LT_" "<"
"_EQ_" "="
"_TILDE_" "~"
"_BANG_" "!"
"_CIRCA_" "@"
"_SHARP_" "#"
"_SINGLEQUOTE_" "'"
"_DOUBLEQUOTE_" "\\\""
"_PERCENT_" "%"
"_CARET_" "^"
"_AMPERSAND_" "&"
"_STAR_" "*"
"_BAR_" "|"
"_LBRACE_" "{"
"_RBRACE_" "}"
"_LBRACK_" "["
"_RBRACK_" "]"
"_SLASH_" "/"
"_BSLASH_" "\\\\"
"_QMARK_" "?"})
(def DEMUNGE_PATTERN nil)
(defn system-time
"Returns highest resolution time offered by host in milliseconds."
[]
(cond
(and (exists? js/performance)
(not (nil? (. js/performance -now))))
(.now js/performance)
(and (exists? js/process)
(not (nil? (. js/process -hrtime))))
(let [t (.hrtime js/process)]
(/ (+ (* (aget t 0) 1e9) (aget t 1)) 1e6))
:else (.getTime (js/Date.))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; arrays ;;;;;;;;;;;;;;;;
(declare apply)
(defn ^array make-array
"Construct a JavaScript array of the specified dimensions. Accepts ignored
type argument for compatibility with Clojure. Note that there is no efficient
way to allocate multi-dimensional arrays in JavaScript; as such, this function
will run in polynomial time when called with 3 or more arguments."
([size]
(js/Array. size))
([type size]
(make-array size))
([type size & more-sizes]
(let [dims more-sizes
dimarray (make-array size)]
(dotimes [i (alength dimarray)]
(aset dimarray i (apply make-array nil dims)))
dimarray)))
(defn aclone
"Returns a javascript array, cloned from the passed in array"
[arr]
(let [len (alength arr)
new-arr (make-array len)]
(dotimes [i len]
(aset new-arr i (aget arr i)))
new-arr))
(defn ^array array
"Creates a new javascript array.
@param {...*} var_args" ;;array is a special case, don't emulate this doc string
[var-args] ;; [& items]
(let [a (js/Array. (alength (cljs.core/js-arguments)))]
(loop [i 0]
(if (< i (alength a))
(do
(aset a i (aget (cljs.core/js-arguments) i))
(recur (inc i)))
a))))
(defn aget
"Returns the value at the index."
([array i]
(cljs.core/aget array i))
([array i & idxs]
(apply aget (aget array i) idxs)))
(defn aset
"Sets the value at the index."
([array i val]
(cljs.core/aset array i val))
([array idx idx2 & idxv]
(apply aset (aget array idx) idx2 idxv)))
(defn ^number alength
"Returns the length of the array. Works on arrays of all types."
[array]
(cljs.core/alength array))
(declare reduce)
(defn ^array into-array
"Returns an array with components set to the values in aseq. Optional type
argument accepted for compatibility with Clojure."
([aseq]
(into-array nil aseq))
([type aseq]
(reduce (fn [a x] (.push a x) a) (array) aseq)))
(defn js-invoke
"Invoke JavaScript object method via string. Needed when the
string is not a valid unquoted property name."
[obj s & args]
(.apply (aget obj s) obj (into-array args)))
;;;;;;;;;;;;;;;;;;;;;;;;;;; core protocols ;;;;;;;;;;;;;
(defprotocol Fn
"Marker protocol")
(defprotocol IFn
"Protocol for adding the ability to invoke an object as a function.
For example, a vector can also be used to look up a value:
([1 2 3 4] 1) => 2"
(-invoke
[this]
[this a]
[this a b]
[this a b c]
[this a b c d]
[this a b c d e]
[this a b c d e f]
[this a b c d e f g]
[this a b c d e f g h]
[this a b c d e f g h i]
[this a b c d e f g h i j]
[this a b c d e f g h i j k]
[this a b c d e f g h i j k l]
[this a b c d e f g h i j k l m]
[this a b c d e f g h i j k l m n]
[this a b c d e f g h i j k l m n o]
[this a b c d e f g h i j k l m n o p]
[this a b c d e f g h i j k l m n o p q]
[this a b c d e f g h i j k l m n o p q r]
[this a b c d e f g h i j k l m n o p q r s]
[this a b c d e f g h i j k l m n o p q r s t]
[this a b c d e f g h i j k l m n o p q r s t rest]))
(defprotocol ICloneable
"Protocol for cloning a value."
(^clj -clone [value]
"Creates a clone of value."))
(defprotocol ICounted
"Protocol for adding the ability to count a collection in constant time."
(^number -count [coll]
"Calculates the count of coll in constant time. Used by cljs.core/count."))
(defprotocol IEmptyableCollection
"Protocol for creating an empty collection."
(-empty [coll]
"Returns an empty collection of the same category as coll. Used
by cljs.core/empty."))
(defprotocol ICollection
"Protocol for adding to a collection."
(^clj -conj [coll o]
"Returns a new collection of coll with o added to it. The new item
should be added to the most efficient place, e.g.
(conj [1 2 3 4] 5) => [1 2 3 4 5]
(conj '(2 3 4 5) 1) => '(1 2 3 4 5)"))
#_(defprotocol IOrdinal
(-index [coll]))
(defprotocol IIndexed
"Protocol for collections to provide indexed-based access to their items."
(-nth [coll n] [coll n not-found]
"Returns the value at the index n in the collection coll.
Returns not-found if index n is out of bounds and not-found is supplied."))
(defprotocol ASeq
"Marker protocol indicating an array sequence.")
(defprotocol ISeq
"Protocol for collections to provide access to their items as sequences."
(-first [coll]
"Returns the first item in the collection coll. Used by cljs.core/first.")
(^clj -rest [coll]
"Returns a new collection of coll without the first item. It should
always return a seq, e.g.
(rest []) => ()
(rest nil) => ()"))
(defprotocol INext
"Protocol for accessing the next items of a collection."
(^clj-or-nil -next [coll]
"Returns a new collection of coll without the first item. In contrast to
rest, it should return nil if there are no more items, e.g.
(next []) => nil
(next nil) => nil"))
(defprotocol ILookup
"Protocol for looking up a value in a data structure."
(-lookup [o k] [o k not-found]
"Use k to look up a value in o. If not-found is supplied and k is not
a valid value that can be used for look up, not-found is returned."))
(defprotocol IAssociative
"Protocol for adding associativity to collections."
(^boolean -contains-key? [coll k]
"Returns true if k is a key in coll.")
#_(-entry-at [coll k])
(^clj -assoc [coll k v]
"Returns a new collection of coll with a mapping from key k to
value v added to it."))
(defprotocol IMap
"Protocol for adding mapping functionality to collections."
#_(-assoc-ex [coll k v])
(^clj -dissoc [coll k]
"Returns a new collection of coll without the mapping for key k."))
(defprotocol IMapEntry
"Protocol for examining a map entry."
(-key [coll]
"Returns the key of the map entry.")
(-val [coll]
"Returns the value of the map entry."))
(defprotocol ISet
"Protocol for adding set functionality to a collection."
(^clj -disjoin [coll v]
"Returns a new collection of coll that does not contain v."))
(defprotocol IStack
"Protocol for collections to provide access to their items as stacks. The top
of the stack should be accessed in the most efficient way for the different
data structures."
(-peek [coll]
"Returns the item from the top of the stack. Is used by cljs.core/peek.")
(^clj -pop [coll]
"Returns a new stack without the item on top of the stack. Is used
by cljs.core/pop."))
(defprotocol IVector
"Protocol for adding vector functionality to collections."
(^clj -assoc-n [coll n val]
"Returns a new vector with value val added at position n."))
(defprotocol IDeref
"Protocol for adding dereference functionality to a reference."
(-deref [o]
"Returns the value of the reference o."))
(defprotocol IDerefWithTimeout
(-deref-with-timeout [o msec timeout-val]))
(defprotocol IMeta
"Protocol for accessing the metadata of an object."
(^clj-or-nil -meta [o]
"Returns the metadata of object o."))
(defprotocol IWithMeta
"Protocol for adding metadata to an object."
(^clj -with-meta [o meta]
"Returns a new object with value of o and metadata meta added to it."))
(defprotocol IReduce
"Protocol for seq types that can reduce themselves.
Called by cljs.core/reduce."
(-reduce [coll f] [coll f start]
"f should be a function of 2 arguments. If start is not supplied,
returns the result of applying f to the first 2 items in coll, then
applying f to that result and the 3rd item, etc."))
(defprotocol IKVReduce
"Protocol for associative types that can reduce themselves
via a function of key and val. Called by cljs.core/reduce-kv."
(-kv-reduce [coll f init]
"Reduces an associative collection and returns the result. f should be
a function that takes three arguments."))
(defprotocol IEquiv
"Protocol for adding value comparison functionality to a type."
(^boolean -equiv [o other]
"Returns true if o and other are equal, false otherwise."))
(defprotocol IHash
"Protocol for adding hashing functionality to a type."
(-hash [o]
"Returns the hash code of o."))
(defprotocol ISeqable
"Protocol for adding the ability to a type to be transformed into a sequence."
(^clj-or-nil -seq [o]
"Returns a seq of o, or nil if o is empty."))
(defprotocol ISequential
"Marker interface indicating a persistent collection of sequential items")
(defprotocol IList
"Marker interface indicating a persistent list")
(defprotocol IRecord
"Marker interface indicating a record object")
(defprotocol IReversible
"Protocol for reversing a seq."
(^clj -rseq [coll]
"Returns a seq of the items in coll in reversed order."))
(defprotocol ISorted
"Protocol for a collection which can represent their items
in a sorted manner. "
(^clj -sorted-seq [coll ascending?]
"Returns a sorted seq from coll in either ascending or descending order.")
(^clj -sorted-seq-from [coll k ascending?]
"Returns a sorted seq from coll in either ascending or descending order.
If ascending is true, the result should contain all items which are > or >=
than k. If ascending is false, the result should contain all items which
are < or <= than k, e.g.
(-sorted-seq-from (sorted-set 1 2 3 4 5) 3 true) => (3 4 5)
(-sorted-seq-from (sorted-set 1 2 3 4 5) 3 false) => (3 2 1)")
(-entry-key [coll entry]
"Returns the key for entry.")
(-comparator [coll]
"Returns the comparator for coll."))
(defprotocol IWriter
"Protocol for writing. Currently only implemented by StringBufferWriter."
(-write [writer s]
"Writes s with writer and returns the result.")
(-flush [writer]
"Flush writer."))
(defprotocol IPrintWithWriter
"The old IPrintable protocol's implementation consisted of building a giant
list of strings to concatenate. This involved lots of concat calls,
intermediate vectors, and lazy-seqs, and was very slow in some older JS
engines. IPrintWithWriter implements printing via the IWriter protocol, so it
be implemented efficiently in terms of e.g. a StringBuffer append."
(-pr-writer [o writer opts]))
(defprotocol IPending
"Protocol for types which can have a deferred realization. Currently only
implemented by Delay and LazySeq."
(^boolean -realized? [x]
"Returns true if a value for x has been produced, false otherwise."))
(defprotocol IWatchable
"Protocol for types that can be watched. Currently only implemented by Atom."
(-notify-watches [this oldval newval]
"Calls all watchers with this, oldval and newval.")
(-add-watch [this key f]
"Adds a watcher function f to this. Keys must be unique per reference,
and can be used to remove the watch with -remove-watch.")
(-remove-watch [this key]
"Removes watcher that corresponds to key from this."))
(defprotocol IEditableCollection
"Protocol for collections which can transformed to transients."
(^clj -as-transient [coll]
"Returns a new, transient version of the collection, in constant time."))
(defprotocol ITransientCollection
"Protocol for adding basic functionality to transient collections."
(^clj -conj! [tcoll val]
"Adds value val to tcoll and returns tcoll.")
(^clj -persistent! [tcoll]
"Creates a persistent data structure from tcoll and returns it."))
(defprotocol ITransientAssociative
"Protocol for adding associativity to transient collections."
(^clj -assoc! [tcoll key val]
"Returns a new transient collection of tcoll with a mapping from key to
val added to it."))
(defprotocol ITransientMap
"Protocol for adding mapping functionality to transient collections."
(^clj -dissoc! [tcoll key]
"Returns a new transient collection of tcoll without the mapping for key."))
(defprotocol ITransientVector
"Protocol for adding vector functionality to transient collections."
(^clj -assoc-n! [tcoll n val]
"Returns tcoll with value val added at position n.")
(^clj -pop! [tcoll]
"Returns tcoll with the last item removed from it."))
(defprotocol ITransientSet
"Protocol for adding set functionality to a transient collection."
(^clj -disjoin! [tcoll v]
"Returns tcoll without v."))
(defprotocol IComparable
"Protocol for values that can be compared."
(^number -compare [x y]
"Returns a negative number, zero, or a positive number when x is logically
'less than', 'equal to', or 'greater than' y."))
(defprotocol IChunk
"Protocol for accessing the items of a chunk."
(-drop-first [coll]
"Return a new chunk of coll with the first item removed."))
(defprotocol IChunkedSeq
"Protocol for accessing a collection as sequential chunks."
(-chunked-first [coll]
"Returns the first chunk in coll.")
(-chunked-rest [coll]
"Return a new collection of coll with the first chunk removed."))
(defprotocol IChunkedNext
"Protocol for accessing the chunks of a collection."
(-chunked-next [coll]
"Returns a new collection of coll without the first chunk."))
(defprotocol INamed
"Protocol for adding a name."
(^string -name [x]
"Returns the name String of x.")
(^string -namespace [x]
"Returns the namespace String of x."))
(defprotocol IAtom
"Marker protocol indicating an atom.")
(defprotocol IReset
"Protocol for adding resetting functionality."
(-reset! [o new-value]
"Sets the value of o to new-value."))
(defprotocol ISwap
"Protocol for adding swapping functionality."
(-swap! [o f] [o f a] [o f a b] [o f a b xs]
"Swaps the value of o to be (apply f current-value-of-atom args)."))
(defprotocol IVolatile
"Protocol for adding volatile functionality."
(-vreset! [o new-value]
"Sets the value of volatile o to new-value without regard for the
current value. Returns new-value."))
(defprotocol IIterable
"Protocol for iterating over a collection."
(-iterator [coll]
"Returns an iterator for coll."))
;; Printing support
(deftype StringBufferWriter [sb]
IWriter
(-write [_ s] (.append sb s))
(-flush [_] nil))
(defn pr-str*
"Support so that collections can implement toString without
loading all the printing machinery."
[^not-native obj]
(let [sb (StringBuffer.)
writer (StringBufferWriter. sb)]
(-pr-writer obj writer (pr-opts))
(-flush writer)
(str sb)))
;;;;;;;;;;;;;;;;;;; Murmur3 ;;;;;;;;;;;;;;;
;;http://hg.openjdk.java.net/jdk7u/jdk7u6/jdk/file/8c2c5d63a17e/src/share/classes/java/lang/Integer.java
(defn ^number int-rotate-left [x n]
(bit-or
(bit-shift-left x n)
(unsigned-bit-shift-right x (- n))))
;; http://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Math/imul
(if (and (exists? Math/imul)
(not (zero? (Math/imul 0xffffffff 5))))
(defn ^number imul [a b] (Math/imul a b))
(defn ^number imul [a b]
(let [ah (bit-and (unsigned-bit-shift-right a 16) 0xffff)
al (bit-and a 0xffff)
bh (bit-and (unsigned-bit-shift-right b 16) 0xffff)
bl (bit-and b 0xffff)]
(bit-or
(+ (* al bl)
(unsigned-bit-shift-right
(bit-shift-left (+ (* ah bl) (* al bh)) 16) 0)) 0))))
;; http://smhasher.googlecode.com/svn/trunk/MurmurHash3.cpp
(def m3-seed 0)
(def m3-C1 (int 0xcc9e2d51))
(def m3-C2 (int 0x1b873593))
(defn ^number m3-mix-K1 [k1]
(-> (int k1) (imul m3-C1) (int-rotate-left 15) (imul m3-C2)))
(defn ^number m3-mix-H1 [h1 k1]
(int (-> (int h1) (bit-xor (int k1)) (int-rotate-left 13) (imul 5) (+ (int 0xe6546b64)))))
(defn ^number m3-fmix [h1 len]
(as-> (int h1) h1
(bit-xor h1 len)
(bit-xor h1 (unsigned-bit-shift-right h1 16))
(imul h1 (int 0x85ebca6b))
(bit-xor h1 (unsigned-bit-shift-right h1 13))
(imul h1 (int 0xc2b2ae35))
(bit-xor h1 (unsigned-bit-shift-right h1 16))))
(defn ^number m3-hash-int [in]
(if (zero? in)
in
(let [k1 (m3-mix-K1 in)
h1 (m3-mix-H1 m3-seed k1)]
(m3-fmix h1 4))))
(defn ^number m3-hash-unencoded-chars [in]
(let [h1 (loop [i 1 h1 m3-seed]
(if (< i (alength in))
(recur (+ i 2)
(m3-mix-H1 h1
(m3-mix-K1
(bit-or (.charCodeAt in (dec i))
(bit-shift-left (.charCodeAt in i) 16)))))
h1))
h1 (if (== (bit-and (alength in) 1) 1)
(bit-xor h1 (m3-mix-K1 (.charCodeAt in (dec (alength in)))))
h1)]
(m3-fmix h1 (imul 2 (alength in)))))
;;;;;;;;;;;;;;;;;;; symbols ;;;;;;;;;;;;;;;
(declare list Symbol = compare)
;; Simple caching of string hashcode
(def string-hash-cache (js-obj))
(def string-hash-cache-count 0)
;;http://hg.openjdk.java.net/jdk7u/jdk7u6/jdk/file/8c2c5d63a17e/src/share/classes/java/lang/String.java
(defn hash-string* [s]
(if-not (nil? s)
(let [len (alength s)]
(if (pos? len)
(loop [i 0 hash 0]
(if (< i len)
(recur (inc i) (+ (imul 31 hash) (.charCodeAt s i)))
hash))
0))
0))
(defn add-to-string-hash-cache [k]
(let [h (hash-string* k)]
(aset string-hash-cache k h)
(set! string-hash-cache-count (inc string-hash-cache-count))
h))
(defn hash-string [k]
(when (> string-hash-cache-count 255)
(set! string-hash-cache (js-obj))
(set! string-hash-cache-count 0))
(if (nil? k)
0
(let [h (aget string-hash-cache k)]
(if (number? h)
h
(add-to-string-hash-cache k)))))
(defn hash
"Returns the hash code of its argument. Note this is the hash code
consistent with =."
[o]
(cond
(implements? IHash o)
(-hash ^not-native o)
(number? o)
(if (js/isFinite o)
(js-mod (Math/floor o) 2147483647)
(case o
Infinity
2146435072
-Infinity
-1048576
2146959360))
;; note: mirrors Clojure's behavior on the JVM, where the hashCode is
;; 1231 for true and 1237 for false
;; http://docs.oracle.com/javase/7/docs/api/java/lang/Boolean.html#hashCode%28%29
(true? o) 1231
(false? o) 1237
(string? o)
(m3-hash-int (hash-string o))
(instance? js/Date o)
(.valueOf o)
(nil? o) 0
:else
(-hash o)))
(defn hash-combine [seed hash]
; a la boost
(bit-xor seed
(+ hash 0x9e3779b9
(bit-shift-left seed 6)
(bit-shift-right seed 2))))
(defn ^boolean instance?
"Evaluates x and tests if it is an instance of the type
c. Returns true or false"
[c x]
(cljs.core/instance? c x))
(defn ^boolean symbol?
"Return true if x is a Symbol"
[x]
(instance? Symbol x))
(defn- hash-symbol [sym]
(hash-combine
(m3-hash-unencoded-chars (.-name sym))
(hash-string (.-ns sym))))
(defn- compare-symbols [a b]
(cond
(identical? (.-str a) (.-str b)) 0
(and (not (.-ns a)) (.-ns b)) -1
(.-ns a) (if-not (.-ns b)
1
(let [nsc (garray/defaultCompare (.-ns a) (.-ns b))]
(if (== 0 nsc)
(garray/defaultCompare (.-name a) (.-name b))
nsc)))
:default (garray/defaultCompare (.-name a) (.-name b))))
(declare get)
(deftype Symbol [ns name str ^:mutable _hash _meta]
Object
(toString [_] str)
(equiv [this other] (-equiv this other))
IEquiv
(-equiv [_ other]
(if (instance? Symbol other)
(identical? str (.-str other))
false))
IFn
(-invoke [sym coll]
(get coll sym))
(-invoke [sym coll not-found]
(get coll sym not-found))
IMeta
(-meta [_] _meta)
IWithMeta
(-with-meta [_ new-meta] (Symbol. ns name str _hash new-meta))
IHash
(-hash [sym]
(caching-hash sym hash-symbol _hash))
INamed
(-name [_] name)
(-namespace [_] ns)
IPrintWithWriter
(-pr-writer [o writer _] (-write writer str)))
(defn symbol
"Returns a Symbol with the given namespace and name."
([name]
(if (symbol? name)
name
(let [idx (.indexOf name "/")]
(if (< idx 1)
(symbol nil name)
(symbol (.substring name 0 idx)
(.substring name (inc idx) (. name -length)))))))
([ns name]
(let [sym-str (if-not (nil? ns)
(str ns "/" name)
name)]
(Symbol. ns name sym-str nil nil))))
(deftype Var [val sym _meta]
Object
(isMacro [_]
(. (val) -cljs$lang$macro))
(toString [_]
(str "#'" sym))
IDeref
(-deref [_] (val))
IMeta
(-meta [_] _meta)
IWithMeta
(-with-meta [_ new-meta]
(Var. val sym new-meta))
IEquiv
(-equiv [this other]
(if (instance? Var other)
(= (.-sym this) (.-sym other))
false))
IHash
(-hash [_]
(hash-symbol sym))
Fn
IFn
(-invoke [_]
((val)))
(-invoke [_ a]
((val) a))
(-invoke [_ a b]
((val) a b))
(-invoke [_ a b c]
((val) a b c))
(-invoke [_ a b c d]
((val) a b c d))
(-invoke [_ a b c d e]
((val) a b c d e))
(-invoke [_ a b c d e f]
((val) a b c d e f))
(-invoke [_ a b c d e f g]
((val) a b c d e f g))
(-invoke [_ a b c d e f g h]
((val) a b c d e f g h))
(-invoke [_ a b c d e f g h i]
((val) a b c d e f g h i))
(-invoke [_ a b c d e f g h i j]
((val) a b c d e f g h i j))
(-invoke [_ a b c d e f g h i j k]
((val) a b c d e f g h i j k))
(-invoke [_ a b c d e f g h i j k l]
((val) a b c d e f g h i j k l))
(-invoke [_ a b c d e f g h i j k l m]
((val) a b c d e f g h i j k l m))
(-invoke [_ a b c d e f g h i j k l m n]
((val) a b c d e f g h i j k l m n))
(-invoke [_ a b c d e f g h i j k l m n o]
((val) a b c d e f g h i j k l m n o))
(-invoke [_ a b c d e f g h i j k l m n o p]
((val) a b c d e f g h i j k l m n o p))
(-invoke [_ a b c d e f g h i j k l m n o p q]
((val) a b c d e f g h i j k l m n o p q))
(-invoke [_ a b c d e f g h i j k l m n o p q r]
((val) a b c d e f g h i j k l m n o p q r))
(-invoke [_ a b c d e f g h i j k l m n o p q r s]
((val) a b c d e f g h i j k l m n o p q r s))
(-invoke [_ a b c d e f g h i j k l m n o p q r s t]
((val) a b c d e f g h i j k l m n o p q r s t))
(-invoke [_ a b c d e f g h i j k l m n o p q r s t rest]
(apply (val) a b c d e f g h i j k l m n o p q r s t rest)))
(defn ^boolean var?
"Returns true if v is of type cljs.core.Var"
[v]
(instance? cljs.core.Var v))
;;;;;;;;;;;;;;;;;;; fundamentals ;;;;;;;;;;;;;;;
(declare array-seq prim-seq IndexedSeq)
(defn ^boolean iterable?
"Return true if x implements IIterable protocol."
[x]
(satisfies? IIterable x))
(defn clone
"Clone the supplied value which must implement ICloneable."
[value]
(-clone value))
(defn ^boolean cloneable?
"Return true if x implements ICloneable protocol."
[value]
(satisfies? ICloneable value))
(defn ^seq seq
"Returns a seq on the collection. If the collection is
empty, returns nil. (seq nil) returns nil. seq also works on
Strings."
[coll]
(when-not (nil? coll)
(cond
(implements? ISeqable coll)
(-seq ^not-native coll)
(array? coll)
(when-not (zero? (alength coll))
(IndexedSeq. coll 0 nil))
(string? coll)
(when-not (zero? (alength coll))
(IndexedSeq. coll 0 nil))
(native-satisfies? ISeqable coll)
(-seq coll)
:else (throw (js/Error. (str coll " is not ISeqable"))))))
(defn first
"Returns the first item in the collection. Calls seq on its
argument. If coll is nil, returns nil."
[coll]
(when-not (nil? coll)
(if (implements? ISeq coll)
(-first ^not-native coll)
(let [s (seq coll)]
(when-not (nil? s)
(-first s))))))
(defn ^seq rest
"Returns a possibly empty seq of the items after the first. Calls seq on its
argument."
[coll]
(if-not (nil? coll)
(if (implements? ISeq coll)
(-rest ^not-native coll)
(let [s (seq coll)]
(if s
(-rest ^not-native s)
())))
()))
(defn ^seq next
"Returns a seq of the items after the first. Calls seq on its
argument. If there are no more items, returns nil"
[coll]
(when-not (nil? coll)
(if (implements? INext coll)
(-next ^not-native coll)
(seq (rest coll)))))
(defn ^boolean =
"Equality. Returns true if x equals y, false if not. Compares
numbers and collections in a type-independent manner. Clojure's immutable data
structures define -equiv (and thus =) as a value, not an identity,
comparison."
([x] true)
([x y]
(if (nil? x)
(nil? y)
(or (identical? x y)
^boolean (-equiv x y))))
([x y & more]
(if (= x y)
(if (next more)
(recur y (first more) (next more))
(= y (first more)))
false)))
;; EXPERIMENTAL: subject to change
(deftype ES6Iterator [^:mutable s]
Object
(next [_]
(if-not (nil? s)
(let [x (first s)]
(set! s (next s))
#js {:value x :done false})
#js {:value nil :done true})))
(defn es6-iterator
"EXPERIMENTAL: Return a ES2015 compatible iterator for coll."
[coll]
(ES6Iterator. (seq coll)))
(declare es6-iterator-seq)
(deftype ES6IteratorSeq [value iter ^:mutable _rest]
ISeqable
(-seq [this] this)
ISeq
(-first [_] value)
(-rest [_]
(when (nil? _rest)
(set! _rest (es6-iterator-seq iter)))
_rest))
(defn es6-iterator-seq
"EXPERIMENTAL: Given an ES2015 compatible iterator return a seq."
[iter]
(let [v (.next iter)]
(if (.-done v)
()
(ES6IteratorSeq. (.-value v) iter nil))))
;;;;;;;;;;;;;;;;;;; Murmur3 Helpers ;;;;;;;;;;;;;;;;
(defn ^number mix-collection-hash
"Mix final collection hash for ordered or unordered collections.
hash-basis is the combined collection hash, count is the number
of elements included in the basis. Note this is the hash code
consistent with =, different from .hashCode.
See http://clojure.org/data_structures#hash for full algorithms."
[hash-basis count]
(let [h1 m3-seed
k1 (m3-mix-K1 hash-basis)
h1 (m3-mix-H1 h1 k1)]
(m3-fmix h1 count)))
(defn ^number hash-ordered-coll
"Returns the hash code, consistent with =, for an external ordered
collection implementing Iterable.
See http://clojure.org/data_structures#hash for full algorithms."
[coll]
(loop [n 0 hash-code 1 coll (seq coll)]
(if-not (nil? coll)
(recur (inc n) (bit-or (+ (imul 31 hash-code) (hash (first coll))) 0)
(next coll))
(mix-collection-hash hash-code n))))
(def ^:private empty-ordered-hash
(mix-collection-hash 1 0))
(defn ^number hash-unordered-coll
"Returns the hash code, consistent with =, for an external unordered
collection implementing Iterable. For maps, the iterator should
return map entries whose hash is computed as
(hash-ordered-coll [k v]).
See http://clojure.org/data_structures#hash for full algorithms."
[coll]
(loop [n 0 hash-code 0 coll (seq coll)]
(if-not (nil? coll)
(recur (inc n) (bit-or (+ hash-code (hash (first coll))) 0) (next coll))
(mix-collection-hash hash-code n))))
(def ^:private empty-unordered-hash
(mix-collection-hash 0 0))
;;;;;;;;;;;;;;;;;;; protocols on primitives ;;;;;;;;
(declare hash-map list equiv-sequential)
(extend-type nil
ICounted
(-count [_] 0))
;; TODO: we should remove this and handle date equality checking
;; by some other means, probably by adding a new primitive type
;; case to the hash table lookup - David
(extend-type js/Date
IEquiv
(-equiv [o other]
(and (instance? js/Date other)
(== (.valueOf o) (.valueOf other))))
IComparable
(-compare [this other]
(if (instance? js/Date other)
(garray/defaultCompare (.valueOf this) (.valueOf other))
(throw (js/Error. (str "Cannot compare " this " to " other))))))
(defprotocol Inst
(inst-ms* [inst]))
(extend-protocol Inst
js/Date
(inst-ms* [inst] (.getTime inst)))
(defn inst-ms
"Return the number of milliseconds since January 1, 1970, 00:00:00 GMT"
[inst]
(inst-ms* inst))
(defn ^boolean inst?
"Return true if x satisfies Inst"
[x]
(satisfies? Inst x))
(extend-type number
IEquiv
(-equiv [x o] (identical? x o)))
(declare with-meta)
(extend-type function
Fn
IMeta
(-meta [_] nil))
(extend-type default
IHash
(-hash [o]
(goog/getUid o)))
;;this is primitive because & emits call to array-seq
(defn inc
"Returns a number one greater than num."
[x] (cljs.core/+ x 1))
(declare deref)
(deftype Reduced [val]
IDeref
(-deref [o] val))
(defn reduced
"Wraps x in a way such that a reduce will terminate with the value x"
[x]
(Reduced. x))
(defn ^boolean reduced?
"Returns true if x is the result of a call to reduced"
[r]
(instance? Reduced r))
(defn ensure-reduced
"If x is already reduced?, returns it, else returns (reduced x)"
[x]
(if (reduced? x) x (reduced x)))
(defn unreduced
"If x is reduced?, returns (deref x), else returns x"
[x]
(if (reduced? x) (deref x) x))
;; generic to all refs
;; (but currently hard-coded to atom!)
(defn deref
"Also reader macro: @var/@atom/@delay. Returns the
most-recently-committed value of ref. When applied to a var
or atom, returns its current state. When applied to a delay, forces
it if not already forced. See also - realized?."
[o]
(-deref o))
(defn- ci-reduce
"Accepts any collection which satisfies the ICount and IIndexed protocols and
reduces them without incurring seq initialization"
([cicoll f]
(let [cnt (-count cicoll)]
(if (zero? cnt)
(f)
(loop [val (-nth cicoll 0), n 1]
(if (< n cnt)
(let [nval (f val (-nth cicoll n))]
(if (reduced? nval)
@nval
(recur nval (inc n))))
val)))))
([cicoll f val]
(let [cnt (-count cicoll)]
(loop [val val, n 0]
(if (< n cnt)
(let [nval (f val (-nth cicoll n))]
(if (reduced? nval)
@nval
(recur nval (inc n))))
val))))
([cicoll f val idx]
(let [cnt (-count cicoll)]
(loop [val val, n idx]
(if (< n cnt)
(let [nval (f val (-nth cicoll n))]
(if (reduced? nval)
@nval
(recur nval (inc n))))
val)))))
(defn- array-reduce
([arr f]
(let [cnt (alength arr)]
(if (zero? (alength arr))
(f)
(loop [val (aget arr 0), n 1]
(if (< n cnt)
(let [nval (f val (aget arr n))]
(if (reduced? nval)
@nval
(recur nval (inc n))))
val)))))
([arr f val]
(let [cnt (alength arr)]
(loop [val val, n 0]
(if (< n cnt)
(let [nval (f val (aget arr n))]
(if (reduced? nval)
@nval
(recur nval (inc n))))
val))))
([arr f val idx]
(let [cnt (alength arr)]
(loop [val val, n idx]
(if (< n cnt)
(let [nval (f val (aget arr n))]
(if (reduced? nval)
@nval
(recur nval (inc n))))
val)))))
(declare hash-coll cons drop count nth RSeq List)
(defn ^boolean counted?
"Returns true if coll implements count in constant time"
[x] (satisfies? ICounted x))
(defn ^boolean indexed?
"Returns true if coll implements nth in constant time"
[x] (satisfies? IIndexed x))
(defn- -indexOf
([coll x]
(-indexOf coll x 0))
([coll x start]
(let [len (count coll)]
(if (>= start len)
-1
(loop [idx (cond
(pos? start) start
(neg? start) (max 0 (+ start len))
:else start)]
(if (< idx len)
(if (= (nth coll idx) x)
idx
(recur (inc idx)))
-1))))))
(defn- -lastIndexOf
([coll x]
(-lastIndexOf coll x (count coll)))
([coll x start]
(let [len (count coll)]
(if (zero? len)
-1
(loop [idx (cond
(pos? start) (min (dec len) start)
(neg? start) (+ len start)
:else start)]
(if (>= idx 0)
(if (= (nth coll idx) x)
idx
(recur (dec idx)))
-1))))))
(deftype IndexedSeqIterator [arr ^:mutable i]
Object
(hasNext [_]
(< i (alength arr)))
(next [_]
(let [ret (aget arr i)]
(set! i (inc i))
ret)))
(deftype IndexedSeq [arr i meta]
Object
(toString [coll]
(pr-str* coll))
(equiv [this other]
(-equiv this other))
(indexOf [coll x]
(-indexOf coll x 0))
(indexOf [coll x start]
(-indexOf coll x start))
(lastIndexOf [coll x]
(-lastIndexOf coll x (count coll)))
(lastIndexOf [coll x start]
(-lastIndexOf coll x start))
ICloneable
(-clone [_] (IndexedSeq. arr i meta))
ISeqable
(-seq [this]
(when (< i (alength arr))
this))
IMeta
(-meta [coll] meta)
IWithMeta
(-with-meta [coll new-meta]
(IndexedSeq. arr i new-meta))
ASeq
ISeq
(-first [_] (aget arr i))
(-rest [_] (if (< (inc i) (alength arr))
(IndexedSeq. arr (inc i) nil)
(list)))
INext
(-next [_] (if (< (inc i) (alength arr))
(IndexedSeq. arr (inc i) nil)
nil))
ICounted
(-count [_]
(max 0 (- (alength arr) i)))
IIndexed
(-nth [coll n]
(let [i (+ n i)]
(if (and (<= 0 i) (< i (alength arr)))
(aget arr i)
(throw (js/Error. "Index out of bounds")))))
(-nth [coll n not-found]
(let [i (+ n i)]
(if (and (<= 0 i) (< i (alength arr)))
(aget arr i)
not-found)))
ISequential
IEquiv
(-equiv [coll other] (equiv-sequential coll other))
IIterable
(-iterator [coll]
(IndexedSeqIterator. arr i))
ICollection
(-conj [coll o] (cons o coll))
IEmptyableCollection
(-empty [coll] (.-EMPTY List))
IReduce
(-reduce [coll f]
(array-reduce arr f (aget arr i) (inc i)))
(-reduce [coll f start]
(array-reduce arr f start i))
IHash
(-hash [coll] (hash-ordered-coll coll))
IReversible
(-rseq [coll]
(let [c (-count coll)]
(if (pos? c)
(RSeq. coll (dec c) nil)))))
(es6-iterable IndexedSeq)
(defn prim-seq
"Create seq from a primitive JavaScript Array-like."
([prim]
(prim-seq prim 0))
([prim i]
(when (< i (alength prim))
(IndexedSeq. prim i nil))))
(defn array-seq
"Create a seq from a JavaScript array."
([array]
(prim-seq array 0))
([array i]
(prim-seq array i)))
(declare with-meta seq-reduce)
(deftype RSeq [ci i meta]
Object
(toString [coll]
(pr-str* coll))
(equiv [this other]
(-equiv this other))
(indexOf [coll x]
(-indexOf coll x 0))
(indexOf [coll x start]
(-indexOf coll x start))
(lastIndexOf [coll x]
(-lastIndexOf coll x (count coll)))
(lastIndexOf [coll x start]
(-lastIndexOf coll x start))
ICloneable
(-clone [_] (RSeq. ci i meta))
IMeta
(-meta [coll] meta)
IWithMeta
(-with-meta [coll new-meta]
(RSeq. ci i new-meta))
ISeqable
(-seq [coll] coll)
ISequential
IEquiv
(-equiv [coll other] (equiv-sequential coll other))
ISeq
(-first [coll]
(-nth ci i))
(-rest [coll]
(if (pos? i)
(RSeq. ci (dec i) nil)
()))
INext
(-next [coll]
(when (pos? i)
(RSeq. ci (dec i) nil)))
ICounted
(-count [coll] (inc i))
ICollection
(-conj [coll o]
(cons o coll))
IEmptyableCollection
(-empty [coll] (with-meta (.-EMPTY List) meta))
IHash
(-hash [coll] (hash-ordered-coll coll))
IReduce
(-reduce [col f] (seq-reduce f col))
(-reduce [col f start] (seq-reduce f start col)))
(es6-iterable RSeq)
(defn second
"Same as (first (next x))"
[coll]
(first (next coll)))
(defn ffirst
"Same as (first (first x))"
[coll]
(first (first coll)))
(defn nfirst
"Same as (next (first x))"
[coll]
(next (first coll)))
(defn fnext
"Same as (first (next x))"
[coll]
(first (next coll)))
(defn nnext
"Same as (next (next x))"
[coll]
(next (next coll)))
(defn last
"Return the last item in coll, in linear time"
[s]
(let [sn (next s)]
(if-not (nil? sn)
(recur sn)
(first s))))
(extend-type default
IEquiv
(-equiv [x o] (identical? x o)))
(defn conj
"conj[oin]. Returns a new collection with the xs
'added'. (conj nil item) returns (item). The 'addition' may
happen at different 'places' depending on the concrete type."
([] [])
([coll] coll)
([coll x]
(if-not (nil? coll)
(-conj coll x)
(list x)))
([coll x & xs]
(if xs
(recur (conj coll x) (first xs) (next xs))
(conj coll x))))
(defn empty
"Returns an empty collection of the same category as coll, or nil"
[coll]
(when-not (nil? coll)
(-empty coll)))
(defn- accumulating-seq-count [coll]
(loop [s (seq coll) acc 0]
(if (counted? s) ; assumes nil is counted, which it currently is
(+ acc (-count s))
(recur (next s) (inc acc)))))
(defn count
"Returns the number of items in the collection. (count nil) returns
0. Also works on strings, arrays, and Maps"
[coll]
(if-not (nil? coll)
(cond
(implements? ICounted coll)
(-count ^not-native coll)
(array? coll)
(alength coll)
(string? coll)
(alength coll)
(implements? ISeqable coll)
(accumulating-seq-count coll)
:else (-count coll))
0))
(defn- linear-traversal-nth
([coll n]
(cond
(nil? coll) (throw (js/Error. "Index out of bounds"))
(zero? n) (if (seq coll)
(first coll)
(throw (js/Error. "Index out of bounds")))
(indexed? coll) (-nth coll n)
(seq coll) (recur (next coll) (dec n))
:else (throw (js/Error. "Index out of bounds"))))
([coll n not-found]
(cond
(nil? coll) not-found
(zero? n) (if (seq coll)
(first coll)
not-found)
(indexed? coll) (-nth coll n not-found)
(seq coll) (recur (next coll) (dec n) not-found)
:else not-found)))
(defn nth
"Returns the value at the index. get returns nil if index out of
bounds, nth throws an exception unless not-found is supplied. nth
also works for strings, arrays, regex Matchers and Lists, and,
in O(n) time, for sequences."
([coll n]
(cond
(not (number? n))
(throw (js/Error. "Index argument to nth must be a number"))
(nil? coll)
coll
(implements? IIndexed coll)
(-nth ^not-native coll n)
(array? coll)
(if (and (>= n 0) (< n (.-length coll)))
(aget coll n)
(throw (js/Error. "Index out of bounds")))
(string? coll)
(if (and (>= n 0) (< n (.-length coll)))
(.charAt coll n)
(throw (js/Error. "Index out of bounds")))
(implements? ISeq coll)
(linear-traversal-nth coll n)
(native-satisfies? IIndexed coll)
(-nth coll n)
:else
(throw (js/Error. (str "nth not supported on this type "
(type->str (type coll)))))))
([coll n not-found]
(cond
(not (number? n))
(throw (js/Error. "Index argument to nth must be a number."))
(nil? coll)
not-found
(implements? IIndexed coll)
(-nth ^not-native coll n not-found)
(array? coll)
(if (and (>= n 0) (< n (.-length coll)))
(aget coll n)
not-found)
(string? coll)
(if (and (>= n 0) (< n (.-length coll)))
(.charAt coll n)
not-found)
(implements? ISeq coll)
(linear-traversal-nth coll n not-found)
(native-satisfies? IIndexed coll)
(-nth coll n)
:else
(throw (js/Error. (str "nth not supported on this type "
(type->str (type coll))))))))
(defn nthrest
"Returns the nth rest of coll, coll when n is 0."
[coll n]
(loop [n n xs coll]
(if (and (pos? n) (seq xs))
(recur (dec n) (rest xs))
xs)))
(defn get
"Returns the value mapped to key, not-found or nil if key not present."
([o k]
(when-not (nil? o)
(cond
(implements? ILookup o)
(-lookup ^not-native o k)
(array? o)
(when (and (some? k) (< k (.-length o)))
(aget o (int k)))
(string? o)
(when (and (some? k) (< k (.-length o)))
(.charAt o (int k)))
(native-satisfies? ILookup o)
(-lookup o k)
:else nil)))
([o k not-found]
(if-not (nil? o)
(cond
(implements? ILookup o)
(-lookup ^not-native o k not-found)
(array? o)
(if (and (some? k) (>= k 0) (< k (.-length o)))
(aget o (int k))
not-found)
(string? o)
(if (and (some? k) (>= k 0) (< k (.-length o)))
(.charAt o (int k))
not-found)
(native-satisfies? ILookup o)
(-lookup o k not-found)
:else not-found)
not-found)))
(declare PersistentHashMap)
(defn assoc
"assoc[iate]. When applied to a map, returns a new map of the
same (hashed/sorted) type, that contains the mapping of key(s) to
val(s). When applied to a vector, returns a new vector that
contains val at index."
([coll k v]
(if-not (nil? coll)
(-assoc coll k v)
(hash-map k v)))
([coll k v & kvs]
(let [ret (assoc coll k v)]
(if kvs
(recur ret (first kvs) (second kvs) (nnext kvs))
ret))))
(defn dissoc
"dissoc[iate]. Returns a new map of the same (hashed/sorted) type,
that does not contain a mapping for key(s)."
([coll] coll)
([coll k]
(when-not (nil? coll)
(-dissoc coll k)))
([coll k & ks]
(when-not (nil? coll)
(let [ret (dissoc coll k)]
(if ks
(recur ret (first ks) (next ks))
ret)))))
(defn ^boolean fn?
"Return true if f is a JavaScript function or satisfies the Fn protocol."
[f]
(or ^boolean (goog/isFunction f) (satisfies? Fn f)))
(deftype MetaFn [afn meta]
IMeta
(-meta [_] meta)
IWithMeta
(-with-meta [_ new-meta]
(MetaFn. afn new-meta))
Fn
IFn
(-invoke [_]
(afn))
(-invoke [_ a]
(afn a))
(-invoke [_ a b]
(afn a b))
(-invoke [_ a b c]
(afn a b c))
(-invoke [_ a b c d]
(afn a b c d))
(-invoke [_ a b c d e]
(afn a b c d e))
(-invoke [_ a b c d e f]
(afn a b c d e f))
(-invoke [_ a b c d e f g]
(afn a b c d e f g))
(-invoke [_ a b c d e f g h]
(afn a b c d e f g h))
(-invoke [_ a b c d e f g h i]
(afn a b c d e f g h i))
(-invoke [_ a b c d e f g h i j]
(afn a b c d e f g h i j))
(-invoke [_ a b c d e f g h i j k]
(afn a b c d e f g h i j k))
(-invoke [_ a b c d e f g h i j k l]
(afn a b c d e f g h i j k l))
(-invoke [_ a b c d e f g h i j k l m]
(afn a b c d e f g h i j k l m))
(-invoke [_ a b c d e f g h i j k l m n]
(afn a b c d e f g h i j k l m n))
(-invoke [_ a b c d e f g h i j k l m n o]
(afn a b c d e f g h i j k l m n o))
(-invoke [_ a b c d e f g h i j k l m n o p]
(afn a b c d e f g h i j k l m n o p))
(-invoke [_ a b c d e f g h i j k l m n o p q]
(afn a b c d e f g h i j k l m n o p q))
(-invoke [_ a b c d e f g h i j k l m n o p q r]
(afn a b c d e f g h i j k l m n o p q r))
(-invoke [_ a b c d e f g h i j k l m n o p q r s]
(afn a b c d e f g h i j k l m n o p q r s))
(-invoke [_ a b c d e f g h i j k l m n o p q r s t]
(afn a b c d e f g h i j k l m n o p q r s t))
(-invoke [_ a b c d e f g h i j k l m n o p q r s t rest]
(apply afn a b c d e f g h i j k l m n o p q r s t rest)))
(defn with-meta
"Returns an object of the same type and value as obj, with
map m as its metadata."
[o meta]
(if ^boolean (goog/isFunction o)
(MetaFn. o meta)
(when-not (nil? o)
(-with-meta o meta))))
(defn meta
"Returns the metadata of obj, returns nil if there is no metadata."
[o]
(when (and (not (nil? o))
(satisfies? IMeta o))
(-meta o)))
(defn peek
"For a list or queue, same as first, for a vector, same as, but much
more efficient than, last. If the collection is empty, returns nil."
[coll]
(when-not (nil? coll)
(-peek coll)))
(defn pop
"For a list or queue, returns a new list/queue without the first
item, for a vector, returns a new vector without the last item.
Note - not the same as next/butlast."
[coll]
(when-not (nil? coll)
(-pop coll)))
(defn disj
"disj[oin]. Returns a new set of the same (hashed/sorted) type, that
does not contain key(s)."
([coll] coll)
([coll k]
(when-not (nil? coll)
(-disjoin coll k)))
([coll k & ks]
(when-not (nil? coll)
(let [ret (disj coll k)]
(if ks
(recur ret (first ks) (next ks))
ret)))))
(defn ^boolean empty?
"Returns true if coll has no items - same as (not (seq coll)).
Please use the idiom (seq x) rather than (not (empty? x))"
[coll] (or (nil? coll)
(not (seq coll))))
(defn ^boolean coll?
"Returns true if x satisfies ICollection"
[x]
(if (nil? x)
false
(satisfies? ICollection x)))
(defn ^boolean set?
"Returns true if x satisfies ISet"
[x]
(if (nil? x)
false
(satisfies? ISet x)))
(defn ^boolean associative?
"Returns true if coll implements Associative"
[x] (satisfies? IAssociative x))
(defn ^boolean sequential?
"Returns true if coll satisfies ISequential"
[x] (satisfies? ISequential x))
(defn ^boolean sorted?
"Returns true if coll satisfies ISorted"
[x] (satisfies? ISorted x))
(defn ^boolean reduceable?
"Returns true if coll satisfies IReduce"
[x] (satisfies? IReduce x))
(defn ^boolean map?
"Return true if x satisfies IMap"
[x]
(if (nil? x)
false
(satisfies? IMap x)))
(defn ^boolean record?
"Return true if x satisfies IRecord"
[x]
(satisfies? IRecord x))
(defn ^boolean vector?
"Return true if x satisfies IVector"
[x] (satisfies? IVector x))
(declare ChunkedCons ChunkedSeq)
(defn ^boolean chunked-seq?
"Return true if x is satisfies IChunkedSeq."
[x] (implements? IChunkedSeq x))
;;;;;;;;;;;;;;;;;;;; js primitives ;;;;;;;;;;;;
(defn js-obj
"Create JavaSript object from an even number arguments representing
interleaved keys and values."
([]
(cljs.core/js-obj))
([& keyvals]
(apply gobject/create keyvals)))
(defn js-keys
"Return the JavaScript keys for an object."
[obj]
(let [keys (array)]
(gobject/forEach obj (fn [val key obj] (.push keys key)))
keys))
(defn js-delete
"Delete a property from a JavaScript object."
[obj key]
(cljs.core/js-delete obj key))
(defn- array-copy
([from i to j len]
(loop [i i j j len len]
(if (zero? len)
to
(do (aset to j (aget from i))
(recur (inc i) (inc j) (dec len)))))))
(defn- array-copy-downward
([from i to j len]
(loop [i (+ i (dec len)) j (+ j (dec len)) len len]
(if (zero? len)
to
(do (aset to j (aget from i))
(recur (dec i) (dec j) (dec len)))))))
;;;;;;;;;;;;;;;; preds ;;;;;;;;;;;;;;;;;;
(def ^:private lookup-sentinel (js-obj))
(defn ^boolean false?
"Returns true if x is the value false, false otherwise."
[x] (cljs.core/false? x))
(defn ^boolean true?
"Returns true if x is the value true, false otherwise."
[x] (cljs.core/true? x))
(defn ^boolean boolean?
"Return true if x is a Boolean"
[x] (or (cljs.core/true? x) (cljs.core/false? x)))
(defn ^boolean undefined?
"Returns true if x identical to the JavaScript undefined value."
[x]
(cljs.core/undefined? x))
(defn ^boolean seq?
"Return true if s satisfies ISeq"
[s]
(if (nil? s)
false
(satisfies? ISeq s)))
(defn ^boolean seqable?
"Return true if the seq function is supported for s"
[s]
(or
(satisfies? ISeqable s)
(array? s)
(string? s)))
(defn ^boolean boolean
"Coerce to boolean"
[x]
(cond
(nil? x) false
(false? x) false
:else true))
(defn ^boolean ifn?
"Returns true if f returns true for fn? or satisfies IFn."
[f]
(or (fn? f) (satisfies? IFn f)))
(defn ^boolean integer?
"Returns true if n is a JavaScript number with no decimal part."
[n]
(and (number? n)
(not ^boolean (js/isNaN n))
(not (identical? n js/Infinity))
(== (js/parseFloat n) (js/parseInt n 10))))
(defn ^boolean int?
"Return true if x satisfies integer? or is an instance of goog.math.Integer
or goog.math.Long."
[x]
(or (integer? x)
(instance? goog.math.Integer x)
(instance? goog.math.Long x)))
(defn ^boolean pos-int?
"Return true if x satisfies int? and is positive."
[x]
(cond
(integer? x) (pos? x)
(instance? goog.math.Integer x)
(and (not (.isNegative x))
(not (.isZero x)))
(instance? goog.math.Long x)
(and (not (.isNegative x))
(not (.isZero x)))
:else false))
(defn ^boolean neg-int?
"Return true if x satisfies int? and is positive."
[x]
(cond
(integer? x) (neg? x)
(instance? goog.math.Integer x)
(.isNegative x)
(instance? goog.math.Long x)
(.isNegative x)
:else false))
(defn ^boolean nat-int?
"Return true if x satisfies int? and is a natural integer value."
[x]
(cond
(integer? x)
(or (not (neg? x)) (zero? x))
(instance? goog.math.Integer x)
(or (not (.isNegative x)) (.isZero x))
(instance? goog.math.Long x)
(or (not (.isNegative x)) (.isZero x))
:else false))
(defn ^boolean float?
"Returns true for JavaScript numbers, false otherwise."
[x]
(number? x))
(defn ^boolean double?
"Returns true for JavaScript numbers, false otherwise."
[x]
(number? x))
(defn ^boolean infinite?
"Returns true for Infinity and -Infinity values."
[x]
(or (identical? x js/Number.POSITIVE_INFINITY)
(identical? x js/Number.NEGATIVE_INFINITY)))
(defn ^boolean contains?
"Returns true if key is present in the given collection, otherwise
returns false. Note that for numerically indexed collections like
vectors and arrays, this tests if the numeric key is within the
range of indexes. 'contains?' operates constant or logarithmic time;
it will not perform a linear search for a value. See also 'some'."
[coll v]
(if (identical? (get coll v lookup-sentinel) lookup-sentinel)
false
true))
(defn find
"Returns the map entry for key, or nil if key not present."
[coll k]
(when (and (not (nil? coll))
(associative? coll)
(contains? coll k))
[k (get coll k)]))
(defn ^boolean distinct?
"Returns true if no two of the arguments are ="
([x] true)
([x y] (not (= x y)))
([x y & more]
(if (not (= x y))
(loop [s #{x y} xs more]
(let [x (first xs)
etc (next xs)]
(if xs
(if (contains? s x)
false
(recur (conj s x) etc))
true)))
false)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Seq fns ;;;;;;;;;;;;;;;;
(defn ^number compare
"Comparator. Returns a negative number, zero, or a positive number
when x is logically 'less than', 'equal to', or 'greater than'
y. Uses IComparable if available and google.array.defaultCompare for objects
of the same type and special-cases nil to be less than any other object."
[x y]
(cond
(identical? x y) 0
(nil? x) -1
(nil? y) 1
(number? x) (if (number? y)
(garray/defaultCompare x y)
(throw (js/Error. (str "Cannot compare " x " to " y))))
(satisfies? IComparable x)
(-compare x y)
:else
(if (and (or (string? x) (array? x) (true? x) (false? x))
(identical? (type x) (type y)))
(garray/defaultCompare x y)
(throw (js/Error. (str "Cannot compare " x " to " y))))))
(defn ^:private compare-indexed
"Compare indexed collection."
([xs ys]
(let [xl (count xs)
yl (count ys)]
(cond
(< xl yl) -1
(> xl yl) 1
(== xl 0) 0
:else (compare-indexed xs ys xl 0))))
([xs ys len n]
(let [d (compare (nth xs n) (nth ys n))]
(if (and (zero? d) (< (+ n 1) len))
(recur xs ys len (inc n))
d))))
(defn ^:private fn->comparator
"Given a fn that might be boolean valued or a comparator,
return a fn that is a comparator."
[f]
(if (= f compare)
compare
(fn [x y]
(let [r (f x y)]
(if (number? r)
r
(if r
-1
(if (f y x) 1 0)))))))
(declare to-array)
(defn sort
"Returns a sorted sequence of the items in coll. Comp can be
boolean-valued comparison function, or a -/0/+ valued comparator.
Comp defaults to compare."
([coll]
(sort compare coll))
([comp coll]
(if (seq coll)
(let [a (to-array coll)]
;; matching Clojure's stable sort, though docs don't promise it
(garray/stableSort a (fn->comparator comp))
(seq a))
())))
(defn sort-by
"Returns a sorted sequence of the items in coll, where the sort
order is determined by comparing (keyfn item). Comp can be
boolean-valued comparison funcion, or a -/0/+ valued comparator.
Comp defaults to compare."
([keyfn coll]
(sort-by keyfn compare coll))
([keyfn comp coll]
(sort (fn [x y] ((fn->comparator comp) (keyfn x) (keyfn y))) coll)))
; simple reduce based on seqs, used as default
(defn- seq-reduce
([f coll]
(if-let [s (seq coll)]
(reduce f (first s) (next s))
(f)))
([f val coll]
(loop [val val, coll (seq coll)]
(if coll
(let [nval (f val (first coll))]
(if (reduced? nval)
@nval
(recur nval (next coll))))
val))))
(declare vec)
(defn shuffle
"Return a random permutation of coll"
[coll]
(let [a (to-array coll)]
(garray/shuffle a)
(vec a)))
(defn reduce
"f should be a function of 2 arguments. If val is not supplied,
returns the result of applying f to the first 2 items in coll, then
applying f to that result and the 3rd item, etc. If coll contains no
items, f must accept no arguments as well, and reduce returns the
result of calling f with no arguments. If coll has only 1 item, it
is returned and f is not called. If val is supplied, returns the
result of applying f to val and the first item in coll, then
applying f to that result and the 2nd item, etc. If coll contains no
items, returns val and f is not called."
([f coll]
(cond
(implements? IReduce coll)
(-reduce ^not-native coll f)
(array? coll)
(array-reduce coll f)
(string? coll)
(array-reduce coll f)
(native-satisfies? IReduce coll)
(-reduce coll f)
:else
(seq-reduce f coll)))
([f val coll]
(cond
(implements? IReduce coll)
(-reduce ^not-native coll f val)
(array? coll)
(array-reduce coll f val)
(string? coll)
(array-reduce coll f val)
(native-satisfies? IReduce coll)
(-reduce coll f val)
:else
(seq-reduce f val coll))))
(defn reduce-kv
"Reduces an associative collection. f should be a function of 3
arguments. Returns the result of applying f to init, the first key
and the first value in coll, then applying f to that result and the
2nd key and value, etc. If coll contains no entries, returns init
and f is not called. Note that reduce-kv is supported on vectors,
where the keys will be the ordinals."
([f init coll]
(if-not (nil? coll)
(-kv-reduce coll f init)
init)))
(defn identity
"Returns its argument."
[x] x)
(defn completing
"Takes a reducing function f of 2 args and returns a fn suitable for
transduce by adding an arity-1 signature that calls cf (default -
identity) on the result argument."
([f] (completing f identity))
([f cf]
(fn
([] (f))
([x] (cf x))
([x y] (f x y)))))
(defn transduce
"reduce with a transformation of f (xf). If init is not
supplied, (f) will be called to produce it. f should be a reducing
step function that accepts both 1 and 2 arguments, if it accepts
only 2 you can add the arity-1 with 'completing'. Returns the result
of applying (the transformed) xf to init and the first item in coll,
then applying xf to that result and the 2nd item, etc. If coll
contains no items, returns init and f is not called. Note that
certain transforms may inject or skip items."
([xform f coll] (transduce xform f (f) coll))
([xform f init coll]
(let [f (xform f)
ret (reduce f init coll)]
(f ret))))
;;; Math - variadic forms will not work until the following implemented:
;;; first, next, reduce
(defn ^number +
"Returns the sum of nums. (+) returns 0."
([] 0)
([x] x)
([x y] (cljs.core/+ x y))
([x y & more]
(reduce + (cljs.core/+ x y) more)))
(defn ^number -
"If no ys are supplied, returns the negation of x, else subtracts
the ys from x and returns the result."
([x] (cljs.core/- x))
([x y] (cljs.core/- x y))
([x y & more] (reduce - (cljs.core/- x y) more)))
(defn ^number *
"Returns the product of nums. (*) returns 1."
([] 1)
([x] x)
([x y] (cljs.core/* x y))
([x y & more] (reduce * (cljs.core/* x y) more)))
(declare divide)
(defn ^number /
"If no denominators are supplied, returns 1/numerator,
else returns numerator divided by all of the denominators."
([x] (/ 1 x))
([x y] (cljs.core/divide x y)) ;; FIXME: waiting on cljs.core//
([x y & more] (reduce / (/ x y) more)))
(defn ^boolean <
"Returns non-nil if nums are in monotonically increasing order,
otherwise false."
([x] true)
([x y] (cljs.core/< x y))
([x y & more]
(if (cljs.core/< x y)
(if (next more)
(recur y (first more) (next more))
(cljs.core/< y (first more)))
false)))
(defn ^boolean <=
"Returns non-nil if nums are in monotonically non-decreasing order,
otherwise false."
([x] true)
([x y] (cljs.core/<= x y))
([x y & more]
(if (cljs.core/<= x y)
(if (next more)
(recur y (first more) (next more))
(cljs.core/<= y (first more)))
false)))
(defn ^boolean >
"Returns non-nil if nums are in monotonically decreasing order,
otherwise false."
([x] true)
([x y] (cljs.core/> x y))
([x y & more]
(if (cljs.core/> x y)
(if (next more)
(recur y (first more) (next more))
(cljs.core/> y (first more)))
false)))
(defn ^boolean >=
"Returns non-nil if nums are in monotonically non-increasing order,
otherwise false."
([x] true)
([x y] (cljs.core/>= x y))
([x y & more]
(if (cljs.core/>= x y)
(if (next more)
(recur y (first more) (next more))
(cljs.core/>= y (first more)))
false)))
(defn dec
"Returns a number one less than num."
[x] (- x 1))
(defn ^number max
"Returns the greatest of the nums."
([x] x)
([x y] (cljs.core/max x y))
([x y & more]
(reduce max (cljs.core/max x y) more)))
(defn ^number min
"Returns the least of the nums."
([x] x)
([x y] (cljs.core/min x y))
([x y & more]
(reduce min (cljs.core/min x y) more)))
(defn ^number byte [x] x)
(defn char
"Coerce to char"
[x]
(cond
(number? x) (.fromCharCode js/String x)
(and (string? x) (== (.-length x) 1)) x
:else (throw (js/Error. "Argument to char must be a character or number"))))
(defn ^number short [x] x)
(defn ^number float [x] x)
(defn ^number double [x] x)
(defn ^number unchecked-byte [x] x)
(defn ^number unchecked-char [x] x)
(defn ^number unchecked-short [x] x)
(defn ^number unchecked-float [x] x)
(defn ^number unchecked-double [x] x)
(defn ^number unchecked-add
"Returns the sum of nums. (+) returns 0."
([] 0)
([x] x)
([x y] (cljs.core/unchecked-add x y))
([x y & more] (reduce unchecked-add (cljs.core/unchecked-add x y) more)))
(defn ^number unchecked-add-int
"Returns the sum of nums. (+) returns 0."
([] 0)
([x] x)
([x y] (cljs.core/unchecked-add-int x y))
([x y & more] (reduce unchecked-add-int (cljs.core/unchecked-add-int x y) more)))
(defn unchecked-dec
"Returns a number one less than x, an int."
[x]
(cljs.core/unchecked-dec x))
(defn unchecked-dec-int
"Returns a number one less than x, an int."
[x]
(cljs.core/unchecked-dec-int x))
(defn ^number unchecked-divide-int
"If no denominators are supplied, returns 1/numerator,
else returns numerator divided by all of the denominators."
([x] (unchecked-divide-int 1 x))
([x y] (cljs.core/divide x y)) ;; FIXME: waiting on cljs.core//
([x y & more] (reduce unchecked-divide-int (unchecked-divide-int x y) more)))
(defn unchecked-inc [x]
(cljs.core/unchecked-inc x))
(defn unchecked-inc-int [x]
(cljs.core/unchecked-inc-int x))
(defn ^number unchecked-multiply
"Returns the product of nums. (*) returns 1."
([] 1)
([x] x)
([x y] (cljs.core/unchecked-multiply x y))
([x y & more] (reduce unchecked-multiply (cljs.core/unchecked-multiply x y) more)))
(defn ^number unchecked-multiply-int
"Returns the product of nums. (*) returns 1."
([] 1)
([x] x)
([x y] (cljs.core/unchecked-multiply-int x y))
([x y & more] (reduce unchecked-multiply-int (cljs.core/unchecked-multiply-int x y) more)))
(defn unchecked-negate [x]
(cljs.core/unchecked-negate x))
(defn unchecked-negate-int [x]
(cljs.core/unchecked-negate-int x))
(declare mod)
(defn unchecked-remainder-int [x n]
(cljs.core/unchecked-remainder-int x n))
(defn ^number unchecked-subtract
"If no ys are supplied, returns the negation of x, else subtracts
the ys from x and returns the result."
([x] (cljs.core/unchecked-subtract x))
([x y] (cljs.core/unchecked-subtract x y))
([x y & more] (reduce unchecked-subtract (cljs.core/unchecked-subtract x y) more)))
(defn ^number unchecked-subtract-int
"If no ys are supplied, returns the negation of x, else subtracts
the ys from x and returns the result."
([x] (cljs.core/unchecked-subtract-int x))
([x y] (cljs.core/unchecked-subtract-int x y))
([x y & more] (reduce unchecked-subtract-int (cljs.core/unchecked-subtract-int x y) more)))
(defn- ^number fix [q]
(if (>= q 0)
(Math/floor q)
(Math/ceil q)))
(defn int
"Coerce to int by stripping decimal places."
[x]
(bit-or x 0))
(defn unchecked-int
"Coerce to int by stripping decimal places."
[x]
(fix x))
(defn long
"Coerce to long by stripping decimal places. Identical to `int'."
[x]
(fix x))
(defn unchecked-long
"Coerce to long by stripping decimal places. Identical to `int'."
[x]
(fix x))
(defn booleans [x] x)
(defn bytes [x] x)
(defn chars [x] x)
(defn shorts [x] x)
(defn ints [x] x)
(defn floats [x] x)
(defn doubles [x] x)
(defn longs [x] x)
(defn js-mod
"Modulus of num and div with original javascript behavior. i.e. bug for negative numbers"
[n d]
(cljs.core/js-mod n d))
(defn mod
"Modulus of num and div. Truncates toward negative infinity."
[n d]
(js-mod (+ (js-mod n d) d) d))
(defn quot
"quot[ient] of dividing numerator by denominator."
[n d]
(let [rem (js-mod n d)]
(fix (/ (- n rem) d))))
(defn rem
"remainder of dividing numerator by denominator."
[n d]
(let [q (quot n d)]
(- n (* d q))))
(defn bit-xor
"Bitwise exclusive or"
([x y] (cljs.core/bit-xor x y))
([x y & more]
(reduce bit-xor (cljs.core/bit-xor x y) more)))
(defn bit-and
"Bitwise and"
([x y] (cljs.core/bit-and x y))
([x y & more]
(reduce bit-and (cljs.core/bit-and x y) more)))
(defn bit-or
"Bitwise or"
([x y] (cljs.core/bit-or x y))
([x y & more]
(reduce bit-or (cljs.core/bit-or x y) more)))
(defn bit-and-not
"Bitwise and with complement"
([x y] (cljs.core/bit-and-not x y))
([x y & more]
(reduce bit-and-not (cljs.core/bit-and-not x y) more)))
(defn bit-clear
"Clear bit at index n"
[x n]
(cljs.core/bit-clear x n))
(defn bit-flip
"Flip bit at index n"
[x n]
(cljs.core/bit-flip x n))
(defn bit-not
"Bitwise complement"
[x] (cljs.core/bit-not x))
(defn bit-set
"Set bit at index n"
[x n]
(cljs.core/bit-set x n))
(defn ^boolean bit-test
"Test bit at index n"
[x n]
(cljs.core/bit-test x n))
(defn bit-shift-left
"Bitwise shift left"
[x n] (cljs.core/bit-shift-left x n))
(defn bit-shift-right
"Bitwise shift right"
[x n] (cljs.core/bit-shift-right x n))
(defn bit-shift-right-zero-fill
"DEPRECATED: Bitwise shift right with zero fill"
[x n] (cljs.core/bit-shift-right-zero-fill x n))
(defn unsigned-bit-shift-right
"Bitwise shift right with zero fill"
[x n] (cljs.core/unsigned-bit-shift-right x n))
(defn bit-count
"Counts the number of bits set in n"
[v]
(let [v (- v (bit-and (bit-shift-right v 1) 0x55555555))
v (+ (bit-and v 0x33333333) (bit-and (bit-shift-right v 2) 0x33333333))]
(bit-shift-right (* (bit-and (+ v (bit-shift-right v 4)) 0xF0F0F0F) 0x1010101) 24)))
(defn ^boolean ==
"Returns non-nil if nums all have the equivalent
value, otherwise false. Behavior on non nums is
undefined."
([x] true)
([x y] (-equiv x y))
([x y & more]
(if (== x y)
(if (next more)
(recur y (first more) (next more))
(== y (first more)))
false)))
(defn ^boolean pos?
"Returns true if num is greater than zero, else false"
[x] (cljs.core/pos? x))
(defn ^boolean zero?
"Returns true if num is zero, else false"
[x]
(cljs.core/zero? x))
(defn ^boolean neg?
"Returns true if num is less than zero, else false"
[x] (cljs.core/neg? x))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; protocols for host types ;;;;;;
(defn nthnext
"Returns the nth next of coll, (seq coll) when n is 0."
[coll n]
(loop [n n xs (seq coll)]
(if (and xs (pos? n))
(recur (dec n) (next xs))
xs)))
;;;;;;;;;;;;;;;;;;;;;;;;;; basics ;;;;;;;;;;;;;;;;;;
(defn str
"With no args, returns the empty string. With one arg x, returns
x.toString(). (str nil) returns the empty string. With more than
one arg, returns the concatenation of the str values of the args."
([] "")
([x] (if (nil? x)
""
(.join #js [x] "")))
([x & ys]
(loop [sb (StringBuffer. (str x)) more ys]
(if more
(recur (. sb (append (str (first more)))) (next more))
(.toString sb)))))
(defn subs
"Returns the substring of s beginning at start inclusive, and ending
at end (defaults to length of string), exclusive."
([s start] (.substring s start))
([s start end] (.substring s start end)))
(declare map name)
(defn- equiv-sequential
"Assumes x is sequential. Returns true if x equals y, otherwise
returns false."
[x y]
(boolean
(when (sequential? y)
(if (and (counted? x) (counted? y)
(not (== (count x) (count y))))
false
(loop [xs (seq x) ys (seq y)]
(cond (nil? xs) (nil? ys)
(nil? ys) false
(= (first xs) (first ys)) (recur (next xs) (next ys))
:else false))))))
(defn- hash-coll [coll]
(if (seq coll)
(loop [res (hash (first coll)) s (next coll)]
(if (nil? s)
res
(recur (hash-combine res (hash (first s))) (next s))))
0))
(declare key val)
(defn- hash-imap [m]
;; a la clojure.lang.APersistentMap
(loop [h 0 s (seq m)]
(if s
(let [e (first s)]
(recur (js-mod (+ h (bit-xor (hash (key e)) (hash (val e))))
4503599627370496)
(next s)))
h)))
(defn- hash-iset [s]
;; a la clojure.lang.APersistentSet
(loop [h 0 s (seq s)]
(if s
(let [e (first s)]
(recur (js-mod (+ h (hash e)) 4503599627370496)
(next s)))
h)))
(declare name chunk-first chunk-rest)
(defn- extend-object!
"Takes a JavaScript object and a map of names to functions and
attaches said functions as methods on the object. Any references to
JavaScript's implicit this (via the this-as macro) will resolve to the
object that the function is attached."
[obj fn-map]
(doseq [[key-name f] fn-map]
(let [str-name (name key-name)]
(aset obj str-name f)))
obj)
;;;;;;;;;;;;;;;; cons ;;;;;;;;;;;;;;;;
(deftype List [meta first rest count ^:mutable __hash]
Object
(toString [coll]
(pr-str* coll))
(equiv [this other]
(-equiv this other))
(indexOf [coll x]
(-indexOf coll x 0))
(indexOf [coll x start]
(-indexOf coll x start))
(lastIndexOf [coll x]
(-lastIndexOf coll x count))
(lastIndexOf [coll x start]
(-lastIndexOf coll x start))
IList
ICloneable
(-clone [_] (List. meta first rest count __hash))
IWithMeta
(-with-meta [coll meta] (List. meta first rest count __hash))
IMeta
(-meta [coll] meta)
ASeq
ISeq
(-first [coll] first)
(-rest [coll]
(if (== count 1)
()
rest))
INext
(-next [coll]
(if (== count 1)
nil
rest))
IStack
(-peek [coll] first)
(-pop [coll] (-rest coll))
ICollection
(-conj [coll o] (List. meta o coll (inc count) nil))
IEmptyableCollection
(-empty [coll] (-with-meta (.-EMPTY List) meta))
ISequential
IEquiv
(-equiv [coll other] (equiv-sequential coll other))
IHash
(-hash [coll] (caching-hash coll hash-ordered-coll __hash))
ISeqable
(-seq [coll] coll)
ICounted
(-count [coll] count)
IReduce
(-reduce [coll f] (seq-reduce f coll))
(-reduce [coll f start] (seq-reduce f start coll)))
(defn ^boolean list?
"Returns true if x implements IList"
[x]
(satisfies? IList x))
(es6-iterable List)
(deftype EmptyList [meta]
Object
(toString [coll]
(pr-str* coll))
(equiv [this other]
(-equiv this other))
(indexOf [coll x]
(-indexOf coll x 0))
(indexOf [coll x start]
(-indexOf coll x start))
(lastIndexOf [coll x]
(-lastIndexOf coll x (count coll)))
(lastIndexOf [coll x start]
(-lastIndexOf coll x start))
IList
ICloneable
(-clone [_] (EmptyList. meta))
IWithMeta
(-with-meta [coll meta] (EmptyList. meta))
IMeta
(-meta [coll] meta)
ISeq
(-first [coll] nil)
(-rest [coll] ())
INext
(-next [coll] nil)
IStack
(-peek [coll] nil)
(-pop [coll] (throw (js/Error. "Can't pop empty list")))
ICollection
(-conj [coll o] (List. meta o nil 1 nil))
IEmptyableCollection
(-empty [coll] coll)
ISequential
IEquiv
(-equiv [coll other]
(if (or (list? other)
(sequential? other))
(nil? (seq other))
false))
IHash
(-hash [coll] empty-ordered-hash)
ISeqable
(-seq [coll] nil)
ICounted
(-count [coll] 0)
IReduce
(-reduce [coll f] (seq-reduce f coll))
(-reduce [coll f start] (seq-reduce f start coll)))
(set! (.-EMPTY List) (EmptyList. nil))
(es6-iterable EmptyList)
(defn ^boolean reversible?
"Returns true if coll satisfies? IReversible."
[coll]
(satisfies? IReversible coll))
(defn ^seq rseq
"Returns, in constant time, a seq of the items in rev (which
can be a vector or sorted-map), in reverse order. If rev is empty returns nil"
[rev]
(-rseq rev))
(defn reverse
"Returns a seq of the items in coll in reverse order. Not lazy."
[coll]
(if (reversible? coll)
(rseq coll)
(reduce conj () coll)))
(defn list
"Creates a new list containing the items."
[& xs]
(let [arr (if (and (instance? IndexedSeq xs) (zero? (.-i xs)))
(.-arr xs)
(let [arr (array)]
(loop [^not-native xs xs]
(if-not (nil? xs)
(do
(.push arr (-first xs))
(recur (-next xs)))
arr))))]
(loop [i (alength arr) ^not-native r ()]
(if (> i 0)
(recur (dec i) (-conj r (aget arr (dec i))))
r))))
(deftype Cons [meta first rest ^:mutable __hash]
Object
(toString [coll]
(pr-str* coll))
(equiv [this other]
(-equiv this other))
(indexOf [coll x]
(-indexOf coll x 0))
(indexOf [coll x start]
(-indexOf coll x start))
(lastIndexOf [coll x]
(-lastIndexOf coll x (count coll)))
(lastIndexOf [coll x start]
(-lastIndexOf coll x start))
IList
ICloneable
(-clone [_] (Cons. meta first rest __hash))
IWithMeta
(-with-meta [coll meta] (Cons. meta first rest __hash))
IMeta
(-meta [coll] meta)
ASeq
ISeq
(-first [coll] first)
(-rest [coll] (if (nil? rest) () rest))
INext
(-next [coll]
(if (nil? rest) nil (seq rest)))
ICollection
(-conj [coll o] (Cons. nil o coll nil))
IEmptyableCollection
(-empty [coll] (with-meta (.-EMPTY List) meta))
ISequential
IEquiv
(-equiv [coll other] (equiv-sequential coll other))
IHash
(-hash [coll] (caching-hash coll hash-ordered-coll __hash))
ISeqable
(-seq [coll] coll)
IReduce
(-reduce [coll f] (seq-reduce f coll))
(-reduce [coll f start] (seq-reduce f start coll)))
(es6-iterable Cons)
(defn cons
"Returns a new seq where x is the first element and coll is the rest."
[x coll]
(if (or (nil? coll)
(implements? ISeq coll))
(Cons. nil x coll nil)
(Cons. nil x (seq coll) nil)))
(defn hash-keyword [k]
(int (+ (hash-symbol k) 0x9e3779b9)))
(defn- compare-keywords [a b]
(cond
(identical? (.-fqn a) (.-fqn b)) 0
(and (not (.-ns a)) (.-ns b)) -1
(.-ns a) (if-not (.-ns b)
1
(let [nsc (garray/defaultCompare (.-ns a) (.-ns b))]
(if (== 0 nsc)
(garray/defaultCompare (.-name a) (.-name b))
nsc)))
:default (garray/defaultCompare (.-name a) (.-name b))))
(deftype Keyword [ns name fqn ^:mutable _hash]
Object
(toString [_] (str ":" fqn))
(equiv [this other]
(-equiv this other))
IEquiv
(-equiv [_ other]
(if (instance? Keyword other)
(identical? fqn (.-fqn other))
false))
IFn
(-invoke [kw coll]
(get coll kw))
(-invoke [kw coll not-found]
(get coll kw not-found))
IHash
(-hash [this]
(caching-hash this hash-keyword _hash))
INamed
(-name [_] name)
(-namespace [_] ns)
IPrintWithWriter
(-pr-writer [o writer _] (-write writer (str ":" fqn))))
(defn ^boolean keyword?
"Return true if x is a Keyword"
[x]
(instance? Keyword x))
(defn ^boolean keyword-identical?
"Efficient test to determine that two keywords are identical."
[x y]
(if (identical? x y)
true
(if (and (keyword? x) (keyword? y))
(identical? (.-fqn x) (.-fqn y))
false)))
(defn ^boolean symbol-identical?
"Efficient test to determine that two symbols are identical."
[x y]
(if (identical? x y)
true
(if (and (symbol? x) (symbol? y))
(identical? (.-str x) (.-str y))
false)))
(defn namespace
"Returns the namespace String of a symbol or keyword, or nil if not present."
[x]
(if (implements? INamed x)
(-namespace ^not-native x)
(throw (js/Error. (str "Doesn't support namespace: " x)))))
(defn ^boolean ident?
"Return true if x is a symbol or keyword"
[x] (or (keyword? x) (symbol? x)))
(defn ^boolean simple-ident?
"Return true if x is a symbol or keyword without a namespace"
[x] (and (ident? x) (nil? (namespace x))))
(defn ^boolean qualified-ident?
"Return true if x is a symbol or keyword with a namespace"
[x] (and (ident? x) (namespace x) true))
(defn ^boolean simple-symbol?
"Return true if x is a symbol without a namespace"
[x] (and (symbol? x) (nil? (namespace x))))
(defn ^boolean qualified-symbol?
"Return true if x is a symbol with a namespace"
[x] (and (symbol? x) (namespace x) true))
(defn ^boolean simple-keyword?
"Return true if x is a keyword without a namespace"
[x] (and (keyword? x) (nil? (namespace x))))
(defn ^boolean qualified-keyword?
"Return true if x is a keyword with a namespace"
[x] (and (keyword? x) (namespace x) true))
(defn keyword
"Returns a Keyword with the given namespace and name. Do not use :
in the keyword strings, it will be added automatically."
([name] (cond
(keyword? name) name
(symbol? name) (Keyword.
(cljs.core/namespace name)
(cljs.core/name name) (.-str name) nil)
(string? name) (let [parts (.split name "/")]
(if (== (alength parts) 2)
(Keyword. (aget parts 0) (aget parts 1) name nil)
(Keyword. nil (aget parts 0) name nil)))))
([ns name]
(let [ns (cond
(keyword? ns) (cljs.core/name ns)
(symbol? ns) (cljs.core/name ns)
:else ns)
name (cond
(keyword? name) (cljs.core/name name)
(symbol? name) (cljs.core/name name)
:else name)]
(Keyword. ns name (str (when ns (str ns "/")) name) nil))))
(deftype LazySeq [meta ^:mutable fn ^:mutable s ^:mutable __hash]
Object
(toString [coll]
(pr-str* coll))
(equiv [this other]
(-equiv this other))
(sval [coll]
(if (nil? fn)
s
(do
(set! s (fn))
(set! fn nil)
s)))
(indexOf [coll x]
(-indexOf coll x 0))
(indexOf [coll x start]
(-indexOf coll x start))
(lastIndexOf [coll x]
(-lastIndexOf coll x (count coll)))
(lastIndexOf [coll x start]
(-lastIndexOf coll x start))
IPending
(-realized? [coll]
(not fn))
IWithMeta
(-with-meta [coll meta] (LazySeq. meta fn s __hash))
IMeta
(-meta [coll] meta)
ISeq
(-first [coll]
(-seq coll)
(when-not (nil? s)
(first s)))
(-rest [coll]
(-seq coll)
(if-not (nil? s)
(rest s)
()))
INext
(-next [coll]
(-seq coll)
(when-not (nil? s)
(next s)))
ICollection
(-conj [coll o] (cons o coll))
IEmptyableCollection
(-empty [coll] (with-meta (.-EMPTY List) meta))
ISequential
IEquiv
(-equiv [coll other] (equiv-sequential coll other))
IHash
(-hash [coll] (caching-hash coll hash-ordered-coll __hash))
ISeqable
(-seq [coll]
(.sval coll)
(when-not (nil? s)
(loop [ls s]
(if (instance? LazySeq ls)
(recur (.sval ls))
(do (set! s ls)
(seq s))))))
IReduce
(-reduce [coll f] (seq-reduce f coll))
(-reduce [coll f start] (seq-reduce f start coll)))
(es6-iterable LazySeq)
(declare ArrayChunk)
(deftype ChunkBuffer [^:mutable buf ^:mutable end]
Object
(add [_ o]
(aset buf end o)
(set! end (inc end)))
(chunk [_ o]
(let [ret (ArrayChunk. buf 0 end)]
(set! buf nil)
ret))
ICounted
(-count [_] end))
(defn chunk-buffer [capacity]
(ChunkBuffer. (make-array capacity) 0))
(deftype ArrayChunk [arr off end]
ICounted
(-count [_] (- end off))
IIndexed
(-nth [coll i]
(aget arr (+ off i)))
(-nth [coll i not-found]
(if (and (>= i 0) (< i (- end off)))
(aget arr (+ off i))
not-found))
IChunk
(-drop-first [coll]
(if (== off end)
(throw (js/Error. "-drop-first of empty chunk"))
(ArrayChunk. arr (inc off) end)))
IReduce
(-reduce [coll f]
(array-reduce arr f (aget arr off) (inc off)))
(-reduce [coll f start]
(array-reduce arr f start off)))
(defn array-chunk
([arr]
(ArrayChunk. arr 0 (alength arr)))
([arr off]
(ArrayChunk. arr off (alength arr)))
([arr off end]
(ArrayChunk. arr off end)))
(deftype ChunkedCons [chunk more meta ^:mutable __hash]
Object
(toString [coll]
(pr-str* coll))
(equiv [this other]
(-equiv this other))
(indexOf [coll x]
(-indexOf coll x 0))
(indexOf [coll x start]
(-indexOf coll x start))
(lastIndexOf [coll x]
(-lastIndexOf coll x (count coll)))
(lastIndexOf [coll x start]
(-lastIndexOf coll x start))
IWithMeta
(-with-meta [coll m]
(ChunkedCons. chunk more m __hash))
IMeta
(-meta [coll] meta)
ISequential
IEquiv
(-equiv [coll other] (equiv-sequential coll other))
ISeqable
(-seq [coll] coll)
ASeq
ISeq
(-first [coll] (-nth chunk 0))
(-rest [coll]
(if (> (-count chunk) 1)
(ChunkedCons. (-drop-first chunk) more meta nil)
(if (nil? more)
()
more)))
INext
(-next [coll]
(if (> (-count chunk) 1)
(ChunkedCons. (-drop-first chunk) more meta nil)
(let [more (-seq more)]
(when-not (nil? more)
more))))
IChunkedSeq
(-chunked-first [coll] chunk)
(-chunked-rest [coll]
(if (nil? more)
()
more))
IChunkedNext
(-chunked-next [coll]
(if (nil? more)
nil
more))
ICollection
(-conj [this o]
(cons o this))
IEmptyableCollection
(-empty [coll] (with-meta (.-EMPTY List) meta))
IHash
(-hash [coll] (caching-hash coll hash-ordered-coll __hash)))
(es6-iterable ChunkedCons)
(defn chunk-cons [chunk rest]
(if (zero? (-count chunk))
rest
(ChunkedCons. chunk rest nil nil)))
(defn chunk-append [b x]
(.add b x))
(defn chunk [b]
(.chunk b))
(defn chunk-first [s]
(-chunked-first s))
(defn chunk-rest [s]
(-chunked-rest s))
(defn chunk-next [s]
(if (implements? IChunkedNext s)
(-chunked-next s)
(seq (-chunked-rest s))))
;;;;;;;;;;;;;;;;
(defn to-array
"Naive impl of to-array as a start."
[s]
(let [ary (array)]
(loop [s s]
(if (seq s)
(do (. ary push (first s))
(recur (next s)))
ary))))
(defn to-array-2d
"Returns a (potentially-ragged) 2-dimensional array
containing the contents of coll."
[coll]
(let [ret (make-array (count coll))]
(loop [i 0 xs (seq coll)]
(when xs
(aset ret i (to-array (first xs)))
(recur (inc i) (next xs))))
ret))
(defn int-array
"Creates an array of ints. Does not coerce array, provided for compatibility
with Clojure."
([size-or-seq]
(if (number? size-or-seq)
(int-array size-or-seq nil)
(into-array size-or-seq)))
([size init-val-or-seq]
(let [a (make-array size)]
(if (seq? init-val-or-seq)
(let [s (seq init-val-or-seq)]
(loop [i 0 s s]
(if (and s (< i size))
(do
(aset a i (first s))
(recur (inc i) (next s)))
a)))
(do
(dotimes [i size]
(aset a i init-val-or-seq))
a)))))
(defn long-array
"Creates an array of longs. Does not coerce array, provided for compatibility
with Clojure."
([size-or-seq]
(if (number? size-or-seq)
(long-array size-or-seq nil)
(into-array size-or-seq)))
([size init-val-or-seq]
(let [a (make-array size)]
(if (seq? init-val-or-seq)
(let [s (seq init-val-or-seq)]
(loop [i 0 s s]
(if (and s (< i size))
(do
(aset a i (first s))
(recur (inc i) (next s)))
a)))
(do
(dotimes [i size]
(aset a i init-val-or-seq))
a)))))
(defn double-array
"Creates an array of doubles. Does not coerce array, provided for compatibility
with Clojure."
([size-or-seq]
(if (number? size-or-seq)
(double-array size-or-seq nil)
(into-array size-or-seq)))
([size init-val-or-seq]
(let [a (make-array size)]
(if (seq? init-val-or-seq)
(let [s (seq init-val-or-seq)]
(loop [i 0 s s]
(if (and s (< i size))
(do
(aset a i (first s))
(recur (inc i) (next s)))
a)))
(do
(dotimes [i size]
(aset a i init-val-or-seq))
a)))))
(defn object-array
"Creates an array of objects. Does not coerce array, provided for compatibility
with Clojure."
([size-or-seq]
(if (number? size-or-seq)
(object-array size-or-seq nil)
(into-array size-or-seq)))
([size init-val-or-seq]
(let [a (make-array size)]
(if (seq? init-val-or-seq)
(let [s (seq init-val-or-seq)]
(loop [i 0 s s]
(if (and s (< i size))
(do
(aset a i (first s))
(recur (inc i) (next s)))
a)))
(do
(dotimes [i size]
(aset a i init-val-or-seq))
a)))))
(defn bounded-count
"If coll is counted? returns its count, else will count at most the first n
elements of coll using its seq"
{:added "1.9"}
[n coll]
(if (counted? coll)
(count coll)
(loop [i 0 s (seq coll)]
(if (and (not (nil? s)) (< i n))
(recur (inc i) (next s))
i))))
(defn spread
[arglist]
(cond
(nil? arglist) nil
(nil? (next arglist)) (seq (first arglist))
:else (cons (first arglist)
(spread (next arglist)))))
(defn concat
"Returns a lazy seq representing the concatenation of the elements in the supplied colls."
([] (lazy-seq nil))
([x] (lazy-seq x))
([x y]
(lazy-seq
(let [s (seq x)]
(if s
(if (chunked-seq? s)
(chunk-cons (chunk-first s) (concat (chunk-rest s) y))
(cons (first s) (concat (rest s) y)))
y))))
([x y & zs]
(let [cat (fn cat [xys zs]
(lazy-seq
(let [xys (seq xys)]
(if xys
(if (chunked-seq? xys)
(chunk-cons (chunk-first xys)
(cat (chunk-rest xys) zs))
(cons (first xys) (cat (rest xys) zs)))
(when zs
(cat (first zs) (next zs)))))))]
(cat (concat x y) zs))))
(defn list*
"Creates a new list containing the items prepended to the rest, the
last of which will be treated as a sequence."
([args] (seq args))
([a args] (cons a args))
([a b args] (cons a (cons b args)))
([a b c args] (cons a (cons b (cons c args))))
([a b c d & more]
(cons a (cons b (cons c (cons d (spread more)))))))
;;; Transients
(defn transient
"Returns a new, transient version of the collection, in constant time."
[coll]
(-as-transient coll))
(defn persistent!
"Returns a new, persistent version of the transient collection, in
constant time. The transient collection cannot be used after this
call, any such use will throw an exception."
[tcoll]
(-persistent! tcoll))
(defn conj!
"Adds val to the transient collection, and return tcoll. The 'addition'
may happen at different 'places' depending on the concrete type."
([] (transient []))
([tcoll] tcoll)
([tcoll val]
(-conj! tcoll val))
([tcoll val & vals]
(let [ntcoll (-conj! tcoll val)]
(if vals
(recur ntcoll (first vals) (next vals))
ntcoll))))
(defn assoc!
"When applied to a transient map, adds mapping of key(s) to
val(s). When applied to a transient vector, sets the val at index.
Note - index must be <= (count vector). Returns coll."
([tcoll key val]
(-assoc! tcoll key val))
([tcoll key val & kvs]
(let [ntcoll (-assoc! tcoll key val)]
(if kvs
(recur ntcoll (first kvs) (second kvs) (nnext kvs))
ntcoll))))
(defn dissoc!
"Returns a transient map that doesn't contain a mapping for key(s)."
([tcoll key]
(-dissoc! tcoll key))
([tcoll key & ks]
(let [ntcoll (-dissoc! tcoll key)]
(if ks
(recur ntcoll (first ks) (next ks))
ntcoll))))
(defn pop!
"Removes the last item from a transient vector. If
the collection is empty, throws an exception. Returns tcoll"
[tcoll]
(-pop! tcoll))
(defn disj!
"disj[oin]. Returns a transient set of the same (hashed/sorted) type, that
does not contain key(s)."
([tcoll val]
(-disjoin! tcoll val))
([tcoll val & vals]
(let [ntcoll (-disjoin! tcoll val)]
(if vals
(recur ntcoll (first vals) (next vals))
ntcoll))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; apply ;;;;;;;;;;;;;;;;
;; see core.clj
(gen-apply-to)
(set! *unchecked-if* true)
(defn apply
"Applies fn f to the argument list formed by prepending intervening arguments to args."
([f args]
(let [fixed-arity (.-cljs$lang$maxFixedArity f)]
(if (.-cljs$lang$applyTo f)
(let [bc (bounded-count (inc fixed-arity) args)]
(if (<= bc fixed-arity)
(apply-to f bc args)
(.cljs$lang$applyTo f args)))
(.apply f f (to-array args)))))
([f x args]
(let [arglist (list* x args)
fixed-arity (.-cljs$lang$maxFixedArity f)]
(if (.-cljs$lang$applyTo f)
(let [bc (bounded-count (inc fixed-arity) arglist)]
(if (<= bc fixed-arity)
(apply-to f bc arglist)
(.cljs$lang$applyTo f arglist)))
(.apply f f (to-array arglist)))))
([f x y args]
(let [arglist (list* x y args)
fixed-arity (.-cljs$lang$maxFixedArity f)]
(if (.-cljs$lang$applyTo f)
(let [bc (bounded-count (inc fixed-arity) arglist)]
(if (<= bc fixed-arity)
(apply-to f bc arglist)
(.cljs$lang$applyTo f arglist)))
(.apply f f (to-array arglist)))))
([f x y z args]
(let [arglist (list* x y z args)
fixed-arity (.-cljs$lang$maxFixedArity f)]
(if (.-cljs$lang$applyTo f)
(let [bc (bounded-count (inc fixed-arity) arglist)]
(if (<= bc fixed-arity)
(apply-to f bc arglist)
(.cljs$lang$applyTo f arglist)))
(.apply f f (to-array arglist)))))
([f a b c d & args]
(let [arglist (cons a (cons b (cons c (cons d (spread args)))))
fixed-arity (.-cljs$lang$maxFixedArity f)]
(if (.-cljs$lang$applyTo f)
(let [bc (bounded-count (inc fixed-arity) arglist)]
(if (<= bc fixed-arity)
(apply-to f bc arglist)
(.cljs$lang$applyTo f arglist)))
(.apply f f (to-array arglist))))))
(set! *unchecked-if* false)
(defn vary-meta
"Returns an object of the same type and value as obj, with
(apply f (meta obj) args) as its metadata."
([obj f]
(with-meta obj (f (meta obj))))
([obj f a]
(with-meta obj (f (meta obj) a)))
([obj f a b]
(with-meta obj (f (meta obj) a b)))
([obj f a b c]
(with-meta obj (f (meta obj) a b c)))
([obj f a b c d]
(with-meta obj (f (meta obj) a b c d)))
([obj f a b c d & args]
(with-meta obj (apply f (meta obj) a b c d args))))
(defn ^boolean not=
"Same as (not (= obj1 obj2))"
([x] false)
([x y] (not (= x y)))
([x y & more]
(not (apply = x y more))))
(defn not-empty
"If coll is empty, returns nil, else coll"
[coll]