1ファイルだけのcall-graph

そのファイルで定義された関数だけ見る。let-fnやletの中で定義された関数は無視。

(use '[clojure.contrib.duck-streams :only (reader writer with-out-writer)])
(use '[clojure.contrib.str-utils :only (re-gsub)])

(defn read-sexps
  "Like read-lines but read with read function (not read-line)"
  [f]
  (let [rdr (-> (reader f)
		(clojure.lang.LineNumberingPushbackReader.))]
    ((fn step [] 
       (if-let [item (read rdr false nil)]
	 (lazy-seq (cons item (step)))
	 (.close rdr))))))

;;;exttract-*系をlazy-seqにする必要はあるのかな？(transientを止めて)
(declare extract-conj! extract-cars)
(defn- extract-conj! [trv x]
  (cond (symbol? x) (conj! trv x)
	(seq? x) (extract-cars (rest x) (extract-conj! trv (first x)))
	:else trv))

(defn- check-car?$ [coll]
  (fn [x]
    (some #(= % (first x)) coll)))

(def car-is-let? (check-car?$ '[let if-let when-let for]))
(def car-is-collfn? (check-car?$ '[map mapcat pmap reduce]))
(def car-is-uses? (check-car?$ '[use import require])) 

(defn extract-cars
  ([sexp] (persistent! (extract-cars sexp (transient []))))
  ([sexp acc]
     (reduce (fn [acc x]
	       (if (seq? x)
		 (cond (car-is-let? x)
		       (reduce #(extract-cars %2 %1)
			       acc
			       (list
				(map fnext (partition 2 (fnext x)))
				(nnext x)))
		       (car-is-collfn? x)
		       (extract-cars
			(nnext x) (extract-conj!(extract-conj! acc (first x))  (fnext x)))
		       :else (extract-cars 
			      (next x) (extract-conj! acc (first x))))
		 acc))
	     acc sexp)))

(defn- get-name [def-form] 
  (let [name (fnext def-form)]
    ;手抜き
    (if (symbol? name) name 'false)))

(defn call-graph-map [xs]
  (let [xs (remove car-is-uses? xs)
	names (map get-name xs)
	name-map (reduce #(assoc! %1 %2 '()) (transient {}) names)]
    (persistent!
     (reduce 
      (fn [m [name sexp]]
	(let [vs (reduce (fn [coll sym]
			   (if (m sym) (cons sym coll) coll))
			 '() (extract-cars sexp))]
	  (if (empty? vs) m (assoc! m name vs))))
      name-map 
      (zipmap names xs)))))

(defn re-gsub* [m string]
     (reduce (fn [str [regexp replacement]]
	       (re-gsub regexp replacement str))
	     string m))

(defn dump-with-graphviz-style 
  ([cmap color label]
     (let [fmt (fn [s]
		 (re-gsub* {#"->>" "aarrow", #"->" "arrow", #"\!" "_bang", #"\?" "_question", #"\$" "_dollar" #"\*" "_star" #"-" "_"}
			   (str s)))]
       (println "digraph simple_hierarchy {")
       (println "\tgraph [concentrate = true];")
       (doseq [[k vs] cmap]
       	 (let [k* (fmt k)]
       	   (printf "\t%s [label=\"%s\"];\n" k* k)
       	   (doseq [v (set vs)]
       	     (printf "\t%s->%s[label=\"%s\", fontcolor=%s];\n" k* (fmt v) label color)))) 
       (println "}")))
  ([cmap] (dump-with-graphviz-style cmap "darkgreen" "call")))

(defn main [ifile ofile]
  (with-out-writer ofile
    (dump-with-graphviz-style (call-graph-map (read-sexps ifile)))))

何かが違う。書いていて違和感が残る。上手くclojureを使えない。