From 6132608cc23cb936a87b3ab3783b1419f9355ae0 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Wed, 17 Jun 2009 12:35:09 -0500 Subject: [PATCH] extra sequences functions moved out of core --- core/sequences/sequences.factor | 39 +++++++++++---------------- core/vocabs/parser/parser.factor | 6 ++--- extra/file-trees/file-trees.factor | 3 ++- extra/fries/fries.factor | 2 +- extra/recipes/recipes.factor | 4 +-- extra/ui/frp/functors/functors.factor | 2 +- extra/ui/frp/gadgets/gadgets.factor | 3 ++- extra/ui/frp/signals/signals.factor | 3 ++- 8 files changed, 28 insertions(+), 34 deletions(-) mode change 100644 => 100755 core/vocabs/parser/parser.factor diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index ab4772de51..6eea872343 100755 --- a/core/sequences/sequences.factor +++ b/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> : 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 \ No newline at end of file diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor old mode 100644 new mode 100755 index 98b8b8d0e8..0bfb607a52 --- a/core/vocabs/parser/parser.factor +++ b/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 ; - + : ( 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 ; \ No newline at end of file + manifest get search-manifest ; diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor index 0329021f57..adfb7d67de 100644 --- a/extra/file-trees/file-trees.factor +++ b/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 ; diff --git a/extra/fries/fries.factor b/extra/fries/fries.factor index 6639607a11..f67d0d7cd3 100644 --- a/extra/fries/fries.factor +++ b/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 ] diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor index 3fa65d336d..cec82a457d 100644 --- a/extra/recipes/recipes.factor +++ b/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 ) 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) ; -: ( str -- button ) i" vocab:recipes/icons/_.tiff" ; +: ( str -- button ) "vocab:recipes/icons/" ".tiff" surround ; : interface ( -- book ) [ [ diff --git a/extra/ui/frp/functors/functors.factor b/extra/ui/frp/functors/functors.factor index cda6a0effa..1b31151013 100644 --- a/extra/ui/frp/functors/functors.factor +++ b/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 diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor index e5dae45b99..ddcde69eaf 100644 --- a/extra/ui/frp/gadgets/gadgets.factor +++ b/extra/ui/frp/gadgets/gadgets.factor @@ -6,8 +6,9 @@ IN: ui.frp.gadgets TUPLE: frp-button < button hook value ; : ( 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 >>model ; : ( text -- button ) border-button-theme ; diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor index e48d477465..b5389f7bb9 100644 --- a/extra/ui/frp/signals/signals.factor +++ b/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