1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/trace.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,97 @@
     1.4 +;;; trace.clj -- simple call-tracing macros for Clojure
     1.5 +
     1.6 +;; by Stuart Sierra, http://stuartsierra.com/
     1.7 +;; December 3, 2008
     1.8 +
     1.9 +;; Copyright (c) Stuart Sierra, 2008. All rights reserved.  The use
    1.10 +;; and distribution terms for this software are covered by the Eclipse
    1.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    1.12 +;; which can be found in the file epl-v10.html at the root of this
    1.13 +;; distribution.  By using this software in any fashion, you are
    1.14 +;; agreeing to be bound by the terms of this license.  You must not
    1.15 +;; remove this notice, or any other, from this software.
    1.16 +
    1.17 +
    1.18 +;; This file defines simple "tracing" macros to help you see what your
    1.19 +;; code is doing.
    1.20 +
    1.21 +
    1.22 +;; CHANGE LOG
    1.23 +;;
    1.24 +;; December 3, 2008:
    1.25 +;;
    1.26 +;;   * replaced *trace-out* with tracer
    1.27 +;;
    1.28 +;;   * made trace a function instead of a macro 
    1.29 +;;     (suggestion from Stuart Halloway)
    1.30 +;;
    1.31 +;;   * added trace-fn-call
    1.32 +;;
    1.33 +;; June 9, 2008: first version
    1.34 +
    1.35 +
    1.36 +
    1.37 +(ns 
    1.38 +  ^{:author "Stuart Sierra, Michel Salim",
    1.39 +     :doc "This file defines simple \"tracing\" macros to help you see what your
    1.40 +code is doing."}
    1.41 +  clojure.contrib.trace)
    1.42 +
    1.43 +(def
    1.44 + ^{:doc "Current stack depth of traced function calls."}
    1.45 + *trace-depth* 0)
    1.46 +
    1.47 +(defn tracer
    1.48 +  "This function is called by trace.  Prints to standard output, but
    1.49 +  may be rebound to do anything you like.  'name' is optional."
    1.50 +  [name value]
    1.51 +  (println (str "TRACE" (when name (str " " name)) ": " value)))
    1.52 +
    1.53 +(defn trace
    1.54 +  "Sends name (optional) and value to the tracer function, then
    1.55 +  returns value.  May be wrapped around any expression without
    1.56 +  affecting the result."
    1.57 +  ([value] (trace nil value))
    1.58 +  ([name value]
    1.59 +     (tracer name (pr-str value))
    1.60 +     value))
    1.61 +
    1.62 +(defn trace-indent
    1.63 +  "Returns an indentation string based on *trace-depth*"
    1.64 +  []
    1.65 +  (apply str (take *trace-depth* (repeat "|    "))))
    1.66 +
    1.67 +(defn trace-fn-call
    1.68 +  "Traces a single call to a function f with args.  'name' is the
    1.69 +  symbol name of the function."
    1.70 +  [name f args]
    1.71 +  (let [id (gensym "t")]
    1.72 +    (tracer id (str (trace-indent) (pr-str (cons name args))))
    1.73 +    (let [value (binding [*trace-depth* (inc *trace-depth*)]
    1.74 +                  (apply f args))]
    1.75 +      (tracer id (str (trace-indent) "=> " (pr-str value)))
    1.76 +      value)))
    1.77 +
    1.78 +(defmacro deftrace
    1.79 +  "Use in place of defn; traces each call/return of this fn, including
    1.80 +  arguments.  Nested calls to deftrace'd functions will print a
    1.81 +  tree-like structure."
    1.82 +  [name & definition]
    1.83 +  `(do
    1.84 +     (def ~name)
    1.85 +     (let [f# (fn ~@definition)]
    1.86 +       (defn ~name [& args#]
    1.87 +         (trace-fn-call '~name f# args#)))))
    1.88 +
    1.89 +(defmacro dotrace
    1.90 +  "Given a sequence of function identifiers, evaluate the body
    1.91 +   expressions in an environment in which the identifiers are bound to
    1.92 +   the traced functions.  Does not work on inlined functions,
    1.93 +   such as clojure.core/+"
    1.94 +  [fnames & exprs]
    1.95 +  `(binding [~@(interleave fnames
    1.96 +                           (for [fname fnames]
    1.97 +                             `(let [f# @(var ~fname)]
    1.98 +                                (fn [& args#]
    1.99 +                                  (trace-fn-call '~fname f# args#)))))]
   1.100 +     ~@exprs))