Merge branch 'master' of git://factorcode.org/git/factor

extra/roles/roles.factor

@@ -8,8 +8,8 @@ IN: roles
 ERROR: role-slot-overlap class slots ;
 ERROR: multiple-inheritance-attempted classes ;
 
-PREDICATE: role < class
-    { [ mixin-class? ] [ "role-slots" word-prop >boolean ] } 1&& ;
+PREDICATE: role < mixin-class
+    "role-slots" word-prop >boolean ;
 
 : parse-role-definition ( -- class superroles slots )
     CREATE-CLASS scan {

extra/sequences/product/product-tests.factor

@@ -1,19 +1,23 @@
-USING: arrays kernel sequences sequences.cartesian-product tools.test ;
+USING: arrays kernel make sequences sequences.product tools.test ;
 IN: sequences.product.tests
 
-[
-    { { 0 "a" } { 1 "a" } { 2 "a" } { 0 "b" } { 1 "b" } { 2 "b" } }
-] [ { { 0 1 2 } { "a" "b" } } [ ] cartesian-product-map ] unit-test
+
+[ { { 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
 
 [
     {
         { 0 "a" t } { 1 "a" t } { 2 "a" t } { 0 "b" t } { 1 "b" t } { 2 "b" t }
         { 0 "a" f } { 1 "a" f } { 2 "a" f } { 0 "b" f } { 1 "b" f } { 2 "b" f }
     }
-] [ { { 0 1 2 } { "a" "b" } { t f } } [ ] cartesian-product-map ] unit-test
-
-[
-    { "012012" "aaabbb" }
-] [ { { "0" "1" "2" } { "a" "b" } } [ [ first2 ] bi* [ append ] bi@ 2array ] cartesian-product-each ] unit-test
-
+] [ { { 0 1 2 } { "a" "b" } { t f } } [ ] product-map ] unit-test
 
+[ "a1b1c1a2b2c2" ] [
+    [
+        { { "a" "b" "c" } { "1" "2" } }
+        [ [ % ] each ] product-each
+    ] "" make
+] unit-test

extra/sequences/product/product.factor

@@ -0,0 +1,28 @@
+USING: accessors arrays kernel math sequences ;
+IN: sequences.product
+
+TUPLE: product-sequence { sequences array read-only } { lengths array read-only } ;
+
+: <product-sequence> ( sequences -- product-sequence )
+    >array dup [ length ] map product-sequence boa ;
+
+INSTANCE: product-sequence sequence
+
+M: product-sequence length lengths>> product ;
+
+: ns ( n lengths -- ns )
+    [ V{ } clone ] 2dip [ /mod swap [ over push ] dip ] each drop ;
+
+: product@ ( n product-sequence -- ns seqs )
+    [ lengths>> ns ] [ nip sequences>> ] 2bi ;
+
+M: product-sequence nth 
+    product@ [ nth ] { } 2map-as ;
+
+M: product-sequence set-nth
+    immutable ;
+
+: product-map ( sequences quot -- sequence )
+    [ <product-sequence> ] dip map ; inline
+: product-each ( sequences quot -- )
+    [ <product-sequence> ] dip each ; inline