basis/ui/tools/profiler/profiler.factor

   1 ! Copyright (C) 2007, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel quotations accessors fry assocs present math.order
   4 math.vectors arrays locals models.search models.sort models sequences
   5 vocabs tools.profiler words prettyprint combinators.smart
   6 definitions.icons ui ui.commands ui.gadgets ui.gadgets.panes
   7 ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.gadgets.buttons
   8 ui.gadgets.tables ui.gadgets.search-tables ui.gadgets.labeled
   9 ui.gadgets.buttons ui.gadgets.packs ui.gadgets.labels
  10 ui.gadgets.tabbed ui.gadgets.status-bar ui.gadgets.borders
  11 ui.tools.browser ui.tools.common ui.baseline-alignment
  12 ui.operations ui.images ;
  13 FROM: models.filter => <filter> ;
  14 FROM: models.compose => <compose> ;
  15 IN: ui.tools.profiler
  16
  17 TUPLE: profiler-gadget < tool
  18 sort
  19 vocabs vocab
  20 words
  21 methods
  22 generic class ;
  23
  24 SINGLETONS: word-renderer vocab-renderer ;
  25 UNION: profiler-renderer word-renderer vocab-renderer ;
  26
  27 <PRIVATE
  28
  29 : with-datastack* ( seq quot -- seq' )
  30     '[ _ input<sequence ] output>array ; inline
  31
  32 PRIVATE>
  33
  34 ! Value is a { word count } pair
  35 M: profiler-renderer row-columns
  36     drop
  37     [
  38         [
  39             [ [ definition-icon <image-name> ] [ present ] bi ]
  40             [ present ]
  41             bi*
  42         ] with-datastack*
  43     ] [ { "" "All" "" } ] if* ;
  44
  45 M: profiler-renderer prototype-row
  46     drop \ = definition-icon <image-name> "" "" 3array ;
  47
  48 M: profiler-renderer row-value
  49     drop dup [ first ] when ;
  50
  51 M: profiler-renderer column-alignment drop { 0 0 1 } ;
  52 M: profiler-renderer filled-column drop 1 ;
  53
  54 M: word-renderer column-titles drop { "" "Word" "Count" } ;
  55 M: vocab-renderer column-titles drop { "" "Vocabulary" "Count" } ;
  56
  57 SINGLETON: method-renderer
  58
  59 M: method-renderer column-alignment drop { 0 0 1 } ;
  60 M: method-renderer filled-column drop 1 ;
  61
  62 ! Value is a { method-body count } pair
  63 M: method-renderer row-columns
  64     drop [
  65         [ [ definition-icon <image-name> ] [ synopsis ] bi ]
  66         [ present ]
  67         bi*
  68     ] with-datastack* ;
  69
  70 M: method-renderer row-value drop first ;
  71
  72 M: method-renderer column-titles drop { "" "Method" "Count" } ;
  73
  74 : <profiler-model> ( values profiler -- model )
  75     [ [ filter-counts ] <filter> ] [ sort>> ] bi* <sort> ;
  76
  77 : <words-model> ( profiler -- model )
  78     [
  79         [ words>> ] [ vocab>> ] bi
  80         [
  81             [
  82                 [ first vocabulary>> ]
  83                 [ vocab-name ]
  84                 bi* =
  85             ] when*
  86         ] <search>
  87     ] keep <profiler-model> ;
  88
  89 : <profiler-table> ( model renderer -- table )
  90     [ dup [ first present ] when ] <search-table>
  91         [ invoke-primary-operation ] >>action ;
  92
  93 : <profiler-filter-model> ( counts profiler -- model' )
  94     [ <model> ] dip <profiler-model> [ f prefix ] <filter> ;
  95
  96 : <vocabs-model> ( profiler -- model )
  97     [ vocab-counters [ [ vocab ] dip ] assoc-map ] dip
  98     <profiler-filter-model> ;
  99
 100 : <generic-model> ( profiler -- model )
 101     [ generic-counters ] dip <profiler-filter-model> ;
 102
 103 : <class-model> ( profiler -- model )
 104     [ class-counters ] dip <profiler-filter-model> ;
 105
 106 : method-matches? ( method generic class -- ? )
 107     [ first ] 2dip
 108     [ drop dup [ subwords memq? ] [ 2drop t ] if ]
 109     [ nip dup [ swap "method-class" word-prop = ] [ 2drop t ] if ]
 110     3bi and ;
 111
 112 : <methods-model> ( profiler -- model )
 113     [
 114         [ method-counters <model> ] dip
 115         [ generic>> ] [ class>> ] bi 3array <compose>
 116         [ first3 '[ _ _ method-matches? ] filter ] <filter>
 117     ] keep <profiler-model> ;
 118
 119 : sort-by-name ( obj1 obj2 -- <=> )
 120     [ first name>> ] compare ;
 121
 122 : sort-by-call-count ( obj1 obj2 -- <=> )
 123     [ second ] compare invert-comparison ;
 124
 125 : sort-options ( -- alist )
 126     {
 127         { [ sort-by-name ] "by name" }
 128         { [ sort-by-call-count ] "by call count" }
 129     } ;
 130
 131 : <sort-options> ( model -- gadget )
 132     <shelf>
 133         +baseline+ >>align
 134         { 5 5 } >>gap
 135         "Sort by:" <label> add-gadget
 136         swap sort-options <radio-buttons> horizontal >>orientation add-gadget ;
 137
 138 : <profiler-tool-bar> ( profiler -- gadget )
 139     <shelf>
 140         1/2 >>align
 141         { 5 5 } >>gap
 142         swap
 143         [ <toolbar> add-gadget ]
 144         [ sort>> <sort-options> add-gadget ] bi ;
 145
 146 :: <words-tab> ( profiler -- gadget )
 147     horizontal <track>
 148         { 3 3 } >>gap
 149         profiler vocabs>> vocab-renderer <profiler-table>
 150             profiler vocab>> >>selected-value
 151             10 >>min-rows
 152             10 >>max-rows
 153         "Vocabularies" <labeled-gadget>
 154     1/2 track-add
 155         profiler <words-model> word-renderer <profiler-table>
 156             10 >>min-rows
 157             10 >>max-rows
 158         "Words" <labeled-gadget>
 159     1/2 track-add ;
 160
 161 :: <methods-tab> ( profiler -- gadget )
 162     vertical <track>
 163         { 3 3 } >>gap
 164         horizontal <track>
 165             { 3 3 } >>gap
 166             profiler <generic-model> word-renderer <profiler-table>
 167                 profiler generic>> >>selected-value
 168             "Generic words" <labeled-gadget>
 169         1/2 track-add
 170             profiler <class-model> word-renderer <profiler-table>
 171                 profiler class>> >>selected-value
 172             "Classes" <labeled-gadget>
 173         1/2 track-add
 174     1/2 track-add
 175         profiler methods>> method-renderer <profiler-table>
 176             5 >>min-rows
 177             5 >>max-rows
 178             40 >>min-cols
 179         "Methods" <labeled-gadget>
 180     1/2 track-add ;
 181
 182 : <selection-model> ( -- model ) { f 0 } <model> ;
 183
 184 : <profiler-gadget> ( -- profiler )
 185     vertical profiler-gadget new-track
 186         { 5 5 } >>gap
 187         [ sort-by-name ] <model> >>sort
 188         all-words counters <model> >>words
 189         <selection-model> >>vocab
 190         dup <vocabs-model> >>vocabs
 191         <selection-model> >>generic
 192         <selection-model> >>class
 193         dup <methods-model> >>methods
 194         dup <profiler-tool-bar> { 3 3 } <filled-border> f track-add
 195         <tabbed-gadget>
 196             over <words-tab> "Words" add-tab
 197             over <methods-tab> "Methods" add-tab
 198         1 track-add ;
 199
 200 : profiler-help ( -- ) "ui-profiler" com-browse ;
 201
 202 \ profiler-help H{ { +nullary+ t } } define-command
 203
 204 profiler-gadget "toolbar" f {
 205     { T{ key-down f f "F1" } profiler-help }
 206 } define-command-map
 207
 208 : profiler-window ( -- )
 209     <profiler-gadget> "Profiling results" open-status-window ;
 210
 211 MAIN: profiler-window