Flesh out 'Methods' tab in new profiler tool

basis/tools/profiler/profiler.factor

@@ -3,7 +3,7 @@
 USING: accessors words sequences math prettyprint kernel arrays io
 io.styles namespaces assocs kernel.private strings combinators
 sorting math.parser vocabs definitions tools.profiler.private
-continuations generic compiler.units sets classes ;
+continuations generic compiler.units sets classes fry ;
 IN: tools.profiler
 
 : profile ( quot -- )
@@ -12,16 +12,38 @@ IN: tools.profiler
 : filter-counts ( alist -- alist' )
     [ second 0 > ] filter ;
 
+: map-counters ( obj quot -- alist )
+    { } map>assoc filter-counts ; inline
+
 : counters ( words -- alist )
-    [ dup counter>> ] { } map>assoc filter-counts ;
+    [ dup counter>> ] map-counters ;
+
+: cumulative-counters ( obj quot -- alist )
+    '[ dup @ [ counter>> ] sigma ] map-counters ; inline
 
 : vocab-counters ( -- alist )
-    vocabs [
+    vocabs [ words [ predicate? not ] filter ] cumulative-counters ;
-        dup
+
-        words
+: generic-counters ( -- alist )
-        [ predicate? not ] filter
+    all-words [ subwords ] cumulative-counters ;
-        [ counter>> ] sigma
+
-    ] { } map>assoc ;
+: methods-on ( class -- methods )
+    dup implementors [ 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 ]
+    [ compiled-generic-usage keys ]
+    [ compiled-usage keys ]
+    tri 3append prune ;
+
+: usage-counters ( word -- alist )
+    profiler-usage counters ;
 
 : counters. ( assoc -- )
     standard-table-style [
@@ -42,15 +64,20 @@ IN: tools.profiler
     "Call counts for words which call " write
     dup pprint
     ":" print
-    [ smart-usage [ word? ] filter ]
+    usage-counters counters. ;
-    [ compiled-generic-usage keys ]
-    [ compiled-usage keys ]
-    tri 3append prune 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. ( -- )
-    all-words [ subwords ] map concat
+    "Call counts for all methods:" print
-    counters counters. ;
+    method-counters counters. ;

basis/ui/tools/operations/operations.factor

@@ -167,7 +167,7 @@ M: word com-stack-effect def>> com-stack-effect ;
     { +listener+ t }
 } define-operation
 
-: com-profile ( quot -- ) profile f profiler-window ;
+: com-profile ( quot -- ) profile profiler-window ;
 
 [ quotation? ] \ com-profile H{
     { +keyboard+ T{ key-down f { C+ } "r" } }

basis/ui/tools/profiler/profiler.factor

@@ -7,12 +7,17 @@ tools.profiler ui ui.commands ui.gadgets ui.gadgets.panes
 ui.gadgets.scrollers ui.gadgets.tracks ui.gestures
 ui.gadgets.buttons ui.gadgets.tables ui.gadgets.search-tables
 ui.gadgets.labelled ui.gadgets.buttons ui.gadgets.packs
-ui.gadgets.labels ui.gadgets.tabbed ;
+ui.gadgets.labels ui.gadgets.tabbed words ;
 FROM: models.filter => <filter> ;
 FROM: models.compose => <compose> ;
 IN: ui.tools.profiler
 
-TUPLE: profiler-gadget < track sort vocabs vocab words ;
+TUPLE: profiler-gadget < track
+sort
+vocabs vocab
+words
+methods
+generic class ;
 
 SINGLETON: profile-renderer
 
@@ -35,9 +40,28 @@ M: profile-renderer row-columns
 : <profiler-table> ( model -- table )
     [ match? ] <search-table> profile-renderer >>renderer ;
 
-: <vocab-model> ( profiler -- model )
+: <profiler-filter-model> ( counts profiler -- model' )
-    [ vocab-counters <model> ] dip
+    [ <model> ] dip <profiler-model> [ f prefix ] <filter> ;
-    <profiler-model> [ f prefix ] <filter> ;
+
+: <vocabs-model> ( profiler -- model )
+    [ vocab-counters ] dip <profiler-filter-model> ;
+
+: <generic-model> ( profiler -- model )
+    [ generic-counters ] dip <profiler-filter-model> ;
+
+: <class-model> ( profiler -- model )
+    [ class-counters ] dip <profiler-filter-model> ;
+
+: method-matches? ( method generic class -- ? )
+    [ dup [ first ] when ] tri@
+    [ drop dup [ subwords memq? ] [ 2drop t ] if ]
+    [ nip dup [ swap "method-class" word-prop = ] [ 2drop t ] if ]
+    3bi and ;
+
+: <methods-model> ( profiler -- model )
+    [ method-counters <model> ] dip
+    [ generic>> ] [ class>> ] bi 3array <compose>
+    [ first3 '[ _ _ method-matches? ] filter ] <filter> ;
 
 : sort-options ( -- alist )
     {
@@ -68,17 +92,30 @@ M: profile-renderer row-columns
 :: <methods-tab> ( profiler -- gadget )
     { 0 1 } <track>
         { 1 0 } <track>
-    f <model> <profiler-table> "Generic words" <labelled-gadget> 1/2 track-add
+            profiler <generic-model> <profiler-table>
-    f <model> <profiler-table> "Classes" <labelled-gadget> 1/2 track-add
+                profiler generic>> >>selected-value
+            "Generic words" <labelled-gadget>
         1/2 track-add
-    f <model> <profiler-table> "Methods" <labelled-gadget> 1/2 track-add ;
+            profiler <class-model> <profiler-table>
+                profiler class>> >>selected-value
+            "Classes" <labelled-gadget>
+        1/2 track-add
+    1/2 track-add
+        profiler methods>> <profiler-table>
+        "Methods" <labelled-gadget>
+    1/2 track-add ;
+
+: <selection-model> ( -- model ) { f 0 } <model> ;
 
 : <profiler-gadget> ( -- profiler )
     { 0 1 } profiler-gadget new-track
         [ [ first ] compare ] <model> >>sort
         all-words counters <model> >>words
-        dup <vocab-model> >>vocabs
+        <selection-model> >>vocab
-        { f 0 } <model> >>vocab
+        dup <vocabs-model> >>vocabs
+        <selection-model> >>generic
+        <selection-model> >>class
+        dup <methods-model> >>methods
         dup <profiler-tool-bar> f track-add
         <tabbed-gadget>
             over <words-tab> "Words" add-tab