-
-
Save vlaaad/0350b61e127e82165d195b490999ec0a to your computer and use it in GitHub Desktop.
Function call tree tracer that abuses function internals
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(ns fdeps | |
(:import [java.lang.reflect Field Modifier] | |
[clojure.lang Var RT])) | |
(defn fdeps | |
([val] | |
(fdeps val {})) | |
([val m] | |
(reduce | |
(fn [acc var] | |
(let [acc (update acc val (fnil conj #{}) var) | |
var-val @var] | |
(if (contains? acc var-val) | |
acc | |
(fdeps var-val acc)))) | |
m | |
(some->> val | |
class | |
.getDeclaredFields | |
(keep (fn [^Field f] | |
(or (and (identical? Var (.getType f)) | |
(Modifier/isPublic (.getModifiers f)) | |
(Modifier/isStatic (.getModifiers f)) | |
(-> f .getName (.startsWith "const__")) | |
(.get f val)) | |
nil))))))) | |
(defn f->sym [f] | |
(symbol (Compiler/demunge (.getName (type f))))) | |
(def ^:dynamic *calls*) | |
(defn track-calls [f args] | |
(let [*calls (atom []) | |
ret (binding [*calls* *calls] | |
(.applyTo f (RT/seq args)))] | |
{:form (->> args | |
(map #(or (some-> % meta ::f f->sym) %)) | |
(cons (f->sym f))) | |
:ret ret | |
:calls @*calls})) | |
(defn trace [f] | |
(let [deps (fdeps f) | |
wrap-fn (fn [f] | |
(with-meta (fn [& args] | |
(let [result (track-calls f args)] | |
(swap! *calls* conj result) | |
(:ret result))) | |
{::f f})) | |
vars (vec (apply clojure.set/union (vals deps))) | |
old-vals (zipmap vars (map #(.getRawRoot %) vars))] | |
(try | |
(doseq [v vars] | |
(alter-var-root v wrap-fn)) | |
(track-calls f nil) | |
(finally | |
(doseq [[var val] old-vals] | |
(.bindRoot var val)))))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Usage:
Pros:
Cons: