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

fix the topological sort and make it use a sorter to resolve nodes at the same level

Browse Source 
svn: r14361

original commit: bab1558e02b7e088b604ae1a3ce259ff5eafa74e
This commit is contained in:
Eli Barzilay 2009-03-30 17:42:09 +00:00
parent df3d14b585
commit cf6dd7adb7
1 changed files with 28 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
collects/profile/analyzer.ss
View File

@ -131,9 +131,10 @@
(set-node-total! *-node total-time) (set-node-total! *-node total-time)
;; convert the nodes from the hash to a list, do a topological sort, and then ;; convert the nodes from the hash to a list, do a topological sort, and then
;; sort by total time (combining both guarantees(?) sensible order) ;; sort by total time (combining both guarantees(?) sensible order)
(let* ([nodes (hash-map id+src->node-hash (lambda (k v) v))] (let ([nodes (remq *-node (topological-sort
[nodes (topological-sort *-node (length nodes))] *-node
[nodes (sort (remq *-node nodes) > #:key node-total)]) (lambda (nodes)
(sort nodes > #:key node-total))))])
;; sort all the edges in the nodes according to total time ;; sort all the edges in the nodes according to total time
(for ([n (in-list nodes)]) (for ([n (in-list nodes)])
(set-node-callees! n (sort (node-callees n) > #:key edge-callee-time)) (set-node-callees! n (sort (node-callees n) > #:key edge-callee-time))
@ -148,21 +149,30 @@
*-node))) *-node)))
;; A simple topological sort of nodes using BFS, starting from node `x' which ;; A simple topological sort of nodes using BFS, starting from node `x' which
;; will be the special *-node. Note that `expected-length' is only given for ;; will be the special *-node. `subsort' is a `resolver' function to sort
;; the sanity check in the end. ;; nodes on the same level.
(define (topological-sort x expected-length) (define (topological-sort x subsort)
(define sorted (let loop ([todo (list x)] [seen (list x)])
(let loop ([todo (list x)] [seen (list x)]) (if (null? todo)
(if (null? todo) '()
'() (let* ([next (append-map (lambda (x) (map edge-callee (node-callees x)))
(let* ([next (append-map (lambda (x) (map edge-caller (node-callers x))) todo)]
todo)] [next (remove-duplicates next)]
[next (remove-duplicates next)] [next (subsort (remq* seen next))])
[next (remq* seen next)]) (append todo (loop next (append next seen)))))))
(append todo (loop next (append next seen))))))) #|
(if (= expected-length (length sorted)) (define (node id) (make-node id #f '() 0 0 '() '()))
sorted (define (X . -> . Y)
(error 'topological "internal error"))) (let ([e (make-edge 0 X 0 Y 0)])
(set-node-callers! Y (cons e (node-callers Y)))
(set-node-callees! X (cons e (node-callees X)))))
(define A (node 'A))
(define B (node 'B))
(define C (node 'C))
(A . -> . B)
(B . -> . C)
(topological-sort A 3)
|#
;; Groups raw samples by their thread-id, returns a vector with a field for ;; Groups raw samples by their thread-id, returns a vector with a field for
;; each thread id holding the sample data for that thread. The samples in ;; each thread id holding the sample data for that thread. The samples in