diff --git a/doc/more-dependencies.dot b/doc/more-dependencies.dot
new file mode 100644
index 000000000..f5d8cd5d9
--- /dev/null
+++ b/doc/more-dependencies.dot
@@ -0,0 +1,42 @@
+strict digraph G {
+
+rankdir = RL;
+
+/* here start the interfaces */
+
+
+{
+ node [shape=box];
+
+ "t.c.analyzer" -> {"tca.passes.annotate-host-expr",
+ "tca.passes.classify-invoke",
+ "tca.passes.emit-form",
+ "tca.passes.infer-tag",
+ "tca.passes.validate",
+ "tca.utils" };
+ "tca.utils" -> {"clojure.core.memoize", "clojure.java.io"};
+
+"tca.passes.analyze-host-expr" -> {"tca.utils" };
+"tca.passes.annotate-host-info" -> {"tca.utils" };
+"tca.passes.annotate-tag" -> {"tca.utils",
+ "tca.passes.constant-lifter" };
+"tca.passes.beta-reduce" -> { "tca.passes.analyze-host-expr",
+ "tca.passes.annotate-tag",
+ "tca.passes.classify-invoke",
+ "tca.passes.emit-form" };
+"tca.passes.classify-invoke" -> {"tca.utils",
+ "tca.passes.validate" };
+"tca.passes.constant-lifter" -> {"tca.utils",
+ "tca.passes.analyze-host-expr" };
+"tca.passes.emit-form";
+"tca.passes.fix-case-test";
+"tca.passes.infer-tag" -> { "tca.utils",
+ "tca.passes.analyze-host-expr",
+ "tca.passes.annotate-tag",
+ "tca.passes.fix-case-test"};
+
+"tca.passes.validate" -> { "tca.utils",
+ "tca.passes.infer-tag"
+ "tca.passes.analyze-host-expr" };
+}
+}
\ No newline at end of file
diff --git a/doc/more-dependencies.png b/doc/more-dependencies.png
new file mode 100644
index 000000000..89a0d0041
Binary files /dev/null and b/doc/more-dependencies.png differ
diff --git a/doc/runtime-dependencies.dot b/doc/runtime-dependencies.dot
new file mode 100644
index 000000000..0424539d1
--- /dev/null
+++ b/doc/runtime-dependencies.dot
@@ -0,0 +1,104 @@
+strict digraph G {
+
+rankdir = RL;
+
+/* here start the interfaces */
+
+
+{
+ node [shape=box];
+
+
+ "typed.clojure" -> {
+ "clojure.core.typed",
+ "cct.macros",
+ "cct.platform-case"};
+ "t.clojure.jvm" -> {
+ "clojure.core.typed",
+ "cct.current-impl",
+ "cct.internal",
+ "t.cljc.rt.env-utils",
+ "cct.macros"};
+
+ "t.clj.rt.env" -> {"t.cljc.rt.env"};
+ "t.cljc.rt.env";
+ "t.cljc.rt.env-utils" -> {"typed.clojure"};
+ "t.cljc.rt.env-utils-annotations" -> {
+ "typed.clojure",
+ "t.cljc.rt.env-utils"};
+
+ "clojure.core.typed" -> {
+ "cct.util-vars",
+ "cct.special-form",
+ "cct.import-macros",
+ "cct.contract",
+ "cct.type-contract",
+ "cct.macros"};
+
+ "cct.all-envs" -> {
+ "cct.current-impl",
+ "cct.load-if-needed",
+ "cct.util-vars",
+ "t.cljc.rt.env-utils",
+ "t.clj.checker.parse-unparse",
+ "t.cljc.checker.name-env",
+ "t.cljc.checker.var-env",
+ "t.cljc.rt.env" };
+
+ "cct.ast-ops" -> {"cct.errors"};
+ "cct.ast-utils" -> {"cct.current-impl", "cct.contract-utils"};
+ "cct.coerce-utils" -> {"typed.clojure", "cct.current-impl"};
+ "cct.contract";
+ "cct.contract-utils";
+ "cct.contract-utils-platform-specific" ->{"cct.contract-utils"};
+ "cct.current-impl" -> {
+ "cct.contract-utils",
+ "cct.util-vars",
+ "t.cljc.rt.env",
+ "t.clj.rt.env",
+ "t.cljs.rt.env"};
+ "cct.errors" -> {
+ "cct.util-vars",
+ "cct.current-impl",
+ "cct.ast-utils"};
+ "cct.expand" -> {
+ "clojure.core.typed",
+ "cct.special-form",
+ "cct.internal"};
+ "cct.hold" -> {"clojure.core.typed"};
+ "cct.import-macros";
+ "cct.internal" -> {
+ "cct.contract-utils",
+ "cct.internal.add-destructure-blame-form"};
+ "cct.load" -> {"cct.load-if-needed", "cct.current-impl"};
+ "cct.load-if-needed" -> {"cct.errors", "cct.util-vars"};
+ "cct.macros" -> {
+ "cct.internal",
+ "cct.special-form",
+ "cct.platform-case"};
+ "cct.parse-ast" -> {
+ "clojure.core.typed",
+ "cct.current-impl",
+ "cct.errors",
+ "cct.util-vars",
+ "cct.coerce-utils"};
+ "cct.platform-case";
+ "cct.rules" -> {
+ "typed.clojure",
+ "cct.internal",
+ "t.cljc.analyzer"};
+ "cct.special-form";
+ "cct.type-contract" -> {
+ "cct.errors",
+ "cct.current-impl",
+ "cct.ast-ops",
+ "cct.contract"};
+ "cct.unsafe";
+ "cct.util-vars";
+
+ "cct.rt.jvm.configs";
+ "cct.internal.add-destructure-blame-form";
+
+
+}
+}
\ No newline at end of file
diff --git a/doc/runtime-dependencies.png b/doc/runtime-dependencies.png
new file mode 100644
index 000000000..e2f8e5a2d
Binary files /dev/null and b/doc/runtime-dependencies.png differ
diff --git a/doc/some-dependencies.dot b/doc/some-dependencies.dot
new file mode 100644
index 000000000..0d64fd9d8
--- /dev/null
+++ b/doc/some-dependencies.dot
@@ -0,0 +1,29 @@
+strict digraph G {
+
+rankdir = RL;
+
+/* here start the interfaces */
+
+
+
+{
+ node [shape=box];
+
+ "typed.clojure";
+ "t.cljc.analyzer" -> {"tca.ast", "tca.utils"};
+ "tca.ast" -> {"tca.utils"};
+ "tca.utils";
+ "tca.env";
+ "tca.types" -> {"typed.clojure", "tca.utils"};
+ "tca.utils";
+
+ "tca.passes.add-binding-atom" -> {"tca.ast", "tca.passes.uniquify"};
+ "tca.passes.cleanup";
+ "tca.passes.constant-lifter" -> {"t.cljc.analyzer", "tca.utils"};
+ "tca.passes.elide-meta" -> {"t.cljc.analyzer", "tca.passes.source-info"};
+ "tca.passes.emit-form" -> {"tca.passes.uniquify"};
+ "tca.passes.source-info" -> {"tca.utils"};
+ "tca.passes.uniquify" -> {"tca.ast", "tca.env"};
+
+}
+}
\ No newline at end of file
diff --git a/doc/some-dependencies.png b/doc/some-dependencies.png
new file mode 100644
index 000000000..b314f8e1d
Binary files /dev/null and b/doc/some-dependencies.png differ
diff --git a/typed/clj.analyzer/deps-clr.edn b/typed/clj.analyzer/deps-clr.edn
new file mode 100644
index 000000000..4ae9ff6cb
--- /dev/null
+++ b/typed/clj.analyzer/deps-clr.edn
@@ -0,0 +1,6 @@
+;; DO NOT EDIT! Instead, edit `dev/resources/root-templates/typed/clj.analyzer/deps.edn` and run `./script/regen-selmer.sh`
+{:paths ["src"]
+ :deps {
+ org.typedclojure/typed.cljc.analyzer {:local/root "../cljc.analyzer"
+ :deps/manifest :deps}}
+}
diff --git a/typed/clj.analyzer/src/clojure/core/cache.cljr b/typed/clj.analyzer/src/clojure/core/cache.cljr
new file mode 100644
index 000000000..6c2ce9d0e
--- /dev/null
+++ b/typed/clj.analyzer/src/clojure/core/cache.cljr
@@ -0,0 +1,663 @@
+; 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 ^{:doc "A caching library for Clojure."
+ :author "Fogus"}
+ clojure.core.cache
+ (:require clojure.data.priority-map)
+ (:import ;;; (java.lang.ref ReferenceQueue SoftReference)
+ )) ;;; (java.util.concurrent ConcurrentHashMap)
+
+(set! *warn-on-reflection* true)
+
+;; # Protocols and Types
+
+(defprotocol CacheProtocol
+ "This is the protocol describing the basic cache capability."
+ (lookup [cache e]
+ [cache e not-found]
+ "Retrieve the value associated with `e` if it exists, else `nil` in
+ the 2-arg case. Retrieve the value associated with `e` if it exists,
+ else `not-found` in the 3-arg case.")
+ (has? [cache e]
+ "Checks if the cache contains a value associated with `e`")
+ (hit [cache e]
+ "Is meant to be called if the cache is determined to contain a value
+ associated with `e`")
+ (miss [cache e ret]
+ "Is meant to be called if the cache is determined to **not** contain a
+ value associated with `e`")
+ (evict [cache e]
+ "Removes an entry from the cache")
+ (seed [cache base]
+ "Is used to signal that the cache should be created with a seed.
+ The contract is that said cache should return an instance of its
+ own type."))
+
+(def ^{:private true} default-wrapper-fn #(%1 %2))
+
+(defn through
+ "The basic hit/miss logic for the cache system. Expects a wrap function and
+ value function. The wrap function takes the value function and the item in question
+ and is expected to run the value function with the item whenever a cache
+ miss occurs. The intent is to hide any cache-specific cells from leaking
+ into the cache logic itelf."
+ ([cache item] (through default-wrapper-fn identity cache item))
+ ([value-fn cache item] (through default-wrapper-fn value-fn cache item))
+ ([wrap-fn value-fn cache item]
+ (if (clojure.core.cache/has? cache item)
+ (clojure.core.cache/hit cache item)
+ (clojure.core.cache/miss cache item (wrap-fn #(value-fn %) item)))))
+
+(defn through-cache
+ "The basic hit/miss logic for the cache system. Like through but always has
+ the cache argument in the first position for easier use with swap! etc."
+ ([cache item] (through-cache cache item default-wrapper-fn identity))
+ ([cache item value-fn] (through-cache cache item default-wrapper-fn value-fn))
+ ([cache item wrap-fn value-fn]
+ (if (clojure.core.cache/has? cache item)
+ (clojure.core.cache/hit cache item)
+ (clojure.core.cache/miss cache item (wrap-fn #(value-fn %) item)))))
+
+(defmacro defcache
+ [type-name fields & specifics]
+ (let [[base & _] fields
+ base-field (with-meta base {:tag 'clojure.lang.IPersistentMap})]
+ `(deftype ~type-name [~@fields]
+ ~@specifics
+
+ clojure.lang.ILookup
+ (valAt [this# key#]
+ (lookup this# key#))
+ (valAt [this# key# not-found#]
+ (if (has? this# key#)
+ (lookup this# key#)
+ not-found#))
+
+ System.Collections.IEnumerable ;;;java.lang.Iterable
+ (System.Collections.IEnumerable.GetEnumerator [_#] ;;;(iterator [_#]
+ (let [base# ^System.Collections.IEnumerable ~base-field]
+ (.GetEnumerator ^System.Collections.IEnumerable base#))) ;;; (.iterator ~base-field))
+
+ clojure.lang.IPersistentMap
+ (clojure.lang.IPersistentMap.assoc [this# k# v#]
+ (miss this# k# v#))
+ (without [this# k#]
+ (evict this# k#))
+
+ clojure.lang.Associative
+ (containsKey [this# k#]
+ (has? this# k#))
+ (entryAt [this# k#]
+ (when (has? this# k#)
+ (clojure.lang.MapEntry. k# (lookup this# k#))))
+ (clojure.lang.Associative.assoc [this# k# v#] ;;; had to add
+ (miss this# k# v#))
+
+
+ clojure.lang.Counted
+ (count [this#]
+ (count ~base-field))
+
+ clojure.lang.IPersistentCollection
+ (clojure.lang.IPersistentCollection.cons [this# elem#]
+ (seed this# (conj ~base-field elem#)))
+ (empty [this#]
+ (seed this# (empty ~base-field)))
+ (equiv [this# other#]
+ (= other# ~base-field))
+
+ clojure.lang.Seqable
+ (seq [_#]
+ (seq ~base-field)))))
+
+(defcache BasicCache [cache]
+ CacheProtocol
+ (lookup [_ item]
+ (get cache item))
+ (lookup [_ item not-found]
+ (get cache item not-found))
+ (has? [_ item]
+ (contains? cache item))
+ (hit [this item] this)
+ (miss [_ item result]
+ (BasicCache. (assoc cache item result)))
+ (evict [_ key]
+ (BasicCache. (dissoc cache key)))
+ (seed [_ base]
+ (BasicCache. base))
+ Object
+ (ToString [_] (str cache))) ;;; ;;;toString
+
+;; FnCache
+
+(defcache FnCache [cache f]
+ CacheProtocol
+ (lookup [_ item]
+ (f (get cache item)))
+ (lookup [_ item not-found]
+ (let [ret (get cache item not-found)]
+ (if (= not-found ret)
+ not-found
+ (f ret))))
+ (has? [_ item]
+ (contains? cache item))
+ (hit [this item] this)
+ (miss [_ item result]
+ (BasicCache. (assoc cache item result)))
+ (evict [_ key]
+ (BasicCache. (dissoc cache key)))
+ (seed [_ base]
+ (BasicCache. base))
+ Object
+ (ToString [_] (str cache))) ;;; ;;;toString
+
+;; # FIFO
+
+(defn- describe-layout [mappy limit]
+ (let [ks (keys mappy)
+ [dropping keeping] (split-at (- (count ks) limit) ks)]
+ {:dropping dropping
+ :keeping keeping
+ :queue
+ (-> clojure.lang.PersistentQueue/EMPTY
+ (into (repeat (- limit (count keeping)) ::free))
+ (into (take limit keeping)))}))
+
+(defn- prune-queue [q k]
+ (reduce (fn [q e] (if (#{k} e) q (conj q e)))
+ (conj clojure.lang.PersistentQueue/EMPTY ::free)
+ q))
+
+(defcache FIFOCache [cache q limit]
+ CacheProtocol
+ (lookup [_ item]
+ (get cache item))
+ (lookup [_ item not-found]
+ (get cache item not-found))
+ (has? [_ item]
+ (contains? cache item))
+ (hit [this item]
+ this)
+ (miss [_ item result]
+ (let [[kache qq] (let [k (peek q)]
+ (if (>= (count cache) limit)
+ [(dissoc cache k) (pop q)]
+ [cache (pop q)]))]
+ (FIFOCache. (assoc kache item result)
+ (conj qq item)
+ limit)))
+ (evict [this key]
+ (if (contains? cache key)
+ (FIFOCache. (dissoc cache key)
+ (prune-queue q key)
+ limit)
+ this))
+ (seed [_ base]
+ (let [{dropping :dropping
+ q :queue} (describe-layout base limit)]
+ (FIFOCache. (apply dissoc base dropping)
+ q
+ limit)))
+ Object
+ (ToString [_] ;;; toString
+ (str cache \, \space (pr-str q))))
+
+(defn- build-leastness-queue
+ [base start-at]
+ (into (clojure.data.priority-map/priority-map) (for [[k _] base] [k start-at])))
+
+(defcache LRUCache [cache lru tick limit]
+ CacheProtocol
+ (lookup [_ item]
+ (get cache item))
+ (lookup [_ item not-found]
+ (get cache item not-found))
+ (has? [_ item]
+ (contains? cache item))
+ (hit [_ item]
+ (let [tick+ (inc tick)]
+ (LRUCache. cache
+ (if (contains? cache item)
+ (assoc lru item tick+)
+ lru)
+ tick+
+ limit)))
+ (miss [_ item result]
+ (let [tick+ (inc tick)]
+ (if (>= (count lru) limit)
+ (let [k (if (contains? lru item)
+ item
+ (first (peek lru))) ;; minimum-key, maybe evict case
+ c (-> cache (dissoc k) (assoc item result))
+ l (-> lru (dissoc k) (assoc item tick+))]
+ (LRUCache. c l tick+ limit))
+ (LRUCache. (assoc cache item result) ;; no change case
+ (assoc lru item tick+)
+ tick+
+ limit))))
+ (evict [this key]
+ (if (contains? cache key)
+ (LRUCache. (dissoc cache key)
+ (dissoc lru key)
+ (inc tick)
+ limit)
+ this))
+ (seed [_ base]
+ (LRUCache. base
+ (build-leastness-queue base 0)
+ 0
+ limit))
+ Object
+ (ToString [_] ;;; toString
+ (str cache \, \space lru \, \space tick \, \space limit)))
+
+
+(defn- key-killer-q
+ [ttl q expiry now]
+ (let [[ks q'] (reduce (fn [[ks q] [k g t]]
+ (if (> (- now t) expiry)
+ (if (= g (first (get ttl k)))
+ [(conj ks k) (pop q)]
+ [ks (pop q)])
+ (reduced [ks q])))
+ [[] q]
+ q)]
+ [#(apply dissoc % ks) q']))
+
+(defcache TTLCacheQ [cache ttl q gen ttl-ms]
+ CacheProtocol
+ (lookup [this item]
+ (let [ret (lookup this item ::nope)]
+ (when-not (= ::nope ret) ret)))
+ (lookup [this item not-found]
+ (if (has? this item)
+ (get cache item)
+ not-found))
+ (has? [_ item]
+ (and (let [[_ t] (get ttl item [0 (- ttl-ms)])]
+ (< (- (Environment/TickCount) ;;; System/currentTimeMillis
+ t)
+ ttl-ms))
+ (contains? cache item)))
+ (hit [this item] this)
+ (miss [this item result]
+ (let [now (Environment/TickCount) ;;; System/currentTimeMillis
+ [kill-old q'] (key-killer-q ttl q ttl-ms now)]
+ (TTLCacheQ. (assoc (kill-old cache) item result)
+ (assoc (kill-old ttl) item [gen now])
+ (conj q' [item gen now])
+ (unchecked-inc gen)
+ ttl-ms)))
+ (seed [_ base]
+ (let [now (Environment/TickCount)] ;;; System/currentTimeMillis
+ (TTLCacheQ. base
+ ;; we seed the cache all at gen, but subsequent entries
+ ;; will get gen+1, gen+2 etc
+ (into {} (for [x base] [(key x) [gen now]]))
+ (into q (for [x base] [(key x) gen now]))
+ (unchecked-inc gen)
+ ttl-ms)))
+ (evict [_ key]
+ (TTLCacheQ. (dissoc cache key)
+ (dissoc ttl key)
+ q
+ gen
+ ttl-ms))
+ Object
+ (ToString [_] ;;; toString
+ (str cache \, \space ttl \, \space ttl-ms)))
+
+
+(defcache LUCache [cache lu limit]
+ CacheProtocol
+ (lookup [_ item]
+ (get cache item))
+ (lookup [_ item not-found]
+ (get cache item not-found))
+ (has? [_ item]
+ (contains? cache item))
+ (hit [_ item]
+ (LUCache. cache (update-in lu [item] inc) limit))
+ (miss [_ item result]
+ (if (>= (count lu) limit) ;; need to evict?
+ (let [min-key (if (contains? lu item)
+ ::nope
+ (first (peek lu))) ;; maybe evict case
+ c (-> cache (dissoc min-key) (assoc item result))
+ l (-> lu (dissoc min-key) (update-in [item] (fnil inc 0)))]
+ (LUCache. c l limit))
+ (LUCache. (assoc cache item result) ;; no change case
+ (update-in lu [item] (fnil inc 0))
+ limit)))
+ (evict [this key]
+ (if (contains? this key)
+ (LUCache. (dissoc cache key)
+ (dissoc lu key)
+ limit)
+ this))
+ (seed [_ base]
+ (LUCache. base
+ (build-leastness-queue base 0)
+ limit))
+ Object
+ (ToString [_] ;;; toString
+ (str cache \, \space lu \, \space limit)))
+
+
+;; # LIRS
+;; *initial Clojure implementation by Jan Oberhagemann*
+
+;; A
+;; [LIRS](http://citeseer.ist.psu.edu/viewdoc/summary?doi=10.1.1.116.2184)
+;; cache consists of two LRU lists, `S` and `Q`, and keeps more history
+;; than a LRU cache. Every cached item is either a LIR, HIR or
+;; non-resident HIR block. `Q` contains only HIR blocks, `S` contains
+;; LIR, HIR, non-resident HIR blocks. The total cache size is
+;; |`S`|+|`Q`|, |`S`| is typically 99% of the cache size.
+
+;; * LIR block:
+;; Low Inter-Reference block, a cached item with a short interval
+;; between accesses. A block `x`, `x` ∈ `S` ∧ `x` ∉ `Q` ∧ `x` ∈
+;; `cache`, is a LIR block.
+
+;; * HIR block:
+;; High Inter-Reference block, a cached item with rare accesses and
+;; long interval. A block `x`, `x` ∈ `Q` ∧ `x` ∈ `cache`, is a HIR block.
+
+;; * non-resident HIR block:
+;; only the key of the HIR block is cached, without the corresponding
+;; value a test (has?) for the corresponding key is always a
+;; miss. Used for additional history information. A block `x`, `x` ∈
+;; `S` ∧ `x` ∉ `Q` ∧ `x` ∉ `cache`, is a non-resident HIR block.
+
+;; ## Outline of the implemented algorithm
+
+;; `cache` is used to store the key value pairs.
+;; `S` and `Q` maintain the relative order of accesses of the keys, like
+;; a LRU list.
+
+;; Definition of `prune stack`:
+;;
+;; repeatedly remove oldest item from S until an item k, k ∉ Q ∧
+;; k ∈ cache (a LIR block), is found
+
+
+;; In case of a miss for key `k` and value `v` (`k` ∉ cache) and
+;;
+;; * (1.1) `S` is not filled, |`S`| < `limitS`
+;; add k to S
+;; add k to the cache
+
+;; * (1.2) `k` ∉ `S`, never seen or not seen for a long, long time
+;; remove oldest item x from Q
+;; remove x from cache
+;; add k to S
+;; add k to Q
+;; add k to the cache
+
+;; * (1.3) `k` ∈ `S`, this is a non-resident HIR block
+;; remove oldest item x from Q
+;; remove x from cache
+;; add k to S
+;; remove oldest item y from S
+;; add y to Q
+;; prune stack
+
+
+;; In case of a hit for key `k` (`k` ∈ cache) and
+
+;; * (2.1) `k` ∈ `S` ∧ `k` ∉ `Q`, a LIR block
+;; add k to S / refresh
+;; prune stack if k was the oldest item in S
+
+;; * (2.2) `k` ∈ `S` ∧ `k` ∈ `Q`, a HIR block
+;; add k to S / refresh
+;; remove k from Q
+;; remove oldest item x from S
+;; add x to Q
+;; prune stack
+
+;; * (2.3) `k` ∉ `S` ∧ `k` ∈ `Q`, a HIR block, only older than the oldest item in S
+;; add k to S
+;; add k to Q / refresh
+
+(defn- prune-stack [lruS lruQ cache]
+ (loop [s lruS q lruQ c cache]
+ (let [k (apply min-key s (keys s))]
+ (if (or (contains? q k) ; HIR item
+ (not (contains? c k))) ; non-resident HIR item
+ (recur (dissoc s k) q c)
+ s))))
+
+(defcache LIRSCache [cache lruS lruQ tick limitS limitQ]
+ CacheProtocol
+ (lookup [_ item]
+ (get cache item))
+ (lookup [_ item not-found]
+ (get cache item not-found))
+ (has? [_ item]
+ (contains? cache item))
+ (hit [_ item]
+ (let [tick+ (inc tick)]
+ (if (not (contains? lruS item))
+ ; (2.3) item ∉ S ∧ item ∈ Q
+ (LIRSCache. cache (assoc lruS item tick+) (assoc lruQ item tick+) tick+ limitS limitQ)
+ (let [k (apply min-key lruS (keys lruS))]
+ (if (contains? lruQ item)
+ ; (2.2) item ∈ S ∧ item ∈ Q
+ (let [new-lruQ (-> lruQ (dissoc item) (assoc k tick+))]
+ (LIRSCache. cache
+ (-> lruS (dissoc k) (assoc item tick+) (prune-stack new-lruQ cache))
+ new-lruQ
+ tick+
+ limitS
+ limitQ))
+ ; (2.1) item ∈ S ∧ item ∉ Q
+ (LIRSCache. cache
+ (-> lruS (assoc item tick+) (prune-stack lruQ cache))
+ lruQ
+ tick+
+ limitS
+ limitQ))))))
+
+ (miss [_ item result]
+ (let [tick+ (inc tick)]
+ (if (< (count cache) limitS)
+ ; (1.1)
+ (let [k (apply min-key lruS (keys lruS))]
+ (LIRSCache. (assoc cache item result)
+ (-> lruS (dissoc k) (assoc item tick+))
+ lruQ
+ tick+
+ limitS
+ limitQ))
+ (let [k (apply min-key lruQ (keys lruQ))
+ new-lruQ (dissoc lruQ k)
+ new-cache (-> cache (dissoc k) (assoc item result))]
+ (if (contains? lruS item)
+ ; (1.3)
+ (let [lastS (apply min-key lruS (keys lruS))]
+ (LIRSCache. new-cache
+ (-> lruS (dissoc lastS) (assoc item tick+) (prune-stack new-lruQ new-cache))
+ (assoc new-lruQ lastS tick+)
+ tick+
+ limitS
+ limitQ))
+ ; (1.2)
+ (LIRSCache. new-cache
+ (assoc lruS item tick+)
+ (assoc new-lruQ item tick+)
+ tick+
+ limitS
+ limitQ))))))
+ (seed [_ base]
+ (LIRSCache. base
+ (into {} (for [x (range (- limitS) 0)] [x x]))
+ (into {} (for [x (range (- limitQ) 0)] [x x]))
+ 0
+ limitS
+ limitQ))
+ Object
+ (ToString [_] ;;; toString
+ (str cache \, \space lruS \, \space lruQ \, \space tick \, \space limitS \, \space limitQ)))
+;;; Port SoftCache some other time -- TODO
+;;;(defn clear-soft-cache! [^java.util.Map cache ^java.util.Map rcache ^ReferenceQueue rq]
+;;; (loop [r (.poll rq)]
+;;; (when r
+;;; (when-let [item (get rcache r)]
+;;; (.remove cache item))
+;;; (.remove rcache r)
+;;; (recur (.poll rq)))))
+;;;
+;;;(defn make-reference [v rq]
+;;; (if (nil? v)
+;;; (SoftReference. ::nil rq)
+;;; (SoftReference. v rq)))
+;;;
+;;;(defcache SoftCache [^java.util.Map cache ^java.util.Map rcache rq]
+;;; CacheProtocol
+;;; (lookup [_ item]
+;;; (when-let [^SoftReference r (get cache (or item ::nil))]
+;;; (let [v (.get r)]
+;;; (if (= ::nil v)
+;;; nil
+;;; v))))
+;;; (lookup [_ item not-found]
+;;; (if-let [^SoftReference r (get cache (or item ::nil))]
+;;; (if-let [v (.get r)]
+;;; (if (= ::nil v)
+;;; nil
+;;; v)
+;;; not-found)
+;;; not-found))
+;;; (has? [_ item]
+;;; (let [item (or item ::nil)
+;;; ^SoftReference cell (get cache item)]
+;;; (boolean
+;;; (when cell
+;;; (not (nil? (.get cell)))))))
+;;; (hit [this item]
+;;; (clear-soft-cache! cache rcache rq)
+;;; this)
+;;; (miss [this item result]
+;;; (let [item (or item ::nil)
+;;; r (make-reference result rq)]
+;;; (.put cache item r)
+;;; (.put rcache r item)
+;;; (clear-soft-cache! cache rcache rq)
+;;; this))
+;;; (evict [this key]
+;;; (let [key (or key ::nil)
+;;; r (get cache key)]
+;;; (when r
+;;; (.remove cache key)
+;;; (.remove rcache r))
+;;; (clear-soft-cache! cache rcache rq)
+;;; this))
+;;; (seed [_ base]
+;;; (let [soft-cache? (instance? SoftCache base)
+;;; cache (ConcurrentHashMap.)
+;;; rcache (ConcurrentHashMap.)
+;;; rq (ReferenceQueue.)]
+;;; (if (seq base)
+;;; (doseq [[k ^SoftReference v] base]
+;;; (let [k (or k ::nil)
+;;; r (if soft-cache?
+;;; (make-reference (.get v) rq)
+;;; (make-reference v rq))]
+;;; (.put cache k r)
+;;; (.put rcache r k))))
+;;; (SoftCache. cache rcache rq)))
+;;; Object
+;;; (toString [_] (str cache)))
+
+;; Factories
+
+(defn basic-cache-factory
+ "Returns a pluggable basic cache initialized to `base`"
+ [base]
+ {:pre [(map? base)]}
+ (BasicCache. base))
+
+(defn fifo-cache-factory
+ "Returns a FIFO cache with the cache and FIFO queue initialized to `base` --
+ the queue is filled as the values are pulled out of `base`. If the associative
+ structure can guarantee ordering, then the said ordering will define the
+ eventual eviction order. Otherwise, there are no guarantees for the eventual
+ eviction ordering.
+
+ This function takes an optional `:threshold` argument that defines the maximum number
+ of elements in the cache before the FIFO semantics apply (default is 32).
+
+ If the number of elements in `base` is greater than the limit then some items
+ in `base` will be dropped from the resulting cache. If the associative
+ structure used as `base` can guarantee sorting, then the last `limit` elements
+ will be used as the cache seed values. Otherwise, there are no guarantees about
+ the elements in the resulting cache."
+ [base & {threshold :threshold :or {threshold 32}}]
+ {:pre [(number? threshold) (< 0 threshold)
+ (map? base)]
+ :post [(== threshold (count (.q ^FIFOCache %)))]}
+ (clojure.core.cache/seed (FIFOCache. {} clojure.lang.PersistentQueue/EMPTY threshold) base))
+
+(defn lru-cache-factory
+ "Returns an LRU cache with the cache and usage-table initialized to `base` --
+ each entry is initialized with the same usage value.
+
+ This function takes an optional `:threshold` argument that defines the maximum number
+ of elements in the cache before the LRU semantics apply (default is 32)."
+ [base & {threshold :threshold :or {threshold 32}}]
+ {:pre [(number? threshold) (< 0 threshold)
+ (map? base)]}
+ (clojure.core.cache/seed (LRUCache. {} (clojure.data.priority-map/priority-map) 0 threshold) base))
+
+(defn ttl-cache-factory
+ "Returns a TTL cache with the cache and expiration-table initialized to `base` --
+ each with the same time-to-live.
+
+ This function also allows an optional `:ttl` argument that defines the default
+ time in milliseconds that entries are allowed to reside in the cache."
+ [base & {ttl :ttl :or {ttl 2000}}]
+ {:pre [(number? ttl) (<= 0 ttl)
+ (map? base)]}
+ (clojure.core.cache/seed (TTLCacheQ. {} {} clojure.lang.PersistentQueue/EMPTY 0 ttl) base))
+
+(defn lu-cache-factory
+ "Returns an LU cache with the cache and usage-table initialized to `base`.
+
+ This function takes an optional `:threshold` argument that defines the maximum number
+ of elements in the cache before the LU semantics apply (default is 32)."
+ [base & {threshold :threshold :or {threshold 32}}]
+ {:pre [(number? threshold) (< 0 threshold)
+ (map? base)]}
+ (clojure.core.cache/seed (LUCache. {} (clojure.data.priority-map/priority-map) threshold) base))
+
+(defn lirs-cache-factory
+ "Returns an LIRS cache with the S & R LRU lists set to the indicated
+ limits."
+ [base & {:keys [s-history-limit q-history-limit]
+ :or {s-history-limit 32
+ q-history-limit 32}}]
+ {:pre [(number? s-history-limit) (< 0 s-history-limit)
+ (number? q-history-limit) (< 0 q-history-limit)
+ (map? base)]}
+ (clojure.core.cache/seed (LIRSCache. {} {} {} 0 s-history-limit q-history-limit) base))
+
+(defn soft-cache-factory
+ "Returns a SoftReference cache. Cached values will be referred to with
+ SoftReferences, allowing the values to be garbage collected when there is
+ memory pressure on the JVM.
+
+ SoftCache is a mutable cache, since it is always based on a
+ ConcurrentHashMap."
+ [base]
+ {:pre [(map? base)]}
+ (throw (System.NotImplementedException.)) ;;; (clojure.core.cache/seed (SoftCache. (ConcurrentHashMap.) (ConcurrentHashMap.) (ReferenceQueue.))
+ ) ;;; base)
+
diff --git a/typed/clj.analyzer/src/clojure/core/cache/wrapped.clj b/typed/clj.analyzer/src/clojure/core/cache/wrapped.clj
new file mode 100644
index 000000000..b530411a2
--- /dev/null
+++ b/typed/clj.analyzer/src/clojure/core/cache/wrapped.clj
@@ -0,0 +1,197 @@
+; 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 clojure.core.cache.wrapped
+ "A higher level way to use clojure.core.cache that assumes the immutable
+ cache is wrapped in an atom.
+
+ The API is (almost) the same as clojure.core.cache -- including the factory
+ functions -- but instead of accepting immutable caches, the functions
+ here accept atoms containing those caches. The factory functions return
+ new atoms containing the newly created cache.
+
+ In addition, lookup-or-miss provides a safe, atomic way to retrieve a
+ value from a cache or compute it if it is missing, without risking a
+ cache stampede."
+ (:require [clojure.core.cache :as c]))
+
+(set! *warn-on-reflection* true)
+
+(defn lookup
+ "Retrieve the value associated with `e` if it exists, else `nil` in
+ the 2-arg case. Retrieve the value associated with `e` if it exists,
+ else `not-found` in the 3-arg case.
+
+ Reads from the current version of the atom."
+ ([cache-atom e]
+ (c/lookup @cache-atom e))
+ ([cache-atom e not-found]
+ (c/lookup @cache-atom e not-found)))
+
+(def ^{:private true} default-wrapper-fn #(%1 %2))
+
+(defn lookup-or-miss
+ "Retrieve the value associated with `e` if it exists, else compute the
+ value (using value-fn, and optionally wrap-fn), update the cache for `e`
+ and then perform the lookup again.
+
+ value-fn (and wrap-fn) will only be called (at most) once even in the
+ case of retries, so there is no risk of cache stampede.
+
+ Since lookup can cause invalidation in some caches (such as TTL), we
+ trap that case and retry (a maximum of ten times)."
+ ([cache-atom e value-fn]
+ (lookup-or-miss cache-atom e default-wrapper-fn value-fn))
+ ([cache-atom e wrap-fn value-fn]
+ (let [d-new-value (delay (wrap-fn value-fn e))]
+ (loop [n 0
+ v (c/lookup (swap! cache-atom
+ c/through-cache
+ e
+ default-wrapper-fn
+ (fn [_] @d-new-value))
+ e
+ ::expired)]
+ (when (< n 10)
+ (if (= ::expired v)
+ (recur (inc n)
+ (c/lookup (swap! cache-atom
+ c/through-cache
+ e
+ default-wrapper-fn
+ (fn [_] @d-new-value))
+ e
+ ::expired))
+ v))))))
+
+(defn has?
+ "Checks if the cache contains a value associated with `e`.
+
+ Reads from the current version of the atom."
+ [cache-atom e]
+ (c/has? @cache-atom e))
+
+(defn hit
+ "Is meant to be called if the cache is determined to contain a value
+ associated with `e`.
+
+ Returns the updated cache from the atom. Provided for completeness."
+ [cache-atom e]
+ (swap! cache-atom c/hit e))
+
+(defn miss
+ "Is meant to be called if the cache is determined to **not** contain a
+ value associated with `e`.
+
+ Returns the updated cache from the atom. Provided for completeness."
+ [cache-atom e ret]
+ (swap! cache-atom c/miss e ret))
+
+(defn evict
+ "Removes an entry from the cache.
+
+ Returns the updated cache from the atom."
+ [cache-atom e]
+ (swap! cache-atom c/evict e))
+
+(defn seed
+ "Is used to signal that the cache should be created with a seed.
+ The contract is that said cache should return an instance of its
+ own type.
+
+ Returns the updated cache from the atom. Provided for completeness."
+ [cache-atom base]
+ (swap! cache-atom c/seed base))
+
+(defn through
+ "The basic hit/miss logic for the cache system. Expects a wrap function and
+ value function. The wrap function takes the value function and the item in question
+ and is expected to run the value function with the item whenever a cache
+ miss occurs. The intent is to hide any cache-specific cells from leaking
+ into the cache logic itelf."
+ ([cache-atom item] (through default-wrapper-fn identity cache-atom item))
+ ([value-fn cache-atom item] (through default-wrapper-fn value-fn cache-atom item))
+ ([wrap-fn value-fn cache-atom item]
+ (swap! cache-atom c/through-cache item wrap-fn value-fn)))
+
+(defn through-cache
+ "The basic hit/miss logic for the cache system. Like through but always has
+ the cache argument in the first position."
+ ([cache-atom item] (through-cache cache-atom item default-wrapper-fn identity))
+ ([cache-atom item value-fn] (through-cache cache-atom item default-wrapper-fn value-fn))
+ ([cache-atom item wrap-fn value-fn]
+ (swap! cache-atom c/through-cache item wrap-fn value-fn)))
+
+(defn basic-cache-factory
+ "Returns a pluggable basic cache initialized to `base`"
+ [base]
+ (atom (c/basic-cache-factory base)))
+
+(defn fifo-cache-factory
+ "Returns a FIFO cache with the cache and FIFO queue initialized to `base` --
+ the queue is filled as the values are pulled out of `base`. If the associative
+ structure can guarantee ordering, then the said ordering will define the
+ eventual eviction order. Otherwise, there are no guarantees for the eventual
+ eviction ordering.
+
+ This function takes an optional `:threshold` argument that defines the maximum number
+ of elements in the cache before the FIFO semantics apply (default is 32).
+
+ If the number of elements in `base` is greater than the limit then some items
+ in `base` will be dropped from the resulting cache. If the associative
+ structure used as `base` can guarantee sorting, then the last `limit` elements
+ will be used as the cache seed values. Otherwise, there are no guarantees about
+ the elements in the resulting cache."
+ [base & {threshold :threshold :or {threshold 32}}]
+ (atom (c/fifo-cache-factory base :threshold threshold)))
+
+(defn lru-cache-factory
+ "Returns an LRU cache with the cache and usage-table initialized to `base` --
+ each entry is initialized with the same usage value.
+
+ This function takes an optional `:threshold` argument that defines the maximum number
+ of elements in the cache before the LRU semantics apply (default is 32)."
+ [base & {threshold :threshold :or {threshold 32}}]
+ (atom (c/lru-cache-factory base :threshold threshold)))
+
+(defn ttl-cache-factory
+ "Returns a TTL cache with the cache and expiration-table initialized to `base` --
+ each with the same time-to-live.
+
+ This function also allows an optional `:ttl` argument that defines the default
+ time in milliseconds that entries are allowed to reside in the cache."
+ [base & {ttl :ttl :or {ttl 2000}}]
+ (atom (c/ttl-cache-factory base :ttl ttl)))
+
+(defn lu-cache-factory
+ "Returns an LU cache with the cache and usage-table initialized to `base`.
+
+ This function takes an optional `:threshold` argument that defines the maximum number
+ of elements in the cache before the LU semantics apply (default is 32)."
+ [base & {threshold :threshold :or {threshold 32}}]
+ (atom (c/lu-cache-factory base :threshold threshold)))
+
+(defn lirs-cache-factory
+ "Returns an LIRS cache with the S & R LRU lists set to the indicated
+ limits."
+ [base & {:keys [s-history-limit q-history-limit]
+ :or {s-history-limit 32
+ q-history-limit 32}}]
+ (atom (c/lirs-cache-factory base
+ :s-history-limit s-history-limit
+ :q-history-limit q-history-limit)))
+
+(defn soft-cache-factory
+ "Returns a SoftReference cache. Cached values will be referred to with
+ SoftReferences, allowing the values to be garbage collected when there is
+ memory pressure on the JVM.
+
+ SoftCache is a mutable cache, since it is always based on a
+ ConcurrentHashMap."
+ [base]
+ (atom (c/soft-cache-factory base)))
\ No newline at end of file
diff --git a/typed/clj.analyzer/src/clojure/core/memoize.cljr b/typed/clj.analyzer/src/clojure/core/memoize.cljr
new file mode 100644
index 000000000..06b829fbc
--- /dev/null
+++ b/typed/clj.analyzer/src/clojure/core/memoize.cljr
@@ -0,0 +1,509 @@
+; Copyright (c) Rich Hickey and Michael Fogus. 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 clojure.core.memoize
+ "core.memoize is a memoization library offering functionality above
+ Clojure's core `memoize` function in the following ways:
+
+ **Pluggable memoization**
+
+ core.memoize allows for different back-end cache implmentations to
+ be used as appropriate without changing the memoization modus operandi.
+ See the `memoizer` function.
+
+ **Manipulable memoization**
+
+ Because core.memoize allows you to access a function's memoization store,
+ you do interesting things like clear it, modify it, and save it for later.
+ "
+ {:author "fogus"}
+
+ (:require [clojure.core.cache :as cache]))
+
+
+
+;; Similar to clojure.lang.Delay, but will not memoize an exception and will
+;; instead retry.
+;; fun - the function, never nil
+;; available? - indicates a memoized value is available, volatile for visibility
+;; value - the value (if available) - volatile for visibility
+(deftype RetryingDelay [fun ^:volatile-mutable available? ^:volatile-mutable value]
+ clojure.lang.IDeref
+ (deref [this]
+ ;; first check (safe with volatile flag)
+ (if available?
+ value
+ (locking fun
+ ;; second check (race condition with locking)
+ (if available?
+ value
+ (do
+ ;; fun may throw - will retry on next deref
+ (let [v (fun)]
+ ;; this ordering is important - MUST set value before setting available?
+ ;; or you have a race with the first check above
+ (set! value v)
+ (set! available? true)
+ v))))))
+ clojure.lang.IPending
+ (isRealized [this]
+ available?))
+
+(defn- d-lay [fun]
+ (->RetryingDelay fun false nil))
+
+(defn- make-derefable
+ "If a value is not already derefable, wrap it up.
+
+ This is used to help rebuild seed/base maps passed in to the various
+ caches so that they conform to core.memoize's world view."
+ [v]
+ (if (instance? clojure.lang.IDeref v)
+ v
+ (reify clojure.lang.IDeref
+ (deref [_] v))))
+
+(defn- derefable-seed
+ "Given a seed/base map, ensure all the values in it are derefable."
+ [seed]
+ (into {} (for [[k v] seed] [k (make-derefable v)])))
+
+;; Plugging Interface
+
+(deftype PluggableMemoization [f cache]
+ cache/CacheProtocol
+ (has? [_ item]
+ (clojure.core.cache/has? cache item))
+ (hit [_ item]
+ (PluggableMemoization. f (clojure.core.cache/hit cache item)))
+ (miss [_ item result]
+ (PluggableMemoization. f (clojure.core.cache/miss cache item result)))
+ (evict [_ key]
+ (PluggableMemoization. f (clojure.core.cache/evict cache key)))
+ (lookup [_ item]
+ (clojure.core.cache/lookup cache item nil))
+ (lookup [_ item not-found]
+ (clojure.core.cache/lookup cache item (delay not-found)))
+ (seed [_ base]
+ (PluggableMemoization.
+ f (clojure.core.cache/seed cache (derefable-seed base))))
+ Object
+ (ToString [_] (str cache))) ;;; toString
+
+;; # Auxilliary functions
+
+(def ^{:private true
+ :doc "Returns a function's argument transformer."}
+ args-fn #(or (::args-fn (meta %)) identity))
+
+(defn- through*
+ "The basic hit/miss logic for the cache system based on `core.cache/through`.
+ Clojure delays are used to hold the cache value."
+ [cache f args item]
+ (clojure.core.cache/through
+ (fn [f _] (d-lay #(f args)))
+ #(clojure.core/apply f %)
+ cache
+ item))
+
+(def ^{:private true
+ :doc "Returns a function's cache identity."}
+ cache-id #(::cache (meta %)))
+
+
+;; # Public Utilities API
+
+(defn snapshot
+ "Returns a snapshot of a core.memo-placed memoization cache. By snapshot
+ you can infer that what you get is only the cache contents at a
+ moment in time."
+ [memoized-fn]
+ (when-let [cache (cache-id memoized-fn)]
+ (into {}
+ (for [[k v] (.cache ^PluggableMemoization @cache)]
+ [(vec k) @v]))))
+
+(defn lazy-snapshot
+ "Returns a lazy snapshot of a core.memo-placed memoization cache. By
+ lazy snapshot you can infer that what you get is only the cache contents at a
+ moment in time -- and, being lazy, the cache could change while you are
+ realizing the snapshot elements.
+
+ Returns a sequence of key/value pairs."
+ [memoized-fn]
+ (when-let [cache (cache-id memoized-fn)]
+ (for [[k v] (.cache ^PluggableMemoization @cache)]
+ [(vec k) @v])))
+
+(defn memoized?
+ "Returns true if a function has an core.memo-placed cache, false otherwise."
+ [f]
+ (boolean (cache-id f)))
+
+(defn memo-clear!
+ "Reaches into an core.memo-memoized function and clears the cache. This is a
+ destructive operation and should be used with care.
+
+ When the second argument is a vector of input arguments, clears cache only
+ for argument vector.
+
+ Keep in mind that depending on what other threads or doing, an
+ immediate call to `snapshot` may not yield an empty cache. That's
+ cool though, we've learned to deal with that stuff in Clojure by
+ now."
+ ([f]
+ (when-let [cache (cache-id f)]
+ (swap! cache (constantly (clojure.core.cache/seed @cache {})))))
+ ([f args]
+ (when-let [cache (cache-id f)]
+ (swap! cache (constantly (clojure.core.cache/evict @cache args))))))
+
+(defn memo-reset!
+ "Takes a core.memo-populated function and a map and replaces the memoization cache
+ with the supplied map. This is potentially some serious voodoo,
+ since you can effectively change the semantics of a function on the fly.
+
+ (def id (memo identity))
+ (memo-swap! id '{[13] :omg})
+ (id 13)
+ ;=> :omg
+
+ With great power comes ... yadda yadda yadda."
+ [f base]
+ (when-let [cache (cache-id f)]
+ (swap! cache
+ (constantly (clojure.core.cache/seed @cache (derefable-seed base))))))
+
+(defn memo-swap!
+ "The 2-arity version takes a core.memo-populated function and a map and
+ replaces the memoization cache with the supplied map. Use `memo-reset!`
+ instead for replacing the cache as this 2-arity version of `memo-swap!`
+ should be considered deprecated.
+
+ The 3+-arity version takes a core.memo-populated function and arguments
+ similar to what you would pass to `clojure.core/swap!` and performs a
+ `swap!` on the underlying cache. In order to satisfy core.memoize's
+ world view, the assumption is that you will generally be calling it like:
+
+ (def id (memo identity))
+ (memo-swap! id clojure.core.cache/miss [13] :omg)
+ (id 13)
+ ;=> :omg
+
+ You'll nearly always use `clojure.core.cache/miss` for this operation but
+ you could pass any function that would work on an immutable cache, such
+ as `evict` or `assoc` etc.
+
+ Be aware that `memo-swap!` assumes it can wrap each of the `results` values
+ in a `delay` so that items conform to `clojure.core.memoize`'s world view."
+ ([f base]
+ (when-let [cache (cache-id f)]
+ (swap! cache
+ (constantly (clojure.core.cache/seed @cache (derefable-seed base))))))
+ ([f swap-fn args & results]
+ (when-let [cache (cache-id f)]
+ (apply swap! cache swap-fn args (map #(delay %) results)))))
+
+(defn memo-unwrap
+ [f]
+ (::original (meta f)))
+
+(defn- cached-function
+ "Given a function, an atom containing a (pluggable memoization cache), and
+ and cache key function, return a new function that behaves like the original
+ function except it is cached, based on its arguments, with the cache and the
+ original function in its metadata."
+ [f cache-atom ckey-fn]
+ (with-meta
+ (fn [& args]
+ (let [ckey (or (ckey-fn args) [])
+ cs (swap! cache-atom through* f args ckey)
+ val (clojure.core.cache/lookup cs ckey ::not-found)]
+ ;; If `lookup` returns `(delay ::not-found)`, it's likely that
+ ;; we ran into a timing issue where eviction and access
+ ;; are happening at about the same time. Therefore, we retry
+ ;; the `swap!` (potentially several times).
+ ;;
+ ;; core.memoize currently wraps all of its values in a `delay`.
+ (when val
+ (loop [n 0 v @val]
+ (if (= ::not-found v)
+ (when-let [v' (clojure.core.cache/lookup
+ (swap! cache-atom through* f args ckey)
+ ckey ::not-found)]
+ (when (< n 10)
+ (recur (inc n) @v')))
+ v)))))
+ {::cache cache-atom
+ ::original f}))
+
+;; # Public memoization API
+
+(defn memoizer
+ "Build a pluggable memoized version of a function. Given a function and a
+ (pluggable memoized) cache, and an optional seed (hash map of arguments to
+ return values), return a cached version of that function.
+
+ If you want to build your own cached function, perhaps with combined caches
+ or customized caches, this is the preferred way to do so now."
+ ([f cache]
+ (let [cache (atom (PluggableMemoization. f cache))
+ ckey-fn (args-fn f)]
+ (cached-function f cache ckey-fn)))
+ ([f cache seed]
+ (let [cache (atom (clojure.core.cache/seed (PluggableMemoization. f cache)
+ (derefable-seed seed)))
+ ckey-fn (args-fn f)]
+ (cached-function f cache ckey-fn))))
+
+(defn build-memoizer
+ "Builds a function that, given a function, returns a pluggable memoized
+ version of it. `build-memoizer` takes a cache factory function, and the
+ argunments to that factory function -- at least one of those arguments
+ should be the function to be memoized (it's usually the first argument).
+
+ `memoizer` above is a simpler version of `build-memoizer` that 'does the
+ right thing' with a cache and a seed hash map. `build-memoizer` remains
+ for backward compatibility but should be considered deprecated."
+ ([cache-factory f & args]
+ (let [cache (atom (apply cache-factory f args))
+ ckey-fn (args-fn f)]
+ (cached-function f cache ckey-fn))))
+
+(defn memo
+ "Used as a more flexible alternative to Clojure's core `memoization`
+ function. Memoized functions built using `memo` will respond to
+ the core.memo manipulable memoization utilities. As a nice bonus,
+ you can use `memo` in place of `memoize` without any additional
+ changes, with the added guarantee that the memoized function will
+ only be called once for a given sequence of arguments (`memoize`
+ can call the function multiple times when concurrent calls are
+ made with the same sequence of arguments).
+
+ The default way to use this function is to simply supply a function
+ that will be memoized. Additionally, you may also supply a map
+ of the form `'{[42] 42, [108] 108}` where keys are a vector
+ mapping expected argument values to arity positions. The map values
+ are the return values of the memoized function.
+
+ If the supplied function has metadata containing an
+ `:clojure.core.memoize/args-fn` key, the value is assumed to be a
+ function that should be applied to the arguments to produce a
+ subset or transformed sequence of arguments that are used for the
+ key in the cache (the full, original arguments will still be used
+ to call the function). This allows you to memoize functions where
+ one or more arguments are irrelevant for memoization, such as the
+ `clojure.java.jdbc` functions, whose first argument may include
+ a (mutable) JDBC `Connection` object:
+
+ (memo/memo (with-meta jdbc/execute! {::memo/args-fn rest}))
+
+ You can access the memoization cache directly via the `:clojure.core.memoize/cache` key
+ on the memoized function's metadata. However, it is advised to
+ use the core.memo primitives instead as implementation details may
+ change over time."
+ ([f] (memo f {}))
+ ([f seed]
+ (memoizer f (cache/basic-cache-factory {}) seed)))
+
+;; ## Utilities
+
+(defn ^{:private true} !! [c]
+ (println "WARNING - Deprecated construction method for"
+ c
+ "cache; prefered way is:"
+ (str "(clojure.core.memoize/" c " function <:" c "/threshold num>)")))
+
+(defmacro ^{:private true} def-deprecated [nom ds & arities]
+ `(defn ~(symbol (str "memo-" (name nom))) ~ds
+ ~@(for [[args body] arities]
+ (list args `(!! (quote ~nom)) body))))
+
+(defmacro ^{:private true} massert [condition msg]
+ `(when-not ~condition
+ (throw (new InvalidOperationException (str "clojure.core.memoize/" ~msg "\n" (pr-str '~condition)))))) ;;; AssertionError
+
+(defmacro ^{:private true} check-args [nom f base key threshold]
+ (when *assert*
+ (let [good-key (keyword nom "threshold")
+ key-error `(str "Incorrect threshold key " ~key)
+ fun-error `(str ~nom " expects a function as its first argument; given " ~f)
+ thresh-error `(str ~nom " expects an integer for its " ~good-key " argument; given " ~threshold)]
+ `(do (massert (= ~key ~good-key) ~key-error)
+ (massert (some #{clojure.lang.IFn
+ clojure.lang.AFn
+ ;;; java.lang.Runnable
+ } ;;; java.util.concurrent.Callable
+ (ancestors (class ~f)))
+ ~fun-error)
+ (massert (number? ~threshold) ~thresh-error)))))
+
+;; ## Main API functions
+
+;; ### FIFO
+
+(def-deprecated fifo
+ "DEPRECATED: Please use clojure.core.memoize/fifo instead."
+ ([f] (memo-fifo f 32 {}))
+ ([f limit] (memo-fifo f limit {}))
+ ([f limit base]
+ (memoizer f (cache/fifo-cache-factory {} :threshold limit) base)))
+
+(defn fifo
+ "Works the same as the basic memoization function (i.e. `memo`
+ and `core.memoize` except when a given threshold is breached.
+
+ Observe the following:
+
+ (require '[clojure.core.memoize :as memo])
+
+ (def id (memo/fifo identity :fifo/threshold 2))
+
+ (id 42)
+ (id 43)
+ (snapshot id)
+ ;=> {[42] 42, [43] 43}
+
+ As you see, the limit of `2` has not been breached yet, but
+ if you call again with another value, then it is:
+
+ (id 44)
+ (snapshot id)
+ ;=> {[44] 44, [43] 43}
+
+ That is, the oldest entry `42` is pushed out of the
+ memoization cache. This is the standard **F**irst **I**n
+ **F**irst **O**ut behavior."
+ ([f] (fifo f {} :fifo/threshold 32))
+ ([f base] (fifo f base :fifo/threshold 32))
+ ([f tkey threshold] (fifo f {} tkey threshold))
+ ([f base key threshold]
+ (check-args "fifo" f base key threshold)
+ (memoizer f (cache/fifo-cache-factory {} :threshold threshold) base)))
+
+;; ### LRU
+
+(def-deprecated lru
+ "DEPRECATED: Please use clojure.core.memoize/lru instead."
+ ([f] (memo-lru f 32))
+ ([f limit] (memo-lru f limit {}))
+ ([f limit base]
+ (memoizer f (cache/lru-cache-factory {} :threshold limit) base)))
+
+(defn lru
+ "Works the same as the basic memoization function (i.e. `memo`
+ and `core.memoize` except when a given threshold is breached.
+
+ Observe the following:
+
+ (require '[clojure.core.memoize :as memo])
+
+ (def id (memo/lru identity :lru/threshold 2))
+
+ (id 42)
+ (id 43)
+ (snapshot id)
+ ;=> {[42] 42, [43] 43}
+
+ At this point the cache has not yet crossed the set threshold
+ of `2`, but if you execute yet another call the story will
+ change:
+
+ (id 44)
+ (snapshot id)
+ ;=> {[44] 44, [43] 43}
+
+ At this point the operation of the LRU cache looks exactly
+ the same at the FIFO cache. However, the difference becomes
+ apparent on further use:
+
+ (id 43)
+ (id 0)
+ (snapshot id)
+ ;=> {[0] 0, [43] 43}
+
+ As you see, once again calling `id` with the argument `43`
+ will expose the LRU nature of the underlying cache. That is,
+ when the threshold is passed, the cache will expel the
+ **L**east **R**ecently **U**sed element in favor of the new."
+ ([f] (lru f {} :lru/threshold 32))
+ ([f base] (lru f base :lru/threshold 32))
+ ([f tkey threshold] (lru f {} tkey threshold))
+ ([f base key threshold]
+ (check-args "lru" f base key threshold)
+ (memoizer f (cache/lru-cache-factory {} :threshold threshold) base)))
+
+;; ### TTL
+
+(def-deprecated ttl
+ "DEPRECATED: Please use clojure.core.memoize/ttl instead."
+ ([f] (memo-ttl f 3000 {}))
+ ([f limit] (memo-ttl f limit {}))
+ ([f limit base]
+ (memoizer f (cache/ttl-cache-factory {} :ttl limit) base)))
+
+(defn ttl
+ "Unlike many of the other core.memo memoization functions,
+ `memo-ttl`'s cache policy is time-based rather than algortihmic
+ or explicit. When memoizing a function using `memo-ttl` you
+ should provide a **T**ime **T**o **L**ive parameter in
+ milliseconds.
+
+ (require '[clojure.core.memoize :as memo])
+
+ (def id (memo/ttl identity :ttl/threshold 5000))
+
+ (id 42)
+ (snapshot id)
+ ;=> {[42] 42}
+
+ ... wait 5 seconds ...
+ (id 43)
+ (snapshot id)
+ ;=> {[43] 43}
+
+ The expired cache entries will be removed on each cache **miss**."
+ ([f] (ttl f {} :ttl/threshold 32))
+ ([f base] (ttl f base :ttl/threshold 32))
+ ([f tkey threshold] (ttl f {} tkey threshold))
+ ([f base key threshold]
+ (check-args "ttl" f base key threshold)
+ (memoizer f (cache/ttl-cache-factory {} :ttl threshold) base)))
+
+;; ### LU
+
+(def-deprecated lu
+ "DEPRECATED: Please use clojure.core.memoize/lu instead."
+ ([f] (memo-lu f 32))
+ ([f limit] (memo-lu f limit {}))
+ ([f limit base]
+ (memoizer f (cache/lu-cache-factory {} :threshold limit) base)))
+
+(defn lu
+ "Similar to the implementation of memo-lru, except that this
+ function removes all cache values whose usage value is
+ smallest:
+
+ (require '[clojure.core.memoize :as memo])
+
+ (def id (memo/lu identity :lu/threshold 3))
+
+ (id 42)
+ (id 42)
+ (id 43)
+ (id 44)
+ (snapshot id)
+ ;=> {[44] 44, [42] 42}
+
+ The **L**east **U**sed values are cleared on cache misses."
+ ([f] (lu f {} :lu/threshold 32))
+ ([f base] (lu f base :lu/threshold 32))
+ ([f tkey threshold] (lu f {} tkey threshold))
+ ([f base key threshold]
+ (check-args "lu" f base key threshold)
+ (memoizer f (cache/lu-cache-factory {} :threshold threshold) base)))
diff --git a/typed/clj.analyzer/src/clojure/data/priority_map.cljr b/typed/clj.analyzer/src/clojure/data/priority_map.cljr
new file mode 100644
index 000000000..4ed558592
--- /dev/null
+++ b/typed/clj.analyzer/src/clojure/data/priority_map.cljr
@@ -0,0 +1,549 @@
+;; Copyright (c) Mark Engelberg, Rich Hickey and contributors. 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.
+
+;; A priority map is a map from items to priorities,
+;; offering queue-like peek/pop as well as the map-like ability to
+;; easily reassign priorities and other conveniences.
+;; by Mark Engelberg (mark.engelberg@gmail.com)
+;; Last update - September 19, 2021
+
+(ns
+ ^{:author "Mark Engelberg",
+ :doc "A priority map is very similar to a sorted map, but whereas a sorted map produces a
+sequence of the entries sorted by key, a priority map produces the entries sorted by value.
+In addition to supporting all the functions a sorted map supports, a priority map
+can also be thought of as a queue of [item priority] pairs. To support usage as
+a versatile priority queue, priority maps also support conj/peek/pop operations.
+
+The standard way to construct a priority map is with priority-map:
+user=> (def p (priority-map :a 2 :b 1 :c 3 :d 5 :e 4 :f 3))
+#'user/p
+user=> p
+{:b 1, :a 2, :c 3, :f 3, :e 4, :d 5}
+
+So :b has priority 1, :a has priority 2, and so on.
+Notice how the priority map prints in an order sorted by its priorities (i.e., the map's values)
+
+We can use assoc to assign a priority to a new item:
+user=> (assoc p :g 1)
+{:b 1, :g 1, :a 2, :c 3, :f 3, :e 4, :d 5}
+
+or to assign a new priority to an extant item:
+user=> (assoc p :c 4)
+{:b 1, :a 2, :f 3, :c 4, :e 4, :d 5}
+
+We can remove an item from the priority map:
+user=> (dissoc p :e)
+{:b 1, :a 2, :c 3, :f 3, :d 5}
+
+An alternative way to add to the priority map is to conj a [item priority] pair:
+user=> (conj p [:g 0])
+{:g 0, :b 1, :a 2, :c 3, :f 3, :e 4, :d 5}
+
+or use into:
+user=> (into p [[:g 0] [:h 1] [:i 2]])
+{:g 0, :b 1, :h 1, :a 2, :i 2, :c 3, :f 3, :e 4, :d 5}
+
+Priority maps are countable:
+user=> (count p)
+6
+
+Like other maps, equivalence is based not on type, but on contents.
+In other words, just as a sorted-map can be equal to a hash-map,
+so can a priority-map.
+user=> (= p {:b 1, :a 2, :c 3, :f 3, :e 4, :d 5})
+true
+
+You can test them for emptiness:
+user=> (empty? (priority-map))
+true
+user=> (empty? p)
+false
+
+You can test whether an item is in the priority map:
+user=> (contains? p :a)
+true
+user=> (contains? p :g)
+false
+
+It is easy to look up the priority of a given item, using any of the standard map mechanisms:
+user=> (get p :a)
+2
+user=> (get p :g 10)
+10
+user=> (p :a)
+2
+user=> (:a p)
+2
+
+Priority maps derive much of their utility by providing priority-based seq.
+Note that no guarantees are made about the order in which items of the same priority appear.
+user=> (seq p)
+([:b 1] [:a 2] [:c 3] [:f 3] [:e 4] [:d 5])
+Because no guarantees are made about the order of same-priority items, note that
+rseq might not be an exact reverse of the seq. It is only guaranteed to be in
+descending order.
+user=> (rseq p)
+([:d 5] [:e 4] [:c 3] [:f 3] [:a 2] [:b 1])
+
+This means first/rest/next/for/map/etc. all operate in priority order.
+user=> (first p)
+[:b 1]
+user=> (rest p)
+([:a 2] [:c 3] [:f 3] [:e 4] [:d 5])
+
+Priority maps also support subseq and rsubseq, however, *you must use the subseq and rsubseq
+defined in the clojure.data.priority-map namespace*, which patches longstanding JIRA issue
+[CLJ-428](https://clojure.atlassian.net/browse/CLJ-428). These patched versions
+of subseq and rsubseq will work on Clojure's other sorted collections as well, so you can
+use them as a drop-in replacement for the subseq and rsubseq found in core.
+user=> (subseq p < 3)
+([:b 1] [:a 2])
+user=> (subseq p >= 3)
+([:c 3] [:f 3] [:e 4] [:d 5])
+user=> (subseq p >= 2 < 4)
+([:a 2] [:c 3] [:f 3])
+user=> (rsubseq p < 4)
+([:c 3] [:f 3] [:a 2] [:b 1])
+user=> (rsubseq p >= 4)
+([:d 5] [:e 4])
+
+Priority maps support metadata:
+user=> (meta (with-meta p {:extra :info}))
+{:extra :info}
+
+But perhaps most importantly, priority maps can also function as priority queues.
+peek, like first, gives you the first [item priority] pair in the collection.
+pop removes the first [item priority] from the collection.
+(Note that unlike rest, which returns a seq, pop returns a priority map).
+
+user=> (peek p)
+[:b 1]
+user=> (pop p)
+{:a 2, :c 3, :f 3, :e 4, :d 5}
+
+It is also possible to use a custom comparator:
+user=> (priority-map-by > :a 1 :b 2 :c 3)
+{:c 3, :b 2, :a 1}
+
+Sometimes, it is desirable to have a map where the values contain more information
+than just the priority. For example, let's say you want a map like:
+{:a [2 :apple], :b [1 :banana], :c [3 :carrot]}
+and you want to sort the map by the numeric priority found in the pair.
+
+A common mistake is to try to solve this with a custom comparator:
+(priority-map-by
+ (fn [[priority1 _] [priority2 _]] (< priority1 priority2))
+ :a [2 :apple], :b [1 :banana], :c [3 :carrot])
+
+This will not work! Although it may appear to work with these particular values, it is not safe.
+In Clojure, like Java, all comparators must be *total orders*,
+meaning that you can't have a tie unless the objects you are comparing are
+in fact equal. The above comparator breaks that rule because objects such as
+`[2 :apple]` and `[2 :apricot]` would tie, but are not equal.
+
+The correct way to construct such a priority map is by specifying a keyfn, which is used
+to extract the true priority from the priority map's vals. (Note: It might seem a little odd
+that the priority-extraction function is called a *key*fn, even though it is applied to the
+map's values. This terminology is based on the docstring of clojure.core/sort-by, which
+uses `keyfn` for the function which extracts the sort order.)
+
+In the above example,
+
+user=> (priority-map-keyfn first :a [2 :apple], :b [1 :banana], :c [3 :carrot])
+{:b [1 :banana], :a [2 :apple], :c [3 :carrot]}
+
+You can also combine a keyfn with a comparator that operates on the extracted priorities:
+
+user=> (priority-map-keyfn-by
+ first >
+ :a [2 :apple], :b [1 :banana], :c [3 :carrot])
+{:c [3 :carrot], :a [2 :apple], :b [1 :banana]}
+
+
+
+All of these operations are efficient. Generally speaking, most operations
+are O(log n) where n is the number of distinct priorities. Some operations
+(for example, straightforward lookup of an item's priority, or testing
+whether a given item is in the priority map) are as efficient
+as Clojure's built-in map.
+
+The key to this efficiency is that internally, not only does the priority map store
+an ordinary hash map of items to priority, but it also stores a sorted map that
+maps priorities to sets of items with that priority.
+
+A typical textbook priority queue data structure supports at the ability to add
+a [item priority] pair to the queue, and to pop/peek the next [item priority] pair.
+But many real-world applications of priority queues require more features, such
+as the ability to test whether something is already in the queue, or to reassign
+a priority. For example, a standard formulation of Dijkstra's algorithm requires the
+ability to reduce the priority number associated with a given item. Once you
+throw persistence into the mix with the desire to adjust priorities, the traditional
+structures just don't work that well.
+
+This particular blend of Clojure's built-in hash sets, hash maps, and sorted maps
+proved to be a great way to implement an especially flexible persistent priority queue.
+
+Connoisseurs of algorithms will note that this structure's peek operation is not O(1) as
+it would be if based upon a heap data structure, but I feel this is a small concession for
+the blend of persistence, priority reassignment, and priority-sorted seq, which can be
+quite expensive to achieve with a heap (I did actually try this for comparison). Furthermore,
+this peek's logarithmic behavior is quite good (on my computer I can do a million
+peeks at a priority map with a million items in 750ms). Also, consider that peek and pop
+usually follow one another, and even with a heap, pop is logarithmic. So the net combination
+of peek and pop is not much different between this versatile formulation of a priority map and
+a more limited heap-based one. In a nutshell, peek, although not O(1), is unlikely to be the
+bottleneck in your program.
+
+All in all, I hope you will find priority maps to be an easy-to-use and useful addition
+to Clojure's assortment of built-in maps (hash-map and sorted-map).
+"}
+ clojure.data.priority-map
+ (:refer-clojure :exclude [subseq rsubseq])
+ (:import clojure.lang.MapEntry clojure.lang.PersistentTreeMap)) ;;; java.util.Map
+
+(declare pm-empty)
+
+(defmacro apply-keyfn [x]
+ `(if ~'keyfn (~'keyfn ~x) ~x))
+
+(defmacro ^:private compile-if [test then else]
+ (if (eval test)
+ then
+ else))
+
+;; We create a patched version of subseq and rsubseq from core, that works on ordinary sorted collections, as well as priority maps
+;; See https://dev.clojure.org/jira/browse/CLJ-428
+
+(defn mk-bound-fn
+ {:private true}
+ [^clojure.lang.Sorted sc test key]
+ (fn [e] (test (.. sc comparator (Compare (. sc entryKey e) key)) 0))) ;;; compare
+
+(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"
+ ([^clojure.lang.Sorted sc test key]
+ (let [include (mk-bound-fn sc test key)]
+ (if (#{> >=} test)
+ (when-let [[e :as s] (. sc seqFrom key true)]
+ (seq (drop-while #(not (include %)) s)))
+ (seq (take-while include (. sc seq true))))))
+ ([^clojure.lang.Sorted sc start-test start-key end-test end-key]
+ (when-let [[e :as s] (. sc seqFrom start-key true)]
+ (seq (take-while (mk-bound-fn sc end-test end-key)
+ (drop-while (complement (mk-bound-fn sc start-test start-key)) 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"
+ ([^clojure.lang.Sorted sc test key]
+ (let [include (mk-bound-fn sc test key)]
+ (if (#{< <=} test)
+ (when-let [[e :as s] (. sc seqFrom key false)]
+ (seq (drop-while #(not (include %)) s)))
+ (seq (take-while include (. sc seq false))))))
+ ([^clojure.lang.Sorted sc start-test start-key end-test end-key]
+ (when-let [[e :as s] (. sc seqFrom end-key false)]
+ (seq (take-while (mk-bound-fn sc start-test start-key)
+ (drop-while (complement (mk-bound-fn sc end-test end-key)) s))))))
+
+;; A Priority Map is comprised of a sorted map that maps priorities to hash sets of items
+;; with that priority (priority->set-of-items),
+;; as well as a hash map that maps items to priorities (item->priority)
+;; Priority maps may also have metadata
+;; Priority maps can also have a keyfn which is applied to the "priorities" found as values in
+;; the item->priority map to get the actual sortable priority keys used in priority->set-of-items.
+
+(deftype PersistentPriorityMap [priority->set-of-items item->priority _meta keyfn]
+ Object
+ (ToString [this] (str (.seq ^clojure.lang.Seqable this))) ;;; toString + added ^PersistentPriorityMap
+
+ clojure.lang.ILookup
+ ;; valAt gives (get pm key) and (get pm key not-found) behavior
+ (valAt [this item] (get item->priority item))
+ (valAt [this item not-found] (get item->priority item not-found))
+
+ clojure.lang.IPersistentMap
+ (count [this] (count item->priority))
+
+ (clojure.lang.IPersistentMap.assoc [this item priority] ;;; clojure.lang.IPersistentMap. added
+ (let [current-priority (get item->priority item nil)]
+ (if current-priority
+ ;;Case 1 - item is already in priority map, so this is a reassignment
+ (if (= current-priority priority)
+ ;;Subcase 1 - no change in priority, do nothing
+ this
+ (let [priority-key (apply-keyfn priority)
+ current-priority-key (apply-keyfn current-priority)
+ item-set (get priority->set-of-items current-priority-key)]
+ (if (= (count item-set) 1)
+ ;;Subcase 2 - it was the only item of this priority
+ ;;so remove old priority entirely
+ ;;and conj item onto new priority's set
+ (PersistentPriorityMap.
+ (assoc (dissoc priority->set-of-items current-priority-key)
+ priority-key (conj (get priority->set-of-items priority-key #{}) item))
+ (assoc item->priority item priority)
+ (meta this)
+ keyfn)
+ ;;Subcase 3 - there were many items associated with the item's original priority,
+ ;;so remove it from the old set and conj it onto the new one.
+ (PersistentPriorityMap.
+ (assoc priority->set-of-items
+ current-priority-key (disj (get priority->set-of-items current-priority-key) item)
+ priority-key (conj (get priority->set-of-items priority-key #{}) item))
+ (assoc item->priority item priority)
+ (meta this)
+ keyfn))))
+ ;; Case 2: Item is new to the priority map, so just add it.
+ (let [priority-key (apply-keyfn priority)]
+ (PersistentPriorityMap.
+ (assoc priority->set-of-items
+ priority-key (conj (get priority->set-of-items priority-key #{}) item))
+ (assoc item->priority item priority)
+ (meta this)
+ keyfn)))))
+
+ (empty [this] (PersistentPriorityMap. (empty priority->set-of-items) {} _meta keyfn))
+
+ ;; cons defines conj behavior
+ (clojure.lang.IPersistentMap.cons [this e] ;;; clojure.lang.IPersistentMap. added
+ (if (map? e)
+ (into this e)
+ (let [[item priority] e] (.assoc this item priority))))
+
+
+ ;; Like sorted maps, priority maps are equal to other maps provided
+ ;; their key-value pairs are the same.
+ (equiv [this o] (= item->priority o))
+ (GetHashCode [this] (.GetHashCode item->priority)) ;;; hashCode .hashCode
+ (Equals [this o] (or (identical? this o) (.Equals item->priority o))) ;;; equals .Equals
+
+ ;;containsKey implements (contains? pm k) behavior
+ (containsKey [this item] (contains? item->priority item))
+
+ (entryAt [this k]
+ (let [v (.valAt this k this)]
+ (when-not (identical? v this)
+ (MapEntry. k v))))
+
+ (seq [this]
+ (if keyfn
+ (seq (for [[priority item-set] priority->set-of-items, item item-set]
+ (MapEntry. item (item->priority item))))
+ (seq (for [[priority item-set] priority->set-of-items, item item-set]
+ (MapEntry. item priority)))))
+
+ ;;without implements (dissoc pm k) behavior
+ (without
+ [this item]
+ (let [priority (item->priority item ::not-found)]
+ (if (= priority ::not-found)
+ ;; If item is not in map, return the map unchanged.
+ this
+ (let [priority-key (apply-keyfn priority)
+ item-set (priority->set-of-items priority-key)]
+ (if (= (count item-set) 1)
+ ;;If it is the only item with this priority, remove that priority's set completely
+ (PersistentPriorityMap. (dissoc priority->set-of-items priority-key)
+ (dissoc item->priority item)
+ (meta this)
+ keyfn)
+ ;;Otherwise, just remove the item from the priority's set.
+ (PersistentPriorityMap.
+ (assoc priority->set-of-items priority-key (disj item-set item)),
+ (dissoc item->priority item)
+ (meta this)
+ keyfn))))))
+
+ ;;; Had to add the IPersistentCollection methods because of the masking of IPersistentCollection.cons by IPersistenMap.cons -- need to be smarter in the deftype -- someday -- major sigh
+ clojure.lang.IPersistentCollection
+ (count [this] (count item->priority))
+ (clojure.lang.IPersistentCollection.cons [this e]
+ (if (map? e)
+ (into this e)
+ (let [[item priority] e] (assoc this item priority))))
+ (empty [this] (PersistentPriorityMap. (empty priority->set-of-items) {} _meta keyfn))
+ (equiv [this o] (= item->priority o))
+
+ ;;; Similarly for Associative // assoc
+ clojure.lang.Associative
+ (containsKey [this item] (contains? item->priority item))
+ (entryAt [this k]
+ (let [v (.valAt this k this)]
+ (when-not (identical? v this)
+ (MapEntry. k v))))
+ (clojure.lang.Associative.assoc [this k v] (.assoc ^clojure.lang.IPersistentMap this k v))
+
+
+ clojure.lang.IHashEq
+ (hasheq [this]
+ (compile-if (resolve 'clojure.core/hash-unordered-coll)
+ (hash-unordered-coll this)
+ (.GetHashCode this))) ;;; .hashCode
+
+ ;;; We need to attach at attribute -- I have to look up how to do this ;;; java.io.Serializable ;Serialization comes for free with the other things implemented
+ clojure.lang.MapEquivalence
+
+ System.Collections.IDictionary
+ (get_IsFixedSize [this] false)
+ (get_IsReadOnly [this] true)
+ (get_Keys [this] (keys this))
+ (get_Values [this] (vals this))
+ (get_Item [this key] (.valAt this key))
+ (Add [this k v] (throw (NotImplementedException.)))
+ (Clear [this] (throw (NotImplementedException.)))
+ (Contains [this key] (contains? item->priority key))
+ (System.Collections.IDictionary.GetEnumerator [this] (clojure.lang.MapEnumerator. ^clojure.lang.IPersistentMap this ))
+ (Remove [this key] (throw (NotImplementedException.)))
+ (get_IsSynchronized [this] true)
+ (get_Count [this] (count item->priority))
+ (get_SyncRoot [this] this)
+ (CopyTo [this array index] (throw (NotImplementedException.))) ;;; TODO -- when I'm feeling less lazy
+
+
+ ;;; Map ;Makes this compatible with java's map
+ ;;;(size [this] (count item->priority))
+ ;;;(isEmpty [this] (zero? (count item->priority)))
+ ;;;(containsValue [this v]
+ ;;; (if keyfn
+ ;;; (some (partial = v) (vals this)) ; no shortcut if there is a keyfn
+ ;;; (contains? priority->set-of-items v)))
+ ;;;(get [this k] (.valAt this k))
+ ;;;(put [this k v] (throw (NotImplementedException.))) ;;; UnsupportedOperationException
+ ;;;(remove [this k] (throw (NotImplementedException.))) ;;; UnsupportedOperationException
+ ;;;(putAll [this m] (throw (NotImplementedException.))) ;;; UnsupportedOperationException
+ ;;;(clear [this] (throw (NotImplementedException.))) ;;; UnsupportedOperationException
+ ;;;(keySet [this] (set (keys this)))
+ ;;;(values [this] (vals this))
+ ;;;(entrySet [this] (set this))
+
+ System.Collections.IEnumerable ;;; Iterable
+ (System.Collections.IEnumerable.GetEnumerator [this] (clojure.lang.SeqEnumerator. (seq this))) ;;; iterator SeqIterator.
+
+ clojure.core.protocols/IKVReduce
+ (kv-reduce [this f init]
+ (if keyfn
+ (reduce-kv (fn [a k v]
+ (reduce (fn [a v] (f a v (item->priority v))) a v))
+ init priority->set-of-items)
+ (reduce-kv (fn [a k v]
+ (reduce (fn [a v] (f a v k)) a v))
+ init priority->set-of-items)))
+
+ clojure.lang.IPersistentStack
+ (peek [this]
+ (when-not (= (count item->priority) 0) ;;; (.isEmpty this)
+ (let [f (first priority->set-of-items)
+ item (first (val f))]
+ (if keyfn
+ (MapEntry. item (item->priority item))
+ (MapEntry. item (key f))))))
+
+ (pop [this]
+ (if (= (count item->priority) 0) (throw (InvalidOperationException. "Can't pop empty priority map")) ;;; (.isEmpty this) IllegalStateException.
+ (let [f (first priority->set-of-items),
+ item-set (val f)
+ item (first item-set),
+ priority-key (key f)]
+ (if (= (count item-set) 1)
+ ;;If the first item is the only item with its priority, remove that priority's set completely
+ (PersistentPriorityMap.
+ (dissoc priority->set-of-items priority-key)
+ (dissoc item->priority item)
+ (meta this)
+ keyfn)
+ ;;Otherwise, just remove the item from the priority's set.
+ (PersistentPriorityMap.
+ (assoc priority->set-of-items priority-key (disj item-set item)),
+ (dissoc item->priority item)
+ (meta this)
+ keyfn)))))
+
+ clojure.lang.IFn
+ ;;makes priority map usable as a function
+ (invoke [this k] (.valAt this k))
+ (invoke [this k not-found] (.valAt this k not-found))
+
+ clojure.lang.IObj
+ ;;adds metadata support
+ (meta [this] _meta)
+ (withMeta [this m] (PersistentPriorityMap. priority->set-of-items item->priority m keyfn))
+
+ clojure.lang.Reversible
+ (rseq [this]
+ (if keyfn
+ (seq (for [[priority item-set] (rseq priority->set-of-items), item item-set]
+ (MapEntry. item (item->priority item))))
+ (seq (for [[priority item-set] (rseq priority->set-of-items), item item-set]
+ (MapEntry. item priority)))))
+
+ clojure.lang.Sorted
+ ;; These methods provide support for subseq and rsubseq
+ (comparator [this] (.comparator ^PersistentTreeMap priority->set-of-items))
+ (entryKey [this entry] (if keyfn (keyfn (val entry)) (val entry)))
+ (seqFrom [this k ascending]
+ (let [sets (if ascending (subseq priority->set-of-items >= k) (rsubseq priority->set-of-items <= k))]
+ (if keyfn
+ (seq (for [[priority item-set] sets, item item-set]
+ (MapEntry. item (item->priority item))))
+ (seq (for [[priority item-set] sets, item item-set]
+ (MapEntry. item priority))))))
+ (seq [this ascending]
+ (if ascending (seq this) (rseq this))))
+
+(def ^:private pm-empty (PersistentPriorityMap. (sorted-map) {} {} nil))
+(defn- pm-empty-by [comparator] (PersistentPriorityMap. (sorted-map-by comparator) {} {} nil))
+(defn- pm-empty-keyfn
+ ([keyfn] (PersistentPriorityMap. (sorted-map) {} {} keyfn))
+ ([keyfn comparator] (PersistentPriorityMap. (sorted-map-by comparator) {} {} keyfn)))
+
+
+;; The main way to build priority maps
+(defn priority-map
+ "Usage: (priority-map key val key val ...)
+ Returns a new priority map with optional supplied mappings.
+ (priority-map) returns an empty priority map."
+ [& keyvals]
+ {:pre [(even? (count keyvals))]}
+ (reduce conj pm-empty (partition 2 keyvals)))
+
+(defn priority-map-by
+ "Usage: (priority-map comparator key val key val ...)
+ Returns a new priority map with custom comparator and optional supplied mappings.
+ (priority-map-by comparator) yields an empty priority map with custom comparator."
+ [comparator & keyvals]
+ {:pre [(even? (count keyvals))]}
+ (reduce conj (pm-empty-by comparator) (partition 2 keyvals)))
+
+(defn priority-map-keyfn
+ "Usage: (priority-map-keyfn keyfn key val key val ...)
+ Returns a new priority map with custom keyfn and optional supplied mappings.
+ The priority is determined by comparing (keyfn val).
+ (priority-map-keyfn keyfn) yields an empty priority map with custom keyfn."
+ [keyfn & keyvals]
+ {:pre [(even? (count keyvals))]}
+ (reduce conj (pm-empty-keyfn keyfn) (partition 2 keyvals)))
+
+(defn priority-map-keyfn-by
+ "Usage: (priority-map-keyfn-by keyfn comparator key val key val ...)
+ Returns a new priority map with custom keyfn, custom comparator, and optional supplied mappings.
+ The priority is determined by comparing (keyfn val).
+ (priority-map-keyfn-by keyfn comparator) yields an empty priority map with custom keyfn and comparator."
+ [keyfn comparator & keyvals]
+ {:pre [(even? (count keyvals))]}
+ (reduce conj (pm-empty-keyfn keyfn comparator) (partition 2 keyvals)))
+
+(defn priority->set-of-items
+ "Takes a priority map p, and returns a sorted map from each priority
+ to the set of items with that priority in p"
+ [^PersistentPriorityMap p]
+ (.priority->set-of-items p))
diff --git a/typed/clj.analyzer/src/typed/clj/analyzer.clj b/typed/clj.analyzer/src/typed/clj/analyzer.cljc
similarity index 91%
rename from typed/clj.analyzer/src/typed/clj/analyzer.clj
rename to typed/clj.analyzer/src/typed/clj/analyzer.cljc
index dd1ebdd8e..5ea4f8bde 100644
--- a/typed/clj.analyzer/src/typed/clj/analyzer.clj
+++ b/typed/clj.analyzer/src/typed/clj/analyzer.cljc
@@ -26,7 +26,7 @@
[typed.clj.analyzer.passes.infer-tag :as infer-tag]
[typed.clj.analyzer.passes.validate :as validate]
[typed.clj.analyzer.utils :as ju])
- (:import [clojure.lang IObj RT Var Compiler$LocalBinding]))
+ (:import [clojure.lang IObj RT Var]))
(def ^:dynamic *parse-deftype-with-existing-class*
"If true, don't generate a new class when analyzing deftype* if a class
@@ -67,18 +67,18 @@
(meta form)))
(cond
- (.startsWith opname ".") ; (.foo bar ..)
+ (#?(:cljr .StartsWith :default .startsWith) opname ".") ; (.foo bar ..)
(let [[target & args] expr
target (if-let [target (ju/maybe-class-literal target)]
(with-meta (list 'do target)
- {:tag 'java.lang.Class})
+ {:tag #?(:cljr 'System.Type :default 'java.lang.Class)})
target)
args (list* (symbol (subs opname 1)) args)]
(with-meta (list '. target (if (= 1 (count args)) ;; we don't know if (.foo bar) is
(first args) args)) ;; a method call or a field access
(meta form)))
- (.endsWith opname ".") ;; (class. ..)
+ (#?(:cljr .EndsWith :default .endsWith) opname ".") ;; (class. ..)
(with-meta (list* 'new (symbol (subs opname 0 (dec (count opname)))) expr)
(meta form))
@@ -239,7 +239,7 @@
(ju/special-arrays (str t)))
t
(if-let [c (ju/maybe-class t)]
- (let [new-t (-> c .getName symbol)]
+ (let [new-t (-> c #?(:cljr .FullName :default .getName) symbol)]
(if (= new-t t)
t
(with-meta new-t {::qualified? true})))
@@ -361,7 +361,7 @@
(memo/memo-clear! ju/members* [arg])
(memo/memo-clear! ju/members* [(str arg)]))
- (let [interfaces (mapv #(symbol (.getName ^Class %)) interfaces)]
+ (let [interfaces (mapv #(symbol #?(:cljr (.FullName ^Type %) :default (.getName ^Class %))) interfaces)]
(eval (list 'let []
(list 'deftype* cname class-name args :implements interfaces)
(list 'import class-name)))))
@@ -567,20 +567,20 @@
([form] (analyze form (empty-env) {}))
([form env] (analyze form env {}))
([form env opts]
- (with-bindings (into {Compiler/LOADER (RT/makeClassLoader)
- #'ana/macroexpand-1 macroexpand-1
- #'ana/create-var create-var
- #'ana/scheduled-passes @scheduled-default-passes
- #'ana/parse parse
- #'ana/var? var?
- #'ana/resolve-ns resolve-ns
- #'ana/resolve-sym resolve-sym
- #'ana/unanalyzed unanalyzed
- #'ana/analyze-outer analyze-outer
- #'ana/current-ns-name current-ns-name
- ;#'*ns* (the-ns (:ns env))
- }
- (:bindings opts))
+ (with-bindings (-> {#'ana/macroexpand-1 macroexpand-1
+ #'ana/create-var create-var
+ #'ana/scheduled-passes @scheduled-default-passes
+ #'ana/parse parse
+ #'ana/var? var?
+ #'ana/resolve-ns resolve-ns
+ #'ana/resolve-sym resolve-sym
+ #'ana/unanalyzed unanalyzed
+ #'ana/analyze-outer analyze-outer
+ #'ana/current-ns-name current-ns-name
+ ;#'*ns* (the-ns (:ns env))
+ }
+ #?@(:cljr [] :default [(assoc Compiler/LOADER (RT/makeClassLoader))])
+ (into (:bindings opts)))
(env/ensure (global-env)
(env/with-env (u/mmerge (env/deref-env) {:passes-opts (get opts :passes-opts default-passes-opts)})
(ana/run-passes (ana/unanalyzed form env)))))))
@@ -598,21 +598,21 @@
(assoc ast :result result)))
(defn default-thread-bindings [env]
- {Compiler/LOADER (RT/makeClassLoader)
- #'ana/macroexpand-1 macroexpand-1
- #'ana/create-var create-var
- #'ana/scheduled-passes @scheduled-default-passes
- #'ana/parse parse
- #'ana/var? var?
- #'ana/resolve-ns resolve-ns
- #'ana/resolve-sym resolve-sym
- #'ana/var->sym var->sym
- #'ana/eval-ast eval-ast2
- #'ana/current-ns-name current-ns-name
- #'ana/analyze-outer analyze-outer
- #'ana/unanalyzed unanalyzed
- ;#'*ns* (the-ns (:ns env))
- })
+ (-> {#'ana/macroexpand-1 macroexpand-1
+ #'ana/create-var create-var
+ #'ana/scheduled-passes @scheduled-default-passes
+ #'ana/parse parse
+ #'ana/var? var?
+ #'ana/resolve-ns resolve-ns
+ #'ana/resolve-sym resolve-sym
+ #'ana/var->sym var->sym
+ #'ana/eval-ast eval-ast2
+ #'ana/current-ns-name current-ns-name
+ #'ana/analyze-outer analyze-outer
+ #'ana/unanalyzed unanalyzed
+ ;#'*ns* (the-ns (:ns env))
+ }
+ #?@(:cljr [] :default [(assoc Compiler/LOADER (RT/makeClassLoader))])))
(defmethod emit-form/-emit-form :unanalyzed
[{:keys [form] :as ast} opts]
@@ -664,13 +664,13 @@
:as opts}]
(env/ensure (global-env)
(let [env (merge env (u/-source-info form env))
- [mform raw-forms] (with-bindings {Compiler/LOADER (RT/makeClassLoader)
- ;#'*ns* (the-ns (:ns env))
- #'ana/resolve-ns resolve-ns
- #'ana/resolve-sym resolve-sym
- #'ana/current-ns-name current-ns-name
- #'ana/macroexpand-1 (get-in opts [:bindings #'ana/macroexpand-1]
- macroexpand-1)}
+ [mform raw-forms] (with-bindings (-> {;#'*ns* (the-ns (:ns env))
+ #'ana/resolve-ns resolve-ns
+ #'ana/resolve-sym resolve-sym
+ #'ana/current-ns-name current-ns-name
+ #'ana/macroexpand-1 (get-in opts [:bindings #'ana/macroexpand-1]
+ macroexpand-1)}
+ #?@(:cljr [] :default [(assoc Compiler/LOADER (RT/makeClassLoader))]))
(loop [form form raw-forms []]
(let [mform (if (stop-gildardi-check form env)
form
diff --git a/typed/clj.analyzer/src/typed/clj/analyzer/passes/analyze_host_expr.clj b/typed/clj.analyzer/src/typed/clj/analyzer/passes/analyze_host_expr.cljc
similarity index 97%
rename from typed/clj.analyzer/src/typed/clj/analyzer/passes/analyze_host_expr.clj
rename to typed/clj.analyzer/src/typed/clj/analyzer/passes/analyze_host_expr.cljc
index b593ade2e..12c1d4a3b 100644
--- a/typed/clj.analyzer/src/typed/clj/analyzer/passes/analyze_host_expr.clj
+++ b/typed/clj.analyzer/src/typed/clj/analyzer/passes/analyze_host_expr.cljc
@@ -169,8 +169,8 @@
(u/maybe-class-literal (:form target)))]
(merge target
(assoc (ana/analyze-const the-class env :class)
- :tag Class
- :o-tag Class))
+ :tag #?(:cljr Type :default Class)
+ :o-tag #?(:cljr Type :default Class)))
target)
class? (and (= :const (:op target))
(= :class (:type target))
@@ -194,7 +194,7 @@
{:tag tag})))
:var
(if-let [the-class (and (not (namespace form))
- (pos? (.indexOf (str form) "."))
+ (pos? (#?(:cljr .IndexOf :default .indexOf) (str form) "."))
(u/maybe-class-literal form))]
(assoc (ana/analyze-const the-class env :class) :form form)
ast)
diff --git a/typed/clj.analyzer/src/typed/clj/analyzer/passes/annotate_host_info.clj b/typed/clj.analyzer/src/typed/clj/analyzer/passes/annotate_host_info.cljc
similarity index 86%
rename from typed/clj.analyzer/src/typed/clj/analyzer/passes/annotate_host_info.clj
rename to typed/clj.analyzer/src/typed/clj/analyzer/passes/annotate_host_info.cljc
index 356328eba..81c1fd3f8 100644
--- a/typed/clj.analyzer/src/typed/clj/analyzer/passes/annotate_host_info.clj
+++ b/typed/clj.analyzer/src/typed/clj/analyzer/passes/annotate_host_info.cljc
@@ -15,6 +15,17 @@
[typed.cljc.analyzer.utils :as cu]
[typed.clj.analyzer.utils :as ju]))
+#?(
+:cljr
+
+;;; Added this to deal with explicit interface implementation.
+(defn explicit-implementation-name-matches
+ [impl-method-name interface-method-name]
+ (let [member-name (str impl-method-name )
+ i (.LastIndexOf member-name ".")]
+ (and (pos? i) (= (subs member-name (inc i)) (str interface-method-name)))))
+)
+
(defn annotate-host-info
"Adds a :methods key to reify/deftype :methods info representing
the reflected informations for the required methods, replaces
@@ -40,7 +51,8 @@
()
(let [nm? (ju/name-matches? name)]
(filter #(and (= argc (count (:parameter-types %)))
- (nm? (:name %)))
+ (or (nm? (:name %))
+ #?(:cljr (explicit-implementation-name-matches name (:name %)))))
all-methods))))))
methods)))
@@ -50,7 +62,7 @@
(and (= :const (:op class))
(= :default (:form class)))
- Throwable
+ #?(:cljr Exception :default Throwable)
(= :maybe-class (:op class))
(ju/maybe-class-literal (:class class)))
@@ -59,8 +71,8 @@
(-> ast
(assoc :class (assoc (ana/analyze-const the-class env :class)
:form (:form class)
- :tag Class
- :o-tag Class)))
+ :tag #?(:cljr Type :default Class)
+ :o-tag #?(:cljr Type :default Class))))
ast)]
(assoc-in ast [:local :tag] (-> ast :class :val)))
@@ -85,7 +97,7 @@
(= arg-tags (mapv ju/maybe-class parameter-types)))) rest))
(assoc (dissoc ast :interfaces :methods)
:bridges (filter #(and (= arg-tags (mapv ju/maybe-class (:parameter-types %)))
- (.isAssignableFrom (ju/maybe-class (:return-type %)) ret-tag))
+ (#?(:cljr .IsAssignableFrom :default .isAssignableFrom) (ju/maybe-class (:return-type %)) ret-tag))
(disj methods-set (dissoc m :declaring-class :flags)))
:methods methods
:interface i-tag
diff --git a/typed/clj.analyzer/src/typed/clj/analyzer/passes/annotate_tag.clj b/typed/clj.analyzer/src/typed/clj/analyzer/passes/annotate_tag.cljc
similarity index 94%
rename from typed/clj.analyzer/src/typed/clj/analyzer/passes/annotate_tag.clj
rename to typed/clj.analyzer/src/typed/clj/analyzer/passes/annotate_tag.cljc
index 925a4dc79..8f9297e91 100644
--- a/typed/clj.analyzer/src/typed/clj/analyzer/passes/annotate_tag.clj
+++ b/typed/clj.analyzer/src/typed/clj/analyzer/passes/annotate_tag.cljc
@@ -39,7 +39,7 @@
(assoc ast :o-tag t :tag t))
:char
- (assoc ast :o-tag Character/TYPE :tag Character/TYPE)
+ (assoc ast :o-tag #?(:cljr Char :default Character/TYPE) :tag #?(:cljr Char :default Character/TYPE))
:seq
(assoc ast :o-tag ISeq :tag ISeq)
@@ -54,7 +54,7 @@
(and (= :arg local) variadic? ISeq)
o-tag
Object)
- o-tag (if (#{Void Void/TYPE} o-tag)
+ o-tag (if (#?(:cljr #{Void} :default #{Void Void/TYPE}) o-tag)
Object
o-tag)]
(if-let [tag (or (:tag (meta form)) tag)]
diff --git a/typed/clj.analyzer/src/typed/clj/analyzer/passes/beta_reduce.clj b/typed/clj.analyzer/src/typed/clj/analyzer/passes/beta_reduce.cljc
similarity index 99%
rename from typed/clj.analyzer/src/typed/clj/analyzer/passes/beta_reduce.clj
rename to typed/clj.analyzer/src/typed/clj/analyzer/passes/beta_reduce.cljc
index 63a0344c5..c9ecbdf6b 100644
--- a/typed/clj.analyzer/src/typed/clj/analyzer/passes/beta_reduce.clj
+++ b/typed/clj.analyzer/src/typed/clj/analyzer/passes/beta_reduce.cljc
@@ -122,8 +122,8 @@
:max-count (count (:val ast))}])
:do (splice-seqable-expr (:ret ast))
(:let :let-fn) (splice-seqable-expr (:body ast))
- :new (let [cls ^Class (:class ast)
- csym (symbol (.getName cls))]
+ :new (let [cls ^#?(:cljr Type :default Class) (:class ast)
+ csym (symbol #?(:cljr (.FullName cls) :default (.getName cls)))]
(case csym
;; TODO needs testing
;clojure.lang.LazySeq (let [body (-> ast :args first :methods first :body)]
diff --git a/typed/clj.analyzer/src/typed/clj/analyzer/passes/classify_invoke.clj b/typed/clj.analyzer/src/typed/clj/analyzer/passes/classify_invoke.cljc
similarity index 96%
rename from typed/clj.analyzer/src/typed/clj/analyzer/passes/classify_invoke.clj
rename to typed/clj.analyzer/src/typed/clj/analyzer/passes/classify_invoke.cljc
index 7fbfc8b04..b8454e52d 100644
--- a/typed/clj.analyzer/src/typed/clj/analyzer/passes/classify_invoke.clj
+++ b/typed/clj.analyzer/src/typed/clj/analyzer/passes/classify_invoke.cljc
@@ -69,8 +69,8 @@
:target (second args)
:form form
:env env
- :o-tag Boolean/TYPE
- :tag (or tag Boolean/TYPE)
+ :o-tag #?(:cljr Boolean :default Boolean/TYPE)
+ :tag (or tag #?(:cljr Boolean :default Boolean/TYPE))
:children [:target]})
(and var? (cu/protocol-node? the-var (:meta the-fn)))
diff --git a/typed/clj.analyzer/src/typed/clj/analyzer/passes/emit_form.clj b/typed/clj.analyzer/src/typed/clj/analyzer/passes/emit_form.cljc
similarity index 96%
rename from typed/clj.analyzer/src/typed/clj/analyzer/passes/emit_form.clj
rename to typed/clj.analyzer/src/typed/clj/analyzer/passes/emit_form.cljc
index e98ef3482..7285b92f3 100644
--- a/typed/clj.analyzer/src/typed/clj/analyzer/passes/emit_form.clj
+++ b/typed/clj.analyzer/src/typed/clj/analyzer/passes/emit_form.cljc
@@ -49,7 +49,7 @@
[{:keys [type val] :as ast} opts]
(if (and (= type :class)
(:qualified-symbols opts))
- (symbol (.getName ^Class val))
+ (symbol #?(:cljr (.FullName ^Type val) :default (.getName ^Class val)))
(default/-emit-form ast opts)))
(defmethod -emit-form :monitor-enter
@@ -79,12 +79,12 @@
(defn class->str [class]
(if (symbol? class)
(name class)
- (.getName ^Class class)))
+ #?(:cljr (.FullName ^Type class) :default (.getName ^Class class))))
(defn class->sym [class]
(if (symbol? class)
class
- (symbol (.getName ^Class class))))
+ (symbol #?(:cljr (.FullName ^Type class) :default (.getName ^Class class)))))
(defmethod -emit-form :catch
[{:keys [class local body]} opts]
diff --git a/typed/clj.analyzer/src/typed/clj/analyzer/passes/infer_tag.clj b/typed/clj.analyzer/src/typed/clj/analyzer/passes/infer_tag.cljc
similarity index 98%
rename from typed/clj.analyzer/src/typed/clj/analyzer/passes/infer_tag.clj
rename to typed/clj.analyzer/src/typed/clj/analyzer/passes/infer_tag.cljc
index efa0f656b..52d2bce52 100644
--- a/typed/clj.analyzer/src/typed/clj/analyzer/passes/infer_tag.clj
+++ b/typed/clj.analyzer/src/typed/clj/analyzer/passes/infer_tag.cljc
@@ -109,7 +109,7 @@
(let [tag (:tag body)]
(-> ast
(assoc :o-tag tag
- :tag (if (#{Void Void/TYPE} tag)
+ :tag (if (#?(:cljr #{Void} :default #{Void Void/TYPE}) tag)
Object
tag))
(into (select-keys body [:return-tag :arglists])))))
@@ -207,7 +207,7 @@
(:tag (meta (:form local))))
body-tag (:tag body)
tag (or annotated-tag body-tag)
- tag (if (#{Void Void/TYPE} tag)
+ tag (if (#?(:cljr #{Void} :default #{Void Void/TYPE}) tag)
Object
tag)]
(-> ast
diff --git a/typed/clj.analyzer/src/typed/clj/analyzer/passes/validate.clj b/typed/clj.analyzer/src/typed/clj/analyzer/passes/validate.cljc
similarity index 93%
rename from typed/clj.analyzer/src/typed/clj/analyzer/passes/validate.clj
rename to typed/clj.analyzer/src/typed/clj/analyzer/passes/validate.cljc
index a215ffa27..95e98b501 100644
--- a/typed/clj.analyzer/src/typed/clj/analyzer/passes/validate.clj
+++ b/typed/clj.analyzer/src/typed/clj/analyzer/passes/validate.cljc
@@ -29,7 +29,7 @@
[{:keys [class env] :as ast}]
(if-let [handle (-> (env/deref-env) :passes-opts :validate/unresolvable-symbol-handler)]
(handle nil class ast)
- (if (not (.contains (str class) "."))
+ (if (not (#?(:cljr .Contains :default .contains) (str class) "."))
(throw (ex-info (str "Could not resolve var: " class)
(into {:var class}
(cu/source-info env))))
@@ -69,8 +69,8 @@
(into {:class (:form (:class ast))
:ast ast}
(cu/source-info (:env ast)))))
- (let [^Class class (-> ast :class :val)
- c-name (symbol (.getName class))
+ (let [^#?(:cljr Type :default Class) class (-> ast :class :val)
+ c-name #?(:cljr '.ctor :default (symbol (.getName class))) ;; ;; in .NET, ctors are named .ctor, not with the class name
argc (count args)
tags (mapv :tag args)]
(let [[ctor & rest] (->> (filter #(= (count (:parameter-types %)) argc)
@@ -162,9 +162,10 @@
(defmethod -validate :import
[{:keys [^String class validated? env form] :as ast}]
(if-not validated?
- (let [class-sym (-> class (subs (inc (.lastIndexOf class "."))) symbol)
+ (let [class-sym (-> class (subs (inc #?(:cljr (.LastIndexOf class ".") :default (.lastIndexOf class ".")))) symbol)
sym-val (ana2/resolve-sym class-sym env)]
- (if (and (class? sym-val) (not= (.getName ^Class sym-val) class)) ;; allow deftype redef
+ (if (and (class? sym-val) (not= #?(:cljr (.FullName ^Type sym-val)
+ :default (.getName ^Class sym-val)) class)) ;; allow deftype redef
(throw (ex-info (str class-sym " already refers to: " sym-val
" in namespace: " (:ns env))
(into {:class class
@@ -179,7 +180,7 @@
[ast]
(when-not (var? (:var ast))
(throw (ex-info (str "Cannot def " (:name ast) " as it refers to the class "
- (.getName ^Class (:var ast)))
+ #?(:cljr (.FullName ^Type (:var ast)) :default (.getName ^Class (:var ast))))
(into {:ast (ast/prewalk ast cleanup/cleanup)}
(cu/source-info (:env ast))))))
(into
@@ -213,7 +214,7 @@
ast)))
(defn validate-interfaces [{:keys [env form interfaces]}]
- (when-not (every? #(.isInterface ^Class %) (disj interfaces Object))
+ (when-not (every? #?(:cljr #(.IsInterface ^Type %) :default #(.isInterface ^Class %)) (disj interfaces Object))
(throw (ex-info "only interfaces or Object can be implemented by deftype/reify"
(into {:interfaces interfaces
:form form}
diff --git a/typed/clj.analyzer/src/typed/clj/analyzer/utils.clj b/typed/clj.analyzer/src/typed/clj/analyzer/utils.cljc
similarity index 60%
rename from typed/clj.analyzer/src/typed/clj/analyzer/utils.clj
rename to typed/clj.analyzer/src/typed/clj/analyzer/utils.cljc
index 6a2ce3c4a..c7275d6ce 100644
--- a/typed/clj.analyzer/src/typed/clj/analyzer/utils.clj
+++ b/typed/clj.analyzer/src/typed/clj/analyzer/utils.cljc
@@ -13,18 +13,31 @@
[clojure.reflect :as reflect]
[clojure.string :as s]
[clojure.core.memoize :refer [lru]]
- [clojure.java.io :as io])
+ #?(:cljr [clojure.clr.io] :default [clojure.java.io :as io]))
(:import (clojure.lang RT Symbol Var)
- org.objectweb.asm.Type))
+ #?(:clj org.objectweb.asm.Type)))
(set! *warn-on-reflection* true)
+#?(
+:cljr
+
(defn ^:private type-reflect
[typeref & options]
(apply reflect/type-reflect typeref
- :reflector (reflect/->JavaReflector (RT/baseLoader))
options))
+:default
+
+(defn ^:private type-reflect
+ [typeref & options]
+ (apply reflect/type-reflect typeref
+ :reflector #?(:cljr (reflect/->ClrReflector nil)
+ :default (reflect/->JavaReflector (RT/baseLoader)))
+ options))
+)
+
+
;difference: use ana2/resolve-sym
(defn macro? [sym env]
(when-let [v (ana2/resolve-sym sym env)]
@@ -40,6 +53,30 @@
(or (not inline-arities-f)
(inline-arities-f (count args)))
(:inline (meta v))))))
+
+#?(
+:cljr
+
+(defn specials [c]
+ (case c
+ "byte" Byte ;;; Byte/TYPE
+ "boolean" Boolean ;;; Boolean/TYPE
+ "char" Char ;;; Character/TYPE
+ "int" Int32 ;;; Integer/TYPE
+ "long" Int64 ;;; Long/TYPE
+ "float" Single ;;; Float/TYPE
+ "double" Double ;;; Double/TYPE
+ "short" Int16 ;;; Short/TYPE
+ "void" System.Void ;;; Void/TYPE
+ "object" Object ;;; DM: Added
+ "decimal" Decimal ;;; DM: Added
+ "sbyte" SByte ;;; DM: Added
+ "ushort" UInt16 ;;; DM: Added
+ "uint" UInt32 ;;; DM: Added
+ "ulong" UInt64 ;;; DM: Added
+ nil))
+
+:default
(defn specials [c]
(case c
@@ -54,6 +91,30 @@
"void" Void/TYPE
"object" Object
nil))
+)
+
+#?(
+:cljr
+
+(defn special-arrays [c]
+ (case c
+ "bytes" |System.Byte[]| ;;; (Class/forName "[B")
+ "booleans" |System.Boolean[]| ;;; (Class/forName "[Z")
+ "chars" |System.Char[]| ;;; (Class/forName "[C")
+ "ints" |System.Int32[]| ;;; (Class/forName "[I")
+ "longs" |System.Int64[]| ;;; (Class/forName "[J")
+ "floats" |System.Single[]| ;;; (Class/forName "[F")
+ "doubles" |System.Double[]| ;;; (Class/forName "[D")
+ "shorts" |System.Int16[]| ;;; (Class/forName "[S")
+ "objects" |System.Object[]| ;;; (Class/forName "[Ljava.lang.Object;")
+ "sbytes" |System.SByte[]| ;;; DM: Added
+ "ushorts" |System.Int16[]| ;;; DM: Added
+ "uints" |System.Int32[]| ;;; DM: Added
+ "ulongs" |System.Int64[]| ;;; DM: Added
+ "decimals" |System.Decimal[]| ;;; DM: Added
+ nil))
+
+:default
(defn special-arrays [c]
(case c
@@ -67,30 +128,38 @@
"shorts" (Class/forName "[S")
"objects" (Class/forName "[Ljava.lang.Object;")
nil))
+)
+
-(defmulti ^Class maybe-class
+(defmulti ^#?(:cljr Type :default Class) maybe-class
"Takes a Symbol, String or Class and tries to resolve to a matching Class"
class)
(defn array-class [element-type]
(RT/classForName
- (str "[" (-> element-type
- maybe-class
- Type/getType
- .getDescriptor
- (.replace \/ \.)))))
+ #?(:cljr (str (-> element-type
+ maybe-class
+ .FullName
+ (.Replace \/ \.))
+ "[]")
+ :default (str "[" (-> element-type
+ maybe-class
+ Type/getType
+ .getDescriptor
+ (.replace \/ \.))))))
+
;difference: always use ana2/resolve-sym
(defn maybe-class-from-string [^String s]
- (or (when-let [maybe-class (and (neg? (.indexOf s "."))
+ (or (when-let [maybe-class (and (neg? (#?(:cljr .IndexOf :default .indexOf) s "."))
(not= \[ (first s))
(ana2/resolve-sym (symbol s) {:ns (ns-name *ns*)}))]
(when (class? maybe-class) maybe-class))
(try (RT/classForName s)
- (catch ClassNotFoundException _))))
+ (catch #?(:cljr Exception :default ClassNotFoundException) _))))
(defmethod maybe-class :default [_] nil)
-(defmethod maybe-class Class [c] c)
+(defmethod maybe-class #?(:cljr Type :default Class) [c] c)
(defmethod maybe-class String [s]
(maybe-class (symbol s)))
@@ -98,7 +167,7 @@
(when-not (namespace sym)
(let [sname (name sym)
snamec (count sname)]
- (if-let [base-type (and (.endsWith sname "<>")
+ (if-let [base-type (and (#?(:cljr .EndsWith :default .endsWith) sname "<>")
(maybe-class (subs sname 0 (- snamec 2))))]
(array-class base-type)
(if-let [ret (or (specials sname)
@@ -115,21 +184,51 @@
(def primitive?
"Returns non-nil if the argument represents a primitive Class other than Void"
- #{Double/TYPE Character/TYPE Byte/TYPE Boolean/TYPE
- Short/TYPE Float/TYPE Long/TYPE Integer/TYPE})
+ #?(:cljr
+ #{Double Char Byte Boolean SByte Decimal
+ Int16 Single Int64 Int32 UInt16 UInt64 UInt32}
+ :default
+ #{Double/TYPE Character/TYPE Byte/TYPE Boolean/TYPE
+ Short/TYPE Float/TYPE Long/TYPE Integer/TYPE}))
(def ^:private convertible-primitives
"If the argument is a primitive Class, returns a set of Classes
to which the primitive Class can be casted"
- {Integer/TYPE #{Integer Long/TYPE Long Short/TYPE Byte/TYPE Object Number}
- Float/TYPE #{Float Double/TYPE Object Number}
- Double/TYPE #{Double Float/TYPE Object Number}
- Long/TYPE #{Long Integer/TYPE Short/TYPE Byte/TYPE Object Number}
- Character/TYPE #{Character Object}
- Short/TYPE #{Short Object Number}
- Byte/TYPE #{Byte Object Number}
- Boolean/TYPE #{Boolean Object}
- Void/TYPE #{Void}})
+ #?(:cljr
+ {Int32 #{Int32 Int64 Int16 Byte SByte}
+ Single #{Single Double}
+ Double #{Double Single}
+ Int64 #{Int64 Int32 Int16 Byte}
+ Char #{Char}
+ Int16 #{Int16}
+ Byte #{Byte}
+ Boolean #{Boolean}
+ UInt32 #{Int32 Int64 Int16 Byte SByte}
+ UInt64 #{Int64 Int32 Int16 Byte}
+ UInt16 #{Int16}
+ SByte #{SByte}
+ Decimal #{Decimal}
+ System.Void #{System.Void}}
+ :default
+ {Integer/TYPE #{Integer Long/TYPE Long Short/TYPE Byte/TYPE Object Number}
+ Float/TYPE #{Float Double/TYPE Object Number}
+ Double/TYPE #{Double Float/TYPE Object Number}
+ Long/TYPE #{Long Integer/TYPE Short/TYPE Byte/TYPE Object Number}
+ Character/TYPE #{Character Object}
+ Short/TYPE #{Short Object Number}
+ Byte/TYPE #{Byte Object Number}
+ Boolean/TYPE #{Boolean Object}
+ Void/TYPE #{Void}}))
+
+#?(
+:cljr
+(defn ^Type box
+ "If the argument is a primitive Class, returns its boxed equivalent,
+ otherwise returns the argument"
+ [c]
+ c)
+
+:default
(defn ^Class box
"If the argument is a primitive Class, returns its boxed equivalent,
@@ -145,6 +244,19 @@
Boolean/TYPE Boolean
Void/TYPE Void}
c c))
+)
+
+
+#?(
+:cljr
+
+(defn ^Type unbox ;;; ^Class
+ "If the argument is a Class with a primitive equivalent, returns that,
+ otherwise returns the argument"
+ [c]
+ c)
+
+:default
(defn ^Class unbox
"If the argument is a Class with a primitive equivalent, returns that,
@@ -160,13 +272,18 @@
Double Double/TYPE,
Void Void/TYPE}
c c))
+)
(defn numeric?
"Returns true if the given class is numeric"
[c]
(when c
- (.isAssignableFrom Number (box c))))
+ #?(:cljr (clojure.lang.Util/IsNumeric ^Type c)
+ :default (.isAssignableFrom Number (box c)))))
+(defmacro assignable-from? [t1 t2]
+ `(#?(:cljr .IsAssignableFrom :default .isAssignableFrom) ~t1 ~t2))
+
(defn subsumes?
"Returns true if c2 is subsumed by c1"
[c1 c2]
@@ -175,7 +292,7 @@
(and (not= c1 c2)
(or (and (not (primitive? c1))
(primitive? c2))
- (.isAssignableFrom c2 c1)))))
+ (assignable-from? c2 c1)))))
(defn convertible?
"Returns true if it's possible to convert from c1 to c2"
@@ -186,21 +303,33 @@
(not (primitive? c2))
(or
(= c1 c2)
- (.isAssignableFrom c2 c1)
+ (assignable-from? c2 c1)
(and (primitive? c2)
((convertible-primitives c2) c1))
(and (primitive? c1)
- (.isAssignableFrom (box c1) c2))))))
+ (assignable-from? (box c1) c2))))))
(def wider-than
"If the argument is a numeric primitive Class, returns a set of primitive Classes
that are narrower than the given one"
- {Long/TYPE #{Integer/TYPE Short/TYPE Byte/TYPE}
- Integer/TYPE #{Short/TYPE Byte/TYPE}
- Float/TYPE #{Integer/TYPE Short/TYPE Byte/TYPE Long/TYPE}
- Double/TYPE #{Integer/TYPE Short/TYPE Byte/TYPE Long/TYPE Float/TYPE}
- Short/TYPE #{Byte/TYPE}
- Byte/TYPE #{}})
+ #?(:cljr
+ {Int64 #{Int32 UInt32 Int16 UInt16 Byte SByte}
+ Int32 #{Int16 UInt16 Byte SByte}
+ Single #{Int32 UInt32 Int16 UInt16 Byte SByte}
+ Double #{Int32 UInt32 Int16 UInt16 Byte SByte Single}
+ Int16 #{Byte SByte}
+ UInt64 #{Int32 UInt32 Int16 UInt16 Byte SByte}
+ UInt32 #{Int16 UInt16 Byte SByte}
+ UInt16 #{Byte SByte}
+ Decimal #{}
+ Byte #{}}
+ :default
+ {Long/TYPE #{Integer/TYPE Short/TYPE Byte/TYPE}
+ Integer/TYPE #{Short/TYPE Byte/TYPE}
+ Float/TYPE #{Integer/TYPE Short/TYPE Byte/TYPE Long/TYPE}
+ Double/TYPE #{Integer/TYPE Short/TYPE Byte/TYPE Long/TYPE Float/TYPE}
+ Short/TYPE #{Byte/TYPE}
+ Byte/TYPE #{}}))
(defn wider-primitive
"Given two numeric primitive Classes, returns the wider one"
@@ -247,7 +376,7 @@
(defn name-matches?
[member]
(let [member-name (str member)
- i (.lastIndexOf member-name ".")
+ i (#?(:cljr .LastIndexOf :default .lastIndexOf) member-name ".")
member-name* (when (pos? i)
(str (s/replace (subs member-name 0 i) "-" "_") (subs member-name i)))
member-name** (s/replace member-name "-" "_")
@@ -270,8 +399,8 @@
(not-any? #{:public :protected} flags))
(-> class
maybe-class
- ^Class (box)
- .getName
+ box
+ #?(:cljr .FullName :default .getName)
symbol
(type-reflect :ancestors true)
:members)))))))
@@ -327,13 +456,33 @@
[tag]
(if (and tag (primitive? tag))
tag
- java.lang.Object))
+ #?(:cljr System.Object :default java.lang.Object)))
+
+#?(
+:cljr
+
+;;; We have to work a lot harder on this one.
+;;; The idea is that if (in Java) tags is Long Object Double Object, then you extract LODO and look up "clojure.lang.IFn$LODO" to see if it is a class.
+;;; This would be one of the primitive interface types.
+;;; Our problem is that we have Int64 instead of Long, so we get "I" instead of "L". Double and Object are okay.
+;;; We'll create a map mapping Int64, Double, Object to the correct character, and default every other type to something bogus.
+;;; Then do the class lookup. However, our classes are named clojure.lang.primifs.LODO, e.g.
+
+(defn prim-interface [tags]
+ (when (some primitive? tags)
+ (let [sig (apply str (mapv #(get {Object "O" Int64 "L" Double "D"} % "x") tags))]
+ (maybe-class (str "clojure.lang.primifs." sig)))))
+
+:default
(defn prim-interface [tags]
(when (some primitive? tags)
(let [sig (apply str (mapv #(.toUpperCase (subs (.getSimpleName ^Class %) 0 1)) tags))]
(maybe-class (str "clojure.lang.IFn$" sig)))))
+)
+
+
(defn tag-match? [arg-tags meth]
(every? identity (map convertible? arg-tags (:parameter-types meth))))
@@ -359,15 +508,15 @@
(cond
(= prev-ret next-ret)
(cond
- (.isAssignableFrom prev-decl next-decl)
+ (assignable-from? prev-decl next-decl)
[next]
- (.isAssignableFrom next-decl prev-decl)
+ (assignable-from? next-decl prev-decl)
p
:else
(conj p next))
- (.isAssignableFrom prev-ret next-ret)
+ (assignable-from? prev-ret next-ret)
[next]
- (.isAssignableFrom next-ret prev-ret)
+ (assignable-from? next-ret prev-ret)
p
:else
(conj p next))
@@ -381,7 +530,18 @@
(defn ns->relpath [s]
(-> s str (s/replace \. \/) (s/replace \- \_) (str ".clj")))
+#?(
+:cljr
+
+;; no equivalent
+
+(defn ns-url [ns]
+ (ns->relpath ns))
+
+:default
(defn ns-url [ns]
(let [f (ns->relpath ns)]
(or (io/resource f)
(io/resource (str f "c")))))
+
+)
diff --git a/typed/clj.analyzer/test/typed_test/clj/analyzer.clj b/typed/clj.analyzer/test/typed_test/clj/analyzer.cljc
similarity index 69%
rename from typed/clj.analyzer/test/typed_test/clj/analyzer.clj
rename to typed/clj.analyzer/test/typed_test/clj/analyzer.cljc
index 2513e745d..afbd275d2 100644
--- a/typed/clj.analyzer/test/typed_test/clj/analyzer.clj
+++ b/typed/clj.analyzer/test/typed_test/clj/analyzer.cljc
@@ -27,7 +27,8 @@
(is (= true
(:result (ast (do (ns foo) (= 1 1))))))
(is (= "a"
- (:result (ast (.toString (reify Object (toString [this] "a")))))))
+ (:result (ast #?(:cljr (.ToString (reify Object (ToString [this] "a")))
+ :default (.toString (reify Object (toString [this] "a"))))))))
(is (= 2 (:result (ast (#(inc %) 1)))))
#_
(is (->
@@ -35,35 +36,44 @@
(:require [typed.clojure :as t]))
(t/ann-form 'foo 'a)))
:ret))
- (is (= [:const Number]
- ((juxt :op :val) (ast Number))))
+ #?(:cljr
+ (is (= [:const Int64]
+ ((juxt :op :val) (ast Int64))))
+ :default
+ (is (= [:const Number]
+ ((juxt :op :val) (ast Number)))))
(is (= [:const clojure.lang.Compiler]
((juxt :op :val) (ast clojure.lang.Compiler))))
- (is (= [:static-field 'LOADER]
- ((juxt :op :field) (ast clojure.lang.Compiler/LOADER))))
+
+ #?(:cljr
+ (is (= [:static-field 'specials]
+ ((juxt :op :field) (ast clojure.lang.Compiler/specials))))
+ :default
+ (is (= [:static-field 'LOADER]
+ ((juxt :op :field) (ast clojure.lang.Compiler/LOADER)))))
)
(deftest local-tag-test
- (is (= java.lang.String
+ (is (= #?(:cljr System.String :default java.lang.String)
(:tag (ast "asdf"))))
- (is (= [:const java.lang.String]
+ (is (= [:const #?(:cljr System.String :default java.lang.String)]
(-> (ast (let [a "asdf"]))
:bindings
first
:init
((juxt :op :tag)))))
- (is (= [:binding java.lang.String]
+ (is (= [:binding #?(:cljr System.String :default java.lang.String)]
(-> (ast (let [a "asdf"]))
:bindings
first
((juxt :op :tag)))))
- (is (= [:local java.lang.String]
+ (is (= [:local #?(:cljr System.String :default java.lang.String)]
(-> (ast (let [a "asdf"]
a))
:body
:ret
((juxt :op :tag)))))
- (is (= java.lang.String
+ (is (= #?(:cljr System.String :default java.lang.String)
(:tag (ast (let [a "asdf"]
a)))))
)
@@ -75,7 +85,7 @@
(ast
(deftype A []
Object
- (toString [_] (A.) "a")))))))
+ (#?(:cljr ToString :default toString) [_] (A.) "a")))))))
(deftest uniquify-test
(let [ret (ast' (let [a 1]
diff --git a/typed/clj.analyzer/test/typed_test/clj/analyzer/gilardi_test.clj b/typed/clj.analyzer/test/typed_test/clj/analyzer/gilardi_test.cljc
similarity index 98%
rename from typed/clj.analyzer/test/typed_test/clj/analyzer/gilardi_test.clj
rename to typed/clj.analyzer/test/typed_test/clj/analyzer/gilardi_test.cljc
index 3956cdda7..fca0905d2 100644
--- a/typed/clj.analyzer/test/typed_test/clj/analyzer/gilardi_test.clj
+++ b/typed/clj.analyzer/test/typed_test/clj/analyzer/gilardi_test.cljc
@@ -212,7 +212,7 @@
(is (= 2 (:result
(chk `(do (ns ~(gensym 'foo))
(require '~'[clojure.core :as core])
- (assert (.startsWith (str (ns-name *ns*)) "foo")
+ (assert (#?(:cljr .StartsWith :default .startsWith) (str (ns-name *ns*)) "foo")
*ns*)
;(prn (ns-aliases *ns*))
;(println "foo ADSF")
@@ -329,7 +329,7 @@
(~'demunge "a")))
nil)))
(is (thrown-with-msg?
- RuntimeException
+ #?(:cljr Exception :default RuntimeException)
#"" ;#"Unable to resolve symbol: demunge in this context"
(eval-in-fresh-ns `(let* []
(my-body (change-to-clojure-repl-on-eval)
@@ -342,7 +342,7 @@
(~'demunge "a")))
nil)))
(is (thrown-with-msg?
- RuntimeException
+ #?(:cljr Exception :default RuntimeException)
#"" ;#"Unable to resolve symbol: demunge in this context"
(eval-in-fresh-ns `(let* []
(do (change-to-clojure-repl-on-eval)
diff --git a/typed/clj.analyzer/test/typed_test/clj/analyzer/perf.clj b/typed/clj.analyzer/test/typed_test/clj/analyzer/perf.cljc
similarity index 100%
rename from typed/clj.analyzer/test/typed_test/clj/analyzer/perf.clj
rename to typed/clj.analyzer/test/typed_test/clj/analyzer/perf.cljc
diff --git a/typed/clj.runtime/deps-clr.edn b/typed/clj.runtime/deps-clr.edn
new file mode 100644
index 000000000..2108abfa9
--- /dev/null
+++ b/typed/clj.runtime/deps-clr.edn
@@ -0,0 +1,3 @@
+{:paths ["src" "resources"]
+ :deps {local/typed.cljc.analyzer {:local/root "../cljc.analyzer"}}
+}
\ No newline at end of file
diff --git a/typed/clj.runtime/src/clj - Shortcut.lnk b/typed/clj.runtime/src/clj - Shortcut.lnk
new file mode 100644
index 000000000..85ac0dcdc
Binary files /dev/null and b/typed/clj.runtime/src/clj - Shortcut.lnk differ
diff --git a/typed/clj.runtime/src/clojure/core/typed.cljc b/typed/clj.runtime/src/clojure/core/typed.cljc
index 3e2142f5a..fcb579cd1 100644
--- a/typed/clj.runtime/src/clojure/core/typed.cljc
+++ b/typed/clj.runtime/src/clojure/core/typed.cljc
@@ -74,7 +74,7 @@ for checking namespaces, cf for checking individual forms."}
Intended for use at the REPL."
[mname]
(load-if-needed)
- (core/let [ms (->> (Class/forName (namespace mname))
+ (core/let [ms (->> (#?(:cljr clojure.lang.RT/classForNameE :default Class/forName) (namespace mname))
reflect/type-reflect
:members
(core/filter #(and (instance? clojure.reflect.Method %)
@@ -347,9 +347,9 @@ for checking namespaces, cf for checking individual forms."}
(binding [vs/*current-env* {:ns {:name (ns-name *ns*)}
:file *file*
:line (or (-> form# meta :line)
- @Compiler/LINE)
+ #?(:cljr @Compiler/LineVar :default @Compiler/LINE))
:column (or (-> form# meta :column)
- @Compiler/COLUMN)}]
+ #?(:cljr @Compiler/ColumnVar :default @Compiler/COLUMN))}]
(do ~@body))))
(defmacro ^:private delay-rt-parse
@@ -441,13 +441,13 @@ for checking namespaces, cf for checking individual forms."}
(core/let
[qsym (qualify-sym sym)]
`(tc-ignore
- (when (= "true" (System/getProperty "clojure.core.typed.intern-defaliases"))
+ (when (= "true" (#?(:cljr Environment/GetEnvironmentVariable :default System/getProperty) "clojure.core.typed.intern-defaliases"))
(intern '~qsym '~(with-meta (symbol (name sym))
(meta sym))))
(defalias* '~qsym '~t '~&form)))))
(defmacro ^:private defspecial [& body]
- (when (= "true" (System/getProperty "clojure.core.typed.special-vars"))
+ (when (= "true" (#?(:cljr Environment/GetEnvironmentVariable :default System/getProperty) "clojure.core.typed.special-vars"))
`(def ~@body)))
(defspecial
@@ -1695,10 +1695,10 @@ for checking namespaces, cf for checking individual forms."}
~*file*)
:line (or (:line opt#)
~(or (-> &form meta :line)
- @Compiler/LINE))
+ #?(:cljr @Compiler/LineVar :default @Compiler/LINE)))
:column (or (:column opt#)
~(or (-> &form meta :column)
- @Compiler/COLUMN))))))
+ #?(:cljr @Compiler/ColumnVar :default @Compiler/COLUMN)))))))
~x))))
(core/defn infer-unannotated-vars
@@ -1735,7 +1735,7 @@ for checking namespaces, cf for checking individual forms."}
; thus dynaload as lazily as possible.
;============================================================
-(when (= "true" (System/getProperty "clojure.core.typed.deprecated-wrapper-macros"))
+(when (= "true" (#?(:cljr Environment/GetEnvironmentVariable :default System/getProperty) "clojure.core.typed.deprecated-wrapper-macros"))
(load "typed/deprecated_wrapper_macros"))
;;TODO make typing rule
diff --git a/typed/clj.runtime/src/clojure/core/typed/coerce_utils.cljc b/typed/clj.runtime/src/clojure/core/typed/coerce_utils.cljc
index b5011d923..59933efd5 100644
--- a/typed/clj.runtime/src/clojure/core/typed/coerce_utils.cljc
+++ b/typed/clj.runtime/src/clojure/core/typed/coerce_utils.cljc
@@ -9,11 +9,11 @@
(ns ^:no-doc clojure.core.typed.coerce-utils
(:require [typed.clojure :as t]
[clojure.string :as str]
- [clojure.java.io :as io]
+ #?(:cljr [clojure.clr.io] :default [clojure.java.io :as io])
[clojure.core.typed.current-impl :as impl])
(:import (clojure.lang RT Var)))
-(t/ann symbol->Class [t/Sym -> Class])
+(t/ann symbol->Class [t/Sym -> #?(:cljr Type :default Class)])
(defn symbol->Class
"Returns the Class represented by the symbol. Works for
primitives (eg. byte, int). Does not further resolve the symbol."
@@ -29,13 +29,20 @@
double Double/TYPE
boolean Boolean/TYPE
char Character/TYPE
+ #?@(:cljr [
+ sbyte SByte
+ ushort UInt16
+ uint UInt32
+ ulong UInt64
+ decimal Decimal
+ ])
(RT/classForName (str sym))))
-(t/ann Class->symbol [Class -> t/Sym])
-(defn Class->symbol [^Class cls]
+(t/ann Class->symbol [#?(:cljr Type :default Class) -> t/Sym])
+(defn Class->symbol [^#?(:cljr Type :default Class) cls]
#_{:pre [(class? cls)]
:post [(symbol? %)]}
- (symbol (.getName cls)))
+ (symbol (#?(:cljr .FullName :default .getName) cls)))
(t/ann var->symbol [t/AnyVar -> t/Sym])
(defn var->symbol [^Var var]
@@ -71,7 +78,10 @@
(cond-> p
(str/starts-with? p "/") (subs 1))))
+;; no equivalent of io/resource for CLR
+#?(:cljr nil :default (do
(t/ann ns->URL [t/Sym -> (t/Nilable java.net.URL)])
+
(defn ns->URL ^java.net.URL [nsym]
{:pre [(symbol? nsym)]
:post [((some-fn #(instance? java.net.URL %)
@@ -79,6 +89,7 @@
%)]}
(let [p (ns->file nsym)]
(io/resource p)))
+))
(t/ann sym->kw [t/Sym -> t/Kw])
(defn sym->kw [sym]
diff --git a/typed/clj.runtime/src/clojure/core/typed/contract.cljc b/typed/clj.runtime/src/clojure/core/typed/contract.cljc
index 3392a7b57..937e8ca58 100644
--- a/typed/clj.runtime/src/clojure/core/typed/contract.cljc
+++ b/typed/clj.runtime/src/clojure/core/typed/contract.cljc
@@ -128,7 +128,7 @@
[& {:as bls}]
(map->Blame bls))
-#?(:clj
+#?(:cljs :ignore :default
(defmacro contract
"Check a contract against a value, with an optional Blame object.
@@ -142,9 +142,9 @@
:negative ~(str "Not " (ns-name *ns*))
:file ~*file*
:line ~(or (-> &form meta :line)
- @Compiler/LINE)
+ #?(:cljr @clojure.lang.Compiler/LineVar :default @Compiler/LINE))
:column ~(or (-> &form meta :column)
- @Compiler/COLUMN))))
+ #?(:cljr @clojure.lang.Compiler/ColumnVar :default @Compiler/COLUMN)))))
~x))))
#_(ann swap-blame [Blame :-> Blame])
@@ -165,7 +165,7 @@
(make-flat-contract :name 'int-c :first-order integer?))
;; macro to allow instance? specialisation
-#?(:clj
+#?(:cljs :ignore :default
(defmacro instance-c
"Flat contracts for instance? checks on Class's."
[c]
@@ -294,8 +294,12 @@
(next [this]
(when-let [n (next s)]
(->CheckedISeq n c b)))
- (cons [this x]
+ #?(:cljr
+ (^clojure.lang.ISeq cons [this ^Object x] ;; Sigh -- overloaded in cljr
(->CheckedISeq (conj s x) c b))
+ :default
+ (cons [this x]
+ (->CheckedISeq (conj s x) c b)))
(empty [this]
(empty s))
(seq [this]
@@ -303,7 +307,7 @@
this))
(equiv [this o]
(if (or (not (instance? clojure.lang.Sequential o))
- (not (instance? java.util.List o)))
+ (not (instance? #?(:cljr System.Collections.IEnumerable :default java.util.List) o)))
false
(loop [ms this
s (seq o)]
diff --git a/typed/clj.runtime/src/clojure/core/typed/contract_utils_platform_specific.cljc b/typed/clj.runtime/src/clojure/core/typed/contract_utils_platform_specific.cljc
index 045b8a2d8..75d9d9617 100644
--- a/typed/clj.runtime/src/clojure/core/typed/contract_utils_platform_specific.cljc
+++ b/typed/clj.runtime/src/clojure/core/typed/contract_utils_platform_specific.cljc
@@ -11,13 +11,19 @@
;; reader conditions in .clj files, and where PersistentArrayMap doesn't
;; exist.
(ns ^:no-doc clojure.core.typed.contract-utils-platform-specific
- #?(:clj (:require [clojure.core.typed.contract-utils :as con]))
- #?(:clj (:import (clojure.lang PersistentArrayMap))))
+ #?(:clj (:require [clojure.core.typed.contract-utils :as con])
+ :cljr (:require [clojure.core.typed.contract-utils :as con]))
+ #?(:clj (:import (clojure.lang PersistentArrayMap))
+ :cljr (:import (clojure.lang PersistentArrayMap))))
#?(:bb nil
- :clj (def namespace? #(instance? clojure.lang.Namespace %)))
+ :clj (def namespace? #(instance? clojure.lang.Namespace %))
+ :cljr (def namespace? #(instance? clojure.lang.Namespace %)))
#?(:clj (defn array-map-c? [ks-c? vs-c?]
+ (every-pred #(instance? PersistentArrayMap %)
+ (con/every-c? (con/hvector-c? ks-c? vs-c?))))
+ :cljr (defn array-map-c? [ks-c? vs-c?]
(every-pred #(instance? PersistentArrayMap %)
(con/every-c? (con/hvector-c? ks-c? vs-c?)))))
diff --git a/typed/clj.runtime/src/clojure/core/typed/current_impl.cljc b/typed/clj.runtime/src/clojure/core/typed/current_impl.cljc
index 0255cbd53..fd54a3091 100644
--- a/typed/clj.runtime/src/clojure/core/typed/current_impl.cljc
+++ b/typed/clj.runtime/src/clojure/core/typed/current_impl.cljc
@@ -23,17 +23,23 @@
;; copied to typed.cljs.runtime.env
(def clojurescript ::clojurescript)
+;; We don't have a typed.cljr.runtime.env to copy to -- is this a problem? What does this even mean?
+(def cljr ::cljr)
+
(def unknown ::unknown)
(derive clojure unknown)
(derive clojurescript unknown)
+(derive cljr unknown)
;; :clojure = ::clojure
;; :cljs = ::clojurescript
+;; :cljr = ::cljr
;; :unknown = ::unknown
-#?(:clj
+#?(:cljs :ignore
+:default
(defmacro impl-case [& {clj-case :clojure cljs-case :cljs unknown :unknown :as opts}]
- (let [bad (set/difference (set (keys opts)) #{:clojure :cljs :unknown})]
+ (let [bad (set/difference (set (keys opts)) #{:clojure :cljs :cljr :unknown})]
(assert (empty? bad)
(str "Incorrect cases to impl-case: " (pr-str bad))))
`(case (current-impl)
@@ -41,7 +47,9 @@
~clojurescript ~cljs-case
~(if (contains? opts :unknown)
unknown
- `(assert nil (str "No case matched for impl-case " (current-impl)))))))
+ `(assert nil (str "No case matched for impl-case " (current-impl))))))
+)
+
;; copied to typed.clj{s}.runtime.env
(def current-impl-kw ::current-impl)
@@ -219,14 +227,16 @@
(env/swap-checker! assoc-in [ns-opts-kw nsym :warn-on-unannotated-vars] true)
nil)
-#?(:clj
+#?(:cljs :ignore
+:default
(def ^:private force-type #((requiring-resolve 'typed.cljc.runtime.env-utils/force-type) %)))
-#?(:clj
+#?(:cljs :ignore :default
(defmacro ^:private delay-type [& body]
`((requiring-resolve 'typed.cljc.runtime.env-utils/delay-type*)
(fn [] (do ~@body)))))
-#?(:clj
+#?(:cljs :ignore
+:default
(defmacro create-env
"For name n, creates defs for {n}, {n}-kw, add-{n},
and reset-{n}!"
@@ -250,20 +260,20 @@
nil))))
;; runtime environments
-#?(:clj
+#?(:cljs :ignore :default
(create-env var-env))
-#?(:clj
+#?(:cljs :ignore :default
(create-env alias-env))
-#?(:clj
+#?(:cljs :ignore :default
(create-env protocol-env))
-#?(:clj
+#?(:cljs :ignore :default
(create-env rclass-env))
-#?(:clj
+#?(:cljs :ignore :default
(create-env datatype-env))
-#?(:clj
+#?(:cljs :ignore :default
(create-env jsnominal-env))
-#?(:clj
+#?(:cljs :ignore :default
(defn v [vsym]
{:pre [(qualified-symbol? vsym)]}
(let [ns (find-ns (symbol (namespace vsym)))
@@ -272,7 +282,7 @@
(assert (var? var) (str "Cannot find var: " vsym))
@var)))
-#?(:clj
+#?(:cljs :ignore :default
(defn the-var [vsym]
{:pre [(qualified-symbol? vsym)]
:post [(var? %)]}
@@ -285,7 +295,7 @@
(declare bindings-for-impl)
-#?(:clj
+#?(:cljs :ignore :default
(defmacro with-impl [impl & body]
`(with-bindings (let [impl# ~impl]
(or (get (bindings-for-impl) impl#)
@@ -300,7 +310,7 @@
(defn clj-bindings []
{#'env/*checker* (clj-checker)})
-#?(:clj
+#?(:cljs :ignore :default
(defmacro with-clojure-impl [& body]
`(with-impl clojure
~@body)))
@@ -319,7 +329,7 @@
(defn cljs-bindings []
{#'env/*checker* (cljs-checker)})
-#?(:clj
+#?(:cljs :ignore :default
(defmacro with-cljs-impl [& body]
`(with-impl clojurescript
~@body)))
@@ -330,7 +340,7 @@
clojure (clj-bindings)
clojurescript (cljs-bindings)})
-#?(:clj
+#?(:cljs :ignore :default
(defmacro with-full-impl [impl & body]
`(with-impl ~impl
~@body)))
@@ -366,18 +376,18 @@
(str ": " msg#)))))))
-#?(:clj
+#?(:cljs :ignore :default
(defn var->symbol [^clojure.lang.Var var]
{:pre [(var? var)]
:post [(qualified-symbol? %)]}
(symbol (str (ns-name (.ns var)))
(str (.sym var)))))
-#?(:clj
-(defn Class->symbol [^Class cls]
+#?(:cljs :ignore :default
+(defn Class->symbol [^#?(:cljr Type :clj Class) cls]
{:pre [(class? cls)]
:post [(simple-symbol? %)]}
- (symbol (.getName cls))))
+ (symbol (#?(:cljr .FullName :clj .getName) cls))))
; for type-contract
(defn hmap-c? [& {:keys [mandatory optional absent-keys complete?]}]
@@ -406,58 +416,58 @@
(vc (get % k))))
optional)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private int-error #(apply (requiring-resolve 'clojure.core.typed.errors/int-error) %&)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private parse-free-binder-with-variance #((requiring-resolve 'typed.clj.checker.parse-unparse/parse-free-binder-with-variance) %)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private with-parse-ns* #((requiring-resolve 'typed.clj.checker.parse-unparse/with-parse-ns*) %1 %2)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private with-bounded-frees* #((requiring-resolve 'typed.cljc.checker.free-ops/with-bounded-frees*) %1 %2)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private unparse-type #((requiring-resolve 'typed.clj.checker.parse-unparse/unparse-type) %)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private parse-type #((requiring-resolve 'typed.clj.checker.parse-unparse/parse-type) %)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private fully-resolve-type #((requiring-resolve 'typed.cljc.checker.type-ctors/fully-resolve-type) %)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private Poly? #((requiring-resolve 'typed.cljc.checker.type-rep/Poly?) %)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private Poly-fresh-symbols* #((requiring-resolve 'typed.cljc.checker.type-ctors/Poly-fresh-symbols*) %)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private Poly-body* #(apply (requiring-resolve 'typed.cljc.checker.type-ctors/Poly-body*) %&)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private PolyDots? #((requiring-resolve 'typed.cljc.checker.type-rep/PolyDots?) %)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private PolyDots-fresh-symbols* #((requiring-resolve 'typed.cljc.checker.type-ctors/PolyDots-fresh-symbols*) %)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private PolyDots-body* #((requiring-resolve 'typed.cljc.checker.type-ctors/PolyDots-body*) %1 %2)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private FnIntersection? #((requiring-resolve 'typed.cljc.checker.type-rep/FnIntersection?) %)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private Protocol* #(apply (requiring-resolve 'typed.cljc.checker.type-ctors/Protocol*) %&)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private Protocol-var->on-class #((requiring-resolve 'typed.cljc.checker.type-ctors/Protocol-var->on-class) %)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private -any #(deref (requiring-resolve 'typed.cljc.checker.type-rep/-any))))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private protocol-method-var-ann #(apply (requiring-resolve 'typed.cljc.checker.collect-utils/protocol-method-var-ann) %&)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private make-F #((requiring-resolve 'typed.cljc.checker.type-rep/make-F) %)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private DataType* #(apply (requiring-resolve 'typed.cljc.checker.type-ctors/DataType*) %&)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private Poly* #(apply (requiring-resolve 'typed.cljc.checker.type-ctors/Poly*) %&)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private make-FnIntersection #((requiring-resolve 'typed.cljc.checker.type-rep/make-FnIntersection) %)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private make-Function #(apply (requiring-resolve 'typed.cljc.checker.type-rep/make-Function) %&)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private DataType-of #(apply (requiring-resolve 'typed.cljc.checker.type-ctors/DataType-of) %&)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private subtype? #((requiring-resolve 'typed.clj.checker.subtype/subtype?) %1 %2)))
-#?(:clj
+#?(:cljs :ignore :default
(defn gen-protocol* [current-env current-ns vsym binder mths]
{:pre [(symbol? current-ns)
((some-fn nil? map?) mths)]}
@@ -555,24 +565,24 @@
(env/swap-checker! update-in [current-dt-ancestors-kw sym] merge tmap)
nil)
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private demunge #((requiring-resolve 'clojure.repl/demunge) %)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private abstract-many #((requiring-resolve 'typed.cljc.checker.type-ctors/abstract-many) %1 %2)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private with-frees* #((requiring-resolve 'typed.cljc.checker.free-ops/with-frees*) %1 %2)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private -val #((requiring-resolve 'typed.cljc.checker.type-rep/-val) %1)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private -nil #(deref (requiring-resolve 'typed.cljc.checker.type-rep/-nil))))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private fv #((requiring-resolve 'typed.cljc.checker.frees/fv) %)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private fi #((requiring-resolve 'typed.cljc.checker.frees/fi) %)))
-#?(:clj
+#?(:cljs :ignore :default
(def ^:private make-HMap #(apply (requiring-resolve 'typed.cljc.checker.type-ctors/make-HMap) %&)))
-#?(:clj
+#?(:cljs :ignore :default
(defn gen-datatype* [current-env current-ns provided-name fields vbnd opt record?]
{:pre [(symbol? current-ns)
(impl-case
diff --git a/typed/clj.runtime/src/clojure/core/typed/errors.cljc b/typed/clj.runtime/src/clojure/core/typed/errors.cljc
index 2ec65ab69..0cdd594ad 100644
--- a/typed/clj.runtime/src/clojure/core/typed/errors.cljc
+++ b/typed/clj.runtime/src/clojure/core/typed/errors.cljc
@@ -217,7 +217,7 @@
{:type-error nyi-error-kw
:env (env-for-error env)}))))
-#?(:clj
+#?(:cljs :ignore :default
(defmacro with-ex-info-handlers
"Handle an ExceptionInfo e thrown in body. The first handler whose left hand
side returns true, then the right hand side is called passing (ex-info e) and e."
@@ -282,7 +282,7 @@
(str ":" column))))
") "))
(println)
- (print (.getMessage e))
+ (print (#?(:cljr .Message :default .getMessage) e))
(println)
(flush)
(let [[_ form :as has-form?] (find data :form)]
diff --git a/typed/clj.runtime/src/clojure/core/typed/expand.clj b/typed/clj.runtime/src/clojure/core/typed/expand.cljc
similarity index 99%
rename from typed/clj.runtime/src/clojure/core/typed/expand.clj
rename to typed/clj.runtime/src/clojure/core/typed/expand.cljc
index 4c8f2dcea..0fc29bc1c 100644
--- a/typed/clj.runtime/src/clojure/core/typed/expand.clj
+++ b/typed/clj.runtime/src/clojure/core/typed/expand.cljc
@@ -259,7 +259,7 @@
~(expand-with-open (subvec bindings 2) body)
(finally
(. ~(bindings 0) close))))
- :else (throw (IllegalArgumentException. "with-open only allows Symbols in bindings"))))]
+ :else (throw (#?(:cljr ArgumentException. :default IllegalArgumentException.) "with-open only allows Symbols in bindings"))))]
(expand-with-open bindings body)))
(defmethod -expand-macro 'clojure.core/assert
@@ -286,7 +286,7 @@
(if (seq? (first sigs))
sigs
;; Assume single arity syntax
- (throw (IllegalArgumentException.
+ (throw (#?(:cljr ArgumentException. :default IllegalArgumentException.)
(if (seq sigs)
(str "Parameter declaration "
(first sigs)
diff --git a/typed/clj.runtime/src/clojure/core/typed/load_if_needed.cljc b/typed/clj.runtime/src/clojure/core/typed/load_if_needed.cljc
index 7729f4158..1d8991d20 100644
--- a/typed/clj.runtime/src/clojure/core/typed/load_if_needed.cljc
+++ b/typed/clj.runtime/src/clojure/core/typed/load_if_needed.cljc
@@ -9,6 +9,7 @@
(ns ^:no-doc clojure.core.typed.load-if-needed
#?(:clj (:refer-clojure :exclude [requiring-resolve]))
(:require [clojure.core.typed.errors :as err]
+ #?(:clj [clojure.java.io :as io])
[clojure.java.io :as io]
[clojure.core.typed.util-vars :as vs]
#?(:clj [io.github.frenchy64.fully-satisfies.requiring-resolve :refer [requiring-resolve]])))
diff --git a/typed/clj.runtime/src/clojure/core/typed/parse_ast.cljc b/typed/clj.runtime/src/clojure/core/typed/parse_ast.cljc
index 729347e7d..b0cb3cddc 100644
--- a/typed/clj.runtime/src/clojure/core/typed/parse_ast.cljc
+++ b/typed/clj.runtime/src/clojure/core/typed/parse_ast.cljc
@@ -122,12 +122,12 @@
(t/ann *dotted-scope* (t/Map t/Sym t/Sym))
(def ^:dynamic *dotted-scope* {})
-#?(:clj
+#?(:cljs :ignore :default
(defmacro with-frees [fs & args]
`(binding [*tvar-scope* (merge *tvar-scope* ~fs)]
~@args)))
-#?(:clj
+#?(:cljs :ignore :default
(defmacro with-dfrees [fs & args]
`(binding [*dotted-scope* (merge *dotted-scope* ~fs)]
~@args)))
@@ -152,6 +152,14 @@
:id NameRef}
:optional {:path (t/Vec PathElem)}))))
+#?(:cljr
+
+(do
+ (def ^:private init-symbol-escape *allow-symbol-escape*)
+ (.bindRoot #'*allow-symbol-escape* false))
+
+)
+
(t/ann parse-filter [t/Any -> Filter])
(defn parse-filter [syn]
(case syn
@@ -216,6 +224,12 @@
m
(err/int-error (str "Bad filter syntax: " syn))))))
+
+#?(:cljr
+
+ (.bindRoot #'*allow-symbol-escape* init-symbol-escape)
+)
+
(t/defalias FilterSet
'{:op ':filter-set
:then Filter
@@ -445,6 +459,25 @@
:upper-bound {:op :Any}
:lower-bound {:op :U :types []}})
+#?(
+:cljr
+(def clj-primitives
+ {'byte {:op :clj-prim :name 'byte}
+ 'sbyte {:op :clj-pimr :name 'sbyte}
+ 'short {:op :clj-prim :name 'short}
+ 'int {:op :clj-prim :name 'int}
+ 'long {:op :clj-prim :name 'long}
+ 'ushort {:op :clj-prim :name 'ushort}
+ 'uint {:op :clj-prim :name 'uint}
+ 'ulong {:op :clj-prim :name 'ulong}
+ 'float {:op :clj-prim :name 'float}
+ 'double {:op :clj-prim :name 'double}
+ 'boolean {:op :clj-prim :name 'boolean}
+ 'char {:op :clj-prim :name 'char}
+ 'decimal {:op :clj-prim :name 'decimal}
+ 'void {:op :singleton :val nil}})
+
+:default
(def clj-primitives
{'byte {:op :clj-prim :name 'byte}
'short {:op :clj-prim :name 'short}
@@ -455,6 +488,7 @@
'boolean {:op :clj-prim :name 'boolean}
'char {:op :clj-prim :name 'char}
'void {:op :singleton :val nil}})
+ )
(def cljs-primitives
{'int {:op :cljs-prim :name 'int}
diff --git a/typed/clj.runtime/src/typed/cljc/runtime/env.cljc b/typed/clj.runtime/src/typed/cljc/runtime/env.cljc
index ce08993cb..14ef9e0e2 100644
--- a/typed/clj.runtime/src/typed/cljc/runtime/env.cljc
+++ b/typed/clj.runtime/src/typed/cljc/runtime/env.cljc
@@ -12,6 +12,7 @@
(defn checker-or-nil []
{:post [(or #?(:clj (instance? clojure.lang.IAtom2 %)
+ :cljr (instance? clojure.lang.IAtom2 %)
:cljs (instance? Atom %))
(nil? %))]}
*checker*)
@@ -19,6 +20,7 @@
(defn checker []
(let [c *checker*]
(assert (or #?(:clj (instance? clojure.lang.IAtom2 c)
+ :cljr (instance? clojure.lang.IAtom2 c)
:cljs (instance? Atom c))
(delay? c))
(str "No checker state: " (pr-str c)))
diff --git a/typed/clj.runtime/src/typed/cljc/runtime/env_utils.clj b/typed/clj.runtime/src/typed/cljc/runtime/env_utils.cljc
similarity index 89%
rename from typed/clj.runtime/src/typed/cljc/runtime/env_utils.clj
rename to typed/clj.runtime/src/typed/cljc/runtime/env_utils.cljc
index da38de375..0c4c914ca 100644
--- a/typed/clj.runtime/src/typed/cljc/runtime/env_utils.clj
+++ b/typed/clj.runtime/src/typed/cljc/runtime/env_utils.cljc
@@ -11,7 +11,7 @@
;; load dependencies when using clojure.core.typed without typed.clojure
;;DON'T require typed.clojure here
(:require [typed.clojure :as-alias t])
- (:import [java.lang.ref SoftReference]))
+ (:import #?(:clj [java.lang.ref SoftReference])))
(defonce ^{:doc "Internal use only"} ^:no-doc parsed-types-invalidation-id (atom (str (random-uuid))))
@@ -23,7 +23,7 @@
(defn delay-type* [f]
(let [f (bound-fn* f)
this-invalidation-id (volatile! @parsed-types-invalidation-id)
- def-ns-vol (volatile! (SoftReference. *ns*))
+ def-ns-vol (volatile! (#?(:cljr identity :default SoftReference.) *ns*))
->f-delay (fn [] (delay
;; locals clearing issue?
;; reproduce via (refresh) then (clojure.core.typed/envs)
@@ -31,8 +31,8 @@
(when f (f)))))
d (atom (->f-delay))]
(fn []
- (when-some [^SoftReference sr @def-ns-vol]
- (when-some [def-ns (.get sr)]
+ (when-some [^#?(:cljr Object :default SoftReference) sr @def-ns-vol]
+ (when-some [def-ns #?(:cljr sr :default (.get sr))]
(assert (instance? clojure.lang.Namespace def-ns))
(if (identical? def-ns (find-ns (ns-name def-ns)))
(let [_ (when (not= @this-invalidation-id @parsed-types-invalidation-id)
diff --git a/typed/clj.runtime/src/typed/cljc/runtime/env_utils_annotations.clj b/typed/clj.runtime/src/typed/cljc/runtime/env_utils_annotations.cljc
similarity index 93%
rename from typed/clj.runtime/src/typed/cljc/runtime/env_utils_annotations.clj
rename to typed/clj.runtime/src/typed/cljc/runtime/env_utils_annotations.cljc
index 57c961689..82876bdcb 100644
--- a/typed/clj.runtime/src/typed/cljc/runtime/env_utils_annotations.clj
+++ b/typed/clj.runtime/src/typed/cljc/runtime/env_utils_annotations.cljc
@@ -8,8 +8,7 @@
(ns ^:no-doc typed.cljc.runtime.env-utils-annotations
(:require [typed.clojure :as t]
- [typed.cljc.runtime.env-utils :as env-utils])
- (:import [java.lang.ref SoftReference]))
+ [typed.cljc.runtime.env-utils :as env-utils]))
(t/defalias env-utils/InvalidationId t/Str)
(t/defalias env-utils/ForcedType
diff --git a/typed/clj.runtime/src/typed/clojure.cljc b/typed/clj.runtime/src/typed/clojure.cljc
index 4fd42ab61..207159263 100644
--- a/typed/clj.runtime/src/typed/clojure.cljc
+++ b/typed/clj.runtime/src/typed/clojure.cljc
@@ -13,12 +13,12 @@
typed.clojure
(:refer-clojure :exclude [type defprotocol #_letfn fn loop dotimes let for doseq
defn atom ref cast #?(:clj requiring-resolve)])
- (:require #?(;; not loadable in self hosted CLJS, otherwise always needed for
- ;; CLJ AOT compilation compatibility
- :clj clojure.core.typed
- ;; for self hosted CLJS normal :require's from .clj/c files. for
+ (:require #?(;; for self hosted CLJS normal :require's from .clj/c files. for
;; .clj{s,c} files, loaded via :require-macros in typed/clojure.cljs.
- :cljs cljs.core.typed)
+ :cljs cljs.core.typed
+ ;; not loadable in self hosted CLJS, otherwise always needed for
+ ;; CLJ AOT compilation compatibility
+ :default clojure.core.typed)
[clojure.core :as cc]
[clojure.core.typed.macros :as macros]
[clojure.core.typed.platform-case :refer [platform-case]]
@@ -76,7 +76,7 @@
:clj `(clojure.core.typed/inst ~@args)
:cljs `(cljs.core.typed/inst ~@args)))
-#?(:clj
+#?(:cljs nil :default
(defmacro inst-ctor [& args]
(platform-case
:clj `(clojure.core.typed/inst-ctor ~@args)
@@ -150,22 +150,22 @@
:clj `(clojure.core.typed/atom ~@args)
:cljs `(cljs.core.typed/atom ~@args)))
-#?(:clj
- (defmacro ref [& args]
- (platform-case
- :clj `(clojure.core.typed/ref ~@args)
- :cljs (throw (ex-info "ref does not exist in CLJS" {})))))
+#?(:cljs nil :default
+(defmacro ref [& args]
+ (platform-case
+ :clj `(clojure.core.typed/ref ~@args)
+ :cljs (throw (ex-info "ref does not exist in CLJS" {})))))
;; checker ops
(defn check-ns-clj
"In Clojure, checks the current namespace or provided namespaces.
Similar for self-hosted ClojureScript, except for macros namespaces."
- ([] #?(:clj ((requiring-resolve 'typed.clj.checker/check-ns3))
- :cljs (cljs.core.typed/check-ns-macros)))
+ ([] #?(:cljs (cljs.core.typed/check-ns-macros)
+ :default ((requiring-resolve 'typed.clj.checker/check-ns3))))
([ns-or-syms & {:as opt}]
- (#?(:clj (requiring-resolve 'typed.clj.checker/check-ns3)
- :cljs cljs.core.typed/check-ns-macros)
+ (#?(:cljs cljs.core.typed/check-ns-macros
+ :default (requiring-resolve 'typed.clj.checker/check-ns3))
ns-or-syms
opt)))
@@ -189,60 +189,60 @@
Not compatible with AOT compilation."
[& args]
(assert (#{0 1} (count args)))
- #?(:clj (platform-case
- ;; hmm, should this be evaluated at compile-time too for consistency?
- :clj `(check-ns-clj ~@args)
- :cljs (apply (requiring-resolve 'cljs.core.typed/check-ns-expansion-side-effects) args))
- ;; idea:
+ #?(;; idea:
;; - if *ns* ends in $macros, check-ns-clj
;; - otherwise, check-ns-cljs
- :cljs `(check-ns-cljs ~@args)))
+ :cljs `(check-ns-cljs ~@args)
+ :default (platform-case
+ ;; hmm, should this be evaluated at compile-time too for consistency?
+ :clj `(check-ns-clj ~@args)
+ :cljs (apply (requiring-resolve 'cljs.core.typed/check-ns-expansion-side-effects) args))))
(defmacro cf-clj
"Check a Clojure form in the current *ns*."
[& args]
- #?(:clj (platform-case
- :clj `(clojure.core.typed/cf ~@args)
- :cljs (binding [*ns* (create-ns @(requiring-resolve 'cljs.analyzer/*cljs-ns*))]
- (list 'quote
- (apply (requiring-resolve 'clojure.core.typed/check-form*)
- (case (count args)
- ;; form | expected expected-provided?
- 1 (concat args [nil nil])
- ;; form expected | expected-provided?
- 2 (concat args [true]))))))
- ;;TODO check in macros ns?
- :cljs `(cljs.core.typed/cf ~@args)))
+ #?(;;TODO check in macros ns?
+ :cljs `(cljs.core.typed/cf ~@args)
+ :default (platform-case
+ :clj `(clojure.core.typed/cf ~@args)
+ :cljs (binding [*ns* (create-ns @(requiring-resolve 'cljs.analyzer/*cljs-ns*))]
+ (list 'quote
+ (apply (requiring-resolve 'clojure.core.typed/check-form*)
+ (case (count args)
+ ;; form | expected expected-provided?
+ 1 (concat args [nil nil])
+ ;; form expected | expected-provided?
+ 2 (concat args [true]))))))))
(defmacro cf-cljs
"Check a ClojureScript form in the same namespace as the current platform."
[& args]
- #?(:clj (platform-case
- :clj `(with-bindings {(requiring-resolve 'cljs.analyzer/*cljs-ns*) (ns-name *ns*)}
- (apply (requiring-resolve 'cljs.core.typed/check-form*)
- '~(case (count args)
- ;; form | expected expected-provided?
- 1 (concat args [nil nil])
- ;; form expected | expected-provided?
- 2 (concat args [true]))))
- :cljs (list 'quote
+ #?(:cljs `(cljs.core.typed/cf ~@args)
+ :default (platform-case
+ :clj `(with-bindings {(requiring-resolve 'cljs.analyzer/*cljs-ns*) (ns-name *ns*)}
(apply (requiring-resolve 'cljs.core.typed/check-form*)
- (case (count args)
- ;; form | expected expected-provided?
- 1 (concat args [nil nil])
- ;; form expected | expected-provided?
- 2 (concat args [true])))))
- :cljs `(cljs.core.typed/cf ~@args)))
+ '~(case (count args)
+ ;; form | expected expected-provided?
+ 1 (concat args [nil nil])
+ ;; form expected | expected-provided?
+ 2 (concat args [true]))))
+ :cljs (list 'quote
+ (apply (requiring-resolve 'cljs.core.typed/check-form*)
+ (case (count args)
+ ;; form | expected expected-provided?
+ 1 (concat args [nil nil])
+ ;; form expected | expected-provided?
+ 2 (concat args [true])))))))
;; TODO add check-form-clj{s} defn's for symmetry
(defmacro cf
"In Clojure, expands to (clojure.core.typed/cf ~@args).
In ClojureScript JVM, expands to (cljs.core.typed/cf ~@args)."
[& args]
- #?(:clj (platform-case
- :clj `(cf-clj ~@args)
- :cljs `(cf-cljs ~@args))
- :cljs `(cf-cljs ~@args)))
+ #?(:cljs `(cf-cljs ~@args)
+ :default (platform-case
+ :clj `(cf-clj ~@args)
+ :cljs `(cf-cljs ~@args))))
(defmacro doc-clj
"Pass any syntax fragment related to Typed Clojure to print documentation on it.
diff --git a/typed/clj.runtime/src/typed/clojure/jvm.cljc b/typed/clj.runtime/src/typed/clojure/jvm.cljc
index a4e6ab721..200e66cd2 100644
--- a/typed/clj.runtime/src/typed/clojure/jvm.cljc
+++ b/typed/clj.runtime/src/typed/clojure/jvm.cljc
@@ -43,9 +43,9 @@
(apply hash-map args))
this-ns (ns-name *ns*)]
`(clojure.core.typed/tc-ignore
- (let [nme# (or (when-some [^Class c# (ns-resolve '~this-ns '~nme)]
+ (let [nme# (or (when-some [^#?(:cljr Type :default Class) c# (ns-resolve '~this-ns '~nme)]
(when (class? c#)
- (-> c# .getName symbol)))
+ (-> c# #?(:cljr .FullName :default .getName) symbol)))
(throw (ex-info (str "Could not resolve class: " '~nme) {:class-name '~nme})))]
;; TODO runtime env
#_
diff --git a/typed/clj.runtime/test/clojure/core/typed/test_rt.clj b/typed/clj.runtime/test/clojure/core/typed/test_rt.cljc
similarity index 58%
rename from typed/clj.runtime/test/clojure/core/typed/test_rt.clj
rename to typed/clj.runtime/test/clojure/core/typed/test_rt.cljc
index e88cb508a..b9a49d06b 100644
--- a/typed/clj.runtime/test/clojure/core/typed/test_rt.clj
+++ b/typed/clj.runtime/test/clojure/core/typed/test_rt.cljc
@@ -1,41 +1,41 @@
(ns clojure.core.typed.test-rt
(:require [clojure.core.typed :as t]
[clojure.core.typed.errors :as err]
- [clojure.java.io :as io]
+ #?(:cljr [clojure.clr.io :as io] :default [clojure.java.io :as io])
[clojure.test :refer [deftest is]]))
(deftest typed-clojure-loaded
(is (nil? (require 'clojure.core.typed))))
(deftest ^:typed/skip-from-repo-root checking-ops
- (is (thrown? java.io.FileNotFoundException
+ (is (thrown? #?(:cljr System.IO.FileNotFoundException :default java.io.FileNotFoundException)
(t/load-if-needed)))
- (is (thrown? java.io.FileNotFoundException
+ (is (thrown? #?(:cljr System.IO.FileNotFoundException :default java.io.FileNotFoundException)
(t/reset-caches)))
- (is (thrown? java.io.FileNotFoundException
+ (is (thrown? #?(:cljr System.IO.FileNotFoundException :default java.io.FileNotFoundException)
(t/method-type 'foo)))
- (is (thrown? java.io.FileNotFoundException
+ (is (thrown? #?(:cljr System.IO.FileNotFoundException :default java.io.FileNotFoundException)
(t/into-array> 'foo 'bar [1])))
- (is (thrown? java.io.FileNotFoundException
+ (is (thrown? #?(:cljr System.IO.FileNotFoundException :default java.io.FileNotFoundException)
(t/cf 1)))
- (is (thrown? java.io.FileNotFoundException
+ (is (thrown? #?(:cljr System.IO.FileNotFoundException :default java.io.FileNotFoundException)
(t/check-form* 1)))
- (is (thrown? java.io.FileNotFoundException
+ (is (thrown? #?(:cljr System.IO.FileNotFoundException :default java.io.FileNotFoundException)
(t/check-form-info 1)))
- (is (thrown? java.io.FileNotFoundException
+ (is (thrown? #?(:cljr System.IO.FileNotFoundException :default java.io.FileNotFoundException)
(t/check-ns 'foo)))
- (is (thrown? java.io.FileNotFoundException
+ (is (thrown? #?(:cljr System.IO.FileNotFoundException :default java.io.FileNotFoundException)
(t/check-ns-info 'foo)))
- (is (thrown? java.io.FileNotFoundException
+ (is (thrown? #?(:cljr System.IO.FileNotFoundException :default java.io.FileNotFoundException)
(t/statistics ['foo])))
- (is (thrown? java.io.FileNotFoundException
+ (is (thrown? #?(:cljr System.IO.FileNotFoundException :default java.io.FileNotFoundException)
(t/var-coverage))))
(defmacro thrown-blame? [& e]
`(try (try (do ~@e)
false
- (catch clojure.lang.Compiler$CompilerException e#
- (throw (.source e#))))
+ (catch #?(:cljr clojure.lang.Compiler+CompilerException :default clojure.lang.Compiler$CompilerException) e#
+ (throw (#?(:cljr .FileSource :default .source) e#))))
(catch clojure.lang.ExceptionInfo e#
(boolean (-> e# ex-data :blame)))))
diff --git a/typed/cljc.analyzer/deps-clr.edn b/typed/cljc.analyzer/deps-clr.edn
new file mode 100644
index 000000000..1f95ba371
--- /dev/null
+++ b/typed/cljc.analyzer/deps-clr.edn
@@ -0,0 +1,3 @@
+;; DO NOT EDIT! Instead, edit `dev/resources/root-templates/typed/cljc.analyzer/deps.edn` and run `./script/regen-selmer.sh`
+{:paths ["src"]
+}
\ No newline at end of file
diff --git a/typed/cljc.analyzer/src/typed/cljc/analyzer.cljc b/typed/cljc.analyzer/src/typed/cljc/analyzer.cljc
index 102071b13..ab32f79e4 100644
--- a/typed/cljc.analyzer/src/typed/cljc/analyzer.cljc
+++ b/typed/cljc.analyzer/src/typed/cljc/analyzer.cljc
@@ -9,7 +9,8 @@
;; adapted from clojure.tools.analyzer
(ns typed.cljc.analyzer
(:refer-clojure :exclude [macroexpand-1 var?])
- (:require #?(:cljs [typed.clojure :as-alias t])
+ (:require #?@(:clj []
+ :default [[typed.clojure :as-alias t]])
[typed.cljc.analyzer.ast :as ast]
[typed.cljc.analyzer.utils :as u])
#?(:clj (:import (clojure.lang IType))))
@@ -164,9 +165,9 @@
(defmacro create-expr [m cls]
{:pre [(symbol? cls)
(map? m)]}
- (let [^Class rcls (resolve cls)
+ (let [^#?(:cljr Type :default Class) rcls (resolve cls)
_ (assert (class? rcls) {:cls cls :resolved rcls})
- rsym (symbol (.getName rcls))
+ rsym (symbol (#?(:cljr .FullName :default .getName) rcls))
{:keys [fields] :as info} (get defexpr-info rsym)
_ (assert info (str "No info for expr " cls))
fset (into #{} (map keyword) fields)
@@ -180,9 +181,9 @@
(defmacro update-expr [e cls & cases]
{:pre [(symbol? cls)
(every? vector? cases)]}
- (let [^Class rcls (resolve cls)
+ (let [^#?(:cljr Type :default Class) rcls (resolve cls)
_ (assert (class? rcls) {:cls cls :resolved rcls})
- rsym (symbol (.getName rcls))
+ rsym (symbol (#?(:cljr .FullName :default .getName) rcls))
{:keys [fields] :as info} (get defexpr-info rsym)
_ (assert info (str "No info for expr " cls))
ks (map first cases)
diff --git a/typed/cljc.analyzer/src/typed/cljc/analyzer/utils.cljc b/typed/cljc.analyzer/src/typed/cljc/analyzer/utils.cljc
index 0e41408fd..a65767071 100644
--- a/typed/cljc.analyzer/src/typed/cljc/analyzer/utils.cljc
+++ b/typed/cljc.analyzer/src/typed/cljc/analyzer/utils.cljc
@@ -234,4 +234,4 @@
(transient {}))
m))
(meta m)))
- :cljs (def update-vals clojure.core/update-vals))
+ :default (def update-vals clojure.core/update-vals))
pFad - Phonifier reborn
Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.
Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.
Alternative Proxies:
Alternative Proxy
pFad Proxy
pFad v3 Proxy
pFad v4 Proxy