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

vm/code_gc.c

@@ -22,13 +22,13 @@ void add_to_free_list(F_HEAP *heap, F_FREE_BLOCK *block)
 	if(block->block.size < FREE_LIST_COUNT * BLOCK_SIZE_INCREMENT)
 	{
 		int index = block->block.size / BLOCK_SIZE_INCREMENT;
-		block->next_free = heap->free.small[index];
-		heap->free.small[index] = block;
+		block->next_free = heap->free.small_blocks[index];
+		heap->free.small_blocks[index] = block;
 	}
 	else
 	{
-		block->next_free = heap->free.large;
-		heap->free.large = block;
+		block->next_free = heap->free.large_blocks;
+		heap->free.large_blocks = block;
 	}
 }
 
@@ -101,11 +101,11 @@ F_FREE_BLOCK *find_free_block(F_HEAP *heap, CELL size)
 	while(attempt < FREE_LIST_COUNT * BLOCK_SIZE_INCREMENT)
 	{
 		int index = attempt / BLOCK_SIZE_INCREMENT;
-		F_FREE_BLOCK *block = heap->free.small[index];
+		F_FREE_BLOCK *block = heap->free.small_blocks[index];
 		if(block)
 		{
 			assert_free_block(block);
-			heap->free.small[index] = block->next_free;
+			heap->free.small_blocks[index] = block->next_free;
 			return block;
 		}
 
@@ -113,7 +113,7 @@ F_FREE_BLOCK *find_free_block(F_HEAP *heap, CELL size)
 	}
 
 	F_FREE_BLOCK *prev = NULL;
-	F_FREE_BLOCK *block = heap->free.large;
+	F_FREE_BLOCK *block = heap->free.large_blocks;
 
 	while(block)
 	{
@@ -123,7 +123,7 @@ F_FREE_BLOCK *find_free_block(F_HEAP *heap, CELL size)
 			if(prev)
 				prev->next_free = block->next_free;
 			else
-				heap->free.large = block->next_free;
+				heap->free.large_blocks = block->next_free;
 			return block;
 		}
 

vm/code_gc.h

@@ -2,8 +2,8 @@
 #define BLOCK_SIZE_INCREMENT 32
 
 typedef struct {
-	F_FREE_BLOCK *small[FREE_LIST_COUNT];
-	F_FREE_BLOCK *large;
+	F_FREE_BLOCK *small_blocks[FREE_LIST_COUNT];
+	F_FREE_BLOCK *large_blocks;
 } F_HEAP_FREE_LIST;
 
 typedef struct {