suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Render module graph.

Browse Source
This commit is contained in:
Vincent St-Amour 2013-05-30 17:28:15 -04:00
parent 693c88ff54
commit a5f47f86e5
1 changed files with 28 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
collects/profile/contract-profile.rkt
View File

@ -3,7 +3,9 @@
(require racket/list unstable/list racket/match racket/set racket/format (require racket/list unstable/list racket/match racket/set racket/format
racket/contract racket/contract
(only-in racket/contract/private/guts contract-continuation-mark-key) (only-in racket/contract/private/guts contract-continuation-mark-key)
"sampler.rkt" "utils.rkt") "sampler.rkt" "utils.rkt"
;; for grphviz rendering
redex/private/dot racket/system)
(struct contract-profile (struct contract-profile
(total-time n-samples n-contract-samples (total-time n-samples n-contract-samples
@ -121,6 +123,9 @@
;; boundary. ;; boundary.
;; Typed modules are in green, untyped modules are in red. ;; 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) (define (module-graph-view correlated)
(match-define (contract-profile total-time n-samples n-contract-samples (match-define (contract-profile total-time n-samples n-contract-samples
live-contract-samples all-blames) live-contract-samples all-blames)
@ -161,20 +166,28 @@
(values n typed?))) (values n typed?)))
;; graphviz output ;; graphviz output
(printf "digraph {\n") (with-output-to-file module-graph-dot-file
(define nodes->names (for/hash ([n nodes]) (values n (gensym)))) #:exists 'replace
(for ([n nodes]) (lambda ()
(printf "~a[label=\"~a\"][color=\"~a\"]\n" (printf "digraph {\n")
(hash-ref nodes->names n) (define nodes->names (for/hash ([n nodes]) (values n (gensym))))
n (for ([n nodes])
(if (hash-ref nodes->typed? n) "green" "red"))) (printf "~a[label=\"~a\"][color=\"~a\"]\n"
(for ([(k v) (in-hash edge-samples)]) (hash-ref nodes->names n)
(match-define (cons pos neg) k) n
(printf "~a -> ~a[label=\"~ams\"]\n" (if (hash-ref nodes->typed? n) "green" "red")))
(hash-ref nodes->names neg) (for ([(k v) (in-hash edge-samples)])
(hash-ref nodes->names pos) (match-define (cons pos neg) k)
(samples-time v))) (printf "~a -> ~a[label=\"~ams\"]\n"
(printf "}\n")) (hash-ref nodes->names neg)
(hash-ref nodes->names pos)
(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))))
;;--------------------------------------------------------------------------- ;;---------------------------------------------------------------------------