 : foreign-thread-time ( -- n )
     most-recent-profile-data foreign-thread-time* ;
 
-: collect-threads ( samples -- by-thread )
-    [ sample-thread ] collect-by ;
-
-: time-per-thread ( -- n )
-    most-recent-profile-data collect-threads [ total-time* ] assoc-map ;
-
-: leaf-callstack? ( callstack -- ? )
-    [ ignore-word? ] all? ;
-
-CONSTANT: zero-counts { 0 0 0 0 0 }
-
-: sum-counts ( samples -- times )
-    zero-counts [ sample-counts-slice v+ ] reduce ;
-
 TUPLE: profile-node
     total-time gc-time jit-time foreign-time foreign-thread-time children
     depth ;
 
+<PRIVATE
+
+: collect-threads ( samples -- by-thread )
+    [ sample-thread ] collect-by ;
+
+: time-per-thread ( -- n )
+    most-recent-profile-data collect-threads [ total-time* ] assoc-map ;
+
+: leaf-callstack? ( callstack -- ? )
+    [ ignore-word? ] all? ;
+
+CONSTANT: zero-counts { 0 0 0 0 0 }
+
+: sum-counts ( samples -- times )
+    zero-counts [ sample-counts-slice v+ ] reduce ;
+
 : <profile-node> ( times children depth -- node )
     [ 5 firstn [ samples>time ] 5 napply ] 2dip profile-node boa ;
 
 : <profile-root-node> ( samples collector-quot -- node )
     [ sum-counts ] swap bi 0 <profile-node> ; inline
 
-:: (collect-subtrees) ( samples child-quot -- children )
-    samples [ sample-callstack leaf-callstack? not ] filter
-    [ f ] [ child-quot call ] if-empty ; inline
-
-:: collect-tops ( samples depth -- node )
+:: (collect-subtrees) ( samples max-depth depth child-quot: ( samples -- child ) -- children )
+    max-depth depth > [
+        samples [ sample-callstack leaf-callstack? not ] filter
+        [ f ] [ child-quot call ] if-empty
+    ] [ f ] if ; inline
+
+:: collect-tops ( samples max-depth depth -- node )
     samples [ unclip-callstack ] collect-pairs [
         [ sum-counts ]
-        [ [ depth 1 + collect-tops ] (collect-subtrees) ] bi depth <profile-node>
+        [ max-depth depth [ max-depth depth 1 + collect-tops ] (collect-subtrees) ] bi
+        depth <profile-node>
     ] assoc-map ;
 
 : redundant-root-node? ( assoc -- ? )

    ] each
    per-word-samples [ f depth <profile-node> ] assoc-map ;

:: cross-section* ( depth profile-data -- flat )
    profile-data collect-threads
    [ [ depth collect-cross-section ] <profile-root-node> ] assoc-map ;

: cross-section ( depth -- tree )
    most-recent-profile-data cross-section* ;

: depth. ( depth -- )
    [ "  " write ] times ;

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

:: (top-down) ( profile-data max-depth depth -- tree )
    profile-data collect-threads
    [ [ max-depth depth collect-tops ] <profile-root-node> trim-root ] assoc-map ;

PRIVATE>

: top-down-max-depth* ( profile-data max-depth -- tree )
    0 (top-down) ;

: top-down-max-depth ( max-depth -- tree )
    most-recent-profile-data swap top-down-max-depth* ;

: top-down* ( profile-data -- tree )
    most-positive-fixnum top-down-max-depth* ;

: top-down ( -- tree )
    most-positive-fixnum top-down-max-depth ;

<PRIVATE

:: counts+at ( key assoc sample -- )
    key assoc [ zero-counts or sample sample-counts-slice v+ ] change-at ;
