assocs.extras: adding assoc-invert.

diff --git a/extra/assocs/extras/extras-tests.factor b/extra/assocs/extras/extras-tests.factor
index e490beeaf10f9741f58559d6cf042101474efcfc..951aebe5fb4005e41b527eb0431dfca3ad0324b3 100644 (file)
--- a/extra/assocs/extras/extras-tests.factor
+++ b/extra/assocs/extras/extras-tests.factor
@@ -13,3 +13,5 @@ IN: assocs.extras
 {  { { 1 3 } { 2 4 } } } [ { 1 2 } { 3 4 }  { } zip-as ] unit-test
 { V{ { 1 3 } { 2 4 } } } [ { 1 2 } { 3 4 } V{ } zip-as ] unit-test
 { H{ { 1 3 } { 2 4 } } } [ { 1 2 } { 3 4 } H{ } zip-as ] unit-test
+
+{ H{ { 2 1 } { 4 3 } } } [ H{ { 1 2 } { 3 4 } } assoc-invert ] unit-test

diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor
index 1af224c697bbb69309f5745a10645aef4a8fdd2c..8c8c97438c8ee244b40d31dc5c5faf6597e56c59 100644 (file)
--- a/extra/assocs/extras/extras.factor
+++ b/extra/assocs/extras/extras.factor
@@ -39,3 +39,9 @@ IN: assocs.extras
 
 : if-assoc-empty ( ..a assoc quot1: ( ..a -- ..b ) quot2: ( ..a assoc -- ..b ) -- ..b )
     [ dup assoc-empty? ] [ [ drop ] prepose ] [ ] tri* if ; inline
+
+: assoc-invert-as ( assoc exemplar -- newassoc )
+    [ swap ] swap assoc-map-as ;
+
+: assoc-invert ( assoc -- newassoc )
+    dup assoc-invert-as ;