diff options
author | Andy Wingo <wingo@pobox.com> | 2009-07-19 15:35:33 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-01-07 22:06:56 +0100 |
commit | a2689737679cf2553c118a1d96de7c9ddfec62b0 (patch) | |
tree | 527a55fa0ed77eae66e282f8b87cf7b836edb9e8 /libguile/srfi-4.i.c | |
parent | 3dc2afe2b85eb5c7ec784b6ed8b19242e45f6e34 (diff) | |
download | guile-a2689737679cf2553c118a1d96de7c9ddfec62b0.tar.gz |
reimplement srfi-4 vectors on top of bytevectors
* libguile/srfi-4.h:
* libguile/srfi-4.c (scm_make_srfi_4_vector): New function, exported by
(srfi srfi-4 gnu).
* libguile/srfi-4.i.c: Removed.
* module/srfi/srfi-4.scm:
* module/srfi/srfi-4/gnu.scm: Reimplement srfi-4 vectors on top of
bytevectors. The implementation is mostly in Scheme now.
* test-suite/tests/unif.test: Update to use (srfi srfi-4 gnu).
* libguile/bytevectors.c (bytevector_ref_c32, bytevector_ref_c64)
(bytevector_set_c32, bytevector_set_c64): Fix some embarrassing bugs.
Still need to do an upper bounds check.
* libguile/deprecated.h: Remove deprecated array functions:
scm_i_arrayp, scm_i_array_ndim, scm_i_array_mem, scm_i_array_v,
scm_i_array_base, scm_i_array_dims, and the deprecated macros:
SCM_ARRAYP, SCM_ARRAY_NDIM, SCM_ARRAY_CONTP, SCM_ARRAY_MEM,
SCM_ARRAY_V, SCM_ARRAY_BASE, SCM_ARRAY_DIMS.
* libguile/deprecated.c (scm_uniform_vector_read_x)
(scm_uniform_vector_write, scm_uniform_array_read_x)
(scm_uniform_array_write): Newly deprecated functions.
* libguile/generalized-arrays.c (scm_array_type): Remove the bytevector
hack.
* libguile/objcodes.c (scm_bytecode_to_objcode, scm_objcode_to_bytecode):
Rework to operate on bytevectors, as scm_make_u8vector now causes a
module lookup, which can't be done e.g. when loading the VM boot
program for psyntax-pp.go on a fresh bootstrap.
* libguile/objcodes.h (SCM_F_OBJCODE_IS_BYTEVECTOR):
(SCM_OBJCODE_IS_BYTEVECTOR): s/U8VECTOR/BYTEVECTOR/.
* module/ice-9/boot-9.scm (the-scm-module): A terrible hack to pull in
(srfi srfi-4), as the bindings are primarily there now. We'll worry
about this later.
Diffstat (limited to 'libguile/srfi-4.i.c')
-rw-r--r-- | libguile/srfi-4.i.c | 207 |
1 files changed, 0 insertions, 207 deletions
diff --git a/libguile/srfi-4.i.c b/libguile/srfi-4.i.c deleted file mode 100644 index 098752ef2..000000000 --- a/libguile/srfi-4.i.c +++ /dev/null @@ -1,207 +0,0 @@ -/* This file defines the procedures related to one type of uniform - numeric vector. It is included multiple time in srfi-4.c, once for - each type. - - Before inclusion, the following macros must be defined. They are - undefined at the end of this file to get back to a clean slate for - the next inclusion. - - - TYPE - - The type tag of the vector, for example SCM_UVEC_U8 - - - TAG - - The tag name of the vector, for example u8. The tag is used to - form the function names and is included in the docstrings, for - example. - - - CTYPE - - The C type of the elements, for example scm_t_uint8. The code - below will never do sizeof (CTYPE), thus you can use just 'float' - for the c32 type, for example. - - When CTYPE is not defined, the functions using it are excluded. -*/ - -/* The first level does not expand macros in the arguments. */ -#define paste(a1,a2,a3) a1##a2##a3 -#define s_paste(a1,a2,a3) s_##a1##a2##a3 -#define stringify(a) #a - -/* But the second level does. */ -#define F(pre,T,suf) paste(pre,T,suf) -#define s_F(pre,T,suf) s_paste(pre,T,suf) -#define S(T) stringify(T) - -SCM_DEFINE (F(scm_,TAG,vector_p), S(TAG)"vector?", 1, 0, 0, - (SCM obj), - "Return @code{#t} if @var{obj} is a vector of type " S(TAG) ",\n" - "@code{#f} otherwise.") -#define FUNC_NAME s_F(scm_, TAG, vector_p) -{ - return uvec_p (TYPE, obj); -} -#undef FUNC_NAME - -SCM_DEFINE (F(scm_make_,TAG,vector), "make-"S(TAG)"vector", 1, 1, 0, - (SCM len, SCM fill), - "Return a newly allocated uniform numeric vector which can\n" - "hold @var{len} elements. If @var{fill} is given, it is used to\n" - "initialize the elements, otherwise the contents of the vector\n" - "is unspecified.") -#define FUNC_NAME s_S(scm_make_,TAG,vector) -{ - return make_uvec (TYPE, len, fill); -} -#undef FUNC_NAME - -SCM_DEFINE (F(scm_,TAG,vector), S(TAG)"vector", 0, 0, 1, - (SCM l), - "Return a newly allocated uniform numeric vector containing\n" - "all argument values.") -#define FUNC_NAME s_F(scm_,TAG,vector) -{ - return list_to_uvec (TYPE, l); -} -#undef FUNC_NAME - - -SCM_DEFINE (F(scm_,TAG,vector_length), S(TAG)"vector-length", 1, 0, 0, - (SCM uvec), - "Return the number of elements in the uniform numeric vector\n" - "@var{uvec}.") -#define FUNC_NAME s_F(scm_,TAG,vector_length) -{ - return uvec_length (TYPE, uvec); -} -#undef FUNC_NAME - - -SCM_DEFINE (F(scm_,TAG,vector_ref), S(TAG)"vector-ref", 2, 0, 0, - (SCM uvec, SCM index), - "Return the element at @var{index} in the uniform numeric\n" - "vector @var{uvec}.") -#define FUNC_NAME s_F(scm_,TAG,vector_ref) -{ - return uvec_ref (TYPE, uvec, index); -} -#undef FUNC_NAME - - -SCM_DEFINE (F(scm_,TAG,vector_set_x), S(TAG)"vector-set!", 3, 0, 0, - (SCM uvec, SCM index, SCM value), - "Set the element at @var{index} in the uniform numeric\n" - "vector @var{uvec} to @var{value}. The return value is not\n" - "specified.") -#define FUNC_NAME s_F(scm_,TAG,vector_set_x) -{ - return uvec_set_x (TYPE, uvec, index, value); -} -#undef FUNC_NAME - - -SCM_DEFINE (F(scm_,TAG,vector_to_list), S(TAG)"vector->list", 1, 0, 0, - (SCM uvec), - "Convert the uniform numeric vector @var{uvec} to a list.") -#define FUNC_NAME s_F(scm_,TAG,vector_to_list) -{ - return uvec_to_list (TYPE, uvec); -} -#undef FUNC_NAME - - -SCM_DEFINE (F(scm_list_to_,TAG,vector), "list->"S(TAG)"vector", 1, 0, 0, - (SCM l), - "Convert the list @var{l} to a numeric uniform vector.") -#define FUNC_NAME s_F(scm_list_to_,TAG,vector) -{ - return list_to_uvec (TYPE, l); -} -#undef FUNC_NAME - -#ifdef CTYPE - -SCM -F(scm_take_,TAG,vector) (CTYPE *data, size_t n) -{ - /* The manual says "Return a new uniform numeric vector [...] that uses the - memory pointed to by DATA". We *have* to use DATA as the underlying - storage; thus we must register a finalizer to eventually free(3) it. */ - GC_finalization_proc prev_finalizer; - GC_PTR prev_finalization_data; - - GC_REGISTER_FINALIZER_NO_ORDER (data, free_user_data, 0, - &prev_finalizer, - &prev_finalization_data); - - return take_uvec (TYPE, data, n); -} - -const CTYPE * -F(scm_array_handle_,TAG,_elements) (scm_t_array_handle *h) -{ - return F(scm_array_handle_,TAG,_writable_elements) (h); -} - -CTYPE * -F(scm_array_handle_,TAG,_writable_elements) (scm_t_array_handle *h) -{ - SCM vec = h->array; - if (SCM_I_ARRAYP (vec)) - vec = SCM_I_ARRAY_V (vec); - uvec_assert (TYPE, vec); - if (TYPE == SCM_UVEC_C32 || TYPE == SCM_UVEC_C64) - return ((CTYPE *)SCM_UVEC_BASE (vec)) + 2*h->base; - else - return ((CTYPE *)SCM_UVEC_BASE (vec)) + h->base; -} - -const CTYPE * -F(scm_,TAG,vector_elements) (SCM uvec, - scm_t_array_handle *h, - size_t *lenp, ssize_t *incp) -{ - return F(scm_,TAG,vector_writable_elements) (uvec, h, lenp, incp); -} - -CTYPE * -F(scm_,TAG,vector_writable_elements) (SCM uvec, - scm_t_array_handle *h, - size_t *lenp, ssize_t *incp) -{ - scm_generalized_vector_get_handle (uvec, h); - if (lenp) - { - scm_t_array_dim *dim = scm_array_handle_dims (h); - *lenp = dim->ubnd - dim->lbnd + 1; - *incp = dim->inc; - } - return F(scm_array_handle_,TAG,_writable_elements) (h); -} - -#endif - -static SCM -F(,TAG,ref) (scm_t_array_handle *handle, size_t pos) -{ - return uvec_fast_ref (TYPE, handle->elements, pos); -} - -static void -F(,TAG,set) (scm_t_array_handle *handle, size_t pos, SCM val) -{ - uvec_fast_set_x (TYPE, handle->writable_elements, pos, val); -} - -#undef paste -#undef s_paste -#undef stringify -#undef F -#undef s_F -#undef S - -#undef TYPE -#undef TAG -#undef CTYPE |