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