! Copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors words sequences math prettyprint kernel arrays
io io.styles namespaces assocs kernel.private strings
combinators sorting math.parser vocabs definitions
tools.counting-profiler.private tools.crossref continuations generic
compiler.units compiler.crossref sets classes fry ;
FROM: sets => members ;
IN: tools.counting-profiler

: profile ( quot -- )
    [ t profiling call ] [ f profiling ] [ ] cleanup ; inline

: filter-counts ( alist -- alist' )
    [ second 0 > ] filter ;

: map-counters ( obj quot -- alist )
    { } map>assoc filter-counts ; inline

: counters ( words -- alist )
    [ dup counter>> ] map-counters ;

: cumulative-counters ( obj quot -- alist )
    '[ dup @ [ counter>> ] map-sum ] map-counters ; inline

: vocab-counters ( -- alist )
    vocabs [ words [ predicate? not ] filter ] cumulative-counters ;

: generic-counters ( -- alist )
    all-words [ subwords ] cumulative-counters ;

: methods-on ( class -- methods )
    dup implementors [ lookup-method ] with map ;

: class-counters ( -- alist )
    classes [ methods-on ] cumulative-counters ;

: method-counters ( -- alist )
    all-words [ subwords ] map concat counters ;

: profiler-usage ( word -- words )
    [ smart-usage [ word? ] filter ]
    [ generic-call-sites-of keys ]
    [ effect-dependencies-of keys ]
    tri 3append members ;

: usage-counters ( word -- alist )
    profiler-usage counters ;

: counters. ( assoc -- )
    sort-values simple-table. ;

: profile. ( -- )
    "Call counts for all words:" print
    all-words counters counters. ;

: vocab-profile. ( vocab -- )
    "Call counts for words in the " write
    dup dup lookup-vocab write-object
    " vocabulary:" print
    words counters counters. ;

: usage-profile. ( word -- )
    "Call counts for words which call " write
    dup pprint
    ":" print
    usage-counters counters. ;

: vocabs-profile. ( -- )
    "Call counts for all vocabularies:" print
    vocab-counters counters. ;

: generic-profile. ( -- )
    "Call counts for methods on generic words:" print
    generic-counters counters. ;

: class-profile. ( -- )
    "Call counts for methods on classes:" print
    class-counters counters. ;

: method-profile. ( -- )
    "Call counts for all methods:" print
    method-counters counters. ;