From e161ea06ce645ba2595c26954a0b00ec6b74d6eb Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 27 Nov 2009 22:58:17 -0600
Subject: [PATCH] add product-map>assoc and docs

---
 basis/sequences/product/product-docs.factor |  7 ++++++-
 basis/sequences/product/product.factor      | 10 +++++++++-
 2 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/basis/sequences/product/product-docs.factor b/basis/sequences/product/product-docs.factor
index 117d77d38e..06c99ab806 100644
--- a/basis/sequences/product/product-docs.factor
+++ b/basis/sequences/product/product-docs.factor
@@ -1,5 +1,5 @@
 ! (c)2009 Joe Groff bsd license
-USING: help.markup help.syntax quotations sequences ;
+USING: assocs help.markup help.syntax quotations sequences ;
 IN: sequences.product
 
 HELP: product-sequence
@@ -48,6 +48,10 @@ HELP: product-map-as
 { $values { "sequences" sequence } { "quot" { $quotation "( sequence -- value )" } } { "exemplar" sequence } { "sequence" sequence } }
 { $description "Calls " { $snippet "quot" } " for every element of the cartesian product of " { $snippet "sequences" } " and collects the results from " { $snippet "quot" } " into an output sequence the same type as the " { $snippet "exemplar" } " sequence." } ;
 
+HELP: product-map>assoc
+{ $values { "sequences" sequence } { "quot" { $quotation "( sequence -- key value )" } } { "exemplar" assoc } { "assoc" assoc } }
+{ $description "Calls " { $snippet "quot" } " for every element of the cartesian product of " { $snippet "sequences" } " and collects the results from " { $snippet "quot" } " into an output assoc." } ;
+
 HELP: product-each
 { $values { "sequences" sequence } { "quot" { $quotation "( sequence -- )" } } }
 { $description "Calls " { $snippet "quot" } " for every element of the cartesian product of " { $snippet "sequences" } "." }
@@ -62,6 +66,7 @@ ARTICLE: "sequences.product" "Product sequences"
     <product-sequence>
     product-map
     product-map-as
+    product-map>assoc
     product-each
 } ;
 
diff --git a/basis/sequences/product/product.factor b/basis/sequences/product/product.factor
index 52d4a2d937..4290085482 100644
--- a/basis/sequences/product/product.factor
+++ b/basis/sequences/product/product.factor
@@ -1,5 +1,5 @@
 ! (c)2009 Joe Groff bsd license
-USING: accessors arrays kernel locals math sequences ;
+USING: accessors arrays assocs kernel locals math sequences ;
 IN: sequences.product
 
 TUPLE: product-sequence { sequences array read-only } { lengths array read-only } ;
@@ -65,3 +65,11 @@ M: product-sequence nth
 
 : product-map ( sequences quot -- sequence )
     over product-map-as ; inline
+
+:: product-map>assoc ( sequences quot exemplar -- assoc )
+    0 :> i!
+    sequences [ length ] [ * ] map-reduce { }
+    [| result |
+        sequences [ quot call 2array i result set-nth i 1 + i! ] product-each
+        result
+    ] new-like exemplar assoc-like ; inline