assocs.extras: Add deep-set-of, deep-change-of

diff --git a/extra/assocs/extras/extras-tests.factor b/extra/assocs/extras/extras-tests.factor
index cf7ce6ce37a80e4b699d75f9fbae6bd19316a2af..0ea413f86ad3d6c7a28a3624b2aa57936dac2021 100644 (file)
--- a/extra/assocs/extras/extras-tests.factor
+++ b/extra/assocs/extras/extras-tests.factor
@@ -13,6 +13,14 @@ USING: arrays assocs.extras kernel math math.order sequences tools.test ;
 { 1 } [ H{ { "a" H{ { "b" 1 } } } } { "a" "b" } deep-of ] unit-test
 { 4 } [ H{ { 1 H{ { 2 H{ { 3 4 } } } } } } { 1 2 3 } deep-of ] unit-test
 
+{ H{ { 1 H{ { 2 H{ { 3 44 } } } } } } } [
+    H{ { 1 H{ { 2 H{ { 3 4 } } } } } } dup { 1 2 3 } [ 40 + ] deep-change-of
+] unit-test
+
+{ H{ { 1 H{ { 2 H{ { 3 40 } } } } } } } [
+    H{ { 1 H{ { 2 H{ { 3 4 } } } } } } dup { 1 2 3 } 40 deep-set-of
+] unit-test
+
 { H{ { 2 1 } { 4 3 } } } [ H{ { 1 2 } { 3 4 } } assoc-invert ] unit-test
 
 { H{ { "a" V{ 2 5 } } { "b" V{ 3 } } { "c" V{ 10 } } } }

diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor
index 7073a074382ca3ed6fa105dcb0466d9b8327c444..9a66e6a4750e0d14fe50f39725556dd74a8bac3d 100644 (file)
--- a/extra/assocs/extras/extras.factor
+++ b/extra/assocs/extras/extras.factor
@@ -10,6 +10,15 @@ IN: assocs.extras
 : deep-of ( assoc seq -- value/f )
     [ of ] each ; inline
 
+: deep-of-but-last ( assoc seq -- obj key )
+    unclip-last [ [ of ] each ] dip ; inline
+
+: deep-change-of ( assoc seq quot -- )
+    [ deep-of-but-last swap ] dip change-at ; inline
+
+: deep-set-of ( assoc seq elt -- )
+    [ deep-of-but-last ] dip spin set-at ; inline
+
 : substitute! ( seq assoc -- seq )
     substituter map! ;