From e0f6825757892b7226853af7d54d38c33795bb71 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 26 Apr 2009 10:02:52 -0500 Subject: [PATCH 1/2] 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 { From 291ac48a1766e942a20099d023ba3e84deee5609 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 26 Apr 2009 13:31:10 -0500 Subject: [PATCH 2/2] tuple-arrays: completely rewritten to use functors, 10x faster on benchmark --- basis/inverse/inverse.factor | 2 +- basis/tuple-arrays/authors.txt | 2 +- basis/tuple-arrays/summary.txt | 1 - basis/tuple-arrays/tags.txt | 1 - basis/tuple-arrays/tuple-arrays-docs.factor | 13 ---- basis/tuple-arrays/tuple-arrays-tests.factor | 16 ++-- basis/tuple-arrays/tuple-arrays.factor | 76 ++++++++++++++----- extra/benchmark/tuple-arrays/authors.txt | 1 + .../tuple-arrays/tuple-arrays.factor | 20 +++++ 9 files changed, 88 insertions(+), 44 deletions(-) delete mode 100644 basis/tuple-arrays/summary.txt delete mode 100644 basis/tuple-arrays/tags.txt delete mode 100644 basis/tuple-arrays/tuple-arrays-docs.factor create mode 100644 extra/benchmark/tuple-arrays/authors.txt create mode 100644 extra/benchmark/tuple-arrays/tuple-arrays.factor diff --git a/basis/inverse/inverse.factor b/basis/inverse/inverse.factor index a988063293..0b86b02e92 100755 --- a/basis/inverse/inverse.factor +++ b/basis/inverse/inverse.factor @@ -12,7 +12,7 @@ IN: inverse ERROR: fail ; M: fail summary drop "Matching failed" ; -: assure ( ? -- ) [ fail ] unless ; +: assure ( ? -- ) [ fail ] unless ; inline : =/fail ( obj1 obj2 -- ) = assure ; diff --git a/basis/tuple-arrays/authors.txt b/basis/tuple-arrays/authors.txt index f990dd0ed2..d4f5d6b3ae 100644 --- a/basis/tuple-arrays/authors.txt +++ b/basis/tuple-arrays/authors.txt @@ -1 +1 @@ -Daniel Ehrenberg +Slava Pestov \ No newline at end of file diff --git a/basis/tuple-arrays/summary.txt b/basis/tuple-arrays/summary.txt deleted file mode 100644 index ac05ae9bcc..0000000000 --- a/basis/tuple-arrays/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Packed homogeneous tuple arrays diff --git a/basis/tuple-arrays/tags.txt b/basis/tuple-arrays/tags.txt deleted file mode 100644 index 42d711b32b..0000000000 --- a/basis/tuple-arrays/tags.txt +++ /dev/null @@ -1 +0,0 @@ -collections diff --git a/basis/tuple-arrays/tuple-arrays-docs.factor b/basis/tuple-arrays/tuple-arrays-docs.factor deleted file mode 100644 index 18f5547e7f..0000000000 --- a/basis/tuple-arrays/tuple-arrays-docs.factor +++ /dev/null @@ -1,13 +0,0 @@ -USING: help.syntax help.markup splitting kernel sequences ; -IN: tuple-arrays - -HELP: tuple-array -{ $description "The class of packed homogeneous tuple arrays. They are created with " { $link } ". All elements are of the same tuple class. Mutations done to an element are not copied back to the packed array unless it is explicitly written back. To convert a sequence to a tuple array, use the word " { $link >tuple-array } "." } ; - -HELP: -{ $values { "class" "a tuple class" } { "length" "a non-negative integer" } { "tuple-array" tuple-array } } -{ $description "Creates an instance of the " { $link } " class with the given length and containing the given tuple class." } ; - -HELP: >tuple-array -{ $values { "seq" sequence } { "tuple-array" tuple-array } } -{ $description "Converts a sequence into a homogeneous unboxed tuple array of the type indicated by the first element." } ; diff --git a/basis/tuple-arrays/tuple-arrays-tests.factor b/basis/tuple-arrays/tuple-arrays-tests.factor index 7aa49b880f..4606ecdada 100644 --- a/basis/tuple-arrays/tuple-arrays-tests.factor +++ b/basis/tuple-arrays/tuple-arrays-tests.factor @@ -5,17 +5,21 @@ IN: tuple-arrays.tests SYMBOL: mat TUPLE: foo bar ; C: foo -[ 2 ] [ 2 foo dup mat set length ] unit-test +TUPLE-ARRAY: foo + +[ 2 ] [ 2 dup mat set length ] unit-test [ T{ foo } ] [ mat get first ] unit-test [ T{ foo f 2 } ] [ T{ foo f 2 } 0 mat get [ set-nth ] keep first ] unit-test -[ t ] [ { T{ foo f 1 } T{ foo f 2 } } >tuple-array dup mat set tuple-array? ] unit-test +[ t ] [ { T{ foo f 1 } T{ foo f 2 } } >foo-array dup mat set foo-array? ] unit-test [ T{ foo f 3 } t ] -[ mat get [ bar>> 2 + ] map [ first ] keep tuple-array? ] unit-test +[ mat get [ bar>> 2 + ] map [ first ] keep foo-array? ] unit-test -[ 2 ] [ 2 foo dup mat set length ] unit-test +[ 2 ] [ 2 dup mat set length ] unit-test [ T{ foo } ] [ mat get first ] unit-test [ T{ foo f 1 } ] [ T{ foo f 1 } 0 mat get [ set-nth ] keep first ] unit-test TUPLE: baz { bing integer } bong ; -[ 0 ] [ 1 baz first bing>> ] unit-test -[ f ] [ 1 baz first bong>> ] unit-test +TUPLE-ARRAY: baz + +[ 0 ] [ 1 first bing>> ] unit-test +[ f ] [ 1 first bong>> ] unit-test diff --git a/basis/tuple-arrays/tuple-arrays.factor b/basis/tuple-arrays/tuple-arrays.factor index af62c0b0d7..466262f3e0 100644 --- a/basis/tuple-arrays/tuple-arrays.factor +++ b/basis/tuple-arrays/tuple-arrays.factor @@ -1,34 +1,68 @@ -! Copyright (C) 2007 Daniel Ehrenberg. +! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: splitting grouping classes.tuple classes math kernel -sequences arrays accessors ; +USING: accessors arrays combinators.smart fry functors grouping +kernel macros sequences sequences.private stack-checker +parser ; +FROM: inverse => undo ; IN: tuple-arrays -TUPLE: tuple-array { seq read-only } { class read-only } ; + ( length class -- tuple-array ) - [ - new tuple>array 1 tail - [ concat ] [ length ] bi - ] [ ] bi tuple-array boa ; +MACRO: infer-in ( class -- quot ) infer in>> '[ _ ] ; -M: tuple-array nth - [ seq>> nth ] [ class>> ] bi prefix >tuple ; +: smart-tuple>array ( tuple class -- array ) + '[ [ _ boa ] undo ] output>array ; inline -M: tuple-array set-nth ( elt n seq -- ) - [ tuple>array 1 tail ] 2dip seq>> set-nth ; +: smart-array>tuple ( array class -- tuple ) + '[ _ boa ] input> ; +: tuple-arity ( class -- quot ) '[ _ boa ] infer-in ; inline -: >tuple-array ( seq -- tuple-array ) +: tuple-prototype ( class -- array ) + [ new ] [ smart-tuple>array ] bi ; inline + +PRIVATE> + +FUNCTOR: define-tuple-array ( CLASS -- ) + +CLASS IS ${CLASS} + +CLASS-array DEFINES-CLASS ${CLASS}-array +CLASS-array? IS ${CLASS-array}? + + DEFINES <${CLASS}-array> +>CLASS-array DEFINES >${CLASS}-array + +WHERE + +TUPLE: CLASS-array { seq sliced-groups read-only } ; + +: ( length -- tuple-array ) + CLASS tuple-prototype concat + CLASS tuple-arity + CLASS-array boa ; + +M: CLASS-array nth-unsafe + seq>> nth-unsafe CLASS smart-array>tuple ; + +M: CLASS-array set-nth-unsafe + [ CLASS smart-tuple>array ] 2dip seq>> set-nth-unsafe ; + +M: CLASS-array new-sequence + drop ; + +: >CLASS-array ( seq -- tuple-array ) dup empty? [ - 0 over first class clone-like + 0 clone-like ] unless ; -M: tuple-array like - drop dup tuple-array? [ >tuple-array ] unless ; +M: CLASS-array like + drop dup CLASS-array? [ >CLASS-array ] unless ; -M: tuple-array length seq>> length ; +M: CLASS-array length seq>> length ; -INSTANCE: tuple-array sequence +INSTANCE: CLASS-array sequence + +;FUNCTOR + +SYNTAX: TUPLE-ARRAY: scan-word define-tuple-array ; diff --git a/extra/benchmark/tuple-arrays/authors.txt b/extra/benchmark/tuple-arrays/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/benchmark/tuple-arrays/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/benchmark/tuple-arrays/tuple-arrays.factor b/extra/benchmark/tuple-arrays/tuple-arrays.factor new file mode 100644 index 0000000000..483311d4f4 --- /dev/null +++ b/extra/benchmark/tuple-arrays/tuple-arrays.factor @@ -0,0 +1,20 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math math.functions tuple-arrays accessors fry sequences +prettyprint ; +IN: benchmark.tuple-arrays + +TUPLE: point { x float } { y float } { z float } ; + +TUPLE-ARRAY: point + +: tuple-array-benchmark ( -- ) + 100 [ + drop 5000 [ + [ 1+ ] change-x + [ 1- ] change-y + [ 1+ 2 / ] change-z + ] map [ z>> ] sigma + ] sigma . ; + +MAIN: tuple-array-benchmark \ No newline at end of file