From 6688cf1c9779dce87529392f3bbdcdcabcd81baa Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sun, 26 Apr 2009 08:42:31 -0500 Subject: [PATCH 1/3] mopping up some noobsauce --- extra/roles/roles.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/roles/roles.factor b/extra/roles/roles.factor index f9ce808eb8..d54b4339a7 100644 --- a/extra/roles/roles.factor +++ b/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 { From d2e293eb5ea779d2bfbbde84b76009748ab8de6b Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sun, 26 Apr 2009 09:39:38 -0500 Subject: [PATCH 2/3] product virtual sequence --- extra/sequences/product/product-tests.factor | 24 ++++++++++------- extra/sequences/product/product.factor | 28 ++++++++++++++++++++ 2 files changed, 42 insertions(+), 10 deletions(-) create mode 100644 extra/sequences/product/product.factor diff --git a/extra/sequences/product/product-tests.factor b/extra/sequences/product/product-tests.factor index dfabc166ac..0a984072e0 100644 --- a/extra/sequences/product/product-tests.factor +++ b/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" } } >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 diff --git a/extra/sequences/product/product.factor b/extra/sequences/product/product.factor new file mode 100644 index 0000000000..73ba1e4e01 --- /dev/null +++ b/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 } ; + +: ( 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 ) + [ ] dip map ; inline +: product-each ( sequences quot -- ) + [ ] dip each ; inline From e0f6825757892b7226853af7d54d38c33795bb71 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 26 Apr 2009 10:02:52 -0500 Subject: [PATCH 3/3] Rename some fields to avoid conflicting with windows.h macros 'small' and 'large' --- vm/code_gc.c | 16 ++++++++-------- vm/code_gc.h | 4 ++-- 2 files changed, 10 insertions(+), 10 deletions(-) mode change 100644 => 100755 vm/code_gc.h diff --git a/vm/code_gc.c b/vm/code_gc.c index e7fcfd3289..1405daa93f 100755 --- a/vm/code_gc.c +++ b/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; } diff --git a/vm/code_gc.h b/vm/code_gc.h old mode 100644 new mode 100755 index 9b1e768a7b..d71dee29c5 --- a/vm/code_gc.h +++ b/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 {