]> gitweb.factorcode.org Git - factor.git/commitdiff
Add models.arrow.smart: abstracts out common <product>/<arrow> pattern
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sat, 28 Mar 2009 09:19:33 +0000 (04:19 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sat, 28 Mar 2009 09:19:33 +0000 (04:19 -0500)
basis/models/arrow/smart/authors.txt [new file with mode: 0644]
basis/models/arrow/smart/smart-tests.factor [new file with mode: 0644]
basis/models/arrow/smart/smart.factor [new file with mode: 0644]
basis/models/search/search.factor
basis/models/sort/sort.factor
basis/tools/profiler/profiler.factor
basis/ui/gadgets/panes/panes-tests.factor
basis/ui/gadgets/search-tables/search-tables.factor
basis/ui/tools/profiler/profiler-tests.factor [new file with mode: 0644]
basis/ui/tools/profiler/profiler.factor

diff --git a/basis/models/arrow/smart/authors.txt b/basis/models/arrow/smart/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /dev/null
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/basis/models/arrow/smart/smart-tests.factor b/basis/models/arrow/smart/smart-tests.factor
new file mode 100644 (file)
index 0000000..3e8375e
--- /dev/null
@@ -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
\ No newline at end of file
diff --git a/basis/models/arrow/smart/smart.factor b/basis/models/arrow/smart/smart.factor
new file mode 100644 (file)
index 0000000..257a2bb
--- /dev/null
@@ -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> ] ;
\ No newline at end of file
index 4bf74b3b92e06807bfbdb4da37a1de0b92007500..5ecb0fa34ada9a88cf9a3ac944fe6cb7bd7687e7 100644 (file)
@@ -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
index 23c150796fac63b956280264821018fcf3a3e0c6..efd2e4927b53aa8fe5c4569e5757565f8a1b2880 100644 (file)
@@ -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> ;
\ No newline at end of file
+    [ '[ _ call( obj1 obj2 -- <=> ) ] sort ] <smart-arrow> ; inline
\ No newline at end of file
index 864a637096c0c75790b63ff4d57e74cb208fc96a..f4488136b2d7b32323acb884d07c07be762d7191 100644 (file)
@@ -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 ;
index 0529437a76663c1d6edbb7c5877d4fcc3d39e615..01abe8b3d958c0175ee1f81b2a7be511fc65a917 100644 (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 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
index 4a2983bfe09627da18ae6d84f7d4a41e937a09d2..9947facedbe81fab17be37567172e1ef4092da9b 100644 (file)
@@ -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 ;
diff --git a/basis/ui/tools/profiler/profiler-tests.factor b/basis/ui/tools/profiler/profiler-tests.factor
new file mode 100644 (file)
index 0000000..86bebdd
--- /dev/null
@@ -0,0 +1,3 @@
+USING: ui.tools.profiler tools.test ;
+
+\ profiler-window must-infer
index 1c2318a35e94328d30cdf8f41231591ebb638cc5..5fef64ea8857e72b395f36a6f69529b49df93506 100644 (file)
@@ -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