clean up copy implementation for real

core/sequences/sequences.factor

@@ -270,30 +270,34 @@ ERROR: integer-length-expected obj ;
 : check-length ( n -- n )
     dup integer? [ integer-length-expected ] unless ; inline
 
-: ((copy)) ( dst i src j n -- )
+TUPLE: copy-state
-    [ + swap nth-unsafe [ ] curry 2dip ] keep
+    { src-i integer read-only }
-    + swap set-nth-unsafe ; inline
+    { src sequence read-only }
+    { dst-i integer read-only }
+    { dst sequence read-only } ;
 
-: 5bi ( a b c d e x y -- )
+C: <copy> copy-state
-    bi-curry bi-curry bi-curry bi-curry bi ; inline
 
-: (copy) ( dst i src j n -- dst )
+: ((copy)) ( n copy -- )
-    dup 0 <= [ 2drop 2drop ] [ 1 - [ ((copy)) ] [ (copy) ] 5bi ] if ;
+    [ [ src-i>> + ] [ src>> ] bi nth-unsafe ]
+    [ [ dst-i>> + ] [ dst>> ] bi set-nth-unsafe ] 2bi ; inline
+
+: (copy) ( n copy -- dst )
+    over 0 <= [ nip dst>> ] [ [ 1 - ] dip [ ((copy)) ] [ (copy) ] 2bi ] if ;
     inline recursive
 
-: prepare-subseq ( from to seq -- dst i src j n )
+: subseq>copy ( from to seq -- n copy )
-    [ over - ] dip
+    [ over - check-length swap ] dip
-    [ new-sequence 0 rot ] 2keep
+    3dup nip new-sequence 0 swap <copy> ; inline
-    [ ] curry 2dip check-length ; inline
 
-: check-copy ( src n dst -- )
+: check-copy ( src n dst -- src n dst )
-    over 0 < [ bounds-error ] when
+    3dup over 0 < [ bounds-error ] when
     [ swap length + ] dip lengthen ; inline
 
 PRIVATE>
 
 : subseq ( from to seq -- subseq )
-    [ check-slice prepare-subseq (copy) ] keep like ;
+    [ check-slice subseq>copy (copy) ] keep like ;
 
 : head ( seq n -- headseq ) (head) subseq ;
 
@@ -309,8 +313,8 @@ PRIVATE>
 
 : copy ( src i dst -- )
     #! The check-length call forces partial dispatch
-    pick length check-length [ 3dup check-copy spin 0 ] dip
+    [ [ length check-length 0 ] keep ] 2dip
-    (copy) drop ; inline
+    check-copy <copy> (copy) drop ; inline
 
 M: sequence clone-like
     [ dup length ] dip new-sequence [ 0 swap copy ] keep ; inline