steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

assocs.extras: adding assoc-invert.

John Benediktsson 2012-11-07 17:01:37 -08:00
parent 98394cf35e
commit bbb00b4542
2 changed files with 8 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/assocs/extras/extras-tests.factor
View File

@ -13,3 +13,5 @@ IN: assocs.extras
{ { { 1 3 } { 2 4 } } } [ { 1 2 } { 3 4 } { } zip-as ] unit-test { { { 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 { 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{ { 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

6
extra/assocs/extras/extras.factor
View File

@ -39,3 +39,9 @@ IN: assocs.extras
: if-assoc-empty ( ..a assoc quot1: ( ..a -- ..b ) quot2: ( ..a assoc -- ..b ) -- ..b ) : if-assoc-empty ( ..a assoc quot1: ( ..a -- ..b ) quot2: ( ..a assoc -- ..b ) -- ..b )
[ dup assoc-empty? ] [ [ drop ] prepose ] [ ] tri* if ; inline [ 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 ;