-
Notifications
You must be signed in to change notification settings - Fork 1
/
trace.clj
136 lines (118 loc) · 4.51 KB
/
trace.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
(ns fn.trace
(:require [clojure.pprint :as pp]))
(def ^{:dynamic true
:doc "Current stack depth of traced function calls."}
*trace-depth* 0)
(defmethod print-method Throwable [t out]
(print-ctor t (fn [o w]
(print-method (.getMessage t) w)) out))
(defn trace-indent
"Returns an indentation string based on *trace-depth*"
[]
(apply str (take *trace-depth* (repeat "| "))))
(defn text-format [name value & [out?]]
(let [label (when name (format "%6s: " name))]
(if out?
(str label (trace-indent) "=> " (pr-str value))
(str label (trace-indent) (pr-str value)))))
(defn ^:dynamic tracer
"This function is called by trace. Prints to standard output, but
may be rebound to do anything you like. 'name' is optional."
[name value & [out?]]
(println (text-format name value)))
(def thread-local-filewriter
(proxy [ThreadLocal] []
(initialValue [] (->> (Thread/currentThread)
.getName
(format "%s.trace")
java.io.FileWriter.))))
(defn thread-tracer
"Writes trace to a file based on the current thread name"
[name value & [out?]]
(binding [*out* (.get thread-local-filewriter)]
(println (text-format name value out?))))
(defn per-thread-tracer
"Returns a tracer that writes to a file based on the name of the
current thread. Warning: binding tracer to functions produced here
might not have the effect you want. Futures, for instance, will use
the same binding as the parent thread, and cause shuffled tracing
entries in the output."
[& [formatter]]
(let [formatter (or formatter text-format)
tracefile-name (str (.getName (Thread/currentThread)) ".trace")
tr-file-writer (java.io.FileWriter. tracefile-name)]
(fn [name value & [out?]]
(binding [*out* tr-file-writer]
(println (formatter name value out?))))))
(defn trace-fn-call
"Traces a single call to a function f with args. 'name' is the
symbol name of the function."
[name f args]
(let [id (gensym "t")]
(tracer id (cons name args))
(let [[value err] (binding [*trace-depth* (inc *trace-depth*)]
(try [(apply f args) nil]
(catch Throwable e [e e])))]
(binding [*print-length* (or *print-length* 10)
*print-level* (or *print-level* 10)] ;;catch-all max, rebind if you want more/less
(tracer id value true))
(when err (throw err))
value)))
(defmacro deftrace
"Use in place of defn; traces each call/return of this fn, including
arguments. Nested calls to deftrace'd functions will print a
tree-like structure."
[name & definition]
`(do
(def ~name)
(let [f# (fn ~@definition)]
(defn ~name [& args#]
(trace-fn-call '~name f# args#)))))
(defn rebind-map [fnames]
(into {}
(for [fname fnames :let [thisvar (resolve fname)] :when thisvar]
(let [fn-to-trace (var-get thisvar)]
[thisvar (fn [& args]
(trace-fn-call fname fn-to-trace args))]))))
(defmacro dotrace
"Given a sequence of function identifiers, evaluate
the body expressions in an environment in which the identifiers are
bound to the traced functions. Does not work on inlined functions,
such as clojure.core/+"
[fnames & exprs]
`(with-redefs-fn (rebind-map ~fnames) (fn [] ~@exprs)) )
(defn non-macro-fn? [v]
(and (fn? (deref v)) (not (:macro (meta v)))))
(defn all-fn-in-ns [ & namespaces]
(for [namespace namespaces
[k v] (ns-interns namespace)
:when (non-macro-fn? v)]
(symbol (str (.ns v) "/" (.sym v)))))
(defn all-fns
"Takes a list of symbols corresponding to either fns or namespaces,
namespaces are expanded to all the fns in that namespace. Returns
the larger list of symbols."
[syms]
(mapcat (fn [sym]
(cond (find-ns sym) (all-fn-in-ns sym)
(try (resolve sym) (catch Exception _ nil)) (list sym)
:else (list)))
syms))
(defmacro dotrace-all [syms & forms]
`(dotrace
(all-fns ~syms) ~@forms))
(defn log-dispatch [obj]
(if (-> obj meta :log)
(binding [*print-level* 10
*print-length* 100]
(let [indent 2]
(doseq [[o out?] obj]
(if-not out?
(do
(pp/pprint-indent :current indent)
(pp/code-dispatch o))
(do
(pp/pprint-indent :current (- indent))
(pp/simple-dispatch o)))
(pp/pprint-newline :mandatory))))
(pp/code-dispatch obj)))