From 84b5e3828f3750c10f438b2b949c7a895adff277 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Fri, 24 May 2013 11:19:27 -0700
Subject: [PATCH] sequences.extras: adding subseq* and safe-subseq.

---
 extra/sequences/extras/extras-docs.factor  | 28 ++++++++++++++++++++++
 extra/sequences/extras/extras-tests.factor |  6 +++++
 extra/sequences/extras/extras.factor       |  9 +++++++
 3 files changed, 43 insertions(+)
 create mode 100644 extra/sequences/extras/extras-docs.factor

diff --git a/extra/sequences/extras/extras-docs.factor b/extra/sequences/extras/extras-docs.factor
new file mode 100644
index 0000000000..29eb2bdc7f
--- /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 3fa276e1c9..d057fe7cf1 100644
--- 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 2f37910a67..bef74b6c5b 100644
--- 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 ;