 
 CONSTANT: ignore-words
     { signal-handler leaf-signal-handler profiling minor-gc }
+
+: ignore-word? ( word -- ? ) ignore-words member? ; inline
 
 : get-raw-profile-data ( -- data )
     raw-profile-data get-global [ "No profile data" throw ] unless* ;

: unclip-callstack ( sample -- sample' callstack-top )
    clone 5 over [ unclip swap ] change-nth ;

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

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

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

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

:: (collect-subtrees) ( samples child-quot -- children )
    samples [ sample-callstack leaf-callstack? not ] filter

:: collect-flat ( samples -- flat )
    IH{ } clone :> per-word-samples
    samples [| sample |
        sample sample-callstack unique keys [ ignore-word? not ] filter [
            per-word-samples [ { 0 0 0 0 } or sample 4 head-slice v+ ] change-at
        ] each
    ] each
    per-word-samples [ f <profile-node> ] assoc-map ;

: redundant-flat-node? ( child-node root-node -- ? )
    [ total-time>> ] bi@ = ;

: trim-flat ( root-node -- root-node' )
    dup '[ [ nip _ redundant-flat-node? not ] assoc-filter ] change-children ;

: (flat) ( samples -- flat )
    collect-threads
    [ [ collect-flat ] <profile-root-node> trim-flat ] assoc-map ;

: flat ( -- tree )
    get-raw-profile-data (flat) ;
