From dce2e908399b9ab71b131a45d1488be6c78e1af0 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Thu, 23 Oct 2014 15:08:38 -0700 Subject: [PATCH] assocs.extras: adding delete-value-at. --- extra/assocs/extras/extras-tests.factor | 5 ++++- extra/assocs/extras/extras.factor | 5 +++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/extra/assocs/extras/extras-tests.factor b/extra/assocs/extras/extras-tests.factor index 8cd957e601..1b5a67d960 100644 --- 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 257288977a..0b2aec41f0 100644 --- 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 ; -- 2.34.1