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

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

db4
Doug Coleman 2008-12-06 19:01:35 -06:00
parent 14fb58f448 0290be6e93
commit 29d5278569
7 changed files with 20 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
core/arrays/arrays.factor
View File

@ -12,9 +12,9 @@ M: array resize resize-array ;
: >array ( seq -- array ) { } clone-like ;
M: object new-sequence drop f <array> ;
M: object new-sequence drop 0 <array> ;
M: f new-sequence drop dup zero? [ drop f ] [ f <array> ] if ;
M: f new-sequence drop dup zero? [ drop f ] [ 0 <array> ] if ;
M: array equal?
over array? [ sequence= ] [ 2drop f ] if ;

2
core/assocs/assocs.factor
View File

@ -90,7 +90,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
] if ; inline recursive
: assoc-stack ( key seq -- value )
dup length 1- swap (assoc-stack) ;
dup length 1- swap (assoc-stack) ; flushable
: assoc-subset? ( assoc1 assoc2 -- ? )
[ swapd at* [ = ] [ 2drop f ] if ] curry assoc-all? ;

6
core/namespaces/namespaces.factor
View File

@ -12,12 +12,12 @@ IN: namespaces
PRIVATE>
: namespace ( -- namespace ) namestack* peek ;
: namespace ( -- namespace ) namestack* peek ; inline
: namestack ( -- namestack ) namestack* clone ;
: set-namestack ( namestack -- ) >vector 0 setenv ;
: global ( -- g ) 21 getenv { hashtable } declare ; inline
: init-namespaces ( -- ) global 1array set-namestack ;
: get ( variable -- value ) namestack* assoc-stack ; flushable
: get ( variable -- value ) namestack* assoc-stack ; inline
: set ( value variable -- ) namespace set-at ;
: on ( variable -- ) t swap set ; inline
: off ( variable -- ) f swap set ; inline
@ -28,7 +28,7 @@ PRIVATE>
: inc ( variable -- ) 1 swap +@ ; inline
: dec ( variable -- ) -1 swap +@ ; inline
: bind ( ns quot -- ) swap >n call ndrop ; inline
: counter ( variable -- n ) global [ dup inc get ] bind ;
: counter ( variable -- n ) global [ 0 or 1+ dup ] change-at ;
: make-assoc ( quot exemplar -- hash )
20 swap new-assoc [ >n call ndrop ] keep ; inline

2
core/vectors/vectors.factor
View File

@ -8,7 +8,7 @@ TUPLE: vector
{ underlying array }
{ length array-capacity } ;
: <vector> ( n -- vector ) f <array> 0 vector boa ; inline
: <vector> ( n -- vector ) 0 <array> 0 vector boa ; inline
: >vector ( seq -- vector ) V{ } clone-like ;

2
vm/bignum.c
View File

@ -1396,7 +1396,7 @@ allot_bignum_zeroed(bignum_length_type length, int negative_p)
}
#define BIGNUM_REDUCE_LENGTH(source, length) \
source = reallot_array(source,length + 1,0)
source = reallot_array(source,length + 1)
/* allocates memory */
bignum_type

28
vm/types.c
View File

@ -157,27 +157,18 @@ CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4)
return tag_object(a);
}
F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity, CELL fill)
F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity)
{
int i;
F_ARRAY* new_array;
CELL to_copy = array_capacity(array);
if(capacity < to_copy)
to_copy = capacity;
REGISTER_UNTAGGED(array);
REGISTER_ROOT(fill);
new_array = allot_array_internal(untag_header(array->header),capacity);
UNREGISTER_ROOT(fill);
F_ARRAY* new_array = allot_array_internal(untag_header(array->header),capacity);
UNREGISTER_UNTAGGED(array);
memcpy(new_array + 1,array + 1,to_copy * CELLS);
for(i = to_copy; i < capacity; i++)
put(AREF(new_array,i),fill);
memset((char *)AREF(new_array,to_copy),'\0',(capacity - to_copy) * CELLS);
return new_array;
}
@ -186,7 +177,7 @@ void primitive_resize_array(void)
{
F_ARRAY* array = untag_array(dpop());
CELL capacity = unbox_array_size();
dpush(tag_object(reallot_array(array,capacity,F)));
dpush(tag_object(reallot_array(array,capacity)));
}
F_ARRAY *growable_array_add(F_ARRAY *result, CELL elt, CELL *result_count)
@ -195,8 +186,7 @@ F_ARRAY *growable_array_add(F_ARRAY *result, CELL elt, CELL *result_count)
if(*result_count == array_capacity(result))
{
result = reallot_array(result,
*result_count * 2,F);
result = reallot_array(result,*result_count * 2);
}
UNREGISTER_ROOT(elt);
@ -214,7 +204,7 @@ F_ARRAY *growable_array_append(F_ARRAY *result, F_ARRAY *elts, CELL *result_coun
CELL new_size = *result_count + elts_size;
if(new_size >= array_capacity(result))
result = reallot_array(result,new_size * 2,F);
result = reallot_array(result,new_size * 2);
UNREGISTER_UNTAGGED(elts);
@ -433,7 +423,7 @@ void primitive_string(void)
dpush(tag_object(allot_string(length,initial)));
}
F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill)
F_STRING* reallot_string(F_STRING* string, CELL capacity)
{
CELL to_copy = string_capacity(string);
if(capacity < to_copy)
@ -462,7 +452,7 @@ F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill)
REGISTER_UNTAGGED(string);
REGISTER_UNTAGGED(new_string);
fill_string(new_string,to_copy,capacity,fill);
fill_string(new_string,to_copy,capacity,'\0');
UNREGISTER_UNTAGGED(new_string);
UNREGISTER_UNTAGGED(string);
@ -473,7 +463,7 @@ void primitive_resize_string(void)
{
F_STRING* string = untag_string(dpop());
CELL capacity = unbox_array_size();
dpush(tag_object(reallot_string(string,capacity,0)));
dpush(tag_object(reallot_string(string,capacity)));
}
/* Some ugly macros to prevent a 2x code duplication */

6
vm/types.h
View File

@ -118,7 +118,7 @@ void primitive_tuple_layout(void);
void primitive_byte_array(void);
void primitive_clone(void);
F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity, CELL fill);
F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity);
F_BYTE_ARRAY *reallot_byte_array(F_BYTE_ARRAY *array, CELL capacity);
void primitive_resize_array(void);
void primitive_resize_byte_array(void);
@ -126,7 +126,7 @@ void primitive_resize_byte_array(void);
F_STRING* allot_string_internal(CELL capacity);
F_STRING* allot_string(CELL capacity, CELL fill);
void primitive_string(void);
F_STRING *reallot_string(F_STRING *string, CELL capacity, CELL fill);
F_STRING *reallot_string(F_STRING *string, CELL capacity);
void primitive_resize_string(void);
F_STRING *memory_to_char_string(const char *string, CELL length);
@ -177,7 +177,7 @@ F_ARRAY *growable_array_append(F_ARRAY *result, F_ARRAY *elts, CELL *result_coun
result = tag_object(growable_array_append(untag_object(result),elts,&result##_count))
#define GROWABLE_ARRAY_TRIM(result) \
result = tag_object(reallot_array(untag_object(result),result##_count,F))
result = tag_object(reallot_array(untag_object(result),result##_count))
/* Macros to simulate a byte vector in C */
#define GROWABLE_BYTE_ARRAY(result) \