steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Working on new profiler tool

db4
Slava Pestov 2008-12-22 00:54:08 -06:00
parent 61ac513b32
commit f9851b195a
11 changed files with 119 additions and 105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
basis/models/search/search.factor
View File

@ -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
models.filter sequences ;
USING: arrays fry kernel models.compose models.filter sequences ;
IN: models.search
: <search-model> ( values search quot -- model )
[ 500 milliseconds <delay> 2array <compose> ] dip
'[ first2 @ ] <filter> ;
: <search> ( values search quot -- model )
[ 2array <compose> ] dip
'[ first2 _ curry filter ] <filter> ;

8
basis/models/sort/sort.factor Normal file
View File

@ -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> ;

47
basis/tools/profiler/profiler.factor
View File

@ -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 )
[ dup counter>> ] { } map>assoc ;
: counters ( words -- alist )
[ dup counter>> ] { } map>assoc [ second 0 > ] filter ;
GENERIC: (profile.) ( obj -- )
TUPLE: usage-profile word ;
C: <usage-profile> usage-profile
M: word (profile.)
[ 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 ;
: vocab-counters ( -- alist )
vocabs [
dup
words
[ predicate? not ] filter
[ counter>> ] sigma
] { } map>assoc ;
: 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 [
dup words
[ "predicating" word-prop not ] filter
[ counter>> ] map sum
] { } map>assoc counters. ;
vocab-counters counters. ;
: method-profile. ( -- )
all-words [ subwords ] map concat

15
basis/ui/gadgets/buttons/buttons.factor
View File

@ -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> ] |
gadget
f f radio-paint radio-paint <button-paint> >>interior
radio-paint >>boundary
{ 16 16 } >>dim
] ;
black <radio-paint> :> radio-paint
gadget
f f radio-paint radio-paint <button-paint> >>interior
radio-paint >>boundary
{ 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 )
'[ _ swap _ call add-gadget ] assoc-each ; inline
: <radio-controls> ( assoc model parent quot: ( value model label -- gadget ) -- parent )
'[ _ swap @ add-gadget ] assoc-each ; inline
: radio-button-theme ( gadget -- gadget )
{ 5 5 } >>gap

10
basis/ui/gadgets/panes/panes-tests.factor
View File

@ -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." ;

4
basis/ui/gadgets/search-tables/search-tables.factor
View File

@ -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

2
basis/ui/gadgets/tables/tables.factor
View File

@ -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

9
basis/ui/tools/operations/operations.factor
View File

@ -167,20 +167,13 @@ M: word com-stack-effect def>> com-stack-effect ;
{ +listener+ t }
} define-operation
: com-show-profile ( workspace -- )
profiler-gadget call-tool ;
: com-profile ( quot -- ) profile f com-show-profile ;
: com-profile ( quot -- ) profile f profiler-window ;
[ 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"

102
basis/ui/tools/profiler/profiler.factor
View File

@ -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
ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.tracks ui.gestures ui.gadgets.buttons accessors fry ;
USING: ui.tools.workspace kernel quotations accessors fry
assocs present math math.order math.vectors arrays
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
<pane> >>pane
dup pane>> <scroller> 1 track-add ;
[ [ first ] compare ] <model> >>sort
all-words counters <model> >>words
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 -- )
[ 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 ;
M: profiler-gadget pref-dim* call-next-method { 700 400 } vmax ;
: 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
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 ;
MAIN: profiler-window

4
basis/ui/tools/tools-docs.factor
View File

@ -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"

14
basis/ui/tools/tools.factor
View File

@ -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.operations inspector io kernel math models namespaces
prettyprint quotations sequences ui ui.commands ui.gadgets
ui.tools.inspector ui.tools.listener
ui.tools.operations 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>
4array
3array
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 {