diff --git a/extra/assocs/extras/extras-tests.factor b/extra/assocs/extras/extras-tests.factor index 0916a21728..e490beeaf1 100644 --- a/extra/assocs/extras/extras-tests.factor +++ b/extra/assocs/extras/extras-tests.factor @@ -9,3 +9,7 @@ IN: assocs.extras { f } [ H{ { "a" H{ { "b" 1 } } } } { "a" "c" } deep-at ] unit-test { 1 } [ H{ { "a" H{ { "b" 1 } } } } { "a" "b" } deep-at ] unit-test { 4 } [ H{ { 1 H{ { 2 H{ { 3 4 } } } } } } { 1 2 3 } deep-at ] 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 +{ H{ { 1 3 } { 2 4 } } } [ { 1 2 } { 3 4 } H{ } zip-as ] unit-test diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor index 18b8478042..d788ff6ce5 100644 --- a/extra/assocs/extras/extras.factor +++ b/extra/assocs/extras/extras.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2012 John Benediktsson ! See http://factorcode.org/license.txt for BSD license -USING: assocs kernel sequences ; +USING: arrays assocs assocs.private kernel sequences ; IN: assocs.extras @@ -13,3 +13,11 @@ IN: assocs.extras : deep-at ( assoc seq -- value/f ) [ swap at ] each ; + +: zip-as ( keys values exemplar -- assocs ) + dup sequence? [ + [ 2array ] swap 2map-as + ] [ + [ dup length ] dip new-assoc + [ [ set-at ] with-assoc 2each ] keep + ] if ;