     >alist [ second total-time>> ] inv-sort-with ;
 
 : duration. ( duration -- )
-    duration>seconds >float pprint " " write \ seconds pprint ;
+    duration>milliseconds >integer pprint "ms" write ;
 
 DEFER: (profile.)
 
+: times. ( node -- )
+    {
+        [ total-time>> duration. " (" write ]
+        [ gc-time>> duration. " gc, " write ]
+        [ foreign-time>> duration. " foreign, " write ]
+        [ foreign-thread-time>> duration. " foreign threads)" write ]
+    } cleave ;
+
 :: (profile-node.) ( word node depth -- )
-    depth depth. node total-time>> duration. ": " write word pprint nl
+    depth depth. node times. ": " write word pprint nl
     node children>> depth 1 + (profile.) ;
 
 : (profile.) ( nodes depth -- )
     [ by-total-time ] dip '[ _ (profile-node.) ] assoc-each ;
 
 : profile. ( tree -- )
-    [ [ "Context: " write pprint nl ] [ 1 (profile.) ] bi* ] assoc-each ;
+    [ 0 (profile-node.) ] assoc-each ;

! (c)2011 Joe Groff bsd license
USING: accessors assocs calendar continuations fry io
kernel kernel.private locals math math.statistics
math.vectors namespaces prettyprint sequences sorting
tools.profiler.sampling.private ;
FROM: sequences => change-nth ;
IN: tools.profiler.sampling

TUPLE: profile-node
    total-time gc-time foreign-time foreign-thread-time children ;

: <profile-node> ( times children -- node )
    [ first4 ] dip profile-node boa ;

: leaf-callstack? ( callstack -- ? )
    [ ignore-words member? ] all? ;

: sum-times ( samples -- times )
    { 0 0 0 0 } [ 4 head-slice v+ ] reduce [ samples>time ] map! ;

:: (collect-subtrees) ( samples child-quot -- children )
    samples [ sample-callstack leaf-callstack? not ] filter
    [ f ] [ child-quot call ] if-empty ; inline

: collect-tops ( samples -- node )
    [ unclip-callstack ] collect-pairs [
        [ sum-times ]
        [ [ collect-tops ] (collect-subtrees) ] bi <profile-node>
    ] assoc-map ;

: redundant-root-node? ( assoc -- ? )
    {
        [ children>> assoc-size 1 = ]
        [ children>> values first children>> ]
        [ [ total-time>> ] [ children>> values first total-time>> ] bi = ]
    } 1&& ;

: trim-root ( root -- root' )
    dup redundant-root-node? [ children>> values first trim-root ] when ;

: (top-down) ( samples -- tree )
    collect-contexts [
        [ sum-times ] [ collect-tops ] bi <profile-node> trim-root
    ] assoc-map ;

: top-down ( -- tree )
    get-raw-profile-data (top-down) ;
