Move 3each, 3map from compiler.utilities to sequences
parent
c7b589f712
commit
7b110b0bfd
|
@ -21,11 +21,3 @@ IN: compiler.utilities
|
||||||
: map-flat ( seq quot -- seq' ) [ each ] flattening ; inline
|
: map-flat ( seq quot -- seq' ) [ each ] flattening ; inline
|
||||||
|
|
||||||
: 2map-flat ( seq quot -- seq' ) [ 2each ] flattening ; inline
|
: 2map-flat ( seq quot -- seq' ) [ 2each ] flattening ; inline
|
||||||
|
|
||||||
: (3each) ( seq1 seq2 seq3 quot -- n quot' )
|
|
||||||
[ [ [ length ] tri@ min min ] 3keep ] dip
|
|
||||||
'[ [ _ nth-unsafe ] [ _ nth-unsafe ] [ _ nth-unsafe ] tri @ ] ; inline
|
|
||||||
|
|
||||||
: 3each ( seq1 seq2 seq3 quot -- seq ) (3each) each ; inline
|
|
||||||
|
|
||||||
: 3map ( seq1 seq2 seq3 quot -- seq ) (3each) map ; inline
|
|
||||||
|
|
|
@ -32,8 +32,8 @@ IN: sequences.tests
|
||||||
[ 4 CHAR: o ]
|
[ 4 CHAR: o ]
|
||||||
[ 3 "hello world" "aeiou" [ member? ] curry find-from ] unit-test
|
[ 3 "hello world" "aeiou" [ member? ] curry find-from ] unit-test
|
||||||
|
|
||||||
[ f ] [ 3 [ ] member? ] unit-test
|
[ f ] [ 3 [ ] member? ] unit-test
|
||||||
[ f ] [ 3 [ 1 2 ] member? ] unit-test
|
[ f ] [ 3 [ 1 2 ] member? ] unit-test
|
||||||
[ t ] [ 1 [ 1 2 ] member? ] unit-test
|
[ t ] [ 1 [ 1 2 ] member? ] unit-test
|
||||||
[ t ] [ 2 [ 1 2 ] member? ] unit-test
|
[ t ] [ 2 [ 1 2 ] member? ] unit-test
|
||||||
|
|
||||||
|
@ -55,6 +55,11 @@ IN: sequences.tests
|
||||||
|
|
||||||
[ [ 3 ] ] [ [ 1 2 3 ] 2 [ swap < ] curry filter ] unit-test
|
[ [ 3 ] ] [ [ 1 2 3 ] 2 [ swap < ] curry filter ] unit-test
|
||||||
|
|
||||||
|
[ V{ 1 2 3 } ] [ V{ 1 4 2 5 3 6 } clone [ [ 4 < ] filter-here ] keep ] unit-test
|
||||||
|
[ V{ 4 2 6 } ] [ V{ 1 4 2 5 3 6 } clone [ [ 2 mod 0 = ] filter-here ] keep ] unit-test
|
||||||
|
|
||||||
|
[ V{ 3 } ] [ V{ 1 2 3 } clone [ 2 [ swap < ] curry filter-here ] keep ] unit-test
|
||||||
|
|
||||||
[ "hello world how are you" ]
|
[ "hello world how are you" ]
|
||||||
[ { "hello" "world" "how" "are" "you" } " " join ]
|
[ { "hello" "world" "how" "are" "you" } " " join ]
|
||||||
unit-test
|
unit-test
|
||||||
|
@ -261,3 +266,14 @@ M: bogus-hashcode hashcode* 2drop 0 >bignum ;
|
||||||
|
|
||||||
[ "a,b" ] [ "a" "b" "," glue ] unit-test
|
[ "a,b" ] [ "a" "b" "," glue ] unit-test
|
||||||
[ "(abc)" ] [ "abc" "(" ")" surround ] unit-test
|
[ "(abc)" ] [ "abc" "(" ")" surround ] unit-test
|
||||||
|
|
||||||
|
[ "HELLO" ] [
|
||||||
|
"HELLO" { -1 -1 -1 -1 -1 } { 2 2 2 2 2 2 }
|
||||||
|
[ * 2 + + ] 3map
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ 3 1 } [ [ 3array ] 3map ] must-infer-as
|
||||||
|
|
||||||
|
{ 3 0 } [ [ 3drop ] 3each ] must-infer-as
|
||||||
|
|
||||||
|
[ V{ 0 3 } ] [ "A" { "A" "B" "C" "A" "D" } indices ] unit-test
|
|
@ -1,4 +1,4 @@
|
||||||
! Copyright (C) 2005, 2008 Slava Pestov, Daniel Ehrenberg.
|
! Copyright (C) 2005, 2009 Slava Pestov, Daniel Ehrenberg.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors kernel kernel.private slots.private math
|
USING: accessors kernel kernel.private slots.private math
|
||||||
math.private math.order ;
|
math.private math.order ;
|
||||||
|
@ -117,9 +117,9 @@ INSTANCE: integer immutable-sequence
|
||||||
[ tuck [ nth-unsafe ] 2bi@ ]
|
[ tuck [ nth-unsafe ] 2bi@ ]
|
||||||
[ tuck [ set-nth-unsafe ] 2bi@ ] 3bi ; inline
|
[ tuck [ set-nth-unsafe ] 2bi@ ] 3bi ; inline
|
||||||
|
|
||||||
: (head) ( seq n -- from to seq ) 0 spin ; inline
|
: (head) ( seq n -- from to seq ) [ 0 ] 2dip swap ; inline
|
||||||
|
|
||||||
: (tail) ( seq n -- from to seq ) over length rot ; inline
|
: (tail) ( seq n -- from to seq ) swap [ length ] keep ; inline
|
||||||
|
|
||||||
: from-end ( seq n -- seq n' ) [ dup length ] dip - ; inline
|
: from-end ( seq n -- seq n' ) [ dup length ] dip - ; inline
|
||||||
|
|
||||||
|
@ -352,6 +352,10 @@ PRIVATE>
|
||||||
: 2map-into ( seq1 seq2 quot into -- newseq )
|
: 2map-into ( seq1 seq2 quot into -- newseq )
|
||||||
[ (2each) ] dip collect ; inline
|
[ (2each) ] dip collect ; inline
|
||||||
|
|
||||||
|
: (3each) ( seq1 seq2 seq3 quot -- n quot' )
|
||||||
|
[ [ [ length ] tri@ min min ] 3keep ] dip
|
||||||
|
[ [ [ [ nth-unsafe ] curry ] tri@ tri ] 3curry ] dip compose ; inline
|
||||||
|
|
||||||
: finish-find ( i seq -- i elt )
|
: finish-find ( i seq -- i elt )
|
||||||
over [ dupd nth-unsafe ] [ drop f ] if ; inline
|
over [ dupd nth-unsafe ] [ drop f ] if ; inline
|
||||||
|
|
||||||
|
@ -419,6 +423,12 @@ PRIVATE>
|
||||||
: 2all? ( seq1 seq2 quot -- ? )
|
: 2all? ( seq1 seq2 quot -- ? )
|
||||||
(2each) all-integers? ; inline
|
(2each) all-integers? ; inline
|
||||||
|
|
||||||
|
: 3each ( seq1 seq2 seq3 quot -- )
|
||||||
|
(3each) each ; inline
|
||||||
|
|
||||||
|
: 3map ( seq1 seq2 seq3 quot -- newseq )
|
||||||
|
(3each) map ; inline
|
||||||
|
|
||||||
: find-from ( n seq quot -- i elt )
|
: find-from ( n seq quot -- i elt )
|
||||||
[ (find-integer) ] (find-from) ; inline
|
[ (find-integer) ] (find-from) ; inline
|
||||||
|
|
||||||
|
@ -494,10 +504,12 @@ PRIVATE>
|
||||||
: last-index-from ( obj i seq -- n )
|
: last-index-from ( obj i seq -- n )
|
||||||
rot [ = ] curry find-last-from drop ;
|
rot [ = ] curry find-last-from drop ;
|
||||||
|
|
||||||
|
: (indices) ( elt i obj accum -- )
|
||||||
|
[ swap [ = ] dip ] dip [ push ] 2curry when ; inline
|
||||||
|
|
||||||
: indices ( obj seq -- indices )
|
: indices ( obj seq -- indices )
|
||||||
V{ } clone spin
|
swap V{ } clone
|
||||||
[ rot = [ over push ] [ drop ] if ]
|
[ [ (indices) ] 2curry each-index ] keep ;
|
||||||
curry each-index ;
|
|
||||||
|
|
||||||
: nths ( indices seq -- seq' )
|
: nths ( indices seq -- seq' )
|
||||||
[ nth ] curry map ;
|
[ nth ] curry map ;
|
||||||
|
@ -566,7 +578,7 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: filter-here ( seq quot -- )
|
: filter-here ( seq quot -- )
|
||||||
0 0 roll (filter-here) ; inline
|
swap [ 0 0 ] dip (filter-here) ; inline
|
||||||
|
|
||||||
: delete ( elt seq -- )
|
: delete ( elt seq -- )
|
||||||
[ = not ] with filter-here ;
|
[ = not ] with filter-here ;
|
||||||
|
@ -828,7 +840,7 @@ PRIVATE>
|
||||||
|
|
||||||
: supremum ( seq -- n ) dup first [ max ] reduce ;
|
: supremum ( seq -- n ) dup first [ max ] reduce ;
|
||||||
|
|
||||||
: sigma ( seq quot -- n ) 0 -rot [ rot slip + ] curry each ; inline
|
: sigma ( seq quot -- n ) [ 0 ] 2dip [ rot slip + ] curry each ; inline
|
||||||
|
|
||||||
: count ( seq quot -- n ) [ 1 0 ? ] compose sigma ; inline
|
: count ( seq quot -- n ) [ 1 0 ? ] compose sigma ; inline
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue