sequences.extras: add exchange-subseq

diff --git a/extra/sequences/extras/extras-docs.factor b/extra/sequences/extras/extras-docs.factor
index 16a85a6e290675b380a045bc209ef94393ec688b..d681ee2f5583bce06d4ea77cc2bd1e219e5debd3 100644 (file)
--- a/extra/sequences/extras/extras-docs.factor
+++ b/extra/sequences/extras/extras-docs.factor
@@ -1370,3 +1370,30 @@ HELP: with-string-lines
     { "str" string } { "quot" quotation }
     { "str'" string }
 } ;
+
+HELP: exchange-subseq
+{ $values
+    { "len" { "a non-negative " { $link integer } } }
+    { "pos1" { "a non-negative " { $link integer } } }
+    { "pos2" { "a non-negative " { $link integer } } }
+    { "seq" { "a mutable " { $link sequence } } }
+}
+{ $description "Exchanges the contents of subsequences "
+{ $snippet "[pos1, pos1+len)" } " and " { $snippet "[pos2, pos2+len)" } " in "
+{ $snippet "seq" } ". Overlapping ranges are allowed. If either of the ranges exceeds the "
+{ $snippet "seq" } " length, throws an error before any modifications take place. If "
+{ $snippet "len" } " = 1, the behavior is equivalent to " { $link exchange } "." }
+{ $examples
+    "Non-overlapping ranges:"
+    { $example "USING: kernel sequences.extras prettyprint ;"
+        "2 0 3 \"01_34_\" [ exchange-subseq ] keep ."
+        "\"34_01_\""
+    }
+    "Overlapping ranges:"
+    { $example "USING: kernel sequences.extras prettyprint ;"
+        "3 0 2 \"abcdef\" [ exchange-subseq ] keep ."
+        "\"cdebaf\""
+    }
+}
+{ $side-effects "seq" }
+{ $see-also exchange } ;

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index 2a8668ad32fae645e38ba2701be8bdc393566bbd..a9e8880646de1ceb139dddebd71b39f61c50d4ae 100644 (file)
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -510,3 +510,6 @@ strings tools.test ;
 { { { 1 1 } { 2 2 } { f 3 } { f 4 } { f 5 } } } [
     { 1 2 } { 1 2 3 4 5 } zip-longest
 ] unit-test
+
+{ "34_01_" } [ 2 0 3 "01_34_" [ exchange-subseq ] keep ] unit-test
+{ "cdebaf" } [ 3 0 2 "abcdef" [ exchange-subseq ] keep ] unit-test

diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 06c2490e5571b407dae1dd98b6a91267783e914c..dbadb2afe0464ee4c01dba6ae213895a0a9e2b41 100644 (file)
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -1197,3 +1197,9 @@ INSTANCE: virtual-zip-index immutable-sequence
     [ 2drop length ]
     [ overd new-sequence-like dup ] 3bi
     '[ [ [ _ nth-unsafe @ ] [ _ set-nth-unsafe ] bi ] each-integer _ ] call ; inline
+
+: exchange-subseq ( len pos1 pos2 seq -- )
+    [ 3dup max + 1 - ] dip bounds-check nip '[
+        2dup _ exchange-unsafe
+        [ 1 - ] [ 1 + ] [ 1 + ] tri*
+    ] [ pick 0 > ] swap while 3drop ;