From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 2 Apr 2016 22:46:08 +0000 (-0700)
Subject: sequences.extras: Check if slices overlap or touch. Add a merge-slices word. For... 
X-Git-Tag: unmaintained~1259
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=fc1b8214f052ad4350aaccd15cac1c1c271c54e1

sequences.extras: Check if slices overlap or touch. Add a merge-slices word. For efficiency, provide ordered/unordered versions of each word based on whether you know the slices have been swapped or not so they are ordered by from>>.
---

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index 6fc8296884..8a83650c32 100644
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -52,6 +52,26 @@ IN: sequences.extras.tests
 { "abc" }
 [ "abc" sequence>slice >string ] unit-test
 
+{ t } [ "abcdef" [ 0 3 rot <slice> ] [ 2 4 rot <slice> ] bi slices-overlap? ] unit-test
+{ t } [ "abcdef" [ 0 3 rot <slice> ] [ 1 2 rot <slice> ] bi slices-overlap? ] unit-test
+{ f } [ "abcdef" [ 0 3 rot <slice> ] [ 3 6 rot <slice> ] bi slices-overlap? ] unit-test
+{ t } [ "abcdef" [ 0 3 rot <slice> ] [ 2 4 rot <slice> ] bi slices-touch? ] unit-test
+{ t } [ "abcdef" [ 0 3 rot <slice> ] [ 1 2 rot <slice> ] bi slices-touch? ] unit-test
+{ t } [ "abcdef" [ 0 3 rot <slice> ] [ 3 6 rot <slice> ] bi slices-touch? ] unit-test
+{ f } [ "abcdef" [ 0 3 rot <slice> ] [ 4 6 rot <slice> ] bi slices-touch? ] unit-test
+
+{ "abcdef" } [
+    "abcdef" [ 0 3 rot <slice> ] [ 3 6 rot <slice> ] bi merge-slices >string
+] unit-test
+
+{ "abcdef" } [
+    "abcdef" [ 3 6 rot <slice> ] [ 0 3 rot <slice> ] bi merge-slices >string
+] unit-test
+
+{ "abc" } [
+    "abcdef" [ 0 3 rot <slice> ] [ 0 3 rot <slice> ] bi merge-slices >string
+] unit-test
+
 
 { "hello" } [ "hello" 0 rotate-headwards ] unit-test
 { "llohe" } [ "hello" 2 rotate-headwards ] unit-test
diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index c3e5943c03..04ebf18374 100644
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -158,6 +158,42 @@ PRIVATE>
 : sequence>slice ( sequence -- slice )
     [ drop 0 ] [ length ] [ ] tri <slice> ; inline
 
+: slice-order-by-from ( slice1 slice2 -- slice-lt slice-gt )
+    2dup [ from>> ] bi@ > [ swap ] when ; inline
+
+: ordered-slices-range ( slice-lt slice-gt -- to from )
+    [ to>> ] [ from>> ] bi* ;
+
+: unordered-slices-range ( slice1 slice2 -- to from )
+    slice-order-by-from ordered-slices-range ;
+
+: ordered-slices-overlap? ( slice-lt slice-gt -- ? )
+    ordered-slices-range > ; inline
+
+: unordered-slices-overlap? ( slice1 slice2 -- ? )
+    unordered-slices-range > ; inline
+
+: slices-overlap? ( slice1 slice2 -- ? )
+    unordered-slices-overlap? ;
+
+: ordered-slices-touch? ( slice-lt slice-gt -- ? )
+    ordered-slices-range >= ; inline
+
+: unordered-slices-touch? ( slice1 slice2 -- ? )
+    unordered-slices-range >= ; inline
+
+: slices-touch? ( slice1 slice2 -- ? )
+    unordered-slices-touch? ;
+
+ERROR: slices-don't-touch slice1 slice2 ;
+: merge-slices ( slice1 slice2 -- slice/* )
+    slice-order-by-from
+    2dup ordered-slices-touch? [
+        [ from>> ] [ [ to>> ] [ seq>> ] bi ] bi* <slice>
+    ] [
+        slices-don't-touch
+    ] if ;
+
 : length- ( n sequence -- m ) length swap - ; inline
 
 : rotate-headwards ( seq n -- seq' )