diff --git a/basis/tools/profiler/profiler.factor b/basis/tools/profiler/profiler.factor index 45b95cc1de..19646e55c2 100644 --- a/basis/tools/profiler/profiler.factor +++ b/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 [ - dup - words - [ predicate? not ] filter - [ counter>> ] sigma - ] { } map>assoc ; + vocabs [ words [ predicate? not ] filter ] cumulative-counters ; + +: generic-counters ( -- alist ) + all-words [ subwords ] cumulative-counters ; + +: 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 ] - [ compiled-generic-usage keys ] - [ compiled-usage keys ] - tri 3append prune counters counters. ; + 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. ( -- ) - all-words [ subwords ] map concat - counters counters. ; + "Call counts for all methods:" print + method-counters counters. ; diff --git a/basis/ui/tools/operations/operations.factor b/basis/ui/tools/operations/operations.factor index 6f83a43a66..c91aad7462 100644 --- a/basis/ui/tools/operations/operations.factor +++ b/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" } } diff --git a/basis/ui/tools/profiler/profiler.factor b/basis/ui/tools/profiler/profiler.factor index 8d5c9dedf3..f064856ed0 100644 --- a/basis/ui/tools/profiler/profiler.factor +++ b/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 => ; FROM: models.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 : ( model -- table ) [ match? ] profile-renderer >>renderer ; -: ( profiler -- model ) - [ vocab-counters ] dip - [ f prefix ] ; +: ( counts profiler -- model' ) + [ ] dip [ f prefix ] ; + +: ( profiler -- model ) + [ vocab-counters ] dip ; + +: ( profiler -- model ) + [ generic-counters ] dip ; + +: ( profiler -- model ) + [ class-counters ] dip ; + +: 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 ; + +: ( profiler -- model ) + [ method-counters ] dip + [ generic>> ] [ class>> ] bi 3array + [ first3 '[ _ _ method-matches? ] filter ] ; : sort-options ( -- alist ) { @@ -67,18 +91,31 @@ M: profile-renderer row-columns :: ( profiler -- gadget ) { 0 1 } - { 1 0 } - f "Generic words" 1/2 track-add - f "Classes" 1/2 track-add + { 1 0 } + profiler + profiler generic>> >>selected-value + "Generic words" + 1/2 track-add + profiler + profiler class>> >>selected-value + "Classes" + 1/2 track-add 1/2 track-add - f "Methods" 1/2 track-add ; + profiler methods>> + "Methods" + 1/2 track-add ; + +: ( -- model ) { f 0 } ; : ( -- profiler ) { 0 1 } profiler-gadget new-track [ [ first ] compare ] >>sort all-words counters >>words - dup >>vocabs - { f 0 } >>vocab + >>vocab + dup >>vocabs + >>generic + >>class + dup >>methods dup f track-add over "Words" add-tab