diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 6cda7fc73f..376133b02d 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -289,6 +289,8 @@ M: immutable-sequence clone-like like ; : push-all ( src dest -- ) [ length ] [ copy ] bi ; +r over length r> copy ] [ 0 swap copy ] @@ -304,6 +306,8 @@ M: immutable-sequence clone-like like ; [ ((append)) ] bi ] new-like ; inline +PRIVATE> + : append ( seq1 seq2 -- newseq ) over (append) ; : prepend ( seq1 seq2 -- newseq ) swap append ; inline @@ -402,7 +406,7 @@ PRIVATE> : 2map ( seq1 seq2 quot -- newseq ) pick 2map-as ; inline -: 2change-each ( seq1 seq2 quot -- newseq ) +: 2change-each ( seq1 seq2 quot -- ) pick 2map-into ; inline : 2all? ( seq1 seq2 quot -- ? ) @@ -543,6 +547,8 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; 2over number= [ 3drop ] [ [ nth swap ] [ set-nth ] bi ] if ; inline +r >r 1+ r> r> ] unless >r 1+ r> (delete) ] when ; +PRIVATE> + : delete ( elt seq -- ) 0 0 rot (delete) nip set-length drop ; : prefix ( seq elt -- newseq ) @@ -568,6 +576,8 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; : pop* ( seq -- ) [ length 1- ] [ shorten ] bi ; +r >r over - r> r> move-backward ] if ; +PRIVATE> + : open-slice ( shift from seq -- ) pick zero? [ 3drop @@ -650,9 +662,13 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; first like ] if-empty ; +r dup sum-lengths swap length 1 [-] r> length * + ; +PRIVATE> + : join ( seq glue -- newseq ) [ 2dup joined-length over new-resizable spin @@ -671,7 +687,7 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; : pad-right ( seq n elt -- padded ) [ append ] padding ; -: shorter? ( seq1 seq2 -- ? ) >r length r> length < ; +: shorter? ( seq1 seq2 -- ? ) [ length ] bi@ < ; : head? ( seq begin -- ? ) 2dup shorter? [ @@ -687,7 +703,7 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; tuck length tail-slice* sequence= ] if ; -: cut-slice ( seq n -- before after ) +: cut-slice ( seq n -- before-slice after-slice ) [ head-slice ] [ tail-slice ] 2bi ; : insert-nth ( elt n seq -- seq' ) @@ -695,7 +711,7 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; : midpoint@ ( seq -- n ) length 2/ ; inline -: halves ( seq -- first second ) +: halves ( seq -- first-slice second-slice ) dup midpoint@ cut-slice ; : binary-reduce ( seq start quot: ( elt1 elt2 -- newelt ) -- value ) @@ -749,10 +765,10 @@ PRIVATE> : unclip-last ( seq -- butlast last ) [ but-last ] [ peek ] bi ; -: unclip-slice ( seq -- rest first ) +: unclip-slice ( seq -- rest-slice first ) [ rest-slice ] [ first ] bi ; inline -: 2unclip-slice ( seq1 seq2 -- seq1' seq2' elt1 elt2 ) +: 2unclip-slice ( seq1 seq2 -- rest-slice1 rest-slice2 first1 first2 ) [ unclip-slice ] bi@ swapd ; inline : map-reduce ( seq map-quot reduce-quot -- result ) @@ -763,7 +779,7 @@ PRIVATE> [ [ 2unclip-slice ] dip [ call ] keep ] dip compose 2reduce ; inline -: unclip-last-slice ( seq -- butlast last ) +: unclip-last-slice ( seq -- butlast-slice last ) [ but-last-slice ] [ peek ] bi ; inline : ( seq -- slice )