diff --git a/collects/profile/analyzer.ss b/collects/profile/analyzer.ss index 946e309..664aee7 100644 --- a/collects/profile/analyzer.ss +++ b/collects/profile/analyzer.ss @@ -78,10 +78,8 @@ (set-node-total! *-node total-time) ;; convert the nodes from the hash to a list, do a topological sort, and then ;; sort by total time (combining both guarantees(?) sensible order) - (let* ([nodes (topological-sort *-node)] - [nodes (append-map (lambda (nodes) (sort nodes > #:key node-total)) - nodes)] - [nodes (remq *-node nodes)]) + (let ([nodes (append-map (lambda (nodes) (sort nodes > #:key node-total)) + (topological-sort *-node))]) ;; sort all the edges in the nodes according to total time (for ([n (in-list nodes)]) (set-node-callees! n (sort (node-callees n) > #:key edge-callee-time)) diff --git a/collects/profile/utils.ss b/collects/profile/utils.ss index d94f02a..abf5a99 100644 --- a/collects/profile/utils.ss +++ b/collects/profile/utils.ss @@ -48,12 +48,13 @@ [(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. +;; 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 (list (list x))] [seen (list 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)] diff --git a/collects/tests/profile/topsort.ss b/collects/tests/profile/topsort.ss index 7ab2160..f43dc4a 100644 --- a/collects/tests/profile/topsort.ss +++ b/collects/tests/profile/topsort.ss @@ -33,25 +33,25 @@ (define (topological-sort-tests) (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))) - (same-levels '(A -> B -> C -> A - A -> C -> B -> A) - '((A) (B C))) + (same-levels '(* -> A + * -> B + B -> B) + '((A B))) - (same-levels '(A -> B -> C -> D - A -> D) - '((A) (B) (C) (D))) - - (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))) + (same-levels '(* -> A + * -> B -> C + * -> C -> B) + '((A B C))) ))