factor: rename new-like* to new-like

modern-harvey3
Doug Coleman 2019-11-03 20:39:50 -06:00
parent 2b8204aabc
commit 3f79f14af2
3 changed files with 13 additions and 16 deletions

View File

@ -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

View File

@ -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 ;

View File

@ -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