From 9c8a72538b15078aec51154fa751b754dd2bc46b Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 26 Aug 2022 00:10:21 -0400
Subject: [PATCH] sequences.extras: add -of versions of lots of words.

i think these are more natural, but we can have both! in extra.
---
 extra/sequences/extras/extras-tests.factor | 14 +++++
 extra/sequences/extras/extras.factor       | 70 ++++++++++++++++++++++
 2 files changed, 84 insertions(+)

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index b64ddfcbdd..1a21799bf2 100644
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -221,6 +221,20 @@ strings tools.test ;
 { V{ 1 } } [ 1 0 V{ } [ insert-nth! ] keep ] unit-test
 { V{ 1 2 3 4 } } [ 2 1 V{ 1 3 4 } [ insert-nth! ] keep ] unit-test
 
+{ V{ 1 3 } } [ V{ 1 2 3 } 1 2 delete-slice-of ] unit-test
+{ V{ 1 2 } } [ V{ 1 2 3 } 2 remove-nth-of! ] unit-test
+
+{
+    T{ slice { to 1 } { seq V{ 1 2 3 4 5 } } }
+    T{ slice { from 2 } { to 5 } { seq V{ 1 2 3 4 5 } } }
+} [
+    V{ 1 2 3 4 5 } 1 2 snip-slice-of
+] unit-test
+
+{ V{ 1 } V{ 3 4 5 } } [
+    V{ 1 2 3 4 5 } 1 2 snip-of
+] unit-test
+
 { "abc" } [ B{ 97 98 99 100 101 102 103 } 3 "" head-as ] unit-test
 { "abcd" } [ B{ 97 98 99 100 101 102 103 } 3 "" head*-as ] unit-test
 { "defg" } [ B{ 97 98 99 100 101 102 103 } 3 "" tail-as ] unit-test
diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 74b22a8c79..e80efa54ba 100644
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -664,9 +664,67 @@ PRIVATE>
 
 : all-longest ( seqs -- seqs' ) dup longest length filter-length ;
 
+<PRIVATE
+
+: nth-unsafe-of ( seq n -- elt ) swap nth-unsafe ; inline
+: set-nth-unsafe-of ( seq n elt -- seq ) spin [ set-nth-unsafe ] keep ; inline
+: set-length-of ( seq n -- seq ) over set-length ; inline
+
+: move-unsafe-of ( seq to from -- seq )
+    2dup = [
+        3drop
+    ] [
+        overd nth-unsafe-of set-nth-unsafe-of
+    ] if ; inline
+
+: move-backward-of ( seq shift from to -- seq )
+    2dup = [
+        3drop
+    ] [
+        [ [ [ + ] keep move-unsafe-of ] 2keep 1 + ] dip move-backward-of
+    ] if ;
+
+: open-slice-of ( seq shift from -- seq )
+    over 0 = [
+        3drop
+    ] [
+        [ ] [ drop [ length ] dip + ] 3bi
+        [ pick length [ over - ] dip move-backward-of ] dip
+        set-length-of
+    ] if ;
+
+PRIVATE>
+
+: index-of ( seq obj -- n ) '[ _ = ] find drop ;
+
+ERROR: slice-error-of from to seq ;
+
+: check-slice-of ( seq from to -- seq from to )
+    over 0 < [ slice-error-of ] when
+    dup reach length > [ slice-error-of ] when
+    2dup > [ slice-error-of ] when ; inline
+
+: delete-slice-of ( seq from to -- seq )
+    check-slice-of over [ - ] dip open-slice-of ;
+
+: remove-nth-of ( seq n -- seq' )
+    [ dup 1 + rot snip-slice ] keepd append-as ;
+
+: remove-nth-of! ( seq n -- seq )
+    dup 1 + delete-slice-of ;
+
+: snip-of ( seq from to -- head tail )
+    [ head ] [ tail ] bi-curry* bi ; inline
+
+: snip-slice-of ( seq from to -- head tail )
+    [ head-slice ] [ tail-slice ] bi-curry* bi ; inline
+
 : remove-first ( obj seq -- seq' )
     [ index ] keep over [ remove-nth ] [ nip ] if ;
 
+: remove-first-of ( seq obj -- seq' )
+    dupd index-of [ remove-nth-of ] when* ;
+
 : remove-first! ( obj seq -- seq )
     [ index ] keep over [ remove-nth! ] [ nip ] if ;
 
@@ -676,6 +734,18 @@ PRIVATE>
 : remove-last! ( obj seq -- seq )
     [ last-index ] keep over [ remove-nth! ] [ nip ] if ;
 
+: member-of? ( seq elt -- ? )
+    [ = ] curry any? ;
+
+: member-eq-of? ( seq elt -- ? )
+    [ eq? ] curry any? ;
+
+: remove-of ( seq elt -- newseq )
+    [ = ] curry reject ;
+
+: remove-eq-of ( seq elt -- newseq )
+    [ eq? ] curry reject ;
+
 : ?first2 ( seq -- first/f second/f )
     dup length {
         { 0 [ drop f f ] }
-- 
2.34.1