diff --git a/extra/sequences/product/authors.txt b/extra/sequences/product/authors.txt
new file mode 100644
index 0000000000..f13c9c1e77
--- /dev/null
+++ b/extra/sequences/product/authors.txt
@@ -0,0 +1 @@
+Joe Groff
diff --git a/extra/sequences/product/product-docs.factor b/extra/sequences/product/product-docs.factor
new file mode 100644
index 0000000000..b7dcaa626e
--- /dev/null
+++ b/extra/sequences/product/product-docs.factor
@@ -0,0 +1,61 @@
+! (c)2009 Joe Groff bsd license
+USING: help.markup help.syntax multiline quotations sequences sequences.product ;
+IN: sequences
+
+HELP: product-sequence
+{ $class-description "A class of virtual sequences that present the cartesian product of their underlying set of sequences. Product sequences are constructed with the " { $link <product-sequence> } " word." }
+{ $examples
+{ $example <" USING: arrays prettyprint sequences.product ;
+{ { 1 2 3 } { "a" "b" "c" } } <product-sequence> >array .
+"> <" {
+    { 1 "a" }
+    { 2 "a" }
+    { 3 "a" }
+    { 1 "b" }
+    { 2 "b" }
+    { 3 "b" }
+    { 1 "c" }
+    { 2 "c" }
+    { 3 "c" }
+}"> } } ;
+
+HELP: <product-sequence>
+{ $values { "sequences" sequence } { "product-sequence" product-sequence } }
+{ $description "Constructs a " { $link product-sequence } " over " { $snippet "sequences" } "." }
+{ $examples
+{ $example <" USING: arrays prettyprint sequences.product ;
+{ { 1 2 3 } { "a" "b" "c" } } <product-sequence> >array .
+"> <" {
+    { 1 "a" }
+    { 2 "a" }
+    { 3 "a" }
+    { 1 "b" }
+    { 2 "b" }
+    { 3 "b" }
+    { 1 "c" }
+    { 2 "c" }
+    { 3 "c" }
+}"> } } ;
+
+{ product-sequence <product-sequence> } related-words
+
+HELP: product-map
+{ $values { "sequences" sequence } { "quot" { $quotation "( sequence -- value )" } } { "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." }
+{ $notes { $snippet "[ ... ] product-map" } " is equivalent to, but more efficient than, " { $snippet "<product-sequence> [ ... ] map" } "." } ;
+
+HELP: product-each
+{ $values { "sequences" sequence } { "quot" { $quotation "( sequence -- )" } } }
+{ $description "Calls " { $snippet "quot" } " for every element of the cartesian product of " { $snippet "sequences" } "." }
+{ $notes { $snippet "[ ... ] product-each" } " is equivalent to, but more efficient than, " { $snippet "<product-sequence> [ ... ] each" } "." } ;
+
+{ product-map product-each } related-words
+
+ARTICLE: "sequences.product" "Product sequences"
+"The " { $vocab-link "sequences.product" } " vocabulary provides a virtual sequence and combinators for manipulating the cartesian product of a set of sequences."
+{ $subsection product-sequence }
+{ $subsection <product-sequence> }
+{ $subsection product-map }
+{ $subsection product-each } ;
+
+ABOUT: "sequences.product"
diff --git a/extra/sequences/product/product-tests.factor b/extra/sequences/product/product-tests.factor
index 0a984072e0..5e0997dc2e 100644
--- a/extra/sequences/product/product-tests.factor
+++ b/extra/sequences/product/product-tests.factor
@@ -1,3 +1,4 @@
+! (c)2009 Joe Groff bsd license
 USING: arrays kernel make sequences sequences.product tools.test ;
 IN: sequences.product.tests
 
@@ -5,8 +6,10 @@ IN: sequences.product.tests
 [ { { 0 "a" } { 1 "a" } { 2 "a" } { 0 "b" } { 1 "b" } { 2 "b" } } ]
 [ { { 0 1 2 } { "a" "b" } } <product-sequence> >array ] unit-test
 
-[ { { 0 "a" } { 1 "a" } { 2 "a" } { 0 "b" } { 1 "b" } { 2 "b" } } ]
-[ { { 0 1 2 } { "a" "b" } } [ ] product-map ] unit-test
+: x ( n s -- sss ) <repetition> concat ;
+
+[ { "a" "aa" "aaa" "b" "bb" "bbb" } ]
+[ { { 1 2 3 } { "a" "b" } } [ first2 x ] product-map ] unit-test
 
 [
     {
diff --git a/extra/sequences/product/product.factor b/extra/sequences/product/product.factor
index 73ba1e4e01..665d43f0cd 100644
--- a/extra/sequences/product/product.factor
+++ b/extra/sequences/product/product.factor
@@ -1,4 +1,5 @@
-USING: accessors arrays kernel math sequences ;
+! (c)2009 Joe Groff bsd license
+USING: accessors arrays kernel locals math sequences ;
 IN: sequences.product
 
 TUPLE: product-sequence { sequences array read-only } { lengths array read-only } ;
@@ -10,19 +11,53 @@ INSTANCE: product-sequence sequence
 
 M: product-sequence length lengths>> product ;
 
+<PRIVATE
+
 : ns ( n lengths -- ns )
     [ V{ } clone ] 2dip [ /mod swap [ over push ] dip ] each drop ;
 
+: nths ( ns seqs -- nths )
+    [ nth ] { } 2map-as ;
+
 : product@ ( n product-sequence -- ns seqs )
     [ lengths>> ns ] [ nip sequences>> ] 2bi ;
 
+:: (carry-n) ( ns lengths i -- )
+    ns length i 1+ = [
+        i ns nth i lengths nth = [
+            0 i ns set-nth
+            i 1+ ns [ 1+ ] change-nth
+            ns lengths i 1+ (carry-n)
+        ] when
+    ] unless ;
+
+: carry-ns ( ns lengths -- )
+    0 (carry-n) ;
+    
+: product-iter ( ns lengths -- )
+    [ 0 over [ 1+ ] change-nth ] dip carry-ns ;
+
+: start-product-iter ( sequence-product -- ns lengths )
+    [ [ drop 0 ] map ] [ [ length ] map ] bi ;
+
+: end-product-iter? ( ns lengths -- ? )
+    [ 1 tail* first ] bi@ = ;
+
+PRIVATE>
+
 M: product-sequence nth 
-    product@ [ nth ] { } 2map-as ;
+    product@ nths ;
 
-M: product-sequence set-nth
-    immutable ;
+:: product-each ( sequences quot -- )
+    sequences start-product-iter :> lengths :> ns
+    [ ns lengths end-product-iter? ]
+    [ ns sequences nths quot call ns lengths product-iter ] until ; inline
+
+:: product-map ( sequences quot -- sequence )
+    0 :> i!
+    sequences [ length ] [ * ] map-reduce sequences
+    [| result |
+        sequences [ quot call i result set-nth i 1+ i! ] product-each
+        result
+    ] new-like ; inline
 
-: product-map ( sequences quot -- sequence )
-    [ <product-sequence> ] dip map ; inline
-: product-each ( sequences quot -- )
-    [ <product-sequence> ] dip each ; inline
diff --git a/extra/sequences/product/summary.txt b/extra/sequences/product/summary.txt
new file mode 100644
index 0000000000..c234c84a94
--- /dev/null
+++ b/extra/sequences/product/summary.txt
@@ -0,0 +1 @@
+Cartesian products of sequences