Working on new profiler tool

basis/models/search/search.factor

@@ -1,9 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays calendar fry kernel models.compose models.delay
+USING: arrays fry kernel models.compose models.filter sequences ;
-models.filter sequences ;
 IN: models.search
 
-: <search-model> ( values search quot -- model )
+: <search> ( values search quot -- model )
-    [ 500 milliseconds <delay> 2array <compose> ] dip
+    [ 2array <compose> ] dip
-    '[ first2 @ ] <filter> ;
+    '[ first2 _ curry filter ] <filter> ;

basis/models/sort/sort.factor

@@ -0,0 +1,8 @@
+! Copyright (C) 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays fry kernel models.compose models.filter
+sequences sorting ;
+IN: models.sort
+
+: <sort> ( values sort -- model )
+    2array <compose> [ first2 sort ] <filter> ;

basis/tools/profiler/profiler.factor

@@ -3,45 +3,26 @@
 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 ;
+continuations generic compiler.units sets classes ;
 IN: tools.profiler
 
 : profile ( quot -- )
     [ t profiling call ] [ f profiling ] [ ] cleanup ;
 
-: counters ( words -- assoc )
+: counters ( words -- alist )
-    [ dup counter>> ] { } map>assoc ;
+    [ dup counter>> ] { } map>assoc [ second 0 > ] filter ;
 
-GENERIC: (profile.) ( obj -- )
+: vocab-counters ( -- alist )
-
+    vocabs [
-TUPLE: usage-profile word ;
+        dup
-
+        words
-C: <usage-profile> usage-profile
+        [ predicate? not ] filter
-
+        [ counter>> ] sigma
-M: word (profile.)
+    ] { } map>assoc ;
-    [ name>> "( no name )" or ] [ <usage-profile> ] bi write-object ;
-
-TUPLE: vocab-profile vocab ;
-
-C: <vocab-profile> vocab-profile
-
-M: string (profile.)
-    dup <vocab-profile> write-object ;
-
-M: method-body (profile.)
-    [ synopsis ] [ "method-generic" word-prop <usage-profile> ] bi
-    write-object ;
-
-: counter. ( obj n -- )
-    [
-        [ [ (profile.) ] with-cell ] dip
-        [ number>string write ] with-cell
-    ] with-row ;
 
 : counters. ( assoc -- )
-    [ second 0 > ] filter sort-values
     standard-table-style [
-        [ counter. ] assoc-each
+        sort-values simple-table.
     ] tabular-output ;
 
 : profile. ( -- )
@@ -65,11 +46,7 @@ M: method-body (profile.)
 
 : vocabs-profile. ( -- )
     "Call counts for all vocabularies:" print
-    vocabs [
+    vocab-counters counters. ;
-        dup words
-        [ "predicating" word-prop not ] filter
-        [ counter>> ] map sum
-    ] { } map>assoc counters. ;
 
 : method-profile. ( -- )
     all-words [ subwords ] map concat

basis/ui/gadgets/buttons/buttons.factor

@@ -197,12 +197,11 @@ M: radio-paint draw-boundary
     GL_LINE_STRIP 0 circle-steps 1+ glDrawArrays ;
 
 :: radio-knob-theme ( gadget -- gadget )
-    [let | radio-paint [ black <radio-paint> ] |
+    black <radio-paint> :> radio-paint
     gadget
     f f radio-paint radio-paint <button-paint> >>interior
     radio-paint >>boundary
-        { 16 16 } >>dim
+    { 16 16 } >>dim ;
-    ] ;
 
 : <radio-knob> ( -- gadget )
     <gadget> radio-knob-theme ;
@@ -221,8 +220,8 @@ M: radio-control model-changed
     over value>> = >>selected?
     relayout-1 ;
 
-: <radio-controls> ( assoc model parent quot: ( value model label -- ) -- parent )
+: <radio-controls> ( assoc model parent quot: ( value model label -- gadget ) -- parent )
-    '[ _ swap _ call add-gadget ] assoc-each ; inline
+    '[ _ swap @ add-gadget ] assoc-each ; inline
 
 : radio-button-theme ( gadget -- gadget )
     { 5 5 } >>gap

basis/ui/gadgets/panes/panes-tests.factor

@@ -2,7 +2,7 @@ USING: alien ui.gadgets.panes ui.gadgets namespaces
 kernel sequences io io.styles io.streams.string tools.test
 prettyprint definitions help help.syntax help.markup
 help.stylesheet splitting tools.test.ui models math summary
-inspector accessors ;
+inspector accessors help.topics ;
 IN: ui.gadgets.panes.tests
 
 : #children "pane" get children>> length ;
@@ -79,6 +79,14 @@ IN: ui.gadgets.panes.tests
     ] test-gadget-text
 ] unit-test
 
+[ t ] [
+    [
+        last-element off
+        \ = >link $title
+        "Hello world" print-content
+    ] test-gadget-text
+] unit-test
+
 ARTICLE: "test-article-1" "This is a test article"
 "Hello world, how are you today." ;
 

basis/ui/gadgets/search-tables/search-tables.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel delegate fry sequences
-models models.search locals
+models models.search models.delay calendar locals
 ui.gadgets.editors ui.gadgets.labels ui.gadgets.scrollers
 ui.gadgets.tables ui.gadgets.tracks ui.gadgets.borders
 ui.gadgets.buttons ;
@@ -38,7 +38,7 @@ CONSULT: table-protocol search-table table>> ;
         values >>model
         search <search-field> >>field
         dup field>> 2 <filled-border> f track-add
-        values search quot <search-model> <table> >>table
+        values search 500 milliseconds <delay> quot <search> <table> >>table
         dup table>> <scroller> 1 track-add ;
 
 M: search-table model-changed

basis/ui/gadgets/tables/tables.factor

@@ -41,7 +41,7 @@ CONSTANT: table-gap 5
 
 : column-widths ( font rows -- total widths )
     [ drop 0 { } ] [
-        tuck [ length 0 <repetition> ] 2dip [
+        tuck [ first length 0 <repetition> ] 2dip [
             [ string-width ] with map vmax
         ] with each
         0 [ table-gap + + ] accumulate

basis/ui/tools/operations/operations.factor

@@ -167,20 +167,13 @@ M: word com-stack-effect def>> com-stack-effect ;
     { +listener+ t }
 } define-operation
 
-: com-show-profile ( workspace -- )
+: com-profile ( quot -- ) profile f profiler-window ;
-    profiler-gadget call-tool ;
-
-: com-profile ( quot -- ) profile f com-show-profile ;
 
 [ quotation? ] \ com-profile H{
     { +keyboard+ T{ key-down f { C+ } "r" } }
     { +listener+ t }
 } define-operation
 
-! Profiler presentations
-[ dup usage-profile? swap vocab-profile? or ]
-\ com-show-profile H{ { +primary+ t } } define-operation
-
 ! Operations -> commands
 source-editor
 "word"

basis/ui/tools/profiler/profiler.factor

@@ -1,51 +1,83 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: ui.tools.workspace kernel quotations tools.profiler
+USING: ui.tools.workspace kernel quotations accessors fry
-ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
+assocs present math math.order math.vectors arrays
-ui.gadgets.tracks ui.gestures ui.gadgets.buttons accessors fry ;
+models.search models.sort models sequences vocabs
+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 ;
+FROM: models.filter => <filter> ;
+FROM: models.compose => <compose> ;
 IN: ui.tools.profiler
 
-TUPLE: profiler-gadget < track pane ;
+TUPLE: profiler-gadget < track sort vocabs vocab words ;
 
-: <profiler-gadget> ( -- gadget )
+SINGLETON: profile-renderer
+
+! Value is a { word count } pair
+M: profile-renderer row-columns
+    drop [ [ present ] map ] [ { "All" "" } ] if* ;
+
+: <profiler-model> ( values profiler -- model )
+    [ [ [ second 0 > ] filter ] <filter> ] [ sort>> ] bi* <sort> ;
+
+: <words-model> ( profiler -- model )
+    [
+        [ words>> ] [ vocab>> ] bi
+        [ [ [ first vocabulary>> ] [ first ] bi* = ] when* ] <search>
+    ] keep <profiler-model> ;
+
+: <profiler-table> ( model -- table )
+    [ swap dup [ first present subseq? ] [ 2drop t ] if ] <search-table>
+    profile-renderer >>renderer ;
+
+: <vocab-model> ( profiler -- model )
+    [ vocab-counters <model> ] dip
+    <profiler-model> [ f prefix ] <filter> ;
+
+: sort-options ( -- alist )
+    {
+        { [ [ first ] compare ] "by name" }
+        { [ [ second ] compare invert-comparison ] "by call count" }
+    } ;
+
+: <profiler-tool-bar> ( profiler -- gadget )
+    <shelf>
+        { 5 5 } >>gap
+        over <toolbar> add-gadget
+        "Sort by:" <label> add-gadget
+        swap sort>> sort-options <radio-buttons> { 1 0 } >>orientation add-gadget ;
+
+: <profiler-gadget> ( -- profiler )
     { 0 1 } profiler-gadget new-track
-        add-toolbar
+        [ [ first ] compare ] <model> >>sort
-        <pane> >>pane
+        all-words counters <model> >>words
-        dup pane>> <scroller> 1 track-add ;
+        dup <vocab-model> >>vocabs
+        { f 0 } <model> >>vocab
+        dup <profiler-tool-bar> f track-add
+        { 1 0 } <track>
+                over vocabs>> <profiler-table>
+                    pick vocab>> >>selected-value
+                "Vocabularies" <labelled-gadget>
+            1/2 track-add
+                over <words-model> <profiler-table>
+                "Words" <labelled-gadget>
+            1/2 track-add
+        1 track-add ;
 
-: with-profiler-pane ( gadget quot -- )
+M: profiler-gadget pref-dim* call-next-method { 700 400 } vmax ;
-    [ pane>> ] dip with-pane ;
-
-: com-full-profile ( gadget -- )
-    [ profile. ] with-profiler-pane ;
-
-: com-vocabs-profile ( gadget -- )
-    [ vocabs-profile. ] with-profiler-pane ;
-
-: com-method-profile ( gadget -- )
-    [ method-profile. ] with-profiler-pane ;
 
 : profiler-help ( -- ) "ui-profiler" help-window ;
 
 \ profiler-help H{ { +nullary+ t } } define-command
 
 profiler-gadget "toolbar" f {
-    { f com-full-profile }
-    { f com-vocabs-profile }
-    { f com-method-profile }
     { T{ key-down f f "F1" } profiler-help }
 } define-command-map
 
-GENERIC: profiler-presentation ( obj -- quot )
+: profiler-window ( -- )
+    <profiler-gadget> "Profiler" open-window ;
 
-M: usage-profile profiler-presentation
+MAIN: profiler-window
-    word>> '[ _ usage-profile. ] ;
-
-M: vocab-profile profiler-presentation
-    vocab>> '[ _ vocab-profile. ] ;
-
-M: f profiler-presentation
-    drop [ vocabs-profile. ] ;
-
-M: profiler-gadget call-tool* ( obj gadget -- )
-    swap profiler-presentation with-profiler-pane ;

basis/ui/tools/tools-docs.factor

@@ -62,7 +62,9 @@ ARTICLE: "ui-profiler" "UI profiler"
 $nl
 "To use the profiler, enter a piece of code in the listener input area and press " { $operation com-profile } "."
 $nl
-"Vocabulary and word presentations in the profiler pane can be clicked on to show profiler results pertaining to the object in question. Clicking a vocabulary in the profiler yields the same output as the " { $link vocab-profile. } " word, and clicking a word yields the same output as the " { $link usage-profile. } " word. Consult " { $link "profiling" } " for details."
+"Clicking on a vocabulary in the vocabulary list narrows down the word list to only include words from that vocabulary. The sorting options control the order of elements in the vocabulary and word lists. The search fields narrow down the list to only include words or vocabularies whose names contain a substring."
+$nl
+"Consult " { $link "profiling" } " for details about the profiler itself."
 { $command-map profiler-gadget "toolbar" } ;
 
 ARTICLE: "ui-cocoa" "Functionality specific to Mac OS X"

basis/ui/tools/tools.factor

@@ -2,14 +2,14 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs debugger ui.tools.workspace
 ui.tools.operations ui.tools.traceback ui.tools.browser
-ui.tools.inspector ui.tools.listener ui.tools.profiler
+ui.tools.inspector ui.tools.listener
-ui.tools.operations inspector io kernel math models namespaces
+ui.tools.operations ui ui.commands ui.gadgets
-prettyprint quotations sequences ui ui.commands ui.gadgets
 ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
 ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds
 ui.gadgets.presentations ui.gestures words vocabs.loader
 tools.test tools.vocabs ui.gadgets.buttons ui.gadgets.status-bar
-mirrors fry ;
+mirrors fry inspector io kernel math models namespaces
+prettyprint quotations sequences ;
 IN: ui.tools
 
 : <workspace-tabs> ( workspace -- tabs )
@@ -22,8 +22,7 @@ IN: ui.tools
         <gadget>
         <browser-gadget>
         <inspector-gadget>
-        <profiler-gadget>
+    3array
-    4array
     swap model>> <book> ;
   
 : <workspace> ( -- workspace )
@@ -62,13 +61,10 @@ M: workspace model-changed
 
 : com-inspector ( workspace -- ) 2 select-tool ;
 
-: com-profiler ( workspace -- ) 3 select-tool ;
-
 workspace "tool-switching" f {
     { T{ key-down f { A+ } "1" } com-listener }
     { T{ key-down f { A+ } "2" } com-browser }
     { T{ key-down f { A+ } "3" } com-inspector }
-    { T{ key-down f { A+ } "4" } com-profiler }
 } define-command-map
 
 workspace "multi-touch" f {