assocs.extras: adding delete-value-at.

diff --git a/extra/assocs/extras/extras-tests.factor b/extra/assocs/extras/extras-tests.factor
index 8cd957e601fac8acc2ce150bb14faaf5f8263d97..1b5a67d9607b55354d330f184025746ca073f7ea 100644 (file)
--- a/extra/assocs/extras/extras-tests.factor
+++ b/extra/assocs/extras/extras-tests.factor
@@ -1,5 +1,5 @@
 
-USING: assocs.extras tools.test ;
+USING: assocs.extras kernel tools.test ;
 
 IN: assocs.extras
 
@@ -22,3 +22,6 @@ IN: assocs.extras
     { H{ { "a" 2 } { "b" 3 } } H{ { "a" 5 } { "c" 10 } } }
     assoc-merge
 ] unit-test
+
+{ H{ } } [ H{ { 1 2 } } 2 over delete-value-at ] unit-test
+{ H{ { 1 2 } } } [ H{ { 1 2 } } 3 over delete-value-at ] unit-test

diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor
index 257288977af5125f22c5694de32b79684e5d7b2c..0b2aec41f038fffbee0d7b96e2f15789edf16488 100644 (file)
--- a/extra/assocs/extras/extras.factor
+++ b/extra/assocs/extras/extras.factor
@@ -52,3 +52,8 @@ IN: assocs.extras
 
 : assoc-merge ( seq -- merge )
     H{ } clone [ (assoc-merge) ] reduce ;
+
+GENERIC: delete-value-at ( value assoc -- )
+
+M: assoc delete-value-at
+    [ value-at* ] keep swap [ delete-at ] [ 2drop ] if ;