sequences.extras: add -of versions of lots of words.

i think these are more natural, but we can have both! in extra.

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index b64ddfcbdde934ba171d273d8f648f9256225e33..1a21799bf2606762a89b715b2608e83b93920d00 100644 (file)
--- 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 74b22a8c792033cd1cdbb086ed22ed6e221d7875..e80efa54ba66ed3e9c766abc7c54ba6467c6d0a7 100644 (file)
--- 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 ] }