|
3 | 3 | references." |
4 | 4 | {:added "0.5"} |
5 | 5 | (:require |
| 6 | + [clojure.repl :as repl] |
| 7 | + [clojure.set :as set] |
| 8 | + [clojure.string :as str] |
6 | 9 | [orchard.query :as q])) |
7 | 10 |
|
8 | | -(defn- as-val |
| 11 | +(defn- to-fn |
9 | 12 | "Convert `thing` to a function value." |
10 | 13 | [thing] |
11 | 14 | (cond |
12 | 15 | (var? thing) (var-get thing) |
13 | 16 | (symbol? thing) (var-get (find-var thing)) |
14 | 17 | (fn? thing) thing)) |
15 | 18 |
|
| 19 | +(defn- fn-name [^java.lang.Class f] |
| 20 | + (-> f .getName repl/demunge symbol)) |
| 21 | + |
| 22 | +(defn fn-deps-class |
| 23 | + "Returns a set with all the functions invoked by `v`. |
| 24 | + `v` can be a function class or a symbol." |
| 25 | + {:added "0.9"} |
| 26 | + [v] |
| 27 | + (let [^java.lang.Class v (if (class? v) |
| 28 | + v |
| 29 | + (eval v))] |
| 30 | + (into #{} (keep (fn [^java.lang.reflect.Field f] |
| 31 | + (or (and (identical? clojure.lang.Var (.getType f)) |
| 32 | + (java.lang.reflect.Modifier/isPublic (.getModifiers f)) |
| 33 | + (java.lang.reflect.Modifier/isStatic (.getModifiers f)) |
| 34 | + (-> f .getName (.startsWith "const__")) |
| 35 | + (.get f (fn-name v))) |
| 36 | + nil)) |
| 37 | + (.getDeclaredFields v))))) |
| 38 | + |
| 39 | +(def ^:private class-cache |
| 40 | + "Reference to Clojures class cache. |
| 41 | + This holds of classes compiled by the Clojure compiler, |
| 42 | + one class per function and one per repl eval. |
| 43 | + This field is package private, so it has to be set to |
| 44 | + accessible otherwise an IllegalAccess exception would |
| 45 | + be thrown." |
| 46 | + (let [classCache* (.getDeclaredField clojure.lang.DynamicClassLoader "classCache")] |
| 47 | + (.setAccessible classCache* true) |
| 48 | + (.get classCache* clojure.lang.DynamicClassLoader))) |
| 49 | + |
16 | 50 | (defn fn-deps |
17 | | - "Returns a set with all the functions invoked by `val`. |
18 | | - `val` can be a function value, a var or a symbol." |
| 51 | + "Returns a set with all the functions invoked inside `v` or any contained anonymous functions. |
| 52 | + `v` can be a function value, a var or a symbol. |
| 53 | + If a function was defined multiple times, old lambda deps will |
| 54 | + be returned. |
| 55 | + This does not return functions marked with meta :inline like `+` |
| 56 | + since they are already compiled away at this point." |
19 | 57 | {:added "0.5"} |
20 | | - [val] |
21 | | - (let [val (as-val val)] |
22 | | - (set (some->> val class .getDeclaredFields |
23 | | - (keep (fn [^java.lang.reflect.Field f] |
24 | | - (or (and (identical? clojure.lang.Var (.getType f)) |
25 | | - (java.lang.reflect.Modifier/isPublic (.getModifiers f)) |
26 | | - (java.lang.reflect.Modifier/isStatic (.getModifiers f)) |
27 | | - (-> f .getName (.startsWith "const__")) |
28 | | - (.get f val)) |
29 | | - nil))))))) |
| 58 | + [v] |
| 59 | + (when-let [^clojure.lang.AFn v (to-fn v)] |
| 60 | + (let [f-class-name (-> v .getClass .getName)] |
| 61 | + ;; this uses the implementation detail that the clojure compiler always |
| 62 | + ;; prefixes names of lambdas with the name of its surrounding function class |
| 63 | + (into #{} (comp (filter (fn [[k _v]] (clojure.string/includes? k f-class-name))) |
| 64 | + (map (fn [[_k value]] (.get ^java.lang.ref.Reference value))) |
| 65 | + (mapcat fn-deps-class)) |
| 66 | + class-cache)))) |
| 67 | + |
| 68 | +(defn fn-transitive-deps |
| 69 | + "Returns a set with all the functions invoked inside `v` or inside those functions. |
| 70 | + `v` can be a function value, a var or a symbol." |
| 71 | + {:added "0.9"} |
| 72 | + [v] |
| 73 | + (let [deps (fn-deps v)] |
| 74 | + (loop [checked #{} |
| 75 | + to-check (into [] deps) |
| 76 | + deps deps] |
| 77 | + (cond |
| 78 | + (empty? to-check) deps |
| 79 | + :else (let [[current & remaining] to-check |
| 80 | + new-deps (fn-deps current)] |
| 81 | + (recur (conj checked current) |
| 82 | + (concat remaining (filter #(contains? deps %) new-deps)) |
| 83 | + (set/union deps new-deps))))))) |
30 | 84 |
|
31 | 85 | (defn- fn->sym |
32 | 86 | "Convert a function value `f` to symbol." |
|
45 | 99 | "Find all functions that refer `var`. |
46 | 100 | `var` can be a function value, a var or a symbol." |
47 | 101 | {:added "0.5"} |
48 | | - [var] |
49 | | - (let [var (as-var var) |
| 102 | + [v] |
| 103 | + (let [var (as-var v) |
50 | 104 | all-vars (q/vars {:ns-query {:project? true} :private? true}) |
51 | 105 | deps-map (zipmap all-vars (map fn-deps all-vars))] |
52 | 106 | (map first (filter (fn [[_k v]] (contains? v var)) deps-map)))) |
| 107 | + |
| 108 | +(comment |
| 109 | + ;; this can be used to blow up memory, which will clear the class cache of old references |
| 110 | + (defn oom [] |
| 111 | + (try (let [memKiller (java.util.ArrayList.)] |
| 112 | + (loop [free 10000000] |
| 113 | + (.add memKiller (object-array free)) |
| 114 | + (.get memKiller 0) |
| 115 | + (recur 100000 #_(if (< (Math/abs (.. Runtime (getRuntime) (freeMemory))) Integer/MAX_VALUE) |
| 116 | + (Math/abs (.. Runtime (getRuntime) (freeMemory))) |
| 117 | + Integer/MAX_VALUE)))) |
| 118 | + (catch OutOfMemoryError _ |
| 119 | + (println "freed")))) |
| 120 | + |
| 121 | + (fn-deps #'fn-refs) |
| 122 | + (fn-deps #'orchard.xref/fn-deps) |
| 123 | + (fn-refs #'orchard.xref/fn->sym) |
| 124 | + |
| 125 | + ;; returns all classes in this ns, even repl eval'd |
| 126 | + (let [f-class-name "orchard.xref" #_(-> orchard.xref/fn-deps .getClass .getName) |
| 127 | + classes (into #{} (comp (filter (fn [[k _v]] (clojure.string/includes? k f-class-name))) |
| 128 | + (map (fn [[_k v]] (.get ^java.lang.ref.Reference v)))) |
| 129 | + class-cache)] |
| 130 | + classes) |
| 131 | + |
| 132 | + (oom) |
| 133 | + (def vars (q/vars {:ns-query {:project? true} :private? true})) |
| 134 | + |
| 135 | + (map fn-deps vars)) |
0 commit comments