From 6faf85d9f5e1ee0006b7da9f51063cbcfb8b9ca5 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 11 Jul 2012 20:37:12 -0700
Subject: [PATCH] assocs.extras: adding a "zip-as" that is faster than "zip
 >hashtable".

---
 extra/assocs/extras/extras-tests.factor |  4 ++++
 extra/assocs/extras/extras.factor       | 10 +++++++++-
 2 files changed, 13 insertions(+), 1 deletion(-)

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 ;