steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Joe Groff 2009-04-26 14:35:59 -05:00
parent a2056d932c 319ac42ac2
commit 2ee95694e5
11 changed files with 98 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/inverse/inverse.factor
View File

@ -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 ;

2
basis/tuple-arrays/authors.txt
View File

@ -1 +1 @@
Daniel Ehrenberg
Slava Pestov

1
basis/tuple-arrays/summary.txt
View File

@ -1 +0,0 @@
Packed homogeneous tuple arrays

1
basis/tuple-arrays/tags.txt
View File

@ -1 +0,0 @@
collections

13
basis/tuple-arrays/tuple-arrays-docs.factor
View File

@ -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 <tuple-array> } ". 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: <tuple-array>
{ $values { "class" "a tuple class" } { "length" "a non-negative integer" } { "tuple-array" tuple-array } }
{ $description "Creates an instance of the " { $link <tuple-array> } " 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." } ;

16
basis/tuple-arrays/tuple-arrays-tests.factor
View File

@ -5,17 +5,21 @@ IN: tuple-arrays.tests
SYMBOL: mat
TUPLE: foo bar ;
C: <foo> foo
[ 2 ] [ 2 foo <tuple-array> dup mat set length ] unit-test
TUPLE-ARRAY: foo
[ 2 ] [ 2 <foo-array> 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 + <foo> ] map [ first ] keep tuple-array? ] unit-test
[ mat get [ bar>> 2 + <foo> ] map [ first ] keep foo-array? ] unit-test
[ 2 ] [ 2 foo <tuple-array> dup mat set length ] unit-test
[ 2 ] [ 2 <foo-array> 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 <tuple-array> first bing>> ] unit-test
[ f ] [ 1 baz <tuple-array> first bong>> ] unit-test
TUPLE-ARRAY: baz
[ 0 ] [ 1 <baz-array> first bing>> ] unit-test
[ f ] [ 1 <baz-array> first bong>> ] unit-test

76
basis/tuple-arrays/tuple-arrays.factor
View File

@ -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 } ;
<PRIVATE
: <tuple-array> ( length class -- tuple-array )
[
new tuple>array 1 tail
[ <repetition> concat ] [ length ] bi <sliced-groups>
] [ ] 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<sequence ; inline
M: tuple-array new-sequence
class>> <tuple-array> ;
: 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}?
<CLASS-array> DEFINES <${CLASS}-array>
>CLASS-array DEFINES >${CLASS}-array
WHERE
TUPLE: CLASS-array { seq sliced-groups read-only } ;
: <CLASS-array> ( length -- tuple-array )
CLASS tuple-prototype <repetition> concat
CLASS tuple-arity <sliced-groups>
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> ;
: >CLASS-array ( seq -- tuple-array )
dup empty? [
0 over first class <tuple-array> clone-like
0 <CLASS-array> 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 ;

1
extra/benchmark/tuple-arrays/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

20
extra/benchmark/tuple-arrays/tuple-arrays.factor Normal file
View File

@ -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 <point-array> [
[ 1+ ] change-x
[ 1- ] change-y
[ 1+ 2 / ] change-z
] map [ z>> ] sigma
] sigma . ;
MAIN: tuple-array-benchmark

16
vm/code_gc.c
View File

@ -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;
}

4
vm/code_gc.h Normal file → Executable file
View File

@ -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 {