Add models.arrow.smart: abstracts out common <product>/<arrow> pattern
parent
b5c5991747
commit
9be60e36af
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
|
@ -0,0 +1,4 @@
|
|||
IN: models.arrows.smart.tests
|
||||
USING: models.arrow.smart tools.test accessors models math kernel ;
|
||||
|
||||
[ 7 ] [ 3 <model> 4 <model> [ + ] <smart-arrow> [ activate-model ] [ value>> ] bi ] unit-test
|
|
@ -0,0 +1,9 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: models.arrow models.product stack-checker accessors fry
|
||||
generalizations macros kernel ;
|
||||
IN: models.arrow.smart
|
||||
|
||||
MACRO: <smart-arrow> ( quot -- quot' )
|
||||
[ infer in>> dup ] keep
|
||||
'[ _ narray <product> [ _ firstn @ ] <arrow> ] ;
|
|
@ -1,12 +1,10 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays fry kernel models.product models.arrow
|
||||
sequences unicode.case ;
|
||||
USING: fry kernel models.arrow.smart sequences unicode.case ;
|
||||
IN: models.search
|
||||
|
||||
: <search> ( values search quot -- model )
|
||||
[ 2array <product> ] dip
|
||||
'[ first2 _ curry filter ] <arrow> ;
|
||||
'[ _ curry filter ] <smart-arrow> ; inline
|
||||
|
||||
: <string-search> ( values search quot -- model )
|
||||
'[ swap @ [ >case-fold ] bi@ subseq? ] <search> ;
|
||||
'[ swap @ [ >case-fold ] bi@ subseq? ] <search> ; inline
|
||||
|
|
|
@ -1,8 +1,7 @@
|
|||
! Copyright (C) 2008 Slava Pestov
|
||||
! Copyright (C) 2009 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays fry kernel models.product models.arrow
|
||||
sequences sorting ;
|
||||
USING: sorting models.arrow.smart fry ;
|
||||
IN: models.sort
|
||||
|
||||
: <sort> ( values sort -- model )
|
||||
2array <product> [ first2 sort ] <arrow> ;
|
||||
[ '[ _ call( obj1 obj2 -- <=> ) ] sort ] <smart-arrow> ; inline
|
|
@ -7,7 +7,7 @@ continuations generic compiler.units sets classes fry ;
|
|||
IN: tools.profiler
|
||||
|
||||
: profile ( quot -- )
|
||||
[ t profiling call ] [ f profiling ] [ ] cleanup ;
|
||||
[ t profiling call ] [ f profiling ] [ ] cleanup ; inline
|
||||
|
||||
: filter-counts ( alist -- alist' )
|
||||
[ second 0 > ] filter ;
|
||||
|
|
|
@ -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 ui.gadgets.debug models math summary
|
||||
inspector accessors help.topics see ;
|
||||
inspector accessors help.topics see fry ;
|
||||
IN: ui.gadgets.panes.tests
|
||||
|
||||
: #children ( -- n ) "pane" get children>> length ;
|
||||
|
@ -18,8 +18,9 @@ IN: ui.gadgets.panes.tests
|
|||
[ t ] [ #children "num-children" get = ] unit-test
|
||||
|
||||
: test-gadget-text ( quot -- ? )
|
||||
dup make-pane gadget-text dup print "======" print
|
||||
swap with-string-writer dup print = ;
|
||||
'[ _ call( -- ) ]
|
||||
[ make-pane gadget-text dup print "======" print ]
|
||||
[ with-string-writer dup print ] bi = ;
|
||||
|
||||
[ t ] [ [ "hello" write ] test-gadget-text ] unit-test
|
||||
[ t ] [ [ "hello" pprint ] test-gadget-text ] unit-test
|
||||
|
|
|
@ -73,7 +73,7 @@ CONSULT: table-protocol search-table table>> ;
|
|||
dup field>> { 2 2 } <filled-border> f track-add
|
||||
values search 500 milliseconds <delay> quot <string-search>
|
||||
renderer <table> f >>takes-focus? >>table
|
||||
dup table>> <scroller> 1 track-add ;
|
||||
dup table>> <scroller> 1 track-add ; inline
|
||||
|
||||
M: search-table model-changed
|
||||
nip field>> clear-search-field ;
|
||||
|
|
|
@ -0,0 +1,3 @@
|
|||
USING: ui.tools.profiler tools.test ;
|
||||
|
||||
\ profiler-window must-infer
|
|
@ -11,6 +11,7 @@ ui.gadgets.tabbed ui.gadgets.status-bar ui.gadgets.borders
|
|||
ui.tools.browser ui.tools.common ui.baseline-alignment
|
||||
ui.operations ui.images ;
|
||||
FROM: models.arrow => <arrow> ;
|
||||
FROM: models.arrow.smart => <smart-arrow> ;
|
||||
FROM: models.product => <product> ;
|
||||
IN: ui.tools.profiler
|
||||
|
||||
|
@ -112,8 +113,8 @@ M: method-renderer column-titles drop { "" "Method" "Count" } ;
|
|||
: <methods-model> ( profiler -- model )
|
||||
[
|
||||
[ method-counters <model> ] dip
|
||||
[ generic>> ] [ class>> ] bi 3array <product>
|
||||
[ first3 '[ _ _ method-matches? ] filter ] <arrow>
|
||||
[ generic>> ] [ class>> ] bi
|
||||
[ '[ _ _ method-matches? ] filter ] <smart-arrow>
|
||||
] keep <profiler-model> ;
|
||||
|
||||
: sort-by-name ( obj1 obj2 -- <=> )
|
||||
|
@ -208,6 +209,6 @@ profiler-gadget "toolbar" f {
|
|||
: profiler-window ( -- )
|
||||
<profiler-gadget> "Profiling results" open-status-window ;
|
||||
|
||||
: com-profile ( quot -- ) profile profiler-window ;
|
||||
: com-profile ( quot -- ) profile profiler-window ; inline
|
||||
|
||||
MAIN: profiler-window
|
||||
|
|
Loading…
Reference in New Issue