sequences.extras: adding subseq* and safe-subseq.

diff --git a/extra/sequences/extras/extras-docs.factor b/extra/sequences/extras/extras-docs.factor
new file mode 100644 (file)
index 0000000..29eb2bd
--- /dev/null
+++ b/extra/sequences/extras/extras-docs.factor
@@ -0,0 +1,28 @@
+USING: arrays help.markup help.syntax math
+sequences.private vectors strings kernel math.order layouts
+quotations generic.single ;
+IN: sequences.extras
+
+HELP: subseq*
+{ $values
+     { "from" "an integer" } { "to" "an integer" } { "seq" "sequence" } { "subseq" "sequence" } }
+{ $description "Outputs a new sequence using positions relative to one or both ends of the sequence. Positive values describes offsets relative to the start of the sequence, negative values relative to the end. Values of zero for " { $snippet "from" } " indicate the beginning of the sequence, while a zero for " { $snippet "to" } " indicates the end of the sequence." }
+{ $notes "Both " { $snippet "from" } " and " { $snippet "to" } " can be safely set to values outside the length of the sequence. Also, " { $snippet "from" } " can safely reference a smaller or greater index position than " { $snippet "to" } "." }
+{ $examples
+    "Using a negative relative index:"
+    { $example "USING: prettyprint sequences.extras ; 2 -1 \"abcdefg\" subseq* ."
+               "\"cdef\""
+    }
+    "Using optional indices:"
+    { $example "USING: prettyprint sequences.extras ; f -4 \"abcdefg\" subseq* ."
+               "\"abc\""
+    }
+    "Using larger-than-necessary indices:"
+    { $example "USING: prettyprint sequences.extras ; 0 10 \"abcdefg\" subseq* ."
+               "\"abcdefg\""
+    }
+    "Trimming from either end of the sequence."
+    { $example "USING: prettyprint sequences.extras ; 1 -1 \"abcdefg\" subseq* ."
+               "\"bcdef\""
+    }
+} ;

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index 3fa276e1c91ed3e07f762d280d6a0ee3b6406a59..d057fe7cf1da9c36158d008a8b1486b854d0e8a7 100644 (file)
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -156,3 +156,9 @@ IN: sequences.extras.tests
 
 { t 3 3 } [ 10 iota [ [ odd? ] [ 1 > ] bi* and ] map-find-index ] unit-test
 { f f f } [ 10 iota [ [ odd? ] [ 9 > ] bi* and ] map-find-index ] unit-test
+
+{ "abcdef" } [ f f "abcdef" subseq* ] unit-test
+{ "abcdef" } [ 0 f "abcdef" subseq* ] unit-test
+{ "ab" } [ f 2 "abcdef" subseq* ] unit-test
+{ "cdef" } [ 2 f "abcdef" subseq* ] unit-test
+{ "cd" } [ -4 -2 "abcdef" subseq* ] unit-test

diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 2f37910a67e574581ef57f1075700fa648c4810e..bef74b6c5bb714d8bfbb9c31fbb691b3a0262d03 100644 (file)
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -32,6 +32,15 @@ IN: sequences.extras
 : reduce-from ( ... seq identity quot: ( ... prev elt -- ... next ) i -- ... result )
     [ swap ] 2dip each-from ; inline
 
+:: subseq* ( from to seq -- subseq )
+    seq length :> len
+    from [ dup 0 < [ len + ] when ] [ 0 ] if*
+    to [ dup 0 < [ len + ] when ] [ len ] if*
+    [ 0 len clamp ] bi@ dupd max seq subseq ;
+
+: safe-subseq ( from to seq -- subseq )
+    [ length '[ 0 _ clamp ] bi@ ] keep subseq ;
+
 : all-subseqs ( seq -- seqs )
     dup length [1,b] [ clump ] with map concat ;