diff --git a/collects/profile/contract-profile.rkt b/collects/profile/contract-profile.rkt index b7dcdf6afd..9606aae775 100644 --- a/collects/profile/contract-profile.rkt +++ b/collects/profile/contract-profile.rkt @@ -4,8 +4,7 @@ racket/contract (only-in racket/contract/private/guts contract-continuation-mark-key) "sampler.rkt" "utils.rkt" - ;; for grphviz rendering - redex/private/dot racket/system) + "contract-profiler/dot.rkt") (struct contract-profile (total-time n-samples n-contract-samples @@ -130,7 +129,6 @@ ;; boundary. ;; Typed modules are in green, untyped modules are in red. -(define dot-exe (find-dot)) (define module-graph-dot-file "tmp-contract-profile-module-graph.dot") (define (module-graph-view correlated) @@ -195,10 +193,7 @@ (samples-time v))) (printf "}\n"))) ;; render, if graphviz is installed - (when dot-exe - (system (format "~a -Tpdf -O ~a" - (path->string dot-exe) - module-graph-dot-file)))) + (render-dot module-graph-dot-file)) ;;--------------------------------------------------------------------------- diff --git a/collects/profile/contract-profiler/dot.rkt b/collects/profile/contract-profiler/dot.rkt new file mode 100644 index 0000000000..2a1dcab06f --- /dev/null +++ b/collects/profile/contract-profiler/dot.rkt @@ -0,0 +1,29 @@ +#lang racket/base + +;; Graphviz support +;; inspired by redex/private/dot.rkt (can't use directly because it uses GUI) + +(require racket/system) + +(provide render-dot) + +;; these paths are explicitly checked (when find-executable-path +;; fails) because starting drracket from the finder (or the dock) +;; under mac os x generally does not get the path right. +(define dot-paths + '("/usr/bin" + "/bin" + "/usr/local/bin" + "/opt/local/bin/")) + +(define dot.exe (if (eq? (system-type) 'windows) "dot.exe" "dot")) +(define dot + (or (find-executable-path dot.exe) + (ormap (λ (x) + (define candidate (build-path x dot.exe)) + (and (file-exists? candidate) candidate)) + dot-paths))) + +(define (render-dot input-file) + (when dot + (system (format "~a -Tpdf -O ~a" (path->string dot) input-file))))