From 0ad47550e02b8b5976ae44a84c731eae8773ab23 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 3 Nov 2019 20:32:19 -0600 Subject: [PATCH] factor: Use new-like* everywhere. --- basis/base64/base64.factor | 4 +-- basis/sequences/product/product.factor | 6 ++-- basis/sequences/unrolled/unrolled.factor | 2 +- core/sequences/sequences.factor | 45 ++++++++++++------------ 4 files changed, 27 insertions(+), 30 deletions(-) diff --git a/basis/base64/base64.factor b/basis/base64/base64.factor index 37f17c4ee8..60ba77b492 100644 --- a/basis/base64/base64.factor +++ b/basis/base64/base64.factor @@ -63,7 +63,7 @@ CONSTANT: alphabet $[ { 0 [ ] } { 1 [ drop char: = ] } { 2 [ 2drop char: = char: = ] } - } case data (4sequence) output stream-write-lines + } case data [ (4sequence) ] keep output stream-write-lines ] while 2drop ; inline PRIVATE> @@ -99,7 +99,7 @@ PRIVATE> B{ char: \n char: \r } input read1-ignoring char: = or B{ char: \n char: \r } input read1-ignoring char: = or B{ char: \n char: \r } input read1-ignoring char: = or - [ decode4 data (3sequence) ] 3keep + [ decode4 data [ (3sequence) ] keep ] 3keep [ char: = eq? 1 0 ? ] tri@ + + [ head-slice* ] unless-zero output stream-write diff --git a/basis/sequences/product/product.factor b/basis/sequences/product/product.factor index 141855c232..d48901a68c 100644 --- a/basis/sequences/product/product.factor +++ b/basis/sequences/product/product.factor @@ -65,8 +65,7 @@ M: product-sequence nth sequences product-length exemplar |[ result | sequences [ quot call i result set-nth-unsafe i 1 + i! ] product-each - result - ] new-like ; inline + ] new-like* ; inline : product-map ( ... sequences quot: ( ... seq -- ... value ) -- ... sequence ) over product-map-as ; inline @@ -76,5 +75,4 @@ M: product-sequence nth sequences product-length { } |[ result | sequences [ quot call 2array i result set-nth-unsafe i 1 + i! ] product-each - result - ] new-like exemplar assoc-like ; inline + ] new-like* exemplar assoc-like ; inline diff --git a/basis/sequences/unrolled/unrolled.factor b/basis/sequences/unrolled/unrolled.factor index 543aed2814..b06d214d74 100644 --- a/basis/sequences/unrolled/unrolled.factor +++ b/basis/sequences/unrolled/unrolled.factor @@ -25,7 +25,7 @@ PRIVATE> (unrolled-collect) unrolled-each-integer ; inline : unrolled-map-integers ( n quot: ( n -- value ) exemplar -- newseq ) - overd [ [ unrolled-collect ] keep ] new-like ; inline + overd [ unrolled-collect ] new-like* ; inline ERROR: unrolled-bounds-error seq unroll-length ; diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index fffd65301a..0217ac19c6 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -144,31 +144,31 @@ INSTANCE: iota immutable-sequence : from-end ( seq n -- seq n' ) [ dup length ] dip - ; inline -: (1sequence) ( obj seq -- seq ) - [ 0 swap set-nth-unsafe ] keep ; inline +: (1sequence) ( obj seq -- ) + 0 swap set-nth-unsafe ; inline -: (2sequence) ( obj1 obj2 seq -- seq ) - [ 1 swap set-nth-unsafe ] keep (1sequence) ; inline +: (2sequence) ( obj1 obj2 seq -- ) + [ 1 swap set-nth-unsafe ] [ (1sequence) ] bi ; inline -: (3sequence) ( obj1 obj2 obj3 seq -- seq ) - [ 2 swap set-nth-unsafe ] keep (2sequence) ; inline +: (3sequence) ( obj1 obj2 obj3 seq -- ) + [ 2 swap set-nth-unsafe ] [ (2sequence) ] bi ; inline -: (4sequence) ( obj1 obj2 obj3 obj4 seq -- seq ) - [ 3 swap set-nth-unsafe ] keep (3sequence) ; inline +: (4sequence) ( obj1 obj2 obj3 obj4 seq -- ) + [ 3 swap set-nth-unsafe ] [ (3sequence) ] bi ; inline PRIVATE> : 1sequence ( obj exemplar -- seq ) - 1 swap [ (1sequence) ] new-like ; inline + 1 swap [ (1sequence) ] new-like* ; inline : 2sequence ( obj1 obj2 exemplar -- seq ) - 2 swap [ (2sequence) ] new-like ; inline + 2 swap [ (2sequence) ] new-like* ; inline : 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 ) - 4 swap [ (4sequence) ] new-like ; inline + 4 swap [ (4sequence) ] new-like* ; inline : first2 ( seq -- first second ) 1 swap bounds-check nip first2-unsafe ; inline @@ -353,22 +353,21 @@ M: immutable-sequence clone-like like ; inline : append-as ( seq1 seq2 exemplar -- newseq ) [ 2dup [ length ] bi@ + ] dip - [ (append) ] new-like ; inline + [ (append) ] new-like* ; inline : 3append-as ( seq1 seq2 seq3 exemplar -- newseq ) [ 3dup [ length ] tri@ + + ] dip [ [ [ 2over [ length ] bi@ + ] dip copy-unsafe ] [ (append) ] bi - ] new-like ; inline + ] new-like* ; inline : append ( seq1 seq2 -- newseq ) over append-as ; @@ -473,7 +472,7 @@ PRIVATE> swapd each ; inline : map-integers ( ... len quot: ( ... i -- ... elt ) exemplar -- ... newseq ) - overd [ [ collect ] keep ] new-like ; inline + overd [ collect ] new-like* ; inline : map-as ( ... seq quot: ( ... elt -- ... newelt ) exemplar -- ... newseq ) [ [ length ensure-integer ] keep ] 2dip @@ -768,14 +767,14 @@ PRIVATE> : prefix ( seq elt -- newseq ) over [ over length 1 + ] dip [ - (1sequence) [ 1 swap copy-unsafe ] keep - ] new-like ; + [ (1sequence) ] [ 1 swap copy-unsafe ] bi + ] new-like* ; : suffix ( seq elt -- newseq ) over [ over length 1 + ] dip [ - [ [ over length ] dip set-nth-unsafe ] keep - [ 0 swap copy-unsafe ] keep - ] new-like ; + [ [ over length ] dip set-nth-unsafe ] + [ 0 swap copy-unsafe ] bi + ] new-like* ; : suffix! ( seq elt -- seq ) over push ; inline