trim-slice, rename trim-right, more docs

diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index 1bcd01d9b934552c3aa7e281104f60d4f22f0c88..6c917f133b4234374d23fbbe2a06df29661d431a 100755 (executable)
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@@ -178,6 +178,16 @@ ARTICLE: "sequences-search" "Searching sequences"
 { $subsection find-last }
 { $subsection find-last-from } ;
 
+ARTICLE: "sequences-trimming" "Trimming sequences"
+"Trimming words:"
+{ $subsection trim }
+{ $subsection trim-left }
+{ $subsection trim-right }
+"Potentially more efficient trim:"
+{ $subsection trim-slice }
+{ $subsection trim-left-slice }
+{ $subsection trim-right-slice } ;
+
 ARTICLE: "sequences-destructive" "Destructive operations"
 "These words modify their input, instead of creating a new sequence."
 $nl
@@ -245,6 +255,7 @@ $nl
 { $subsection "sequences-sorting" }
 { $subsection "binary-search" }
 { $subsection "sets" }
+{ $subsection "sequences-trimming" }
 "For inner loops:"
 { $subsection "sequences-unsafe" } ;
 
@@ -722,7 +733,7 @@ HELP: reverse-here
 
 HELP: padding
 { $values { "seq" sequence } { "n" "a non-negative integer" } { "elt" object } { "quot" "a quotation with stack effect " { $snippet "( seq1 seq2 -- newseq )" } } { "newseq" "a new sequence" } }
-{ $description "Outputs a new string sequence of " { $snippet "elt" } " repeated, that when appended to " { $snippet "seq" } ", yields a sequence of length " { $snippet "n" } ". If the length of { " { $snippet "seq" } " is greater than " { $snippet "n" } ", this word outputs an empty sequence." } ;
+{ $description "Outputs a new string sequence of " { $snippet "elt" } " repeated, that when appended to " { $snippet "seq" } ", yields a sequence of length " { $snippet "n" } ". If the length of " { $snippet "seq" } " is greater than " { $snippet "n" } ", this word outputs an empty sequence." } ;
 
 HELP: pad-left
 { $values { "seq" sequence } { "n" "a non-negative integer" } { "elt" object } { "padded" "a new sequence" } }
@@ -995,3 +1006,45 @@ HELP: count
     "50"
 } ;
 
+HELP: pusher
+{ $values
+     { "quot" "a predicate quotation" }
+     { "quot" quotation } { "accum" vector } }
+{ $description "Creates a new vector to accumulate the values which return true for a predicate.  Returns a new quotation which accepts an object to be tested and stored in the accumulator if the test yields true. The accumulator is left on the stack for convenience." }
+{ $example "! Find all the even numbers:" "USING: prettyprint sequences math kernel ;"
+           "10 [ even? ] pusher [ each ] dip ."
+           "V{ 0 2 4 6 8 }"
+}
+{ $notes "Used to implement the " { $link filter } " word." } ;
+
+HELP: trim-left
+{ $values
+     { "seq" sequence } { "quot" quotation }
+     { "newseq" sequence } }
+{ $description "Removes elements starting from the left side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." }
+{ $example "" "USING: prettyprint math sequences ;"
+           "{ 0 0 1 2 3 0 0 } [ zero? ] trim-left ."
+           "{ 1 2 3 0 0 }"
+} ;
+
+HELP: trim-right
+{ $values
+     { "seq" sequence } { "quot" quotation }
+     { "newseq" sequence } }
+{ $description "Removes elements starting from the right side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." }
+{ $example "" "USING: prettyprint math sequences ;"
+           "{ 0 0 1 2 3 0 0 } [ zero? ] trim-right ."
+           "{ 0 0 1 2 3 }"
+} ;
+
+HELP: trim
+{ $values
+     { "seq" sequence } { "quot" quotation }
+     { "newseq" sequence } }
+{ $description "Removes elements starting from the left and right sides of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a new sequence." }
+{ $example "" "USING: prettyprint math sequences ;"
+           "{ 0 0 1 2 3 0 0 } [ zero? ] trim ."
+           "{ 1 2 3 }"
+} ;
+
+{ trim-left trim-right trim } related-words

diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor
index 4b7b8a3151fdc0f26fd85fc44f5d521da3be0f0b..acfaa87e7d16a64b6e6c9f6d3d7dac81c30c7d1a 100755 (executable)
--- a/core/sequences/sequences-tests.factor
+++ b/core/sequences/sequences-tests.factor
@@ -234,13 +234,13 @@ unit-test
 
 [ -1./0. 0 delete-nth ] must-fail
 [ "" ] [ "" [ CHAR: \s = ] trim ] unit-test
-[ "" ] [ "" [ CHAR: \s = ] left-trim ] unit-test
-[ "" ] [ "" [ CHAR: \s = ] right-trim ] unit-test
-[ "" ] [ "  " [ CHAR: \s = ] left-trim ] unit-test
-[ "" ] [ "  " [ CHAR: \s = ] right-trim ] unit-test
+[ "" ] [ "" [ CHAR: \s = ] trim-left ] unit-test
+[ "" ] [ "" [ CHAR: \s = ] trim-right ] unit-test
+[ "" ] [ "  " [ CHAR: \s = ] trim-left ] unit-test
+[ "" ] [ "  " [ CHAR: \s = ] trim-right ] unit-test
 [ "asdf" ] [ " asdf " [ CHAR: \s = ] trim ] unit-test
-[ "asdf " ] [ " asdf " [ CHAR: \s = ] left-trim ] unit-test
-[ " asdf" ] [ " asdf " [ CHAR: \s = ] right-trim ] unit-test
+[ "asdf " ] [ " asdf " [ CHAR: \s = ] trim-left ] unit-test
+[ " asdf" ] [ " asdf " [ CHAR: \s = ] trim-right ] unit-test
 
 [ 328350 ] [ 100 [ sq ] sigma ] unit-test
 

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 73c9289415837ed9e955303996dd4a6d75a1b856..5ab3e59284e3dbf45a4e3dabb60701546d66d43f 100755 (executable)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -725,16 +725,25 @@ PRIVATE>
     dup slice? [ { } like ] when 0 over length rot <slice> ;
     inline
 
-: left-trim ( seq quot -- newseq )
+: trim-left-slice ( seq quot -- slice )
     over >r [ not ] compose find drop r> swap
-    [ tail ] [ dup length tail ] if* ; inline
+    [ tail-slice ] [ dup length tail-slice ] if* ; inline
+    
+: trim-left ( seq quot -- newseq )
+    over [ trim-left-slice ] dip like ; inline
 
-: right-trim ( seq quot -- newseq )
+: trim-right-slice ( seq quot -- slice )
     over >r [ not ] compose find-last drop r> swap
-    [ 1+ head ] [ 0 head ] if* ; inline
+    [ 1+ head-slice ] [ 0 head-slice ] if* ; inline
+
+: trim-right ( seq quot -- newseq )
+    over [ trim-right-slice ] dip like ; inline
+
+: trim-slice ( seq quot -- slice )
+    [ trim-left-slice ] [ trim-right-slice ] bi ;
 
 : trim ( seq quot -- newseq )
-    [ left-trim ] [ right-trim ] bi ; inline
+    over [ trim-slice ] dip like ; inline
 
 : sum ( seq -- n ) 0 [ + ] binary-reduce ;