10763 lines
303 KiB
Clojure
10763 lines
303 KiB
Clojure
; 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))
|