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