| ; 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] |
| [goog.Uri]) |
| (:import [goog.string StringBuffer])) |
| |
| ;; next line is auto-generated by the build-script - Do not edit! |
| (def *clojurescript-version* "1.10.597") |
| |
| ;; Setting of these Vars is in ClojureScript code is associated with intrinsics |
| ;; that affect compilation state, but otherwise turn into no-ops in the emitted |
| ;; JavaScript. |
| |
| ;; The scope of *unchecked-if* is controlled by balanced pairs of set! calls. |
| (def *unchecked-if* false) |
| ;; The scope of *unchecked-arrays* is file-scope: In JVM ClojureScript its side- |
| ;; effect is to set same-named analyzer dynamic Var, which is unset via binding |
| ;; scopes. In self-hosted it is cleared via cljs.js/post-file-side-effects. |
| (def *unchecked-arrays* false) |
| ;; The scope of *warn-on-infer* is file-scope: Its side effect is to set the |
| ;; cljs.analyzer/*cljs-warnings* dynamic Var, which is unset via binding scopes. |
| (def *warn-on-infer* false) |
| |
| (set! *unchecked-arrays* true) |
| |
| (defonce PROTOCOL_SENTINEL #js {}) |
| |
| (def MODULE_URIS nil) ;; set by compiler |
| (def MODULE_INFOS nil) ;; set by compiler |
| |
| (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* nil) |
| |
| (defn ^{:doc "Arranges to have tap functions executed via the supplied f, a |
| function of no arguments. Returns true if successful, false otherwise." :dynamic true} |
| *exec-tap-fn* |
| [f] |
| (and |
| (exists? js/setTimeout) |
| (js/setTimeout f 0) |
| true)) |
| |
| (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* nil) |
| |
| (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) |
| |
| (def |
| ^{:dynamic true |
| :doc "*print-fns-bodies* controls whether functions print their source or |
| only their names."} |
| *print-fn-bodies* false) |
| |
| (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 [] |
| (let [xs (js-arguments)] |
| (.apply (.-log js/console) js/console (garray/clone xs))))) |
| (set-print-err-fn! |
| (fn [] |
| (let [xs (js-arguments)] |
| (.apply (.-error js/console) js/console (garray/clone xs))))) |
| 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 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 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 char? |
| "Returns true if x is a JavaScript string of length one." |
| [x] |
| (and (string? x) (== 1 (.-length x)))) |
| |
| (defn any? |
| "Returns true if given any argument." |
| [x] true) |
| |
| (set! *unchecked-if* true) |
| (defn native-satisfies? |
| "Internal - do not use!" |
| [p x] |
| (let [x (if (nil? x) nil x)] |
| (cond |
| (unchecked-get p (goog/typeOf x)) true |
| (unchecked-get 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) |
| |
| (def |
| ^{:doc "A sequence of the supplied command line arguments, or nil if |
| none were supplied"} |
| *command-line-args* 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- maybe-warn |
| [e] |
| (when *print-err-fn* |
| (*print-err-fn* e))) |
| |
| (defn- checked-aget |
| ([array idx] |
| (when-assert |
| (try |
| (assert (or (array? array) (goog/isArrayLike array))) |
| (assert (number? idx)) |
| (assert (not (neg? idx))) |
| (assert (< idx (alength array))) |
| (catch :default e |
| (maybe-warn e)))) |
| (unchecked-get array idx)) |
| ([array idx & idxs] |
| (apply checked-aget (checked-aget array idx) idxs))) |
| |
| (defn- checked-aset |
| ([array idx val] |
| (when-assert |
| (try |
| (assert (or (array? array) (goog/isArrayLike array))) |
| (assert (number? idx)) |
| (assert (not (neg? idx))) |
| (assert (< idx (alength array))) |
| (catch :default e |
| (maybe-warn e)))) |
| (unchecked-set array idx val)) |
| ([array idx idx2 & idxv] |
| (apply checked-aset (checked-aget array idx) idx2 idxv))) |
| |
| (defn- checked-aget' |
| ([array idx] |
| {:pre [(or (array? array) (goog/isArrayLike array)) |
| (number? idx) (not (neg? idx)) (< idx (alength array))]} |
| (unchecked-get array idx)) |
| ([array idx & idxs] |
| (apply checked-aget' (checked-aget' array idx) idxs))) |
| |
| (defn- checked-aset' |
| ([array idx val] |
| {:pre [(or (array? array) (goog/isArrayLike array)) |
| (number? idx) (not (neg? idx)) (< idx (alength array))]} |
| (unchecked-set array idx val)) |
| ([array idx idx2 & idxv] |
| (apply checked-aset' (checked-aget' array idx) idx2 idxv))) |
| |
| (defn aget |
| "Returns the value at the index/indices. Works on JavaScript arrays." |
| ([array idx] |
| (cljs.core/aget array idx)) |
| ([array idx & idxs] |
| (apply aget (aget array idx) idxs))) |
| |
| (defn aset |
| "Sets the value at the index/indices. Works on JavaScript arrays. |
| Returns val." |
| ([array idx val] |
| (cljs.core/aset array idx 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 (unchecked-get 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 IFind |
| "Protocol for implementing entry finding in collections." |
| (-find [coll k] "Returns the map entry for key, or nil if key not present.")) |
| |
| (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.") |
| ( ^{:tag #{string clj-nil}}-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 (.-length 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 (.-length in) 1) 1) |
| (bit-xor h1 (m3-mix-K1 (.charCodeAt in (dec (.-length in))))) |
| h1)] |
| (m3-fmix h1 (imul 2 (.-length 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 (.-length 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)] |
| (gobject/set 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 (unchecked-get 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) |
| (bit-xor (-hash o) 0) |
| |
| (number? o) |
| (if (js/isFinite o) |
| (js-mod (Math/floor o) 2147483647) |
| (case o |
| ##Inf |
| 2146435072 |
| ##-Inf |
| -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) |
| (bit-xor (.valueOf o) 0) |
| |
| (nil? o) 0 |
| |
| :else |
| (bit-xor (-hash o) 0))) |
| |
| (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 var? |
| "Returns true if v is of type cljs.core.Var" |
| [v] |
| (instance? cljs.core.Var v)) |
| |
| (defn symbol |
| "Returns a Symbol with the given namespace and name. Arity-1 works |
| on strings, keywords, and vars." |
| ([name] |
| (cond (symbol? name) name |
| (string? name) (let [idx (.indexOf name "/")] |
| (if (< idx 1) |
| (symbol nil name) |
| (symbol (.substring name 0 idx) |
| (.substring name (inc idx) (. name -length))))) |
| (var? name) (.-sym name) |
| (keyword? name) (recur (.-fqn name)) |
| :else (throw (new js/Error "no conversion to symbol")))) |
| ([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))) |
| |
| ;;;;;;;;;;;;;;;;;;; fundamentals ;;;;;;;;;;;;;;; |
| |
| (declare array-seq prim-seq IndexedSeq) |
| |
| (defn 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 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 coll) |
| |
| (array? coll) |
| (when-not (zero? (alength coll)) |
| (IndexedSeq. coll 0 nil)) |
| |
| (string? coll) |
| (when-not (zero? (.-length 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 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 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 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 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 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" |
| ([^not-native 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))))) |
| ([^not-native 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))))) |
| |
| (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 counted? |
| "Returns true if coll implements count in constant time" |
| [x] (satisfies? ICounted x)) |
| |
| (defn 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] |
| (if (identical? new-meta meta) |
| coll |
| (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] |
| (if (identical? new-meta meta) |
| coll |
| (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] (.-EMPTY List)) |
| |
| 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) |
| (cond |
| (implements? IEmptyableCollection coll) |
| (-empty coll) |
| |
| (satisfies? IEmptyableCollection coll) |
| (-empty coll) |
| |
| :else nil))) |
| |
| (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 coll) |
| |
| (array? coll) |
| (alength coll) |
| |
| (string? coll) |
| ^number (.-length 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 coll n) |
| |
| (array? coll) |
| (if (and (< -1 n (.-length coll))) |
| (aget coll (int n)) |
| (throw (js/Error. "Index out of bounds"))) |
| |
| (string? coll) |
| (if (and (< -1 n (.-length coll))) |
| (.charAt coll (int n)) |
| (throw (js/Error. "Index out of bounds"))) |
| |
| (or (implements? ISeq coll) |
| (implements? ISequential coll)) |
| (if (neg? n) |
| (throw (js/Error. "Index out of bounds")) |
| (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 coll n not-found) |
| |
| (array? coll) |
| (if (and (< -1 n (.-length coll))) |
| (aget coll (int n)) |
| not-found) |
| |
| (string? coll) |
| (if (and (< -1 n (.-length coll))) |
| (.charAt coll (int n)) |
| not-found) |
| |
| (or (implements? ISeq coll) |
| (implements? ISequential coll)) |
| (if (neg? n) |
| not-found |
| (linear-traversal-nth coll n not-found)) |
| |
| (native-satisfies? IIndexed coll) |
| (-nth coll n not-found) |
| |
| :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-let [xs (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 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 o k not-found) |
| |
| (array? o) |
| (if (and (some? k) (< -1 k (.-length o))) |
| (aget o (int k)) |
| not-found) |
| |
| (string? o) |
| (if (and (some? k) (< -1 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 PersistentArrayMap MapEntry) |
| |
| (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. Note - index must be <= (count vector)." |
| ([coll k v] |
| (if (implements? IAssociative coll) |
| (-assoc coll k v) |
| (if-not (nil? coll) |
| (-assoc coll k v) |
| (array-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 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 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 coll? |
| "Returns true if x satisfies ICollection" |
| [x] |
| (if (nil? x) |
| false |
| (satisfies? ICollection x))) |
| |
| (defn set? |
| "Returns true if x satisfies ISet" |
| [x] |
| (if (nil? x) |
| false |
| (satisfies? ISet x))) |
| |
| (defn associative? |
| "Returns true if coll implements IAssociative" |
| [x] (satisfies? IAssociative x)) |
| |
| (defn ifind? |
| "Returns true if coll implements IFind" |
| [x] (satisfies? IFind x)) |
| |
| (defn sequential? |
| "Returns true if coll satisfies ISequential" |
| [x] (satisfies? ISequential x)) |
| |
| (defn sorted? |
| "Returns true if coll satisfies ISorted" |
| [x] (satisfies? ISorted x)) |
| |
| (defn reduceable? |
| "Returns true if coll satisfies IReduce" |
| [x] (satisfies? IReduce x)) |
| |
| (defn map? |
| "Return true if x satisfies IMap" |
| [x] |
| (if (nil? x) |
| false |
| (satisfies? IMap x))) |
| |
| (defn record? |
| "Return true if x satisfies IRecord" |
| [x] |
| (satisfies? IRecord x)) |
| |
| (defn vector? |
| "Return true if x satisfies IVector" |
| [x] (satisfies? IVector x)) |
| |
| (declare ChunkedCons ChunkedSeq) |
| |
| (defn chunked-seq? |
| "Return true if x 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] |
| (gobject/getKeys obj)) |
| |
| (defn js-delete |
| "Delete a property from a JavaScript object. |
| Returns true upon success, false otherwise." |
| [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? |
| "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 seq? |
| "Return true if s satisfies ISeq" |
| [s] |
| (if (nil? s) |
| false |
| (satisfies? ISeq s))) |
| |
| (defn seqable? |
| "Return true if the seq function is supported for s" |
| [s] |
| (or |
| (nil? s) |
| (satisfies? ISeqable s) |
| (array? s) |
| (string? s))) |
| |
| (defn boolean |
| "Coerce to boolean" |
| [x] |
| (cond |
| (nil? x) false |
| (false? x) false |
| :else true)) |
| |
| (defn ifn? |
| "Returns true if f returns true for fn? or satisfies IFn." |
| [f] |
| (or (fn? f) (satisfies? IFn f))) |
| |
| (defn 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 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 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 negative." |
| [x] |
| (cond |
| (integer? x) (neg? x) |
| |
| (instance? goog.math.Integer x) |
| (.isNegative x) |
| |
| (instance? goog.math.Long x) |
| (.isNegative x) |
| |
| :else false)) |
| |
| (defn nat-int? |
| "Return true if x satisfies int? and is a natural integer value." |
| [x] |
| (cond |
| (integer? x) |
| (not (neg? x)) |
| |
| (instance? goog.math.Integer x) |
| (not (.isNegative x)) |
| |
| (instance? goog.math.Long x) |
| (not (.isNegative x)) |
| |
| :else false)) |
| |
| (defn float? |
| "Returns true for JavaScript numbers, false otherwise." |
| [x] |
| (number? x)) |
| |
| (defn double? |
| "Returns true for JavaScript numbers, false otherwise." |
| [x] |
| (number? x)) |
| |
| (defn infinite? |
| "Returns true for Infinity and -Infinity values." |
| [x] |
| (or (identical? x js/Number.POSITIVE_INFINITY) |
| (identical? x js/Number.NEGATIVE_INFINITY))) |
| |
| (defn 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] |
| (if (ifind? coll) |
| (-find coll k) |
| (when (and (not (nil? coll)) |
| (associative? coll) |
| (contains? coll k)) |
| (MapEntry. k (get coll k) nil)))) |
| |
| (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 function, 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- iter-reduce |
| ([coll f] |
| (let [iter (-iterator coll)] |
| (if (.hasNext iter) |
| (let [init (.next iter)] |
| (loop [acc init] |
| (if ^boolean (.hasNext iter) |
| (let [nacc (f acc (.next iter))] |
| (if (reduced? nacc) |
| @nacc |
| (recur nacc))) |
| acc))) |
| (f)))) |
| ([coll f init] |
| (let [iter (-iterator coll)] |
| (loop [acc init] |
| (if ^boolean (.hasNext iter) |
| (let [nacc (f acc (.next iter))] |
| (if (reduced? nacc) |
| @nacc |
| (recur nacc))) |
| acc))))) |
| |
| (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 coll f) |
| |
| (array? coll) |
| (array-reduce coll f) |
| |
| (string? coll) |
| (array-reduce coll f) |
| |
| (native-satisfies? IReduce coll) |
| (-reduce coll f) |
| |
| (iterable? coll) |
| (iter-reduce coll f) |
| |
| :else |
| (seq-reduce f coll))) |
| ([f val coll] |
| (cond |
| (implements? IReduce coll) |
| (-reduce 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) |
| |
| (iterable? coll) |
| (iter-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] ^string (.substring s start)) |
| ([s start end] ^string (.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)] |
| (gobject/set 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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (List. new-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 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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (EmptyList. new-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 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) |
| (or (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) 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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (Cons. new-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] (.-EMPTY List)) |
| |
| 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] |
| (cond |
| (nil? coll) (List. nil x nil 1 nil) |
| (implements? ISeq coll) (Cons. nil x coll nil) |
| :default (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 keyword? |
| "Return true if x is a Keyword" |
| [x] |
| (instance? Keyword x)) |
| |
| (defn 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 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 x) |
| (throw (js/Error. (str "Doesn't support namespace: " x))))) |
| |
| (defn ident? |
| "Return true if x is a symbol or keyword" |
| [x] (or (keyword? x) (symbol? x))) |
| |
| (defn simple-ident? |
| "Return true if x is a symbol or keyword without a namespace" |
| [x] (and (ident? x) (nil? (namespace x)))) |
| |
| (defn qualified-ident? |
| "Return true if x is a symbol or keyword with a namespace" |
| [x] (boolean (and (ident? x) (namespace x) true))) |
| |
| (defn simple-symbol? |
| "Return true if x is a symbol without a namespace" |
| [x] (and (symbol? x) (nil? (namespace x)))) |
| |
| (defn qualified-symbol? |
| "Return true if x is a symbol with a namespace" |
| [x] (boolean (and (symbol? x) (namespace x) true))) |
| |
| (defn simple-keyword? |
| "Return true if x is a keyword without a namespace" |
| [x] (and (keyword? x) (nil? (namespace x)))) |
| |
| (defn qualified-keyword? |
| "Return true if x is a keyword with a namespace" |
| [x] (boolean (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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (LazySeq. new-meta #(-seq coll) nil __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 [_] |
| (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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (ChunkedCons. chunk more new-meta __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 nil nil) |
| (if (nil? more) |
| () |
| more))) |
| |
| INext |
| (-next [coll] |
| (if (> (-count chunk) 1) |
| (ChunkedCons. (-drop-first chunk) more nil nil) |
| (when-not (nil? more) |
| (-seq 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] (.-EMPTY List)) |
| |
| 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 |
| "Returns an array containing the contents of coll." |
| [coll] |
| (let [ary (array)] |
| (loop [s (seq coll)] |
| (if-not (nil? 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-not (nil? 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] |
| (when-not (nil? arglist) |
| (let [n (next arglist)] |
| (if (nil? n) |
| (seq (first arglist)) |
| (cons (first arglist) |
| (spread n)))))) |
| |
| (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- ^seq next* |
| "Internal. DO NOT USE! Next without the nil? check." |
| [coll] |
| (if (implements? INext coll) |
| (-next ^not-native coll) |
| (seq (rest coll)))) |
| |
| (defn- apply-to-simple |
| "Internal. DO NOT USE! |
| Assumes args was already called with seq beforehand!" |
| ([f ^seq args] |
| (if (nil? args) |
| (if (.-cljs$core$IFn$_invoke$arity$0 f) |
| (.cljs$core$IFn$_invoke$arity$0 f) |
| (.call f f)) |
| (apply-to-simple f (-first args) (next* args)))) |
| ([f a0 ^seq args] |
| (if (nil? args) |
| (if (.-cljs$core$IFn$_invoke$arity$1 f) |
| (.cljs$core$IFn$_invoke$arity$1 f a0) |
| (.call f f a0)) |
| (apply-to-simple f a0 (-first args) (next* args)))) |
| ([f a0 a1 ^seq args] |
| (if (nil? args) |
| (if (.-cljs$core$IFn$_invoke$arity$2 f) |
| (.cljs$core$IFn$_invoke$arity$2 f a0 a1) |
| (.call f f a0 a1)) |
| (apply-to-simple f a0 a1 (-first args) (next* args)))) |
| ([f a0 a1 a2 ^seq args] |
| (if (nil? args) |
| (if (.-cljs$core$IFn$_invoke$arity$3 f) |
| (.cljs$core$IFn$_invoke$arity$3 f a0 a1 a2) |
| (.call f f a0 a1 a2)) |
| (apply-to-simple f a0 a1 a2 (-first args) (next* args)))) |
| ([f a0 a1 a2 a3 ^seq args] |
| (if (nil? args) |
| (if (.-cljs$core$IFn$_invoke$arity$4 f) |
| (.cljs$core$IFn$_invoke$arity$4 f a0 a1 a2 a3) |
| (.call f f a0 a1 a2 a3)) |
| (gen-apply-to-simple f 4 args)))) |
| |
| (defn apply |
| "Applies fn f to the argument list formed by prepending intervening arguments to args." |
| ([f args] |
| (if (.-cljs$lang$applyTo f) |
| (let [fixed-arity (.-cljs$lang$maxFixedArity f) |
| bc (bounded-count (inc fixed-arity) args)] |
| (if (<= bc fixed-arity) |
| (apply-to f bc args) |
| (.cljs$lang$applyTo f args))) |
| (apply-to-simple f (seq args)))) |
| ([f x args] |
| (if (.-cljs$lang$applyTo f) |
| (let [arglist (list* x args) |
| fixed-arity (.-cljs$lang$maxFixedArity f) |
| bc (inc (bounded-count fixed-arity args))] |
| (if (<= bc fixed-arity) |
| (apply-to f bc arglist) |
| (.cljs$lang$applyTo f arglist))) |
| (apply-to-simple f x (seq args)))) |
| ([f x y args] |
| (if (.-cljs$lang$applyTo f) |
| (let [arglist (list* x y args) |
| fixed-arity (.-cljs$lang$maxFixedArity f) |
| bc (+ 2 (bounded-count (dec fixed-arity) args))] |
| (if (<= bc fixed-arity) |
| (apply-to f bc arglist) |
| (.cljs$lang$applyTo f arglist))) |
| (apply-to-simple f x y (seq args)))) |
| ([f x y z args] |
| (if (.-cljs$lang$applyTo f) |
| (let [arglist (list* x y z args) |
| fixed-arity (.-cljs$lang$maxFixedArity f) |
| bc (+ 3 (bounded-count (- fixed-arity 2) args))] |
| (if (<= bc fixed-arity) |
| (apply-to f bc arglist) |
| (.cljs$lang$applyTo f arglist))) |
| (apply-to-simple f x y z (seq args)))) |
| ([f a b c d & args] |
| (if (.-cljs$lang$applyTo f) |
| (let [spread-args (spread args) |
| arglist (cons a (cons b (cons c (cons d spread-args)))) |
| fixed-arity (.-cljs$lang$maxFixedArity f) |
| bc (+ 4 (bounded-count (- fixed-arity 3) spread-args))] |
| (if (<= bc fixed-arity) |
| (apply-to f bc arglist) |
| (.cljs$lang$applyTo f arglist))) |
| (apply-to-simple f a b c d (spread args))))) |
| |
| (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 (.-length 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 |
| (iterable? coll) (-iterator coll) |
| (nil? coll) (nil-iter) |
| (string? coll) (string-iter coll) |
| (array? coll) (array-iter coll) |
| (seqable? coll) (seq-iter coll) |
| :else (throw (js/Error. (str "Cannot create iterator from " coll))))) |
| |
| (deftype Many [vals] |
| Object |
| (add [this o] |
| (.push vals o) |
| this) |
| (remove [this] |
| (.shift vals)) |
| (isEmpty [this] |
| (zero? (.-length vals))) |
| (toString [this] |
| (str "Many: " vals))) |
| |
| (def ^:private NONE #js {}) |
| |
| (deftype Single [^:mutable val] |
| Object |
| (add [this o] |
| (if (identical? val NONE) |
| (do |
| (set! val o) |
| this) |
| (Many. #js [val o]))) |
| (remove [this] |
| (if (identical? val NONE) |
| (throw (js/Error. (str "Removing object from empty buffer"))) |
| (let [ret val] |
| (set! val NONE) |
| ret))) |
| (isEmpty [this] |
| (identical? val NONE)) |
| (toString [this] |
| (str "Single: " val))) |
| |
| (deftype Empty [] |
| Object |
| (add [this o] |
| (Single. o)) |
| (remove [this] |
| (throw (js/Error. (str "Removing object from empty buffer")))) |
| (isEmpty [this] |
| true) |
| (toString [this] |
| "Empty")) |
| |
| (def ^:private EMPTY (Empty.)) |
| |
| (deftype MultiIterator [iters] |
| 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 [_] |
| (let [nexts (array)] |
| (dotimes [i (alength iters)] |
| (aset nexts i (.next (aget iters i)))) |
| (prim-seq nexts 0)))) |
| |
| (defn- chunkIteratorSeq [iter] |
| (lazy-seq |
| (when ^boolean (.hasNext iter) |
| (let [arr (array)] |
| (loop [n 0] |
| (if (and (.hasNext iter) (< n 32)) |
| (do |
| (aset arr n (.next iter)) |
| (recur (inc n))) |
| (chunk-cons (array-chunk arr 0 n) (chunkIteratorSeq iter)))))))) |
| |
| (deftype TransformerIterator [^:mutable buffer ^:mutable _next ^:mutable completed ^:mutable xf sourceIter multi] |
| Object |
| (step [this] |
| (if-not (identical? _next NONE) |
| true |
| (loop [] |
| (if (identical? _next NONE) |
| (if ^boolean (.isEmpty buffer) |
| (if ^boolean completed |
| false |
| (if ^boolean (.hasNext sourceIter) |
| (let [iter (if ^boolean multi |
| (apply xf (cons nil (.next sourceIter))) |
| (xf nil (.next sourceIter)))] |
| (when (reduced? iter) |
| (xf nil) |
| (set! completed true)) |
| (recur)) |
| (do |
| (xf nil) |
| (set! completed true) |
| (recur)))) |
| (do |
| (set! _next (.remove buffer)) |
| (recur))) |
| true)))) |
| (hasNext [this] |
| (.step this)) |
| (next [this] |
| (if ^boolean (.hasNext this) |
| (let [ret _next] |
| (set! _next NONE) |
| ret) |
| (throw (js/Error. "No such element")))) |
| (remove [_] |
| (js/Error. "Unsupported operation"))) |
| |
| (es6-iterable TransformerIterator) |
| |
| (defn transformer-iterator |
| [xform sourceIter multi] |
| (let [iterator (TransformerIterator. EMPTY NONE false nil sourceIter multi)] |
| (set! (.-xf iterator) |
| (xform (fn |
| ([] nil) |
| ([acc] acc) |
| ([acc o] |
| (set! (.-buffer iterator) (.add (.-buffer iterator) o)) |
| acc)))) |
| iterator)) |
| |
| (set! (.-create TransformerIterator) |
| (fn [xform source] |
| (transformer-iterator xform source false))) |
| |
| (set! (.-createMulti TransformerIterator) |
| (fn [xform sources] |
| (transformer-iterator xform (MultiIterator. (to-array sources)) true))) |
| |
| (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] |
| (or (chunkIteratorSeq |
| (.create TransformerIterator xform (iter coll))) |
| ())) |
| ([xform coll & colls] |
| (or (chunkIteratorSeq |
| (.createMulti TransformerIterator xform (map iter (cons coll colls)))) |
| ()))) |
| |
| (defn 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 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-let [s (seq coll)] |
| (or (pred (first s)) (recur pred (next s))))) |
| |
| (defn not-any? |
| "Returns false if (pred x) is logical true for any x in coll, |
| else true." |
| [pred coll] (not (some pred coll))) |
| |
| (defn 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 odd? |
| "Returns true if n is odd, throws an exception if n is not an integer" |
| [n] (not (even? n))) |
| |
| (defn 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 become 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 reset-vals! |
| "Sets the value of atom to newval. Returns [old new], the value of the |
| atom before and after the reset." |
| {:added "1.9"} |
| [a new-value] |
| (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)) |
| [old-value 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 swap-vals! |
| "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 [old new], the value of the atom before and after the swap." |
| {:added "1.9"} |
| ([a f] |
| (reset-vals! a (f (.-state a)))) |
| ([a f x] |
| (reset-vals! a (f (.-state a) x))) |
| ([a f x y] |
| (reset-vals! a (f (.-state a) x y))) |
| ([a f x y & more] |
| (reset-vals! a (apply f (.-state a) 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] |
| (when (and (some? val) |
| (not (val (-deref iref)))) |
| (throw (js/Error. "Validator rejected reference state"))) |
| (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 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))))) |
| |
| (deftype Cycle [meta all prev ^:mutable current ^:mutable _next] |
| Object |
| (toString [coll] |
| (pr-str* coll)) |
| (currentval [coll] |
| (when-not ^seq current |
| (if-let [c (next prev)] |
| (set! current c) |
| (set! current all))) |
| current) |
| |
| IPending |
| (-realized? [coll] |
| (some? current)) |
| |
| IWithMeta |
| (-with-meta [coll new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (Cycle. new-meta all prev current _next))) |
| |
| IMeta |
| (-meta [coll] meta) |
| |
| ISeq |
| (-first [coll] |
| (first (.currentval coll))) |
| (-rest [coll] |
| (when (nil? _next) |
| (set! _next (Cycle. nil all (.currentval coll) nil nil))) |
| _next) |
| |
| INext |
| (-next [coll] |
| (-rest coll)) |
| |
| ICollection |
| (-conj [coll o] (cons o coll)) |
| |
| IEmptyableCollection |
| (-empty [coll] (.-EMPTY List)) |
| |
| ISequential |
| ISeqable |
| (-seq [coll] coll) |
| |
| IReduce |
| (-reduce [coll f] |
| (loop [s (.currentval coll) ret (first s)] |
| (let [s (or (next s) all) |
| ret (f ret (first s))] |
| (if (reduced? ret) |
| @ret |
| (recur s ret))))) |
| (-reduce [coll f start] |
| (loop [s (.currentval coll) ret start] |
| (let [ret (f ret (first s))] |
| (if (reduced? ret) |
| @ret |
| (recur (or (next s) all) ret)))))) |
| |
| (defn cycle |
| "Returns a lazy (infinite!) sequence of repetitions of the items in coll." |
| [coll] (if-let [vals (seq coll)] |
| (Cycle. nil vals nil vals nil) |
| (.-EMPTY List))) |
| |
| (defn split-at |
| "Returns a vector of [(take n coll) (drop n coll)]" |
| [n coll] |
| [(take n coll) (drop n coll)]) |
| |
| (deftype Repeat [meta count val ^:mutable next ^: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)) |
| |
| IPending |
| (-realized? [coll] false) |
| |
| IWithMeta |
| (-with-meta [coll new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (Repeat. new-meta count val next nil))) |
| |
| IMeta |
| (-meta [coll] meta) |
| |
| ISeq |
| (-first [coll] |
| val) |
| (-rest [coll] |
| (if (nil? next) |
| (if (> count 1) |
| (do |
| (set! next (Repeat. nil (dec count) val nil nil)) |
| next) |
| (if (== -1 count) |
| coll |
| ())) |
| next)) |
| |
| INext |
| (-next [coll] |
| (if (nil? next) |
| (if (> count 1) |
| (do |
| (set! next (Repeat. nil (dec count) val nil nil)) |
| next) |
| (if (== -1 count) |
| coll |
| nil)) |
| next)) |
| |
| ICollection |
| (-conj [coll o] (cons o coll)) |
| |
| IEmptyableCollection |
| (-empty [coll] (.-EMPTY List)) |
| |
| IHash |
| (-hash [coll] (caching-hash coll hash-ordered-coll __hash)) |
| |
| ISequential |
| ISeqable |
| (-seq [coll] coll) |
| |
| IEquiv |
| (-equiv [coll other] (equiv-sequential coll other)) |
| |
| IReduce |
| (-reduce [coll f] |
| (if (== count -1) |
| (loop [ret (f val val)] |
| (if (reduced? ret) |
| @ret |
| (recur (f ret val)))) |
| (loop [i 1 ret val] |
| (if (< i count) |
| (let [ret (f ret val)] |
| (if (reduced? ret) |
| @ret |
| (recur (inc i) ret))) |
| ret)))) |
| (-reduce [coll f start] |
| (if (== count -1) |
| (loop [ret (f start val)] |
| (if (reduced? ret) |
| @ret |
| (recur (f ret val)))) |
| (loop [i 0 ret start] |
| (if (< i count) |
| (let [ret (f ret val)] |
| (if (reduced? ret) |
| @ret |
| (recur (inc i) ret))) |
| ret))))) |
| |
| (defn repeat |
| "Returns a lazy (infinite!, or length n if supplied) sequence of xs." |
| ([x] (Repeat. nil -1 x nil nil)) |
| ([n x] (if (pos? n) |
| (Repeat. nil n x nil nil) |
| (.-EMPTY List)))) |
| |
| (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)))) |
| |
| (def ^:private UNREALIZED-SEED #js {}) |
| |
| (deftype Iterate [meta f prev-seed ^:mutable seed ^:mutable next] |
| Object |
| (toString [coll] |
| (pr-str* coll)) |
| |
| IPending |
| (-realized? [coll] |
| (not (identical? seed UNREALIZED-SEED))) |
| |
| IWithMeta |
| (-with-meta [coll new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (Iterate. new-meta f prev-seed seed next))) |
| |
| IMeta |
| (-meta [coll] meta) |
| |
| ISeq |
| (-first [coll] |
| (when (identical? UNREALIZED-SEED seed) |
| (set! seed (f prev-seed))) |
| seed) |
| (-rest [coll] |
| (when (nil? next) |
| (set! next (Iterate. nil f (-first coll) UNREALIZED-SEED nil))) |
| next) |
| |
| INext |
| (-next [coll] |
| (-rest coll)) |
| |
| ICollection |
| (-conj [coll o] (cons o coll)) |
| |
| IEmptyableCollection |
| (-empty [coll] (.-EMPTY List)) |
| |
| ISequential |
| ISeqable |
| (-seq [coll] coll) |
| |
| IReduce |
| (-reduce [coll rf] |
| (let [first (-first coll) |
| v (f first)] |
| (loop [ret (rf first v) v v] |
| (if (reduced? ret) |
| @ret |
| (let [v (f v)] |
| (recur (rf ret v) v)))))) |
| (-reduce [coll rf start] |
| (let [v (-first coll)] |
| (loop [ret (rf start v) v v] |
| (if (reduced? ret) |
| @ret |
| (let [v (f v)] |
| (recur (rf ret v) v))))))) |
| |
| (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] (Iterate. nil f nil x nil)) |
| |
| (defn interleave |
| "Returns a lazy seq of the first item in each coll, then the second etc." |
| ([] ()) |
| ([c1] (lazy-seq c1)) |
| ([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 logical 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 logical 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 to 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 logical 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))) |
| |
| (defn- pv-reduce |
| ([pv f start end] |
| (if (< start end) |
| (pv-reduce pv f (nth pv start) (inc start) end) |
| (f))) |
| ([pv f init start end] |
| (loop [acc init i start arr (unchecked-array-for pv start)] |
| (if (< i end) |
| (let [j (bit-and i 0x01f) |
| arr (if (zero? j) (unchecked-array-for pv i) arr) |
| nacc (f acc (aget arr j))] |
| (if (reduced? nacc) |
| @nacc |
| (recur nacc (inc i) arr))) |
| acc)))) |
| |
| (declare tv-editable-root tv-editable-tail TransientVector deref |
| pr-sequential-writer pr-writer chunked-seq) |
| |
| (defprotocol APersistentVector |
| "Marker protocol") |
| |
| (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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (PersistentVector. new-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)) |
| |
| 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.")))) |
| (-contains-key? [coll k] |
| (if (integer? k) |
| (and (<= 0 k) (< k cnt)) |
| false)) |
| |
| IFind |
| (-find [coll n] |
| (when (and (<= 0 n) (< n cnt)) |
| (MapEntry. n (aget (unchecked-array-for coll n) (bit-and n 0x01f)) nil))) |
| |
| APersistentVector |
| 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] |
| (pv-reduce v f 0 cnt)) |
| (-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] |
| (when (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) |
| |
| (declare map-entry?) |
| |
| (defn vec |
| "Creates a new vector containing the contents of coll. JavaScript arrays |
| will be aliased and should not be modified." |
| [coll] |
| (cond |
| (map-entry? coll) |
| [(key coll) (val coll)] |
| |
| (vector? coll) |
| (with-meta coll nil) |
| |
| (array? coll) |
| (.fromArray PersistentVector coll true) |
| |
| :else |
| (-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) (not (array? (.-arr args)))) |
| (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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (chunked-seq vec node i off new-meta))) |
| 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] |
| ()) |
| |
| 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] |
| (pv-reduce vec f (+ i off) (count vec))) |
| |
| (-reduce [coll f start] |
| (pv-reduce vec f start (+ i off) (count vec)))) |
| |
| (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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (build-subvec new-meta v start end __hash))) |
| |
| IMeta |
| (-meta [coll] meta) |
| |
| IStack |
| (-peek [coll] |
| (when-not (== start end) |
| (-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.")))) |
| |
| IFind |
| (-find [coll n] |
| (when-not (neg? n) |
| (let [idx (+ start n)] |
| (when (< idx end) |
| (MapEntry. n (-lookup v idx) nil))))) |
| |
| 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] |
| (if (implements? APersistentVector v) |
| (pv-reduce v f start end) |
| (ci-reduce coll f))) |
| (-reduce [coll f init] |
| (if (implements? APersistentVector v) |
| (pv-reduce v f init start end) |
| (ci-reduce coll f init))) |
| |
| 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] |
| (if (implements? APersistentVector v) |
| (ranged-iterator v start end) |
| (seq-iter coll)))) |
| |
| (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) |
| (do |
| (when-not (vector? v) |
| (throw (js/Error. "v must satisfy IVector"))) |
| (when (or (neg? start) |
| (< end start) |
| (> end (count v))) |
| (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] |
| (assert (and (not (nil? start)) (not (nil? end)))) |
| (build-subvec nil v (int start) (int 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] |
| (cond |
| (not ^boolean (.-edit root)) (throw (js/Error. "lookup after persistent!")) |
| (number? k) (-nth coll k not-found) |
| :else 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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (PersistentQueueSeq. new-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)))) |
| |
| INext |
| (-next [coll] |
| (if-let [f1 (next front)] |
| (PersistentQueueSeq. meta f1 rear nil) |
| (when (some? rear) |
| (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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (PersistentQueue. new-meta count front rear __hash))) |
| |
| IMeta |
| (-meta [coll] meta) |
| |
| ISeq |
| (-first [coll] (first front)) |
| (-rest [coll] (rest (seq coll))) |
| |
| IStack |
| (-peek [coll] (first front)) |
| (-pop [coll] |
| (if front |
| (if-let [f1 (next front)] |
| (PersistentQueue. meta (dec count) f1 rear nil) |
| (PersistentQueue. meta (dec count) (seq rear) [] nil)) |
| coll)) |
| |
| ICollection |
| (-conj [coll o] |
| (if front |
| (PersistentQueue. meta (inc count) front (conj (or rear []) o) nil) |
| (PersistentQueue. meta (inc count) (conj front o) [] nil))) |
| |
| IEmptyableCollection |
| (-empty [coll] (-with-meta (.-EMPTY PersistentQueue) meta)) |
| |
| ISequential |
| IEquiv |
| (-equiv [coll other] (equiv-sequential coll other)) |
| |
| IHash |
| (-hash [coll] (caching-hash coll hash-ordered-coll __hash)) |
| |
| ISeqable |
| (-seq [coll] |
| (let [rear (seq rear)] |
| (if (or front rear) |
| (PersistentQueueSeq. nil front (seq rear) nil)))) |
| |
| ICounted |
| (-count [coll] count)) |
| |
| (set! (.-EMPTY PersistentQueue) (PersistentQueue. nil 0 nil [] empty-ordered-hash)) |
| |
| (es6-iterable PersistentQueue) |
| |
| (deftype NeverEquiv [] |
| Object |
| (equiv [this other] |
| (-equiv this other)) |
| IEquiv |
| (-equiv [o other] false)) |
| |
| (def ^:private never-equiv (NeverEquiv.)) |
| |
| (defn equiv-map |
| "Test map equivalence. Returns true if x equals y, otherwise returns false." |
| [x y] |
| (boolean |
| (when (and (map? y) (not (record? y))) |
| ; assume all maps are counted |
| (when (== (count x) (count y)) |
| (if (satisfies? IKVReduce x) |
| (reduce-kv |
| (fn [_ k v] |
| (if (= (get y k never-equiv) v) |
| true |
| (reduced false))) |
| true x) |
| (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 (gobject/get 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)] |
| (gobject/set new-obj k (gobject/get 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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (ObjMap. new-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 % (unchecked-get 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)))) |
| (unchecked-get 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)] |
| (gobject/set 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)] |
| (gobject/set 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)) |
| |
| IFind |
| (-find [coll k] |
| (when (and ^boolean (goog/isString k) |
| (not (nil? (scan-array 1 k keys)))) |
| (MapEntry. k (unchecked-get strobj k) nil))) |
| |
| 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 (unchecked-get 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)) |
| (MapEntry. k (-lookup record k) nil)) |
| (.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 MapEntry [key val ^:mutable __hash] |
| 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)) |
| |
| 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] nil) |
| |
| ISequential |
| ISeqable |
| (-seq [node] (IndexedSeq. #js [key val] 0 nil)) |
| |
| IReversible |
| (-rseq [node] (IndexedSeq. #js [val key] 0 nil)) |
| |
| ICounted |
| (-count [node] 2) |
| |
| IIndexed |
| (-nth [node n] |
| (cond (== n 0) key |
| (== n 1) val |
| :else (throw (js/Error. "Index out of bounds")))) |
| |
| (-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)) |
| (-contains-key? [node k] |
| (or (== k 0) (== k 1))) |
| |
| IFind |
| (-find [node k] |
| (case k |
| 0 (MapEntry. 0 key nil) |
| 1 (MapEntry. 1 val nil) |
| nil)) |
| |
| 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] |
| (-nth node k)) |
| |
| (-invoke [node k not-found] |
| (-nth node k not-found))) |
| |
| (defn map-entry? |
| "Returns true if x satisfies IMapEntry" |
| [x] |
| (implements? IMapEntry x)) |
| |
| (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] |
| (if (identical? new-meta _meta) |
| coll |
| (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] (.-EMPTY List)) |
| |
| IHash |
| (-hash [coll] (hash-ordered-coll coll)) |
| |
| ISeq |
| (-first [coll] |
| (MapEntry. (aget arr i) (aget arr (inc i)) nil)) |
| |
| (-rest [coll] |
| (if (< i (- (alength arr) 2)) |
| (PersistentArrayMapSeq. arr (+ i 2) nil) |
| ())) |
| |
| INext |
| (-next [coll] |
| (when (< i (- (alength arr) 2)) |
| (PersistentArrayMapSeq. arr (+ i 2) nil))) |
| |
| 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 (MapEntry. (aget arr i) (aget arr (inc i)) nil)] |
| (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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (PersistentArrayMap. new-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 (and (map? other) (not (record? 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)) |
| false)) |
| |
| 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))) |
| |
| IFind |
| (-find [coll k] |
| (let [idx (array-map-index-of coll k)] |
| (when-not (== idx -1) |
| (MapEntry. (aget arr idx) (aget arr (inc idx)) nil)))) |
| |
| 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] |
| (iter-reduce coll f)) |
| (-reduce [coll f start] |
| (iter-reduce coll f start)) |
| |
| 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 ^boolean 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? |
| (cond |
| (map-entry? o) |
| (-assoc! tcoll (key o) (val o)) |
| |
| (vector? o) |
| (-assoc! tcoll (o 0) (o 1)) |
| |
| :else |
| (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!")))) |
| |
| IFn |
| (-invoke [tcoll key] |
| (-lookup tcoll key nil)) |
| (-invoke [tcoll key not-found] |
| (-lookup tcoll key not-found))) |
| |
| (declare TransientHashMap) |
| |
| (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 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 (MapEntry. key node-or-val nil)) |
| (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) (MapEntry. key-or-nil val-or-node nil) |
| :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 (set! (.-val removed-leaf?) 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)) (MapEntry. (aget arr idx) (aget arr (inc idx)) nil) |
| :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 (set! (.-val removed-leaf?) 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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (NodeSeq. new-meta nodes i s __hash))) |
| |
| ICollection |
| (-conj [coll o] (cons o coll)) |
| |
| IEmptyableCollection |
| (-empty [coll] (.-EMPTY List)) |
| |
| ISequential |
| ISeq |
| (-first [coll] |
| (if (nil? s) |
| (MapEntry. (aget nodes i) (aget nodes (inc i)) nil) |
| (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 ()))) |
| |
| INext |
| (-next [coll] |
| (if (nil? s) |
| (create-inode-seq nodes (+ i 2) nil) |
| (create-inode-seq nodes i (next s)))) |
| |
| ISeqable |
| (-seq [this] this) |
| |
| IEquiv |
| (-equiv [coll other] (equiv-sequential coll other)) |
| |
| IHash |
| (-hash [coll] (caching-hash coll hash-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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (ArrayNodeSeq. new-meta nodes i s __hash))) |
| |
| ICollection |
| (-conj [coll o] (cons o coll)) |
| |
| IEmptyableCollection |
| (-empty [coll] (.-EMPTY List)) |
| |
| ISequential |
| ISeq |
| (-first [coll] (first s)) |
| (-rest [coll] |
| (let [ret (create-array-node-seq nodes i (next s))] |
| (if-not (nil? ret) ret ()))) |
| |
| INext |
| (-next [coll] |
| (create-array-node-seq nodes i (next s))) |
| |
| 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 nodes 0 nil)) |
| ([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. nil nodes (inc j) ns nil) |
| (recur (inc j))) |
| (recur (inc j)))))) |
| (ArrayNodeSeq. nil nodes i s nil)))) |
| |
| (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) |
| (MapEntry. nil nil-val nil)) |
| (.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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (PersistentHashMap. new-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 (MapEntry. nil nil-val nil) 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)))) |
| |
| IFind |
| (-find [coll k] |
| (cond |
| (nil? k) (when has-nil? (MapEntry. nil nil-val nil)) |
| (nil? root) nil |
| :else (.inode-find root 0 (hash k) k nil))) |
| |
| 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)) (unreduced (.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 |
| (cond |
| (map-entry? o) |
| (.assoc! tcoll (key o) (val o)) |
| |
| (vector? o) |
| (.assoc! tcoll (o 0) (o 1)) |
| |
| :else |
| (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 ^boolean (.-val removed-leaf?) |
| (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)) |
| |
| IFn |
| (-invoke [tcoll key] |
| (-lookup tcoll key)) |
| (-invoke [tcoll key not-found] |
| (-lookup tcoll key not-found))) |
| |
| ;;; 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) |
| ()))) |
| INext |
| (-next [this] |
| (let [t (first stack) |
| next-stack (tree-map-seq-push (if ascending? (.-right t) (.-left t)) |
| (next stack) |
| ascending?)] |
| (when-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] (.-EMPTY List)) |
| |
| IHash |
| (-hash [coll] (caching-hash coll hash-ordered-coll __hash)) |
| |
| IMeta |
| (-meta [coll] meta) |
| |
| IWithMeta |
| (-with-meta [coll new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (PersistentTreeMapSeq. new-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 |
| (if-not (nil? (.-right node)) |
| (tree-map-kv-reduce (.-right node) f 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] nil) |
| |
| ISequential |
| ISeqable |
| (-seq [node] (IndexedSeq. #js [key val] 0 nil)) |
| |
| IReversible |
| (-rseq [node] (IndexedSeq. #js [val key] 0 nil)) |
| |
| ICounted |
| (-count [node] 2) |
| |
| IIndexed |
| (-nth [node n] |
| (cond (== n 0) key |
| (== n 1) val |
| :else (throw (js/Error. "Index out of bounds")))) |
| |
| (-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)) |
| (-contains-key? [node k] |
| (or (== k 0) (== k 1))) |
| |
| IFind |
| (-find [node k] |
| (case k |
| 0 (MapEntry. 0 key nil) |
| 1 (MapEntry. 1 val nil) |
| nil)) |
| |
| 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] |
| (-nth node k)) |
| |
| (-invoke [node k not-found] |
| (-nth 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] nil) |
| |
| ISequential |
| ISeqable |
| (-seq [node] (IndexedSeq. #js [key val] 0 nil)) |
| |
| IReversible |
| (-rseq [node] (IndexedSeq. #js [val key] 0 nil)) |
| |
| ICounted |
| (-count [node] 2) |
| |
| IIndexed |
| (-nth [node n] |
| (cond (== n 0) key |
| (== n 1) val |
| :else (throw (js/Error. "Index out of bounds")))) |
| |
| (-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)) |
| (-contains-key? [node k] |
| (or (== k 0) (== k 1))) |
| |
| IFind |
| (-find [node k] |
| (case k |
| 0 (MapEntry. 0 key nil) |
| 1 (MapEntry. 1 val nil) |
| nil)) |
| |
| 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] |
| (-nth node k)) |
| |
| (-invoke [node k not-found] |
| (-nth 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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (PersistentTreeMap. comp tree cnt new-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) |
| (unreduced (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)))) |
| |
| IFind |
| (-find [coll k] |
| (.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))) |
| |
| (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)) |
| (gobject/set 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] |
| (if (identical? new-meta _meta) |
| coll |
| (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] (.-EMPTY List)) |
| |
| 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 nil) |
| ()))) |
| |
| INext |
| (-next [coll] |
| (let [nseq (if (satisfies? INext mseq) |
| (-next mseq) |
| (next mseq))] |
| (when-not (nil? nseq) |
| (KeySeq. nseq nil)))) |
| |
| 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, in the same order as (seq map)." |
| [map] |
| (when-let [mseq (seq 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] |
| (if (identical? new-meta _meta) |
| coll |
| (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] (.-EMPTY List)) |
| |
| 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 nil) |
| ()))) |
| |
| INext |
| (-next [coll] |
| (let [nseq (if (satisfies? INext mseq) |
| (-next mseq) |
| (next mseq))] |
| (when-not (nil? nseq) |
| (ValSeq. nseq nil)))) |
| |
| 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, in the same order as (seq map)." |
| [map] |
| (when-let [mseq (seq 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 (key e) v (val 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) |
| (.-key (.next iter)) |
| (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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (PersistentHashSet. new-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)) |
| ^boolean |
| (try |
| (reduce-kv |
| #(or (contains? other %2) (reduced false)) |
| true hash-map) |
| (catch js/Error ex |
| false)))) |
| |
| 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-let [entry (-find hash-map v)] |
| (key entry) |
| 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 new-meta] |
| (if (identical? new-meta meta) |
| coll |
| (PersistentTreeSet. new-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)) |
| ^boolean |
| (try |
| (reduce-kv |
| #(or (contains? other %2) (reduced false)) |
| true tree-map) |
| (catch js/Error ex |
| false)))) |
| |
| 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] |
| (if (set? coll) |
| (with-meta coll nil) |
| (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 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. |
| |
| If there are multiple such xs, the last one is returned." |
| ([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. |
| |
| If there are multiple such xs, the last one is returned." |
| ([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 logical 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 RangeChunk [start step count] |
| ICounted |
| (-count [coll] count) |
| |
| ISeq |
| (-first [coll] start) |
| |
| IIndexed |
| (-nth [coll i] |
| (+ start (* i step))) |
| (-nth [coll i not-found] |
| (if (and (>= i 0) (< i count)) |
| (+ start (* i step)) |
| not-found)) |
| |
| IChunk |
| (-drop-first [coll] |
| (if (<= count 1) |
| (throw (js/Error. "-drop-first of empty chunk")) |
| (RangeChunk. (+ start step) step (dec count))))) |
| |
| (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 chunk ^:mutable chunk-next ^: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)) |
| (forceChunk [coll] |
| (when (nil? chunk) |
| (let [count (-count coll)] |
| (if (> count 32) |
| (do |
| (set! chunk-next (Range. nil (+ start (* step 32)) end step nil nil nil)) |
| (set! chunk (RangeChunk. start step 32))) |
| (set! chunk (RangeChunk. start step count)))))) |
| |
| ICloneable |
| (-clone [_] (Range. meta start end step chunk chunk-next __hash)) |
| |
| IWithMeta |
| (-with-meta [rng new-meta] |
| (if (identical? new-meta meta) |
| rng |
| (Range. new-meta start end step chunk chunk-next __hash))) |
| |
| IMeta |
| (-meta [rng] meta) |
| |
| ISeqable |
| (-seq [rng] rng) |
| |
| ISeq |
| (-first [rng] start) |
| (-rest [rng] |
| (let [s (-next rng)] |
| (if (nil? s) |
| () |
| s))) |
| |
| IIterable |
| (-iterator [_] |
| (RangeIterator. start end step)) |
| |
| INext |
| (-next [rng] |
| (if (pos? step) |
| (when (< (+ start step) end) |
| (Range. nil (+ start step) end step nil nil nil)) |
| (when (> (+ start step) end) |
| (Range. nil (+ start step) end step nil nil nil)))) |
| |
| IChunkedSeq |
| (-chunked-first [rng] |
| (.forceChunk rng) |
| chunk) |
| (-chunked-rest [rng] |
| (.forceChunk rng) |
| (if (nil? chunk-next) |
| () |
| chunk-next)) |
| |
| IChunkedNext |
| (-chunked-next [rng] |
| (seq (-chunked-rest rng))) |
| |
| ICollection |
| (-conj [rng o] (cons o rng)) |
| |
| IEmptyableCollection |
| (-empty [rng] (.-EMPTY List)) |
| |
| ISequential |
| IEquiv |
| (-equiv [rng other] (equiv-sequential rng other)) |
| |
| IHash |
| (-hash [rng] (caching-hash rng hash-ordered-coll __hash)) |
| |
| ICounted |
| (-count [rng] |
| (Math/ceil (/ (- end start) step))) |
| |
| IIndexed |
| (-nth [rng n] |
| (if (and (<= 0 n) (< n (-count rng))) |
| (+ start (* n step)) |
| (if (and (<= 0 n) (> start end) (zero? step)) |
| start |
| (throw (js/Error. "Index out of bounds"))))) |
| (-nth [rng n not-found] |
| (if (and (<= 0 n) (< n (-count rng))) |
| (+ start (* n step)) |
| (if (and (<= 0 n) (> 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] |
| (cond |
| (pos? step) |
| (if (<= end start) |
| () |
| (Range. nil start end step nil nil nil)) |
| |
| (neg? step) |
| (if (>= end start) |
| () |
| (Range. nil start end step nil nil nil)) |
| |
| :else |
| (if (== end start) |
| () |
| (repeat start))))) |
| |
| (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 (lazy-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-let [s (seq coll)] |
| (recur (next s)))) |
| ([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 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* [re s] |
| (when-some [matches (.exec re s)] |
| (let [match-str (aget matches 0) |
| match-vals (if (== (.-length matches) 1) |
| match-str |
| (vec matches))] |
| (cons match-vals |
| (lazy-seq |
| (let [post-idx (+ (.-index matches) |
| (max 1 (.-length match-str)))] |
| (when (<= post-idx (.-length s)) |
| (re-seq* re (subs s post-idx))))))))) |
| |
| (defn re-seq |
| "Returns a lazy sequence of successive matches of re in s." |
| [re s] |
| (if (string? s) |
| (re-seq* re s) |
| (throw (js/TypeError. "re-seq must match against a string.")))) |
| |
| (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] |
| (when (nil? *print-fn*) |
| (throw (js/Error. "No *print-fn* fn set for evaluation environment"))) |
| (*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] (unchecked-get char-escapes match))) |
| \")) |
| |
| (declare print-map) |
| |
| (defn 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. |
| (satisfies? IPrintWithWriter obj) |
| (-pr-writer obj writer opts) |
| |
| (or (true? obj) (false? obj)) |
| (-write writer (str obj)) |
| |
| (number? obj) |
| (-write writer |
| (cond |
| ^boolean (js/isNaN obj) "##NaN" |
| (identical? obj js/Number.POSITIVE_INFINITY) "##Inf" |
| (identical? obj js/Number.NEGATIVE_INFINITY) "##-Inf" |
| :else (str obj))) |
| |
| (object? obj) |
| (do |
| (-write writer "#js ") |
| (print-map |
| (map (fn [k] |
| (MapEntry. (cond-> k (some? (re-matches #"[A-Za-z_\*\+\?!\-'][\w\*\+\?!\-']*" k)) keyword) (unchecked-get obj k) nil)) |
| (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 |
| (if *print-fn-bodies* |
| (str " \"" (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 (some-> obj .-constructor .-cljs$lang$ctorStr) |
| (write-all writer |
| "#object[" (.replace (.. obj -constructor -cljs$lang$ctorStr) |
| (js/RegExp. "/" "g") ".") "]") |
| (let [name (some-> obj .-constructor .-name) |
| name (if (or (nil? name) (gstring/isEmpty name)) |
| "Object" |
| name)] |
| (if (nil? (. obj -constructor)) |
| (write-all writer "#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] (when (map? m) |
| (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)) |
| |
| TransformerIterator |
| (-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)) |
| |
| MapEntry |
| (-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)) |
| |
| Cycle |
| (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) |
| |
| Repeat |
| (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)) |
| |
| Iterate |
| (-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))))) |
| |
| MapEntry |
| (-compare [x y] |
| (if (vector? y) |
| (compare-indexed x y) |
| (throw (js/Error. (str "Cannot compare " x " to " y))))) |
| |
| BlackNode |
| (-compare [x y] |
| (if (vector? y) |
| (compare-indexed x y) |
| (throw (js/Error. (str "Cannot compare " x " to " y))))) |
| |
| RedNode |
| (-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))))) |
| |
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Delay ;;;;;;;;;;;;;;;;;;;; |
| |
| (deftype Delay [^:mutable f ^:mutable value] |
| IDeref |
| (-deref [_] |
| (when f |
| (set! value (f)) |
| (set! f nil)) |
| value) |
| |
| IPending |
| (-realized? [x] |
| (not f)) |
| |
| IPrintWithWriter |
| (-pr-writer [x writer opts] |
| (-write writer "#object[cljs.core.Delay ") |
| (pr-writer {:status (if (nil? f) :ready :pending), :val value} writer opts) |
| (-write writer "]"))) |
| |
| (defn 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 |
| |
| IIterable |
| (-iterator [_] |
| (.create TransformerIterator xform (iter coll))) |
| |
| 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] (key->js k clj->js)) |
| ([k primitive-fn] |
| (cond |
| (satisfies? IEncodeJS k) (-clj->js k) |
| (or (string? k) |
| (number? k) |
| (keyword? k) |
| (symbol? k)) (primitive-fn k) |
| :default (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`. |
| Options is a key-value pair, where the only valid key is |
| :keyword-fn, which should point to a single-argument function to be |
| called on keyword keys. Default to `name`." |
| [x & {:keys [keyword-fn] |
| :or {keyword-fn name} |
| :as options}] |
| (letfn [(keyfn [k] (key->js k thisfn)) |
| (thisfn [x] (cond |
| (nil? x) nil |
| (satisfies? IEncodeJS x) (-clj->js x) |
| (keyword? x) (keyword-fn x) |
| (symbol? x) (str x) |
| (map? x) (let [m (js-obj)] |
| (doseq [[k v] x] |
| (gobject/set m (keyfn k) (thisfn v))) |
| m) |
| (coll? x) (let [arr (array)] |
| (doseq [x (map thisfn x)] |
| (.push arr x)) |
| arr) |
| :else x))] |
| (thisfn 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)) |
| |
| (map-entry? x) |
| (MapEntry. (thisfn (key x)) (thisfn (val x)) nil) |
| |
| (coll? x) |
| (into (empty x) (map thisfn) x) |
| |
| (array? x) |
| (persistent! |
| (reduce #(conj! %1 (thisfn %2)) |
| (transient []) x)) |
| |
| (identical? (type x) js/Object) |
| (persistent! |
| (reduce (fn [r k] (assoc! r (keyfn k) (thisfn (gobject/get x k)))) |
| (transient {}) (js-keys x))) |
| :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 default-dispatch-val] |
| (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) |
| best-entry (if-let [entry (and (nil? best-entry) (@method-table default-dispatch-val))] |
| [default-dispatch-val entry] |
| best-entry)] |
| (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 default-dispatch-val)))))) |
| |
| (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 |
| (find-and-cache-best-method name dispatch-val hierarchy method-table |
| prefer-table method-cache cached-hierarchy 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] |
| (assert (string? s)) |
| (UUID. (.toLowerCase 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 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 case* 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 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 ["arguments" "abstract" "await" "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" "constructor"]) |
| |
| (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- ^string 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') |
| 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 name'))))) |
| |
| (defonce ^{:jsdoc ["@type {*}"] :private true} |
| tapset nil) |
| |
| (defn- maybe-init-tapset [] |
| (when (nil? tapset) |
| (set! tapset (atom #{})))) |
| |
| (defn add-tap |
| "Adds f, a fn of one argument, to the tap set. This function will be called with |
| anything sent via tap>. Remember f in order to remove-tap" |
| [f] |
| (maybe-init-tapset) |
| (swap! tapset conj f) |
| nil) |
| |
| (defn remove-tap |
| "Remove f from the tap set." |
| [f] |
| (maybe-init-tapset) |
| (swap! tapset disj f) |
| nil) |
| |
| (defn ^boolean tap> |
| "Sends x to any taps. Returns the result of *exec-tap-fn*, a Boolean value." |
| [x] |
| (maybe-init-tapset) |
| (*exec-tap-fn* |
| (fn [] |
| (doseq [tap @tapset] |
| (try |
| (tap x) |
| (catch js/Error ex)))))) |
| |
| ;; ----------------------------------------------------------------------------- |
| ;; 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 |
| (let [ctxt (js/eval (first segs))] |
| (when (and ctxt (object? ctxt)) |
| ctxt)) |
| (catch js/ReferenceError e |
| nil)) |
| (next segs)) |
| (find-ns-obj* goog/global segs)) |
| ("default" "webworker") (find-ns-obj* goog/global segs) |
| (throw (js/Error. (str "find-ns-obj not supported for target " *target*)))))) |
| |
| (defn ns-interns* |
| "Returns a map of the intern mappings for the namespace. |
| 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 |
| "Create a new namespace named by the symbol. Bootstrap only." |
| ([sym] |
| (create-ns sym (find-ns-obj sym))) |
| ([sym ns-obj] |
| (Namespace. ns-obj sym))) |
| |
| (defn find-ns |
| "Returns the namespace named by the symbol or nil if it doesn't exist. |
| 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 |
| "Returns the macros namespace named by the symbol or nil if it doesn't exist. |
| Bootstrap only." |
| [ns] |
| (when (nil? NS_CACHE) |
| (set! NS_CACHE (atom {}))) |
| (let [ns-str (str ns) |
| ns (if (not ^boolean (gstring/contains ns-str "$macros")) |
| (symbol (str ns-str "$macros")) |
| ns) |
| 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 ns-name |
| "Returns the name of the namespace, a Namespace object. |
| Bootstrap only." |
| [ns-obj] |
| (.-name ns-obj)) |
| |
| (defn uri? |
| "Returns true x is a goog.Uri instance." |
| {:added "1.9"} |
| [x] |
| (instance? goog.Uri x)) |
| |
| (defn- maybe-enable-print! [] |
| (cond |
| (exists? js/console) |
| (enable-console-print!) |
| |
| (or (identical? *target* "nashorn") |
| (identical? *target* "graaljs")) |
| (let [system (.type js/Java "java.lang.System")] |
| (set! *print-newline* false) |
| (set-print-fn! |
| (fn [] |
| (let [xs (js-arguments) |
| s (.join (garray/clone xs) "")] |
| (.println (.-out system) s)))) |
| (set-print-err-fn! |
| (fn [] |
| (let [xs (js-arguments) |
| s (.join (garray/clone xs) "")] |
| (.println (.-error system) s))))))) |
| |
| (maybe-enable-print!) |
| |
| (defonce |
| ^{:doc "Runtime environments may provide a way to evaluate ClojureScript |
| forms. Whatever function *eval* is bound to will be passed any forms which |
| should be evaluated." :dynamic true} |
| *eval* |
| (fn [_] |
| (throw (js/Error. "cljs.core/*eval* not bound")))) |
| |
| (defn eval |
| "Evaluates the form data structure (not text!) and returns the result. |
| Delegates to cljs.core/*eval*. Intended for use in self-hosted ClojureScript, |
| which sets up an implementation of cljs.core/*eval* for that environment." |
| [form] |
| (*eval* form)) |
| |
| (when ^boolean js/COMPILED |
| (when (= "nodejs" *target*) |
| (set! goog/global js/global))) |