don't include the *-node in the topological-sort output

svn: r14835

original commit: 8e79a2aed5289f12bc9a111ab50e5a66ab9b24fd
This commit is contained in:
Eli Barzilay 2009-05-15 19:28:38 +00:00
parent 2ac42691a8
commit dffc446fc5
3 changed files with 24 additions and 25 deletions

View File

@ -78,10 +78,8 @@
(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 (topological-sort *-node)] (let ([nodes (append-map (lambda (nodes) (sort nodes > #:key node-total))
[nodes (append-map (lambda (nodes) (sort nodes > #:key node-total)) (topological-sort *-node))])
nodes)]
[nodes (remq *-node nodes)])
;; 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))

View File

@ -48,12 +48,13 @@
[(zero? total-time) (profile-nodes profile)] [(zero? total-time) (profile-nodes profile)]
[else (filter hide? (profile-nodes profile))])) [else (filter hide? (profile-nodes profile))]))
;; A simple topological sort of nodes using the Khan method, starting ;; A simple topological sort of nodes using the Khan method, starting from node
;; from node `x' (which will be given as the special *-node). The ;; `x' (which will be given as the special *-node). The result is a list of
;; result is a list of node lists, each one corresponds to one level. ;; 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) (provide topological-sort)
(define (topological-sort x) (define (topological-sort x)
(let loop ([todo (list x)] [sorted (list (list x))] [seen (list x)]) (let loop ([todo (list x)] [sorted '()] [seen (list x)])
(let* (;; take the next level of nodes (let* (;; take the next level of nodes
[next (append-map (lambda (x) (map edge-callee (node-callees x))) [next (append-map (lambda (x) (map edge-callee (node-callees x)))
todo)] todo)]

View File

@ -33,25 +33,25 @@
(define (topological-sort-tests) (define (topological-sort-tests)
(test (test
(same-levels '(A -> B -> C) (same-levels '(* -> A -> B)
'((A) (B)))
(same-levels '(* -> A -> B -> *
* -> B -> A -> *)
'((A B)))
(same-levels '(* -> A -> B -> C
* -> C)
'((A) (B) (C))) '((A) (B) (C)))
(same-levels '(A -> B -> C -> A (same-levels '(* -> A
A -> C -> B -> A) * -> B
'((A) (B C))) B -> B)
'((A B)))
(same-levels '(A -> B -> C -> D (same-levels '(* -> A
A -> D) * -> B -> C
'((A) (B) (C) (D))) * -> C -> B)
'((A B C)))
(same-levels '(A -> B
A -> C
C -> C)
'((A) (B C)))
(same-levels '(A -> B
A -> C -> D
A -> D -> C)
'((A) (B C D)))
)) ))