42 lines
1.6 KiB
Racket
42 lines
1.6 KiB
Racket
#lang scheme/base
|
|
|
|
(provide render)
|
|
|
|
(require "structs.ss" "analyzer.ss" "utils.ss")
|
|
|
|
(define (render profile
|
|
#:hide-self [hide-self% 1/100]
|
|
#:hide-subs [hide-subs% 2/100])
|
|
(define *-node (profile-*-node profile))
|
|
(define hidden (get-hidden profile hide-self% hide-subs%))
|
|
(define nodes (remq* hidden (profile-nodes profile)))
|
|
(define total-time (profile-total-time profile))
|
|
(define node->
|
|
(let ([t (make-hasheq)])
|
|
(for ([node (in-list nodes)] [idx (in-naturals 1)])
|
|
(let ([id (node-id node)] [src (node-src node)])
|
|
(hash-set! t node
|
|
(list (format "node~a" idx)
|
|
(if id
|
|
(format "~a" id)
|
|
(regexp-replace #rx"^.*/"
|
|
(format-source (node-src node))
|
|
""))))))
|
|
(lambda (mode node)
|
|
((case mode [(index) car] [(label) cadr]) (hash-ref t node)))))
|
|
(define max-self%
|
|
(/ (for/fold ([m 0]) ([node (in-list nodes)]) (max m (node-self node)))
|
|
total-time))
|
|
(printf "digraph Profile {\n")
|
|
(for ([node (in-list nodes)])
|
|
(define self% (/ (node-self node) total-time))
|
|
(printf "~a [" (node-> 'index node))
|
|
(printf "label=~s, " (node-> 'label node))
|
|
(printf "fillcolor=\"1,~a,1\", " (exact->inexact (/ self% max-self%)))
|
|
(printf "style=filled];\n")
|
|
(for ([edge (in-list (node-callees node))])
|
|
(define callee (edge-callee edge))
|
|
(unless (or (eq? *-node callee) (memq callee hidden))
|
|
(printf "~a -> ~a;\n" (node-> 'index node) (node-> 'index callee)))))
|
|
(printf "}\n"))
|