--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+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
\ No newline at end of file
--- /dev/null
+! 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> ] ;
\ No newline at end of file
! 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
-! 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> ;
\ No newline at end of file
+ [ '[ _ call( obj1 obj2 -- <=> ) ] sort ] <smart-arrow> ; inline
\ No newline at end of file
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 ;
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 ;
[ 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
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 ;
--- /dev/null
+USING: ui.tools.profiler tools.test ;
+
+\ profiler-window must-infer
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
: <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 -- <=> )
: 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