extra sequences functions moved out of core

core/sequences/sequences.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2009 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel kernel.private locals slots.private math
+USING: accessors kernel kernel.private slots.private math
 math.private math.order ;
 IN: sequences
 
@@ -358,8 +358,14 @@ PRIVATE>
 
 <PRIVATE
 
+: ((each)) ( seq -- n quot )
+    [ length ] keep [ nth-unsafe ] curry ; inline
+
 : (each) ( seq quot -- n quot' )
-    [ [ length ] keep [ nth-unsafe ] curry ] dip compose ; inline
+    [ ((each)) ] dip compose ; inline
+
+: (each-index) ( seq quot -- n quot' )
+    [ ((each)) [ keep ] curry ] dip compose ; inline
 
 : (collect) ( quot into -- quot' )
     [ [ keep ] dip set-nth-unsafe ] 2curry ; inline
@@ -498,19 +504,18 @@ PRIVATE>
 : follow ( obj quot -- seq )
     [ dup ] swap [ keep ] curry produce nip ; inline
 
-: prepare-index ( seq quot -- seq n quot )
-    [ dup length ] dip ; inline
-
 : each-index ( seq quot -- )
-    prepare-index 2each ; inline
+    (each-index) each-integer ; inline
 
 : interleave ( seq between quot -- )
-    swap [ drop ] [ [ 2dip call ] 2curry ] 2bi
-    [ [ 0 = ] 2dip if ] 2curry
-    each-index ; inline
+    pick empty? [ 3drop ] [
+        [ [ drop first-unsafe ] dip call ]
+        [ [ rest-slice ] 2dip [ bi* ] 2curry each ]
+        3bi
+    ] if ; inline
 
 : map-index ( seq quot -- newseq )
-    prepare-index 2map ; inline
+    [ dup length iota ] dip 2map ; inline
 
 : reduce-index ( seq identity quot -- )
     swapd each-index ; inline
@@ -931,17 +936,3 @@ PRIVATE>
             [ array-flip ] [ generic-flip ] if
         ] [ generic-flip ] if
     ] unless ;
-
-: reduce1 ( seq quot -- result ) [ unclip ] dip reduce ; inline
-
-:: reduce-r
-    ( list identity quot: ( obj1 obj2 -- obj ) -- result )
-    list empty?
-    [ identity ]
-    [ list rest identity quot reduce-r list first quot call ] if ;
-    inline recursive
-
-:: combos ( list1 list2 -- result ) list2 [ [ 2array ] curry list1 swap map ] map concat ;
-: (head-slice) ( seq n -- seq' ) over length over < [ drop ] [ head-slice ] if ;
-: find-all ( seq quot -- elts ) [ [ length iota ] keep ] dip
-    [ dupd call( a -- ? ) [ 2array ] [ 2drop f ] if ] curry 2map [ ] filter ; inline

core/vocabs/parser/parser.factor

@@ -6,7 +6,7 @@ sets strings vocabs sorting accessors arrays compiler.units
 combinators vectors splitting continuations math
 parser.notes ;
 IN: vocabs.parser
- 
+
 ERROR: no-word-error name ;
 
 : word-restarts ( possibilities -- restarts )
@@ -17,7 +17,7 @@ ERROR: no-word-error name ;
     word-restarts
     swap "Defer word in current vocabulary" swap 2array
     suffix ;
- 
+
 : <no-word-error> ( name possibilities -- error restarts )
     [ drop \ no-word-error boa ] [ word-restarts-with-defer ] 2bi ;
 
@@ -198,4 +198,4 @@ PRIVATE>
     2dup qualified-search dup [ 2nip ] [ drop vocab-search ] if ;
 
 : search ( name -- word/f )
-    manifest get search-manifest ;
+    manifest get search-manifest ;

extra/file-trees/file-trees.factor

@@ -1,6 +1,7 @@
 USING: accessors arrays delegate delegate.protocols
 io.pathnames kernel locals sequences
-vectors make strings ui.frp.signals ui.frp.gadgets ;
+vectors make strings ui.frp.signals ui.frp.gadgets
+sequences.extras ;
 IN: file-trees
 
 TUPLE: walkable-vector vector father ;

extra/fries/fries.factor

@@ -1,5 +1,5 @@
 USING: arrays vectors combinators effects kernel math sequences splitting
-strings.parser parser fry ;
+strings.parser parser fry sequences.extras ;
 IN: fries
 : str-fry ( str on -- quot ) split
     [ unclip-last [ [ spin glue ] reduce-r ] 2curry ]

extra/recipes/recipes.factor

@@ -1,7 +1,7 @@
 USING: accessors arrays db.tuples db.sqlite persistency db.queries
 io.files.temp kernel monads sequences ui ui.frp.gadgets
 ui.frp.layout ui.frp.signals ui.gadgets.scrollers ui.gadgets.labels
-colors.constants ui.pens.solid combinators math locals strings fries
+colors.constants ui.pens.solid combinators math locals strings
 ui.images db.types ;
 FROM: sets => prune ;
 IN: recipes
@@ -11,7 +11,7 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
 : top-recipes ( offset search -- recipes ) <query> T{ recipe } rot >>title >>tuple
     "votes" >>order 30 >>limit swap >>offset get-tuples ;
 : top-genres ( -- genres ) f f top-recipes [ genre>> ] map prune 4 (head-slice) ;
-: <image-button> ( str -- button ) i" vocab:recipes/icons/_.tiff" <image-name> <frp-button> ;
+: <image-button> ( str -- button ) "vocab:recipes/icons/" ".tiff" surround <image-name> <frp-button> ;
 
 : interface ( -- book ) [ 
      [

extra/ui/frp/functors/functors.factor

@@ -1,5 +1,5 @@
 USING: fry functors generalizations kernel macros peg peg-lexer
-sequences ;
+sequences sequences.extras ;
 FROM: ui.frp.signals => #1 ;
 IN: ui.frp.functors
 

extra/ui/frp/gadgets/gadgets.factor

@@ -6,8 +6,9 @@ IN: ui.frp.gadgets
 
 TUPLE: frp-button < button hook value ;
 : <frp-button> ( gadget -- button ) [
+      [ dup hook>> [ call( button -- ) ] [ drop ] if* ]
       [ [ [ value>> ] [ ] bi or ] keep set-control-value ]
-      [ dup hook>> [ call( button -- ) ] [ drop ] if* ] bi
+      [ model>> f swap (>>value) ] tri
    ] frp-button new-button f <basic> >>model ;
 : <frp-border-button> ( text -- button ) <frp-button> border-button-theme ;
 

extra/ui/frp/signals/signals.factor

@@ -1,4 +1,5 @@
-USING: accessors arrays kernel monads models models.product sequences classes ;
+USING: accessors arrays kernel monads models models.product sequences classes
+sequences.extras ;
 FROM: models.product => product ;
 IN: ui.frp.signals