From 7e2ff8864fc4918f0e7a97b463123b83973155ce Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 6 Mar 2013 14:06:33 -0800
Subject: [PATCH] sequences: add a copy-unsafe that can be used sometimes.

---
 core/sequences/sequences-docs.factor |  4 ++--
 core/sequences/sequences.factor      | 32 ++++++++++++++++------------
 2 files changed, 20 insertions(+), 16 deletions(-)

diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index b80a9dbca9..9be1be2609 100644
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@@ -59,11 +59,11 @@ HELP: immutable
 
 HELP: new-sequence
 { $values { "len" "a non-negative integer" } { "seq" sequence } { "newseq" "a mutable sequence" } }
-{ $contract "Outputs a mutable sequence of length " { $snippet "n" } " which can hold the elements of " { $snippet "seq" } ". The initial contents of the sequence are undefined." } ;
+{ $contract "Outputs a mutable sequence of length " { $snippet "len" } " which can hold the elements of " { $snippet "seq" } ". The initial contents of the sequence are undefined." } ;
 
 HELP: new-resizable
 { $values { "len" "a non-negative integer" } { "seq" sequence } { "newseq" "a resizable mutable sequence" } }
-{ $contract "Outputs a resizable mutable sequence with an initial capacity of " { $snippet "n" } " elements and zero length, which can hold the elements of " { $snippet "seq" } "." }
+{ $contract "Outputs a resizable mutable sequence with an initial capacity of " { $snippet "len" } " elements and zero length, which can hold the elements of " { $snippet "seq" } "." }
 { $examples
     { $example "USING: prettyprint sequences ;" "300 V{ } new-resizable ." "V{ }" }
     { $example "USING: prettyprint sequences ;" "300 SBUF\" \" new-resizable ." "SBUF\" \"" }
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 9e7d27e11b..4bb2af05cd 100644
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -291,8 +291,9 @@ C: <copy> copy-state
     [ [ 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
+    over 0 <= [ nip dst>> ] [
+        [ 1 - ] dip [ ((copy)) ] [ (copy) ] 2bi
+    ] if ; inline recursive
 
 : subseq>copy ( from to seq -- n copy )
     [ over - check-length swap ] dip
@@ -305,6 +306,10 @@ C: <copy> copy-state
     3dup bounds-check-head
     [ swap length + ] dip lengthen ; inline
 
+: copy-unsafe ( src i dst -- )
+    #! The check-length call forces partial dispatch
+    [ [ length check-length 0 ] keep ] 2dip <copy> (copy) drop ; inline
+
 PRIVATE>
 
 : subseq ( from to seq -- subseq )
@@ -323,12 +328,10 @@ PRIVATE>
 : but-last ( seq -- headseq ) 1 head* ;
 
 : copy ( src i dst -- )
-    #! The check-length call forces partial dispatch
-    [ [ length check-length 0 ] keep ] 2dip
-    check-copy <copy> (copy) drop ; inline
+    check-copy copy-unsafe ; inline
 
 M: sequence clone-like
-    [ dup length ] dip new-sequence [ 0 swap copy ] keep ; inline
+    [ dup length ] dip new-sequence [ 0 swap copy-unsafe ] keep ; inline
 
 M: immutable-sequence clone-like like ; inline
 
@@ -337,8 +340,8 @@ M: immutable-sequence clone-like like ; inline
 <PRIVATE
 
 : (append) ( seq1 seq2 accum -- accum )
-    [ [ over length ] dip copy ]
-    [ 0 swap copy ]
+    [ [ over length ] dip copy-unsafe ]
+    [ 0 swap copy-unsafe ]
     [ ] tri ; inline
 
 PRIVATE>
@@ -349,7 +352,7 @@ PRIVATE>
 
 : 3append-as ( seq1 seq2 seq3 exemplar -- newseq )
     [ 3dup [ length ] tri@ + + ] dip [
-        [ [ 2over [ length ] bi@ + ] dip copy ]
+        [ [ 2over [ length ] bi@ + ] dip copy-unsafe ]
         [ (append) ] bi
     ] new-like ; inline
 
@@ -687,13 +690,13 @@ PRIVATE>
 
 : prefix ( seq elt -- newseq )
     over [ over length 1 + ] dip [
-        (1sequence) [ 1 swap copy ] keep
+        (1sequence) [ 1 swap copy-unsafe ] keep
     ] new-like ;
 
 : suffix ( seq elt -- newseq )
     over [ over length 1 + ] dip [
         [ [ over length ] dip set-nth-unsafe ] keep
-        [ 0 swap copy ] keep
+        [ 0 swap copy-unsafe ] keep
     ] new-like ;
 
 : suffix! ( seq elt -- seq ) over push ; inline
@@ -790,9 +793,9 @@ PRIVATE>
     ] keep ;
 
 : reverse ( seq -- newseq )
-    [
+     [
         dup [ length ] keep new-sequence
-        [ 0 swap copy ] keep reverse!
+        [ 0 swap copy-unsafe ] keep reverse!
     ] keep like ;
 
 : sum-lengths ( seq -- n )
@@ -818,7 +821,8 @@ PRIVATE>
     over empty? [ nip concat-as ] [
         [
             2dup joined-length over new-resizable [
-                [ [ push-all ] 2curry ] [ [ nip push-all ] 2curry ] 2bi
+                [ [ push-all ] 2curry ]
+                [ nip [ push-all ] curry ] 2bi
                 interleave
             ] keep
         ] dip like
-- 
2.34.1