trace forms

gistfile1.clj

(ns trace
  (:use clojure.pprint))

(declare trace-form)

(def *ignore*
  '#{def quote var try monitor-enter monitor-exit})

(defmulti trace-special-form (fn [form] (first form)))

(defn- trace-bindings [bindings]
  (vec (apply concat
              (map (fn [[sym value]]
                     `[~sym (trace-forms ~value)]) (partition 2 bindings)))))

(defmethod trace-special-form 'let* [[_ bindings & body]]
  `(let* ~(trace-bindings bindings)
     (trace-forms ~@body)))

(defmethod trace-special-form 'loop* [[_ bindings & body]]
  `(loop* ~(trace-bindings bindings)
     (trace-forms ~@body)))

(defmethod trace-special-form 'new [[_ name & args]]
  `(new ~name ~@(map trace-form args)))

(defn trace-fn-body [body]
  `(~(first body) ~@(map trace-form (rest body))))

(defmethod trace-special-form 'fn* [[_ & args]]
  (if (symbol? (first args))
    (if (vector? (second args))
      `(fn* ~(first args) ~@(trace-fn-body (rest args)))
      `(fn* ~(first args) ~@(map trace-fn-body (rest args))))
    (if (vector? (first args))
      `(fn* ~@(trace-fn-body args))
      `(fn* ~@(map trace-fn-body args)))))

(defmethod trace-special-form :default [form]
  :default)

(defn trace-value [v]
  (cond
    (vector? v) `(vector ~@(map trace-form v))
    (map? v)    `(into {} ~(vec (map trace-value v)))
    (set? v)    `(into #{} ~(vec (map trace-form v)))
    :else v))

(defn recurs? [form]
  (if (and (or (list? form)
               (seq? form))
           (> (count form) 0))
    (condp = (first form)
      'recur true
      'quote false
      (some identity (map recurs? (rest form))))
    false))

(defn trace-form* [form]
  (if (and (or (list? form)
               (seq? form))
           (> (count form) 0))
    (if (*ignore* (first form))
      form
      (let [sform (trace-special-form form)]
        (if (= sform :default)
          (let [mform (macroexpand-1 form)]
            (if (= form mform)
              (cons (first mform) (map trace-form (rest mform)))
              (trace-form mform)))
          sform)))
    (trace-value form)))

(defn trace-form [form]
  (if (recurs? form)
    (trace-form* form)
    `(try
       ~(trace-form* form)
       (catch Exception e#
         (print "Form failed: ")
         (pprint '~form)
         (throw e#)))))

(defmacro trace-forms [& body]
  `(do
     ~@(map trace-form body)))