From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 4 Jan 2013 00:42:34 +0000 (-0800)
Subject: sequences: Add join-as, which takes an exemplar. Move split-subseq and replace from... 
X-Git-Tag: 0.97~2063
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=10e74c606665ddc0b9e5f04a86687aee500348a3

sequences: Add join-as, which takes an exemplar. Move split-subseq and replace from unicode.case to splitting and fix an infinite loop with split-subseq. Add docs/tests.
---

diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor
index a08e482c3e..c8ed8b2d0f 100644
--- a/basis/unicode/case/case.factor
+++ b/basis/unicode/case/case.factor
@@ -11,12 +11,6 @@ SYMBOL: locale ! Just casing locale, or overall?
 
 <PRIVATE
 
-: split-subseq ( string sep -- strings )
-    [ dup ] swap '[ _ split1-slice swap ] produce nip ;
-
-: replace ( str old new -- newstr )
-    [ split-subseq ] dip join ; inline
-
 : i-dot? ( locale -- ? )
     { "tr" "az" } member? ; inline
 
diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index 4000802a9b..18c9683192 100644
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@@ -624,7 +624,13 @@ HELP: join
 { $notes "If the " { $snippet "glue" } " sequence is empty, this word calls " { $link concat-as } "." }
 { $errors "Throws an error if one of the sequences in " { $snippet "seq" } " contains elements not permitted in sequences of the same class as " { $snippet "glue" } "." } ;
 
-{ join concat concat-as } related-words
+HELP: join-as
+{ $values { "seq" sequence } { "glue" sequence } { "exemplar" sequence } { "newseq" sequence } }
+{ $description "Concatenates a sequence of sequences together into one sequence, placing a copy of " { $snippet "glue" } " between each pair of sequences. The resulting sequence is of the same class as " { $snippet "glue" } "." }
+{ $notes "If the " { $snippet "glue" } " sequence is empty, this word calls " { $link concat-as } "." }
+{ $errors "Throws an error if one of the sequences in " { $snippet "seq" } " contains elements not permitted in sequences of the same class as " { $snippet "exemplar" } "." } ;
+
+{ join join-as concat concat-as } related-words
 
 HELP: last
 { $values { "seq" sequence } { "elt" object } }
diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor
index 2ad5847cc0..26f75e50f9 100644
--- a/core/sequences/sequences-tests.factor
+++ b/core/sequences/sequences-tests.factor
@@ -84,11 +84,15 @@ IN: sequences.tests
 [ V{ 3 } ] [ V{ 1 2 3 } clone 2 [ swap < ] curry filter! ] unit-test
 
 [ "hello world how are you" ]
-[ { "hello" "world" "how" "are" "you" } " " join ]
-unit-test
+[ { "hello" "world" "how" "are" "you" } " " join ] unit-test
+
+[ "hello world how are you" ]
+[ { "hello" "world" "how" "are" "you" } " " "" join-as ] unit-test
 
 [ "" ] [ { } "" join ] unit-test
 
+[ "" ] [ { } "" "" join-as ] unit-test
+
 [ { } ] [ { } flip ] unit-test
 
 [ { "b" "e" } ] [ 1 { { "a" "b" "c" } { "d" "e" "f" } } flip nth ] unit-test
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 201bffe111..a7db7b63b2 100644
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -811,16 +811,19 @@ PRIVATE>
 
 PRIVATE>
 
-: join ( seq glue -- newseq )
-    dup empty? [ concat-as ] [
+: join-as ( seq glue exemplar -- newseq )
+    over empty? [ nip concat-as ] [
         [
             2dup joined-length over new-resizable [
                 [ [ push-all ] 2curry ] [ [ nip push-all ] 2curry ] 2bi
                 interleave
             ] keep
-        ] keep like
+        ] dip like
     ] if ;
 
+: join ( seq glue -- newseq )
+    dup join-as ; inline
+
 : padding ( ... seq n elt quot: ( ... seq1 seq2 -- ... newseq ) -- ... newseq )
     [
         [ over length [-] dup 0 = [ drop ] ] dip
diff --git a/core/splitting/splitting-docs.factor b/core/splitting/splitting-docs.factor
index 824688eefa..c0563b4087 100644
--- a/core/splitting/splitting-docs.factor
+++ b/core/splitting/splitting-docs.factor
@@ -19,7 +19,9 @@ ARTICLE: "sequences-split" "Splitting sequences"
     split*-when
 }
 "Splitting a string into lines:"
-{ $subsections string-lines } ;
+{ $subsections string-lines }
+"Replacing subsequences with another subsequence:"
+{ $subsections replace } ;
 
 ABOUT: "sequences-split"
 
@@ -87,3 +89,13 @@ HELP: string-lines
 { $examples
     { $example "USING: prettyprint splitting ;" "\"Hello\\r\\nworld\\n\" string-lines ." "{ \"Hello\" \"world\" \"\" }" }
 } ;
+
+HELP: replace
+{ $values { "seq" sequence } { "old" sequence } { "new" sequence } { "new-seq" sequence } }
+{ $description "Replaces every occurrence of " { $snippet "old" } " with " { $snippet "new" } " in the " { $snippet "seq" } "." }
+{ $examples
+    { $example "USING: io splitting ;"
+               "\"cool example is cool\" \"cool\" \"silly\" replace print"
+               "silly example is silly"
+    }
+} ;
diff --git a/core/splitting/splitting-tests.factor b/core/splitting/splitting-tests.factor
index d03883fb02..5cda813c7b 100644
--- a/core/splitting/splitting-tests.factor
+++ b/core/splitting/splitting-tests.factor
@@ -75,3 +75,17 @@ unit-test
 { { { 0 } } } [ { 0 } [ 0 > ] split*-when ] unit-test
 { { { 0 0 } } } [ { 0 0 } [ 0 > ] split*-when ] unit-test
 { { { 1 } { 2 } { 0 3 } { 0 0 } } } [ { 1 2 0 3 0 0 } [ 0 > ] split*-when ] unit-test
+
+{ "abarbbarc" }
+[ "afoobfooc" "foo" "bar" replace ] unit-test
+
+{ "abc" }
+[ "afoobfooc" "foo" "" replace ] unit-test
+
+{ "afoobfooc" }
+[ "afoobfooc" "" "bar" replace ] unit-test
+
+{ "afoobfooc" }
+[ "afoobfooc" "" "" replace ] unit-test
+
+{ "" } [ "" "" "" replace ] unit-test
diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor
index 0398cb66d6..65125eed46 100644
--- a/core/splitting/splitting.factor
+++ b/core/splitting/splitting.factor
@@ -44,6 +44,13 @@ PRIVATE>
 : split1-slice ( seq subseq -- before-slice after-slice )
     [ snip-slice ] (split1) ;
 
+: split-subseq ( seq subseq -- seqs )
+    dup empty? [
+        drop 1array
+    ] [
+        [ dup ] swap [ split1-slice swap ] curry produce nip
+    ] if ;
+
 : split1-when ( ... seq quot: ( ... elt -- ... ? ) -- ... before after )
     dupd find drop [ swap [ dup 1 + ] dip snip ] [ f ] if* ; inline
 
@@ -55,6 +62,9 @@ PRIVATE>
     [ <reversed> ] bi@ split1-slice [ <reversed> ] bi@
     [ f ] [ swap ] if-empty ;
 
+: replace ( seq old new -- new-seq )
+    pick [ [ split-subseq ] dip ] dip join-as ;
+
 <PRIVATE
 
 : (split) ( n seq quot: ( ... elt -- ... ? ) -- )