factor: rename new-like* to new-like
parent
2b8204aabc
commit
3f79f14af2
|
@ -65,7 +65,7 @@ M: product-sequence nth
|
||||||
sequences product-length exemplar
|
sequences product-length exemplar
|
||||||
|[ result |
|
|[ result |
|
||||||
sequences [ quot call i result set-nth-unsafe i 1 + i! ] product-each
|
sequences [ quot call i result set-nth-unsafe i 1 + i! ] product-each
|
||||||
] new-like* ; inline
|
] new-like ; inline
|
||||||
|
|
||||||
: product-map ( ... sequences quot: ( ... seq -- ... value ) -- ... sequence )
|
: product-map ( ... sequences quot: ( ... seq -- ... value ) -- ... sequence )
|
||||||
over product-map-as ; inline
|
over product-map-as ; inline
|
||||||
|
@ -75,4 +75,4 @@ M: product-sequence nth
|
||||||
sequences product-length { }
|
sequences product-length { }
|
||||||
|[ result |
|
|[ result |
|
||||||
sequences [ quot call 2array i result set-nth-unsafe i 1 + i! ] product-each
|
sequences [ quot call 2array i result set-nth-unsafe i 1 + i! ] product-each
|
||||||
] new-like* exemplar assoc-like ; inline
|
] new-like exemplar assoc-like ; inline
|
||||||
|
|
|
@ -25,7 +25,7 @@ PRIVATE>
|
||||||
(unrolled-collect) unrolled-each-integer ; inline
|
(unrolled-collect) unrolled-each-integer ; inline
|
||||||
|
|
||||||
: unrolled-map-integers ( n quot: ( n -- value ) exemplar -- newseq )
|
: unrolled-map-integers ( n quot: ( n -- value ) exemplar -- newseq )
|
||||||
overd [ unrolled-collect ] new-like* ; inline
|
overd [ unrolled-collect ] new-like ; inline
|
||||||
|
|
||||||
ERROR: unrolled-bounds-error
|
ERROR: unrolled-bounds-error
|
||||||
seq unroll-length ;
|
seq unroll-length ;
|
||||||
|
|
|
@ -16,9 +16,6 @@ GENERIC: like ( seq exemplar -- newseq ) flushable
|
||||||
GENERIC: clone-like ( seq exemplar -- newseq ) flushable
|
GENERIC: clone-like ( seq exemplar -- newseq ) flushable
|
||||||
|
|
||||||
: new-like ( len exemplar quot -- seq )
|
: new-like ( len exemplar quot -- seq )
|
||||||
over [ [ new-sequence ] dip call ] dip like ; inline
|
|
||||||
|
|
||||||
: new-like* ( len exemplar quot -- seq )
|
|
||||||
over [ [ new-sequence ] dip [ call ] keepd ] dip like ; inline
|
over [ [ new-sequence ] dip [ call ] keepd ] dip like ; inline
|
||||||
|
|
||||||
M: sequence like drop ; inline
|
M: sequence like drop ; inline
|
||||||
|
@ -159,16 +156,16 @@ INSTANCE: iota immutable-sequence
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: 1sequence ( obj exemplar -- seq )
|
: 1sequence ( obj exemplar -- seq )
|
||||||
1 swap [ (1sequence) ] new-like* ; inline
|
1 swap [ (1sequence) ] new-like ; inline
|
||||||
|
|
||||||
: 2sequence ( obj1 obj2 exemplar -- seq )
|
: 2sequence ( obj1 obj2 exemplar -- seq )
|
||||||
2 swap [ (2sequence) ] new-like* ; inline
|
2 swap [ (2sequence) ] new-like ; inline
|
||||||
|
|
||||||
: 3sequence ( obj1 obj2 obj3 exemplar -- seq )
|
: 3sequence ( obj1 obj2 obj3 exemplar -- seq )
|
||||||
3 swap [ (3sequence) ] new-like* ; inline
|
3 swap [ (3sequence) ] new-like ; inline
|
||||||
|
|
||||||
: 4sequence ( obj1 obj2 obj3 obj4 exemplar -- seq )
|
: 4sequence ( obj1 obj2 obj3 obj4 exemplar -- seq )
|
||||||
4 swap [ (4sequence) ] new-like* ; inline
|
4 swap [ (4sequence) ] new-like ; inline
|
||||||
|
|
||||||
: first2 ( seq -- first second )
|
: first2 ( seq -- first second )
|
||||||
1 swap bounds-check nip first2-unsafe ; inline
|
1 swap bounds-check nip first2-unsafe ; inline
|
||||||
|
@ -361,13 +358,13 @@ PRIVATE>
|
||||||
|
|
||||||
: append-as ( seq1 seq2 exemplar -- newseq )
|
: append-as ( seq1 seq2 exemplar -- newseq )
|
||||||
[ 2dup [ length ] bi@ + ] dip
|
[ 2dup [ length ] bi@ + ] dip
|
||||||
[ (append) ] new-like* ; inline
|
[ (append) ] new-like ; inline
|
||||||
|
|
||||||
: 3append-as ( seq1 seq2 seq3 exemplar -- newseq )
|
: 3append-as ( seq1 seq2 seq3 exemplar -- newseq )
|
||||||
[ 3dup [ length ] tri@ + + ] dip [
|
[ 3dup [ length ] tri@ + + ] dip [
|
||||||
[ [ 2over [ length ] bi@ + ] dip copy-unsafe ]
|
[ [ 2over [ length ] bi@ + ] dip copy-unsafe ]
|
||||||
[ (append) ] bi
|
[ (append) ] bi
|
||||||
] new-like* ; inline
|
] new-like ; inline
|
||||||
|
|
||||||
: append ( seq1 seq2 -- newseq ) over append-as ;
|
: append ( seq1 seq2 -- newseq ) over append-as ;
|
||||||
|
|
||||||
|
@ -472,7 +469,7 @@ PRIVATE>
|
||||||
swapd each ; inline
|
swapd each ; inline
|
||||||
|
|
||||||
: map-integers ( ... len quot: ( ... i -- ... elt ) exemplar -- ... newseq )
|
: map-integers ( ... len quot: ( ... i -- ... elt ) exemplar -- ... newseq )
|
||||||
overd [ collect ] new-like* ; inline
|
overd [ collect ] new-like ; inline
|
||||||
|
|
||||||
: map-as ( ... seq quot: ( ... elt -- ... newelt ) exemplar -- ... newseq )
|
: map-as ( ... seq quot: ( ... elt -- ... newelt ) exemplar -- ... newseq )
|
||||||
[ [ length ensure-integer ] keep ] 2dip
|
[ [ length ensure-integer ] keep ] 2dip
|
||||||
|
@ -480,7 +477,7 @@ PRIVATE>
|
||||||
[ [ nth-unsafe ] curry ]
|
[ [ nth-unsafe ] curry ]
|
||||||
[ compose [ keep ] curry ]
|
[ compose [ keep ] curry ]
|
||||||
[ [ set-nth-unsafe ] curry compose ] tri* each-integer
|
[ [ set-nth-unsafe ] curry compose ] tri* each-integer
|
||||||
] new-like* ; inline
|
] new-like ; inline
|
||||||
|
|
||||||
: map ( ... seq quot: ( ... elt -- ... newelt ) -- ... newseq )
|
: map ( ... seq quot: ( ... elt -- ... newelt ) -- ... newseq )
|
||||||
over map-as ; inline
|
over map-as ; inline
|
||||||
|
@ -768,13 +765,13 @@ PRIVATE>
|
||||||
: prefix ( seq elt -- newseq )
|
: prefix ( seq elt -- newseq )
|
||||||
over [ over length 1 + ] dip [
|
over [ over length 1 + ] dip [
|
||||||
[ (1sequence) ] [ 1 swap copy-unsafe ] bi
|
[ (1sequence) ] [ 1 swap copy-unsafe ] bi
|
||||||
] new-like* ;
|
] new-like ;
|
||||||
|
|
||||||
: suffix ( seq elt -- newseq )
|
: suffix ( seq elt -- newseq )
|
||||||
over [ over length 1 + ] dip [
|
over [ over length 1 + ] dip [
|
||||||
[ [ over length ] dip set-nth-unsafe ]
|
[ [ over length ] dip set-nth-unsafe ]
|
||||||
[ 0 swap copy-unsafe ] bi
|
[ 0 swap copy-unsafe ] bi
|
||||||
] new-like* ;
|
] new-like ;
|
||||||
|
|
||||||
: suffix! ( seq elt -- seq ) over push ; inline
|
: suffix! ( seq elt -- seq ) over push ; inline
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue