Created
June 11, 2012 19:38
-
-
Save charles-dyfis-net/2912188 to your computer and use it in GitHub Desktop.
Trawling Clojure's thread-local frames
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 thread-utils) | |
(def ^:private frame-prev-field (doto (.getDeclaredField clojure.lang.Var$Frame "prev") (.setAccessible true))) | |
(def ^:private bindings-field (doto (.getDeclaredField clojure.lang.Var$Frame "bindings") (.setAccessible true))) | |
(def ^:private tbox-val-field (doto (.getDeclaredField clojure.lang.Var$TBox "val") (.setAccessible true))) | |
(def ^:private thread-locals-field (doto (.getDeclaredField Thread "threadLocals") (.setAccessible true))) | |
(def ^:private thread-local-map-field (doto (.getDeclaredField java.lang.ThreadLocal$ThreadLocalMap "table") (.setAccessible true))) | |
(def ^:private entry-value-field (doto (.getDeclaredField java.lang.ThreadLocal$ThreadLocalMap$Entry "value") (.setAccessible true))) | |
(defn all-threads [] | |
(let [thread-array (into-array Thread (repeat 255 nil))] (Thread/enumerate thread-array) (filter identity thread-array))) | |
(defn locals-for-thread [thread] | |
(let [locals (.get thread-locals-field thread) | |
tls-map (and locals (.get thread-local-map-field locals))] | |
(when tls-map | |
(filter identity | |
(map #(.get entry-value-field %) | |
(filter identity tls-map)))))) | |
(defn clojure-frame-heads-for-thread [thread] | |
(filter #(= (type %) clojure.lang.Var$Frame) (locals-for-thread thread))) | |
(defn parent-frame [frame] | |
(.get frame-prev-field frame)) | |
(defn frame-seq [frame] | |
(when frame | |
(lazy-seq (cons frame | |
(frame-seq (parent-frame frame)))))) | |
(defn clojure-frame-vars [] | |
(for [t (all-threads) | |
frame-head (clojure-frame-heads-for-thread t) | |
:when frame-head | |
frame (frame-seq frame-head) | |
:let [bindings (.get bindings-field frame)] | |
[var tbox] bindings | |
:let [value (.get tbox-val-field tbox)]] | |
{:thread t, :frame frame, :var var, :value value})) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
I would write (remove nil? _) instead of (filter identity _), but that's just me.
Edit: I just noticed the implementation of remove. My version becomes (filter (complement nil?) _) which I'm guessing is a bit slower than (filter identity _), which is probably what you were going for.