basis/tools/profiler/profiler.factor

   1 ! Copyright (C) 2007, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors words sequences math prettyprint kernel arrays io
   4 io.styles namespaces assocs kernel.private strings combinators
   5 sorting math.parser vocabs definitions tools.profiler.private
   6 continuations generic ;
   7 IN: tools.profiler
   8
   9 : profile ( quot -- )
  10     [ t profiling call ] [ f profiling ] [ ] cleanup ;
  11
  12 : counters ( words -- assoc )
  13     [ dup counter>> ] { } map>assoc ;
  14
  15 GENERIC: (profile.) ( obj -- )
  16
  17 TUPLE: usage-profile word ;
  18
  19 C: <usage-profile> usage-profile
  20
  21 M: word (profile.)
  22     dup unparse swap <usage-profile> write-object ;
  23
  24 TUPLE: vocab-profile vocab ;
  25
  26 C: <vocab-profile> vocab-profile
  27
  28 M: string (profile.)
  29     dup <vocab-profile> write-object ;
  30
  31 M: method-body (profile.)
  32     dup synopsis swap "method-generic" word-prop
  33     <usage-profile> write-object ;
  34
  35 : counter. ( obj n -- )
  36     [
  37         >r [ (profile.) ] with-cell r>
  38         [ number>string write ] with-cell
  39     ] with-row ;
  40
  41 : counters. ( assoc -- )
  42     [ second 0 > ] filter sort-values
  43     standard-table-style [
  44         [ counter. ] assoc-each
  45     ] tabular-output ;
  46
  47 : profile. ( -- )
  48     "Call counts for all words:" print
  49     all-words counters counters. ;
  50
  51 : vocab-profile. ( vocab -- )
  52     "Call counts for words in the " write
  53     dup dup vocab write-object
  54     " vocabulary:" print
  55     words counters counters. ;
  56
  57 : usage-profile. ( word -- )
  58     "Call counts for words which call " write
  59     dup pprint
  60     ":" print
  61     smart-usage [ word? ] filter counters counters. ;
  62
  63 : vocabs-profile. ( -- )
  64     "Call counts for all vocabularies:" print
  65     vocabs [
  66         dup words
  67         [ "predicating" word-prop not ] filter
  68         [ counter>> ] map sum
  69     ] { } map>assoc counters. ;
  70
  71 : method-profile. ( -- )
  72     all-words [ subwords ] map concat
  73     counters counters. ;