From 1d6209e80eb7cf83521715c4acd2d88a2d013f48 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 7 Nov 2012 17:01:37 -0800 Subject: [PATCH] assocs.extras: adding assoc-invert. --- extra/assocs/extras/extras-tests.factor | 2 ++ extra/assocs/extras/extras.factor | 6 ++++++ 2 files changed, 8 insertions(+) diff --git a/extra/assocs/extras/extras-tests.factor b/extra/assocs/extras/extras-tests.factor index e490beeaf1..951aebe5fb 100644 --- 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 1af224c697..8c8c97438c 100644 --- 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 ; -- 2.34.1