75 lines
3.3 KiB
Scheme
75 lines
3.3 KiB
Scheme
#lang scheme/base
|
|
|
|
(require "structs.ss" scheme/list)
|
|
|
|
;; Format a percent number, possibly doing the division too. If we do the
|
|
;; division, then be careful: if we're dividing by zero, then make the result
|
|
;; zero. This is useful if the total time is zero because we didn't see any
|
|
;; activity (for example, the profiled code is just doing a `sleep'), in which
|
|
;; case all times will be 0.
|
|
(provide format-percent)
|
|
(define format-percent
|
|
(case-lambda
|
|
[(percent)
|
|
(let ([percent (inexact->exact (round (* percent 1000)))])
|
|
(format "~a.~a%" (quotient percent 10) (modulo percent 10)))]
|
|
[(x y) (format-percent (if (zero? y) 0 (/ x y)))]))
|
|
|
|
(provide format-source)
|
|
(define (format-source src)
|
|
(if src
|
|
(format "~a:~a"
|
|
(srcloc-source src)
|
|
(if (srcloc-line src)
|
|
(format "~a:~a" (srcloc-line src) (srcloc-column src))
|
|
(format "#~a" (srcloc-position src))))
|
|
"(unknown source)"))
|
|
|
|
;; Hide a node if its self time is smaller than the self threshold *and* all of
|
|
;; its edges are below the sub-node threshold too -- this avoids confusing
|
|
;; output where a node does not have an entry but appears as a caller/callee.
|
|
(provide get-hidden)
|
|
(define (get-hidden profile hide-self% hide-subs%)
|
|
(define self% (or hide-self% 0))
|
|
(define subs% (or hide-subs% 0))
|
|
(define total-time (profile-total-time profile))
|
|
(define (hide? node)
|
|
(define (hide-sub? get-subs edge-sub edge-sub-time)
|
|
(define %s
|
|
(map (lambda (edge)
|
|
(let ([total (node-total (edge-sub edge))])
|
|
(if (zero? total) 0 (/ (edge-sub-time edge) total))))
|
|
(get-subs node)))
|
|
(subs% . >= . (apply max %s)))
|
|
(and (self% . >= . (/ (node-self node) total-time))
|
|
(hide-sub? node-callees edge-callee edge-caller-time)
|
|
(hide-sub? node-callers edge-caller edge-callee-time)))
|
|
(cond [(and (<= self% 0) (<= subs% 0)) '()]
|
|
[(zero? total-time) (profile-nodes profile)]
|
|
[else (filter hide? (profile-nodes profile))]))
|
|
|
|
;; A simple topological sort of nodes using the Khan method, starting from node
|
|
;; `x' (which will be given as the special *-node). The result is a list of
|
|
;; node lists, each one corresponds to one level. Conceptually, the input node
|
|
;; is always only item in the first level, so it is not included in the result.
|
|
(provide topological-sort)
|
|
(define (topological-sort x)
|
|
(let loop ([todo (list x)] [sorted '()] [seen (list x)])
|
|
(let* (;; take the next level of nodes
|
|
[next (append-map (lambda (x) (map edge-callee (node-callees x)))
|
|
todo)]
|
|
;; remove visited and duplicates
|
|
[next (remove-duplicates (remq* seen next))]
|
|
;; leave only nodes with no other incoming edges
|
|
[seen* (append next seen)] ; important for cycles
|
|
[next* (filter (lambda (node)
|
|
(andmap (lambda (e) (memq (edge-caller e) seen*))
|
|
(node-callers node)))
|
|
next)]
|
|
;; but if all nodes have other incoming edges, then there must be a
|
|
;; cycle, so just do them now (instead of dropping them)
|
|
[next (if (null? next*) next next*)])
|
|
(if (null? next)
|
|
(reverse sorted)
|
|
(loop next (cons next sorted) (append next seen))))))
|