Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

6819 lines (5730 sloc) 194.006 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.string :as gstring]
[goog.string.StringBuffer :as gstringbuf]
[goog.object :as gobject]
[goog.array :as garray]))
(def *unchecked-if* false)
(def
^{:doc "Each runtime environment provides a diffenent way to print output.
Whatever function *print-fn* is bound to will be passed any
Strings which should be printed."}
*print-fn*
(fn [_]
(throw (js/Error. "No *print-fn* fn set for evaluation environment"))))
(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)
(declare not nil? identical)
(defn truth_
"Internal - do not use!"
[x]
(js* "(~{x} != null && ~{x} !== false)"))
(set! *unchecked-if* true)
(defn ^boolean type_satisfies_
"Internal - do not use!"
[p 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-fn* is set to will be called with the command-line
argv as arguments"}
*main-cli-fn* nil)
(defn missing-protocol [proto obj]
(js/Error
(.join (array "No protocol method " proto
" defined for type " (goog/typeOf obj) ": " obj) "")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; arrays ;;;;;;;;;;;;;;;;
(defn aclone
"Returns a javascript array, cloned from the passed in array"
[array-like]
(.slice array-like))
(defn array
"Creates a new javascript array.
@param {...*} var_args" ;;array is a special case, don't emulate this doc string
[var-args] ;; [& items]
(.call (.-slice (.-prototype js/Array)) (js* "arguments")))
(defn make-array
([size]
(js/Array. size))
([type size]
(make-array size)))
(declare apply)
(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))
(defn alength
"Returns the length of the array. Works on arrays of all types."
[array]
(.-length array))
(declare reduce)
(defn into-array
([aseq]
(into-array nil aseq))
([type aseq]
(reduce (fn [a x] (.push a x) a) (array) aseq)))
;;;;;;;;;;;;;;;;;;;;;;;;;;; core protocols ;;;;;;;;;;;;;
(defprotocol IFn
(-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 s]
[this a b c d e f g h i j k l m n o p q s t]
[this a b c d e f g h i j k l m n o p q s t rest]))
(defprotocol ICounted
(-count [coll] "constant time count"))
(defprotocol IEmptyableCollection
(-empty [coll]))
(defprotocol ICollection
(-conj [coll o]))
#_(defprotocol IOrdinal
(-index [coll]))
(defprotocol IIndexed
(-nth [coll n] [coll n not-found]))
(defprotocol ASeq)
(defprotocol ISeq
(-first [coll])
(-rest [coll]))
(defprotocol INext
(-next [coll]))
(defprotocol ILookup
(-lookup [o k] [o k not-found]))
(defprotocol IAssociative
(-contains-key? [coll k])
#_(-entry-at [coll k])
(-assoc [coll k v]))
(defprotocol IMap
#_(-assoc-ex [coll k v])
(-dissoc [coll k]))
(defprotocol IMapEntry
(-key [coll])
(-val [coll]))
(defprotocol ISet
(-disjoin [coll v]))
(defprotocol IStack
(-peek [coll])
(-pop [coll]))
(defprotocol IVector
(-assoc-n [coll n val]))
(defprotocol IDeref
(-deref [o]))
(defprotocol IDerefWithTimeout
(-deref-with-timeout [o msec timeout-val]))
(defprotocol IMeta
(-meta [o]))
(defprotocol IWithMeta
(-with-meta [o meta]))
(defprotocol IReduce
(-reduce [coll f] [coll f start]))
(defprotocol IKVReduce
(-kv-reduce [coll f init]))
(defprotocol IEquiv
(-equiv [o other]))
(defprotocol IHash
(-hash [o]))
(defprotocol ISeqable
(-seq [o]))
(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
(-rseq [coll]))
(defprotocol ISorted
(-sorted-seq [coll ascending?])
(-sorted-seq-from [coll k ascending?])
(-entry-key [coll entry])
(-comparator [coll]))
(defprotocol IPrintable
(-pr-seq [o opts]))
(defprotocol IPending
(-realized? [d]))
(defprotocol IWatchable
(-notify-watches [this oldval newval])
(-add-watch [this key f])
(-remove-watch [this key]))
(defprotocol IEditableCollection
(-as-transient [coll]))
(defprotocol ITransientCollection
(-conj! [tcoll val])
(-persistent! [tcoll]))
(defprotocol ITransientAssociative
(-assoc! [tcoll key val]))
(defprotocol ITransientMap
(-dissoc! [tcoll key]))
(defprotocol ITransientVector
(-assoc-n! [tcoll n val])
(-pop! [tcoll]))
(defprotocol ITransientSet
(-disjoin! [tcoll v]))
(defprotocol IComparable
(-compare [x y]))
(defprotocol IChunk
(-drop-first [coll]))
(defprotocol IChunkedSeq
(-chunked-first [coll])
(-chunked-rest [coll]))
(defprotocol IChunkedNext
(-chunked-next [coll]))
;;;;;;;;;;;;;;;;;;; fundamentals ;;;;;;;;;;;;;;;
(defn ^boolean identical?
"Tests if 2 arguments are the same object"
[x y]
(cljs.core/identical? x y))
(declare first next)
(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] (or (identical? 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 nil?
"Returns true if x is nil, false otherwise."
[x]
(coercive-= x nil))
(defn type [x]
(if (or (nil? x) (undefined? x))
nil
(.-constructor x)))
;;;;;;;;;;;;;;;;;;; protocols on primitives ;;;;;;;;
(declare hash-map list equiv-sequential)
(extend-type nil
IEquiv
(-equiv [_ o] (nil? o))
ICounted
(-count [_] 0)
IEmptyableCollection
(-empty [_] nil)
ICollection
(-conj [_ o] (list o))
IPrintable
(-pr-seq [o] (list "nil"))
IIndexed
(-nth
([_ n] nil)
([_ n not-found] not-found))
ISeq
(-first [_] nil)
(-rest [_] (list))
INext
(-next [_] nil)
ILookup
(-lookup
([o k] nil)
([o k not-found] not-found))
IAssociative
(-assoc [_ k v] (hash-map k v))
IMap
(-dissoc [_ k] nil)
ISet
(-disjoin [_ v] nil)
IStack
(-peek [_] nil)
(-pop [_] nil)
IMeta
(-meta [_] nil)
IWithMeta
(-with-meta [_ meta] nil)
IReduce
(-reduce
([_ f] (f))
([_ f start] start))
IHash
(-hash [o] 0))
(extend-type js/Date
IEquiv
(-equiv [o other] (identical? (. o (toString)) (. other (toString)))))
(extend-type number
IEquiv
(-equiv [x o] (identical? x o))
IHash
(-hash [o] o))
(extend-type boolean
IHash
(-hash [o]
(if (identical? o true) 1 0)))
(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 reduced? deref)
(defn- ci-reduce
"Accepts any collection which satisfies the ICount and IIndexed protocols and
reduces them without incurring seq initialization"
([cicoll f]
(if (zero? (-count cicoll))
(f)
(loop [val (-nth cicoll 0), n 1]
(if (< n (-count cicoll))
(let [nval (f val (-nth cicoll n))]
(if (reduced? nval)
@nval
(recur nval (inc n))))
val))))
([cicoll f val]
(loop [val val, n 0]
(if (< n (-count cicoll))
(let [nval (f val (-nth cicoll n))]
(if (reduced? nval)
@nval
(recur nval (inc n))))
val)))
([cicoll f val idx]
(loop [val val, n idx]
(if (< n (-count cicoll))
(let [nval (f val (-nth cicoll n))]
(if (reduced? nval)
@nval
(recur nval (inc n))))
val))))
(defn- array-reduce
([arr f]
(if (zero? (alength arr))
(f)
(loop [val (aget arr 0), n 1]
(if (< n (alength arr))
(let [nval (f val (aget arr n))]
(if (reduced? nval)
@nval
(recur nval (inc n))))
val))))
([arr f val]
(loop [val val, n 0]
(if (< n (alength arr))
(let [nval (f val (aget arr n))]
(if (reduced? nval)
@nval
(recur nval (inc n))))
val)))
([arr f val idx]
(loop [val val, n idx]
(if (< n (alength arr))
(let [nval (f val (aget arr n))]
(if (reduced? nval)
@nval
(recur nval (inc n))))
val))))
(declare hash-coll cons pr-str counted? RSeq)
(deftype IndexedSeq [a i]
Object
(toString [this]
(pr-str this))
ISeqable
(-seq [this] this)
ASeq
ISeq
(-first [_] (aget a i))
(-rest [_] (if (< (inc i) (.-length a))
(IndexedSeq. a (inc i))
(list)))
INext
(-next [_] (if (< (inc i) (.-length a))
(IndexedSeq. a (inc i))
nil))
ICounted
(-count [_] (- (.-length a) i))
IIndexed
(-nth [coll n]
(let [i (+ n i)]
(when (< i (.-length a))
(aget a i))))
(-nth [coll n not-found]
(let [i (+ n i)]
(if (< i (.-length a))
(aget a i)
not-found)))
ISequential
IEquiv
(-equiv [coll other] (equiv-sequential coll other))
ICollection
(-conj [coll o] (cons o coll))
IReduce
(-reduce [coll f]
(if (counted? a)
(ci-reduce a f (aget a i) (inc i))
(ci-reduce coll f (aget a i) 0)))
(-reduce [coll f start]
(if (counted? a)
(ci-reduce a f start i)
(ci-reduce coll f start 0)))
IHash
(-hash [coll] (hash-coll coll))
IReversible
(-rseq [coll]
(let [c (-count coll)]
(if (pos? c)
(RSeq. coll (dec c) nil)
()))))
(defn prim-seq
([prim]
(prim-seq prim 0))
([prim i]
(when-not (zero? (.-length prim))
(IndexedSeq. prim i))))
(defn array-seq
([array]
(prim-seq array 0))
([array i]
(prim-seq array i)))
(extend-type array
ISeqable
(-seq [array] (array-seq array 0))
ICounted
(-count [a] (.-length a))
IIndexed
(-nth
([array n]
(if (< n (.-length array)) (aget array n)))
([array n not-found]
(if (< n (.-length array)) (aget array n)
not-found)))
ILookup
(-lookup
([array k]
(aget array k))
([array k not-found]
(-nth array k not-found)))
IReduce
(-reduce
([array f]
(ci-reduce array f))
([array f start]
(ci-reduce array f start))))
(deftype RSeq [ci i meta]
Object
(toString [this]
(pr-str this))
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)
()))
ICounted
(-count [coll] (inc i))
ICollection
(-conj [coll o]
(cons o coll))
IHash
(-hash [coll] (hash-coll coll)))
(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)
(if (satisfies? ASeq coll)
coll
(-seq coll))))
(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 (satisfies? ISeq coll)
(-first 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 (satisfies? ISeq coll)
(-rest coll)
(let [s (seq coll)]
(if-not (nil? s)
(-rest 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 (satisfies? INext coll)
(-next coll)
(seq (rest coll)))))
(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 ^boolean not
"Returns true if x is logical false, false otherwise."
[x] (if x false true))
(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 x]
(-conj coll 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]
(-empty coll))
(declare counted?)
(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 (counted? coll)
(-count coll)
(accumulating-seq-count coll)))
(declare indexed?)
(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) (linear-traversal-nth (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) (linear-traversal-nth (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]
(when-not (nil? coll)
(if (satisfies? IIndexed coll)
(-nth coll (.floor js/Math n))
(linear-traversal-nth coll (.floor js/Math n)))))
([coll n not-found]
(if-not (nil? coll)
(if (satisfies? IIndexed coll)
(-nth coll (.floor js/Math n) not-found)
(linear-traversal-nth coll (.floor js/Math n) not-found))
not-found)))
(defn get
"Returns the value mapped to key, not-found or nil if key not present."
([o k]
(-lookup o k))
([o k not-found]
(-lookup o k not-found)))
(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]
(-assoc coll 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]
(-dissoc coll k))
([coll k & ks]
(let [ret (dissoc coll k)]
(if ks
(recur ret (first ks) (next ks))
ret))))
(defn with-meta
"Returns an object of the same type and value as obj, with
map m as its metadata."
[o meta]
(-with-meta o meta))
(defn meta
"Returns the metadata of obj, returns nil if there is no metadata."
[o]
(when (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]
(-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]
(-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]
(-disjoin coll k))
([coll k & ks]
(let [ret (disj coll k)]
(if ks
(recur ret (first ks) (next ks))
ret))))
(defn hash [o]
(-hash o))
(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] (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 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 ^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 vector?
"Return true if x satisfies IVector"
[x] (satisfies? IVector x))
(defn ^boolean chunked-seq?
[x] (satisfies? IChunkedSeq x))
;;;;;;;;;;;;;;;;;;;; js primitives ;;;;;;;;;;;;
(defn js-obj
([]
(js* "{}"))
([& keyvals]
(apply gobject/create keyvals)))
(defn js-keys [obj]
(let [keys (array)]
(goog.object/forEach obj (fn [val key obj] (.push keys key)))
keys))
(defn js-delete [obj key]
(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 undefined? [x]
(cljs.core/undefined? x))
(defn ^boolean instance? [t o]
(js* "(~{o} instanceof ~{t})"))
(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 [x]
(if x true false))
(defn ^boolean string? [x]
(and ^boolean (goog/isString x)
(not (or (identical? (.charAt x 0) \uFDD0)
(identical? (.charAt x 0) \uFDD1)))))
(defn ^boolean keyword? [x]
(and ^boolean (goog/isString x)
(identical? (.charAt x 0) \uFDD0)))
(defn ^boolean symbol? [x]
(and ^boolean (goog/isString x)
(identical? (.charAt x 0) \uFDD1)))
(defn ^boolean number? [n]
(goog/isNumber n))
(defn ^boolean fn? [f]
(goog/isFunction f))
(defn ^boolean ifn? [f]
(or (fn? f) (satisfies? IFn f)))
(defn ^boolean integer?
"Returns true if n is an integer. Warning: returns true on underflow condition."
[n]
(and (number? n)
(coercive-= n (.toFixed n))))
(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? (-lookup 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 coll
(associative? coll)
(contains? coll k))
[k (-lookup 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 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
(identical? (type x) (type y)) (if (satisfies? IComparable x)
(-compare x y)
(garray/defaultCompare x y))
:else (throw (js/Error. "compare on non-nil objects of different types"))))
(defn ^:private compare-indexed
"Compare indexed collection."
([xs ys]
(let [xl (count xs)
yl (count ys)]
(cond
(< xl yl) -1
(> xl yl) 1
: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 funcion, 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]
(if (satisfies? IReduce coll)
(-reduce coll f)
(seq-reduce f coll)))
([f val coll]
(if (satisfies? IReduce coll)
(-reduce coll f val)
(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]
(-kv-reduce coll f init)))
(deftype Reduced [val]
IDeref
(-deref [o] val))
(defn ^boolean reduced?
"Returns true if x is the result of a call to reduced"
[r]
(instance? Reduced r))
(defn reduced
"Wraps x in a way such that a reduce will terminate with the value x"
[x]
(Reduced. x))
;;; Math - variadic forms will not work until the following implemented:
;;; first, next, reduce
(defn +
"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 -
"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 *
"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)))
(defn /
"If no denominators are supplied, returns 1/numerator,
else returns numerator divided by all of the denominators."
([x] (/ 1 x))
([x y] (js* "(~{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 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 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- fix [q]
(if (>= q 0)
(Math/floor q)
(Math/ceil q)))
(defn 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 mod
"Modulus of num and div. Truncates toward negative infinity."
[n d]
(cljs.core/mod n d))
(defn quot
"quot[ient] of dividing numerator by denominator."
[n d]
(let [rem (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 rand
"Returns a random floating point number between 0 (inclusive) and n (default 1) (exclusive)."
([] (Math/random))
([n] (* n (rand))))
(defn rand-int
"Returns a random integer between 0 (inclusive) and n (exclusive)."
[n] (fix (rand n)))
(defn bit-xor
"Bitwise exclusive or"
[x y] (cljs.core/bit-xor x y))
(defn bit-and
"Bitwise and"
[x y] (cljs.core/bit-and x y))
(defn bit-or
"Bitwise or"
[x y] (cljs.core/bit-or x y))
(defn bit-and-not
"Bitwise and"
[x y] (cljs.core/bit-and-not x y))
(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 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
"Bitwise shift right with zero fill"
[x n] (cljs.core/bit-shift-right-zero-fill x n))
(defn bit-count
"Counts the number of bits set in n"
[n]
(loop [c 0 n n]
(if (zero? n)
c
(recur (inc c) (bit-and n (dec n))))))
(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"
[n] (cljs.core/pos? n))
(defn ^boolean zero? [n]
(cljs.core/zero? n))
(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*
"Internal - do not use!"
([] "")
([x] (cond
(nil? x) ""
:else (. x (toString))))
([x & ys]
((fn [sb more]
(if more
(recur (. sb (append (str* (first more)))) (next more))
(str* sb)))
(gstring/StringBuffer. (str* x)) ys)))
(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] (cond
(symbol? x) (. x (substring 2 (.-length x)))
(keyword? x) (str* ":" (. x (substring 2 (.-length x))))
(nil? x) ""
:else (. x (toString))))
([x & ys]
((fn [sb more]
(if more
(recur (. sb (append (str (first more)))) (next more))
(str* sb)))
(gstring/StringBuffer. (str x)) ys)))
(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)))
(defn symbol
"Returns a Symbol with the given namespace and name."
([name] (cond (symbol? name) name
(keyword? name) (str* "\uFDD1" "'" (subs name 2)))
:else (str* "\uFDD1" "'" name))
([ns name] (symbol (str* ns "/" name))))
(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) (str* "\uFDD0" "'" (subs name 2))
:else (str* "\uFDD0" "'" name)))
([ns name] (keyword (str* ns "/" name))))
(defn- equiv-sequential
"Assumes x is sequential. Returns true if x equals y, otherwise
returns false."
[x y]
(boolean
(when (sequential? y)
(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-combine [seed hash]
; a la boost
(bit-xor seed (+ hash 0x9e3779b9
(bit-shift-left seed 6)
(bit-shift-right seed 2))))
(defn- hash-coll [coll]
(reduce #(hash-combine %1 (hash %2)) (hash (first coll)) (next coll)))
(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 (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 (mod (+ h (hash e)) 4503599627370496)
(next s)))
h)))
(declare name)
(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 implict 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]
IList
Object
(toString [this]
(pr-str this))
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] cljs.core.List/EMPTY)
ISequential
IEquiv
(-equiv [coll other] (equiv-sequential coll other))
IHash
(-hash [coll] (caching-hash coll hash-coll __hash))
ISeqable
(-seq [coll] coll)
ICounted
(-count [coll] count))
(deftype EmptyList [meta]
IList
Object
(toString [this]
(pr-str this))
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] (equiv-sequential coll other))
IHash
(-hash [coll] 0)
ISeqable
(-seq [coll] nil)
ICounted
(-count [coll] 0))
(set! cljs.core.List/EMPTY (EmptyList. nil))
(defn ^boolean reversible? [coll]
(satisfies? IReversible coll))
(defn rseq [coll]
(-rseq coll))
(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
([] ())
([x] (conj () x))
([x y] (conj (list y) x))
([x y z] (conj (list y z) x))
([x y z & items]
(conj (conj (conj (reduce conj () (reverse items))
z) y) x)))
(deftype Cons [meta first rest ^:mutable __hash]
IList
Object
(toString [this]
(pr-str this))
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 __hash))
IEmptyableCollection
(-empty [coll] (with-meta cljs.core.List/EMPTY meta))
ISequential
IEquiv
(-equiv [coll other] (equiv-sequential coll other))
IHash
(-hash [coll] (caching-hash coll hash-coll __hash))
ISeqable
(-seq [coll] coll))
(defn cons
"Returns a new seq where x is the first element and seq is the rest."
[x coll]
(if (or (nil? coll)
(satisfies? ISeq coll))
(Cons. nil x coll nil)
(Cons. nil x (seq coll) nil)))
(defn ^boolean list? [x]
(satisfies? IList x))
(extend-type string
IHash
(-hash [o] (goog.string/hashCode o))
ISeqable
(-seq [string] (prim-seq string 0))
ICounted
(-count [s] (.-length s))
IIndexed
(-nth
([string n]
(if (< n (-count string)) (.charAt string n)))
([string n not-found]
(if (< n (-count string)) (.charAt string n)
not-found)))
ILookup
(-lookup
([string k]
(-nth string k))
([string k not_found]
(-nth string k not_found)))
IReduce
(-reduce
([string f]
(ci-reduce string f))
([string f start]
(ci-reduce string f start))))
(deftype Keyword [k]
IFn
(invoke [_ coll]
(when-not (nil? coll)
(let [strobj (.-strobj coll)]
(if (nil? strobj)
(-lookup coll k nil)
(aget strobj k))))))
;;hrm
(extend-type js/String
IFn
(-invoke
([this coll]
(get coll (.toString this)))
([this coll not-found]
(get coll (.toString this) not-found))))
(set! js/String.prototype.apply
(fn
[s args]
(if (< (count args) 2)
(get (aget args 0) s)
(get (aget args 0) s (aget args 1)))))
; could use reify
;;; LazySeq ;;;
(defn- lazy-seq-value [lazy-seq]
(let [x (.-x lazy-seq)]
(if ^boolean (.-realized lazy-seq)
x
(do
(set! (.-x lazy-seq) (x))
(set! (.-realized lazy-seq) true)
(.-x lazy-seq)))))
(deftype LazySeq [meta realized x ^:mutable __hash]
Object
(toString [this]
(pr-str this))
IWithMeta
(-with-meta [coll meta] (LazySeq. meta realized x __hash))
IMeta
(-meta [coll] meta)
ISeq
(-first [coll] (first (lazy-seq-value coll)))
(-rest [coll] (rest (lazy-seq-value coll)))
INext
(-next [coll] (-seq (-rest coll)))
ICollection
(-conj [coll o] (cons o coll))
IEmptyableCollection
(-empty [coll] (with-meta cljs.core.List/EMPTY meta))
ISequential
IEquiv
(-equiv [coll other] (equiv-sequential coll other))
IHash
(-hash [coll] (caching-hash coll hash-coll __hash))
ISeqable
(-seq [coll] (seq (lazy-seq-value coll))))
(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]
(ci-reduce coll f (aget arr off) (inc off)))
(-reduce [coll f start]
(ci-reduce coll f start off)))
(defn array-chunk
([arr]
(array-chunk arr 0 (alength arr)))
([arr off]
(array-chunk arr off (alength arr)))
([arr off end]
(ArrayChunk. arr off end)))
(deftype ChunkedCons [chunk more meta]
IWithMeta
(-with-meta [coll m]
(ChunkedCons. chunk more m))
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)
(if (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)))
(defn chunk-cons [chunk rest]
(if (zero? (-count chunk))
rest
(ChunkedCons. chunk rest 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 (satisfies? 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 long-array
([size-or-seq]
(cond
(number? size-or-seq) (long-array size-or-seq nil)
(seq? size-or-seq) (into-array size-or-seq)
:else (throw (js/Error. "long-array called with something other than size or ISeq"))))
([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
([size-or-seq]
(cond
(number? size-or-seq) (double-array size-or-seq nil)
(seq? size-or-seq) (into-array size-or-seq)
:else (throw (js/Error. "double-array called with something other than size or ISeq"))))
([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
([size-or-seq]
(cond
(number? size-or-seq) (object-array size-or-seq nil)
(seq? size-or-seq) (into-array size-or-seq)
:else (throw (js/Error. "object-array called with something other than size or ISeq"))))
([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 [s n]
(if (counted? s)
(count s)
(loop [s s i n sum 0]
(if (and (pos? i) (seq s))
(recur (next s) (dec i) (inc sum))
sum))))
(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 [coll]
(-as-transient coll))
(defn persistent! [tcoll]
(-persistent! tcoll))
(defn conj! [tcoll val]
(-conj! tcoll val))
(defn assoc! [tcoll key val]
(-assoc! tcoll key val))
(defn dissoc! [tcoll key]
(-dissoc! tcoll key))
(defn pop! [tcoll]
(-pop! tcoll))
(defn disj! [tcoll val]
(-disjoin! tcoll val))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; apply ;;;;;;;;;;;;;;;;
;; see core.clj
(gen-apply-to)
(defn apply
"Applies fn f to the argument list formed by prepending intervening arguments to args.
First cut. Not lazy. Needs to use emitted toApply."
([f args]
(let [fixed-arity (.-cljs$lang$maxFixedArity f)]
(if (.-cljs$lang$applyTo f)
(let [bc (bounded-count args (inc fixed-arity))]
(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 arglist (inc fixed-arity))]
(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 arglist (inc fixed-arity))]
(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 arglist (inc fixed-arity))]
(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 arglist (inc fixed-arity))]
(if (<= bc fixed-arity)
(apply-to f bc arglist)
(.cljs$lang$applyTo f arglist)))
(.apply f f (to-array arglist))))))
(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 & args]
(with-meta obj (apply f (meta obj) 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 ^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 identity [x] x)
(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 arg1]
(fn [& args] (apply f arg1 args)))
([f arg1 arg2]
(fn [& args] (apply f arg1 arg2 args)))
([f arg1 arg2 arg3]
(fn [& args] (apply f arg1 arg2 arg3 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)))))
(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."
[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."
([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))))))))))
(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."
([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."
([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."
[n coll]
(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."
[n coll]
(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 nil."
[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
"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"
[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)))
(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."
([f coll]
(flatten1 (map f coll)))
([f coll & colls]
(flatten1 (apply map f coll 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."
([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."
[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."
[to from]
(if (satisfies? IEditableCollection to)
(persistent! (reduce -conj! (transient to) from))
(reduce -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 upto 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 ke(ys. 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 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 & args]
(if ks
(assoc m k (apply update-in (get m k) ks f args))
(assoc m k (apply f (get m k) args)))))
;;; Vector
;;; DEPRECATED
;;; in favor of PersistentVector
(deftype Vector [meta array ^:mutable __hash]
Object
(toString [this]
(pr-str this))
IWithMeta
(-with-meta [coll meta] (Vector. meta array __hash))
IMeta
(-meta [coll] meta)
IStack
(-peek [coll]
(let [count (.-length array)]
(when (> count 0)
(aget array (dec count)))))
(-pop [coll]
(if (> (.-length array) 0)
(let [new-array (aclone array)]
(. new-array (pop))
(Vector. meta new-array nil))
(throw (js/Error. "Can't pop empty vector"))))
ICollection
(-conj [coll o]
(let [new-array (aclone array)]
(.push new-array o)
(Vector. meta new-array nil)))
IEmptyableCollection
(-empty [coll] (with-meta cljs.core.Vector/EMPTY meta))
ISequential
IEquiv
(-equiv [coll other] (equiv-sequential coll other))
IHash
(-hash [coll] (caching-hash coll hash-coll __hash))
ISeqable
(-seq [coll]
(when (> (.-length array) 0)
(let [vector-seq
(fn vector-seq [i]
(lazy-seq
(when (< i (.-length array))
(cons (aget array i) (vector-seq (inc i))))))]
(vector-seq 0))))
ICounted
(-count [coll] (.-length array))
IIndexed
(-nth [coll n]
(if (and (<= 0 n) (< n (.-length array)))
(aget array n)
#_(throw (js/Error. (str "No item " n " in vector of length " (.-length array))))))
(-nth [coll n not-found]
(if (and (<= 0 n) (< n (.-length array)))
(aget array n)
not-found))
ILookup
(-lookup [coll k] (-nth coll k nil))
(-lookup [coll k not-found] (-nth coll k not-found))
IAssociative
(-assoc [coll k v]
(let [new-array (aclone array)]
(aset new-array k v)
(Vector. meta new-array nil)))
IVector
(-assoc-n [coll n val] (-assoc coll n val))
IReduce
(-reduce [v f]
(ci-reduce array f))
(-reduce [v f start]
(ci-reduce array f start))
IFn
(-invoke [coll k]
(-lookup coll k))
(-invoke [coll k not-found]
(-lookup coll k not-found)))
(set! cljs.core.Vector/EMPTY (Vector. nil (array) 0))
(set! cljs.core.Vector/fromArray (fn [xs] (Vector. nil xs nil)))
;;; 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- array-for [pv i]
(if (and (<= 0 i) (< i (.-cnt pv)))
(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))))
(throw (js/Error. (str "No item " i " in vector of length " (.-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))))
(declare tv-editable-root tv-editable-tail TransientVector deref
pr-sequential pr-seq)
(declare chunked-seq)
(deftype PersistentVector [meta cnt shift root tail ^:mutable __hash]
Object
(toString [this]
(pr-str this))
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 cljs.core.PersistentVector/EMPTY meta)
(< 1 (- cnt (tail-off coll)))
(PersistentVector. meta (dec cnt) shift root (.slice tail 0 -1) nil)
:else (let [new-tail (array-for coll (- cnt 2))
nr (pop-tail coll shift root)
new-root (if (nil? nr) cljs.core.PersistentVector/EMPTY_NODE 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 [new-tail (aclone tail)]
(.push new-tail 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 cljs.core.PersistentVector/EMPTY meta))
ISequential
IEquiv
(-equiv [coll other] (equiv-sequential coll other))
IHash
(-hash [coll] (caching-hash coll hash-coll __hash))
ISeqable
(-seq [coll]
(if (zero? cnt)
nil
(chunked-seq 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))
(-nth coll n)
not-found))
ILookup
(-lookup [coll k] (-nth coll k nil))
(-lookup [coll k not-found] (-nth coll k not-found))
IMapEntry
(-key [coll]
(-nth coll 0))
(-val [coll]
(-nth coll 1))
IAssociative
(-assoc [coll k v]
(cond
(and (<= 0 k) (< k cnt))
(if (<= (tail-off coll) k)
(let [new-tail (aclone tail)]
(aset new-tail (bit-and k 0x01f) v)
(PersistentVector. meta cnt shift root new-tail nil))
(PersistentVector. meta cnt shift (do-assoc coll shift root k v) tail nil))
(== k cnt) (-conj coll v)
:else (throw (js/Error. (str "Index " k " out of bounds [0," cnt "]")))))
IVector
(-assoc-n [coll n val] (-assoc coll n val))
IReduce
(-reduce [v f]
(ci-reduce v f))
(-reduce [v f start]
(ci-reduce v f start))
IKVReduce
(-kv-reduce [v f init]
(let [step-init (array 0 init)] ; [step 0 init init]
(loop [i 0]
(if (< i cnt)
(let [arr (array-for v i)
len (.-length arr)]
(let [init (loop [j 0 init (aget step-init 1)]
(if (< j len)
(let [init (f init (+ j i) (aget arr j))]
(if (reduced? init)
init
(recur (inc j) init)))
(do (aset step-init 0 len)
(aset step-init 1 init)
init)))]
(if (reduced? init)
@init
(recur (+ i (aget step-init 0))))))
(aget step-init 1)))))
IFn
(-invoke [coll k]
(-lookup coll k))
(-invoke [coll k not-found]
(-lookup 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)
())))
(set! cljs.core.PersistentVector/EMPTY_NODE (pv-fresh-node nil))
(set! cljs.core.PersistentVector/EMPTY (PersistentVector. nil 0 5 cljs.core.PersistentVector/EMPTY_NODE (array) 0))
(set! cljs.core.PersistentVector/fromArray
(fn [xs]
(loop [xs (seq xs) out (transient cljs.core.PersistentVector/EMPTY)]
(if-not (nil? xs)
(recur (next xs) (conj! out (first xs)))
(persistent! out)))))
(defn vec [coll]
(reduce conj cljs.core.PersistentVector/EMPTY coll))
(defn vector [& args] (vec args))
(deftype ChunkedSeq [vec node i off meta]
IWithMeta
(-with-meta [coll m]
(chunked-seq vec node i off m))
(-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 cljs.core.PersistentVector/EMPTY meta))
IChunkedSeq
(-chunked-first [coll]
(array-chunk node off))
(-chunked-rest [coll]
(let [l (alength node)
s (when (< (+ i l) (-count vec))
(chunked-seq vec (+ i l) 0))]
(if (nil? s)
()
s)))
IChunkedNext
(-chunked-next [coll]
(let [l (alength node)
s (when (< (+ i l) (-count vec))
(chunked-seq vec (+ i l) 0))]
(if (nil? s)
nil
s))))
(defn chunked-seq
([vec i off] (chunked-seq vec (array-for vec i) i off nil))
([vec node i off] (chunked-seq vec node i off nil))
([vec node i off meta]
(ChunkedSeq. vec node i off meta)))
(deftype Subvec [meta v start end ^:mutable __hash]
Object
(toString [this]
(pr-str this))
IWithMeta
(-with-meta [coll meta] (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"))
(Subvec. meta v start (dec end) nil)))
ICollection
(-conj [coll o]
(Subvec. meta (-assoc-n v end o) start (inc end) nil))
IEmptyableCollection
(-empty [coll] (with-meta cljs.core.Vector/EMPTY meta))
ISequential
IEquiv
(-equiv [coll other] (equiv-sequential coll other))
IHash
(-hash [coll] (caching-hash coll hash-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)))
ICounted
(-count [coll] (- end start))
IIndexed
(-nth [coll n]
(-nth v (+ start n)))
(-nth [coll n not-found]
(-nth v (+ start n) not-found))
ILookup
(-lookup [coll k] (-nth coll k nil))
(-lookup [coll k not-found] (-nth coll k not-found))
IAssociative
(-assoc [coll key val]
(let [v-pos (+ start key)]
(Subvec. meta (-assoc v v-pos val)
start (max end (inc v-pos))
nil)))
IVector
(-assoc-n [coll n val] (-assoc coll n val))
IReduce
(-reduce [coll f]
(ci-reduce coll f))
(-reduce [coll f start]
(ci-reduce coll f start))
IFn
(-invoke [coll k]
(-lookup coll k))
(-invoke [coll k not-found]
(-lookup coll k not-found)))
(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]
(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 (.-length 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- editable-array-for [tv i]
(if (and (<= 0 i) (< i (.-cnt 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)))))
(throw (js/Error.
(str "No item " i " in transient vector of length " (.-cnt tv))))))
(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] (-assoc-n! tcoll key val))
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 (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] (-nth coll k nil))
(-lookup [coll k not-found] (-nth coll k not-found))
IFn
(-invoke [coll k]
(-lookup coll k))
(-invoke [coll k not-found]
(-lookup coll k not-found)))
;;; PersistentQueue ;;;
(deftype PersistentQueueSeq [meta front rear ^:mutable __hash]
Object
(toString [this]
(pr-str this))
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 cljs.core.List/EMPTY meta))
ISequential
IEquiv
(-equiv [coll other] (equiv-sequential coll other))
IHash
(-hash [coll] (caching-hash coll hash-coll __hash))
ISeqable
(-seq [coll] coll))
(deftype PersistentQueue [meta count front rear ^:mutable __hash]
Object
(toString [this]
(pr-str this))
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] cljs.core.PersistentQueue/EMPTY)
ISequential
IEquiv
(-equiv [coll other] (equiv-sequential coll other))
IHash
(-hash [coll] (caching-hash coll hash-coll __hash))
ISeqable
(-seq [coll]
(let [rear (seq rear)]
(if (or front rear)
(PersistentQueueSeq. nil front (seq rear) nil)
cljs.core.List/EMPTY)))
ICounted
(-count [coll] count))
(set! cljs.core.PersistentQueue/EMPTY (PersistentQueue. nil 0 nil [] 0))
(deftype NeverEquiv []
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? identity
(map (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 (.-length ks)
so (.-strobj m)
out (with-meta cljs.core.PersistentHashMap/EMPTY (meta m))]
(loop [i 0
out (transient out)]
(if (< i len)
(let [k (aget ks i)]
(recur (inc i) (assoc! out k (aget so k))))
(persistent! (assoc! out k v))))))
;;; ObjMap
(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 [this]
(pr-str this))
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 cljs.core.ObjMap/EMPTY meta))
IEquiv
(-equiv [coll other] (equiv-map coll other))
IHash
(-hash [coll] (caching-hash coll hash-imap __hash))
ISeqable
(-seq [coll]
(when (pos? (.-length keys))
(map #(vector % (aget strobj %))
(.sort keys obj-map-compare-keys))))
ICounted
(-count [coll] (.-length 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-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
(if (or (< update-count cljs.core.ObjMap/HASHMAP_THRESHOLD)
(< (alength keys) cljs.core.ObjMap/HASHMAP_THRESHOLD))
(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))
;; too many keys, switching to PersistentHashMap
(obj-map->hash-map coll k v)))
; 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))
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! cljs.core.ObjMap/EMPTY (ObjMap. nil (array) (js-obj) 0 0))
(set! cljs.core.ObjMap/HASHMAP_THRESHOLD 32)
(set! cljs.core.ObjMap/fromObject (fn [ks obj] (ObjMap. nil ks obj 0 nil)))
;;; HashMap
;;; DEPRECATED
;;; in favor of PersistentHashMap
; The keys field is an array of all keys of this map, in no particular
; order. Each key is hashed and the result used as a property name of
; hashobj. Each values in hashobj is actually a bucket in order to handle hash
; collisions. A bucket is an array of alternating keys (not their hashes) and
; vals.
(deftype HashMap [meta count hashobj ^:mutable __hash]
Object
(toString [this]
(pr-str this))
IWithMeta
(-with-meta [coll meta] (HashMap. meta count hashobj __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 cljs.core.HashMap/EMPTY meta))
IEquiv
(-equiv [coll other] (equiv-map coll other))
IHash
(-hash [coll] (caching-hash coll hash-imap __hash))
ISeqable
(-seq [coll]
(when (pos? count)
(let [hashes (.sort (js-keys hashobj))]
(mapcat #(map vec (partition 2 (aget hashobj %)))
hashes))))
ICounted
(-count [coll] count)
ILookup
(-lookup [coll k] (-lookup coll k nil))
(-lookup [coll k not-found]
(let [bucket (aget hashobj (hash k))
i (when bucket (scan-array 2 k bucket))]
(if i
(aget bucket (inc i))
not-found)))
IAssociative
(-assoc [coll k v]
(let [h (hash k)
bucket (aget hashobj h)]
(if bucket
(let [new-bucket (aclone bucket)
new-hashobj (goog.object/clone hashobj)]
(aset new-hashobj h new-bucket)
(if-let [i (scan-array 2 k new-bucket)]
(do ; found key, replace
(aset new-bucket (inc i) v)
(HashMap. meta count new-hashobj nil))
(do ; did not find key, append
(.push new-bucket k v)
(HashMap. meta (inc count) new-hashobj nil))))
(let [new-hashobj (goog.object/clone hashobj)] ; did not find bucket
(aset new-hashobj h (array k v))
(HashMap. meta (inc count) new-hashobj nil)))))
(-contains-key? [coll k]
(let [bucket (aget hashobj (hash k))
i (when bucket (scan-array 2 k bucket))]
(if i
true
false)))
IMap
(-dissoc [coll k]
(let [h (hash k)
bucket (aget hashobj h)
i (when bucket (scan-array 2 k bucket))]
(if (not i)
coll ; key not found, return coll unchanged
(let [new-hashobj (goog.object/clone hashobj)]
(if (> 3 (.-length bucket))
(js-delete new-hashobj h)
(let [new-bucket (aclone bucket)]
(.splice new-bucket i 2)
(aset new-hashobj h new-bucket)))
(HashMap. meta (dec count) new-hashobj nil)))))
IFn
(-invoke [coll k]
(-lookup coll k))
(-invoke [coll k not-found]
(-lookup coll k not-found)))
(set! cljs.core.HashMap/EMPTY (HashMap. nil 0 (js-obj) 0))
(set! cljs.core.HashMap/fromArrays (fn [ks vs]
(let [len (.-length ks)]
(loop [i 0, out cljs.core.HashMap/EMPTY]
(if (< i len)
(recur (inc i) (assoc out (aget ks i) (aget vs i)))
out)))))
;;; PersistentArrayMap
(defn- array-map-index-of [m k]
(let [arr (.-arr m)
len (.-length arr)]
(loop [i 0]
(cond
(<= len i) -1
(= (aget arr i) k) i
:else (recur (+ i 2))))))
(declare TransientArrayMap)
(deftype PersistentArrayMap [meta cnt arr ^:mutable __hash]
Object
(toString [this]
(pr-str this))
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))
(reduce -conj coll entry)))
IEmptyableCollection
(-empty [coll] (-with-meta cljs.core.PersistentArrayMap/EMPTY meta))
IEquiv
(-equiv [coll other] (equiv-map coll other))
IHash
(-hash [coll] (caching-hash coll hash-imap __hash))
ISeqable
(-seq [coll]
(when (pos? cnt)
(let [len (.-length arr)
array-map-seq
(fn array-map-seq [i]
(lazy-seq
(when (< i len)
(cons [(aget arr i) (aget arr (inc i))]
(array-map-seq (+ i 2))))))]
(array-map-seq 0))))
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 cljs.core.PersistentArrayMap/HASHMAP_THRESHOLD)
(PersistentArrayMap. meta
(inc cnt)
(doto (aclone arr)
(.push k)
(.push v))
nil)
(persistent!
(assoc!
(transient (into cljs.core.PersistentHashMap/EMPTY coll))
k v)))
(identical? v (aget arr (inc idx)))
coll
:else
(PersistentArrayMap. meta
cnt
(doto (aclone arr)
(aset (inc idx) v))
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 (.-length 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 (.-length 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)))))))
IFn
(-invoke [coll k]
(-lookup coll k))
(-invoke [coll k not-found]
(-lookup coll k not-found))
IEditableCollection
(-as-transient [coll]
(TransientArrayMap. (js-obj) (.-length arr) (aclone arr))))
(set! cljs.core.PersistentArrayMap/EMPTY (PersistentArrayMap. nil 0 (array) nil))
(set! cljs.core.PersistentArrayMap/HASHMAP_THRESHOLD 16)
(set! cljs.core.PersistentArrayMap/fromArrays
(fn [ks vs]
(let [len (count ks)]
(loop [i 0
out (transient cljs.core.PersistentArrayMap/EMPTY)]
(if (< i len)
(recur (inc i) (assoc! out (aget ks i) (aget vs i)))
(persistent! out))))))
(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 cljs.core.PersistentArrayMap/HASHMAP_THRESHOLD))
(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)
(defn- array->transient-hash-map [len arr]
(loop [out (transient {})
i 0]
(if (< i len)
(recur (assoc! out (aget arr i) (aget arr (inc i))) (+ i 2))
out)))
;;; PersistentHashMap
(declare create-inode-seq create-array-node-seq reset! create-node atom deref)
(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 (- (.-length arr) 2))]
(array-copy arr 0 new-arr 0 (* 2 i))
(array-copy arr (* 2 (inc i)) new-arr (* 2 i) (- (.-length 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 (.-length 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 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 cljs.core.BitmapIndexedNode/EMPTY (+ 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 cljs.core.BitmapIndexedNode/EMPTY
(+ 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 added-leaf? 0 true)
(aset new-arr (inc (* 2 idx)) val)
(array-copy arr (* 2 idx) new-arr (* 2 (inc idx)) (* 2 (- n idx)))
(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 key-or-nil)
(if (identical? val val-or-node)
inode
(BitmapIndexedNode. nil bitmap (clone-and-set arr (inc (* 2 idx)) val)))
:else
(do (aset added-leaf? 0 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 key-or-nil)
(BitmapIndexedNode. nil (bit-xor bitmap bit) (remove-pair arr idx))
:else inode)))))
(inode-find [inode shift hash key]
(let [bit (bitpos hash shift)]
(if (zero? (bit-and bitmap bit))
nil
(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)
(= key key-or-nil) [key-or-nil val-or-node]
:else nil)))))
(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 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 (.-length 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) (.-length arr))
(let [editable (.ensure-editable inode edit)
earr (.-arr editable)]
(aset added-leaf? 0 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! cljs.core.BitmapIndexedNode/EMPTY 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! cljs.core.BitmapIndexedNode/EMPTY
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 added-leaf? 0 true)
(aset new-arr (inc (* 2 idx)) val)
(array-copy arr (* 2 idx) new-arr (* 2 (inc idx)) (* 2 (- n idx)))
(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 key-or-nil)
(if (identical? val val-or-node)
inode
(edit-and-set inode edit (inc (* 2 idx)) val))
:else
(do (aset added-leaf? 0 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 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)))
(set! cljs.core.BitmapIndexedNode/EMPTY (BitmapIndexedNode. nil 0 (make-array 0)))
(defn- pack-array-node [array-node edit idx]
(let [arr (.-arr array-node)
len (* 2 (dec (.-cnt array-node)))
new-arr (make-array len)]
(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 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 cljs.core.BitmapIndexedNode/EMPTY (+ 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-find [inode shift hash key]
(let [idx (mask hash shift)
node (aget arr idx)]
(if-not (nil? node)
(.inode-find node (+ shift 5) hash key)
nil)))
(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! cljs.core.BitmapIndexedNode/EMPTY 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 (.-length 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)))))
init)))))
(defn- hash-collision-node-find-index [arr cnt key]
(let [lim (* 2 cnt)]
(loop [i 0]
(if (< i lim)
(if (= 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 (.-length 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)
(aset added-leaf? 0 true)
(HashCollisionNode. nil collision-hash (inc cnt) new-arr))
(if (= (aget arr 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-find [inode shift hash key]
(let [idx (hash-collision-node-find-index arr cnt key)]
(cond (< idx 0) nil
(= key (aget arr idx)) [(aget arr idx) (aget arr (inc idx))]
:else nil)))
(inode-find [inode shift hash key not-found]
(let [idx (hash-collision-node-find-index arr cnt key)]
(cond (< idx 0) not-found
(= 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 [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 (> (.-length arr) (* 2 cnt))
(let [editable (edit-and-set inode edit (* 2 cnt) key (inc (* 2 cnt)) val)]
(aset added-leaf? 0 true)
(set! (.-cnt editable) (inc (.-cnt editable)))
editable)
(let [len (.-length 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)
(aset added-leaf? 0 true)
(.ensure-editable 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)))
(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? (array false)]
(-> cljs.core.BitmapIndexedNode/EMPTY
(.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? (array false)]
(-> cljs.core.BitmapIndexedNode/EMPTY
(.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 [this]
(pr-str this))
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 cljs.core.List/EMPTY meta))
ICollection
(-conj [coll o] (cons o coll))
IEmptyableCollection
(-empty [coll] (with-meta cljs.core.List/EMPTY meta))
ISequential
ISeq
(-first [coll]
(if (nil? s)
[(aget nodes i) (aget nodes (inc i))]
(first s)))
(-rest [coll]
(if (nil? s)
(create-inode-seq nodes (+ i 2) nil)
(create-inode-seq nodes i (next s))))
ISeqable
(-seq [this] this)
IEquiv
(-equiv [coll other] (equiv-sequential coll other))
IHash
(-hash [coll] (caching-hash coll hash-coll __hash)))
(defn- create-inode-seq
([nodes]
(create-inode-seq nodes 0 nil))
([nodes i s]
(if (nil? s)
(let [len (.-length 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 [this]
(pr-str this))
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 cljs.core.List/EMPTY meta))
ICollection
(-conj [coll o] (cons o coll))
IEmptyableCollection
(-empty [coll] (with-meta cljs.core.List/EMPTY meta))
ISequential
ISeq
(-first [coll] (first s))
(-rest [coll] (create-array-node-seq nil nodes i (next s)))
ISeqable
(-seq [this] this)
IEquiv
(-equiv [coll other] (equiv-sequential coll other))
IHash
(-hash [coll] (caching-hash coll hash-coll __hash)))
(defn- create-array-node-seq
([nodes] (create-array-node-seq nil nodes 0 nil))
([meta nodes i s]
(if (nil? s)
(let [len (.-length 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 PersistentHashMap [meta cnt root has-nil? nil-val ^:mutable __hash]
Object
(toString [this]
(pr-str this))
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))
(reduce -conj coll entry)))
IEmptyableCollection
(-empty [coll] (-with-meta cljs.core.PersistentHashMap/EMPTY meta))
IEquiv
(-equiv [coll other] (equiv-map coll other))
IHash
(-hash [coll] (caching-hash coll hash-imap __hash))
ISeqable