1 /* This file defines the procedures related to one type of uniform
2 numeric vector. It is included multiple time in srfi-4.c, once for
5 Before inclusion, the following macros must be defined. They are
6 undefined at the end of this file to get back to a clean slate for
11 The type tag of the vector, for example SCM_UVEC_U8
15 The tag name of the vector, for example u8. The tag is used to
16 form the function names and is included in the docstrings, for
21 The C type of the elements, for example scm_t_uint8. The code
22 below will never do sizeof (CTYPE), thus you can use just 'float'
23 for the c32 type, for example.
25 When CTYPE is not defined, the functions using it are excluded.
28 /* The first level does not expand macros in the arguments. */
29 #define paste(a1,a2,a3) a1##a2##a3
30 #define s_paste(a1,a2,a3) s_##a1##a2##a3
31 #define stringify(a) #a
33 /* But the second level does. */
34 #define F(pre,T,suf) paste(pre,T,suf)
35 #define s_F(pre,T,suf) s_paste(pre,T,suf)
36 #define S(T) stringify(T)
38 SCM_DEFINE (F(scm_
,TAG
,vector_p
), S(TAG
)"vector?", 1, 0, 0,
40 "Return @code{#t} if @var{obj} is a vector of type " S(TAG
) ",\n"
41 "@code{#f} otherwise.")
42 #define FUNC_NAME s_F(scm_, TAG, vector_p)
44 return uvec_p (TYPE
, obj
);
48 SCM_DEFINE (F(scm_make_
,TAG
,vector
), "make-"S(TAG
)"vector", 1, 1, 0,
50 "Return a newly allocated uniform numeric vector which can\n"
51 "hold @var{len} elements. If @var{fill} is given, it is used to\n"
52 "initialize the elements, otherwise the contents of the vector\n"
54 #define FUNC_NAME s_S(scm_make_,TAG,vector)
56 return make_uvec (TYPE
, len
, fill
);
60 SCM_DEFINE (F(scm_
,TAG
,vector
), S(TAG
)"vector", 0, 0, 1,
62 "Return a newly allocated uniform numeric vector containing\n"
63 "all argument values.")
64 #define FUNC_NAME s_F(scm_,TAG,vector)
66 return list_to_uvec (TYPE
, l
);
71 SCM_DEFINE (F(scm_
,TAG
,vector_length
), S(TAG
)"vector-length", 1, 0, 0,
73 "Return the number of elements in the uniform numeric vector\n"
75 #define FUNC_NAME s_F(scm_,TAG,vector_length)
77 return uvec_length (TYPE
, uvec
);
82 SCM_DEFINE (F(scm_
,TAG
,vector_ref
), S(TAG
)"vector-ref", 2, 0, 0,
83 (SCM uvec
, SCM index
),
84 "Return the element at @var{index} in the uniform numeric\n"
86 #define FUNC_NAME s_F(scm_,TAG,vector_ref)
88 return uvec_ref (TYPE
, uvec
, index
);
93 SCM_DEFINE (F(scm_
,TAG
,vector_set_x
), S(TAG
)"vector-set!", 3, 0, 0,
94 (SCM uvec
, SCM index
, SCM value
),
95 "Set the element at @var{index} in the uniform numeric\n"
96 "vector @var{uvec} to @var{value}. The return value is not\n"
98 #define FUNC_NAME s_F(scm_,TAG,vector_set_x)
100 return uvec_set_x (TYPE
, uvec
, index
, value
);
105 SCM_DEFINE (F(scm_
,TAG
,vector_to_list
), S(TAG
)"vector->list", 1, 0, 0,
107 "Convert the uniform numeric vector @var{uvec} to a list.")
108 #define FUNC_NAME s_F(scm_,TAG,vector_to_list)
110 return uvec_to_list (TYPE
, uvec
);
115 SCM_DEFINE (F(scm_list_to_
,TAG
,vector
), "list->"S(TAG
)"vector", 1, 0, 0,
117 "Convert the list @var{l} to a numeric uniform vector.")
118 #define FUNC_NAME s_F(scm_list_to_,TAG,vector)
120 return list_to_uvec (TYPE
, l
);
124 SCM_DEFINE (F(scm_any_to_
,TAG
,vector
), "any->"S(TAG
)"vector", 1, 0, 0,
126 "Convert @var{obj}, which can be a list, vector, or\n"
127 "uniform vector, to a numeric uniform vector of\n"
129 #define FUNC_NAME s_F(scm_any_to_,TAG,vector)
131 return coerce_to_uvec (TYPE
, obj
);
138 F(scm_take_
,TAG
,vector
) (CTYPE
*data
, size_t n
)
140 scm_gc_register_collectable_memory ((void *)data
, n
*uvec_sizes
[TYPE
],
142 return take_uvec (TYPE
, data
, n
);
146 F(scm_array_handle_
,TAG
,_elements
) (scm_t_array_handle
*h
)
148 return F(scm_array_handle_
,TAG
,_writable_elements
) (h
);
152 F(scm_array_handle_
,TAG
,_writable_elements
) (scm_t_array_handle
*h
)
155 if (SCM_I_ARRAYP (vec
))
156 vec
= SCM_I_ARRAY_V (vec
);
157 uvec_assert (TYPE
, vec
);
158 if (TYPE
== SCM_UVEC_C32
|| TYPE
== SCM_UVEC_C64
)
159 return ((CTYPE
*)SCM_UVEC_BASE (vec
)) + 2*h
->base
;
161 return ((CTYPE
*)SCM_UVEC_BASE (vec
)) + h
->base
;
165 F(scm_
,TAG
,vector_elements
) (SCM uvec
,
166 scm_t_array_handle
*h
,
167 size_t *lenp
, ssize_t
*incp
)
169 return F(scm_
,TAG
,vector_writable_elements
) (uvec
, h
, lenp
, incp
);
173 F(scm_
,TAG
,vector_writable_elements
) (SCM uvec
,
174 scm_t_array_handle
*h
,
175 size_t *lenp
, ssize_t
*incp
)
177 scm_generalized_vector_get_handle (uvec
, h
);
180 scm_t_array_dim
*dim
= scm_array_handle_dims (h
);
181 *lenp
= dim
->ubnd
- dim
->lbnd
+ 1;
184 return F(scm_array_handle_
,TAG
,_writable_elements
) (h
);
190 F(,TAG
,ref
) (scm_t_array_handle
*handle
, ssize_t pos
)
192 return uvec_fast_ref (TYPE
, handle
->elements
, pos
);
196 F(,TAG
,set
) (scm_t_array_handle
*handle
, ssize_t pos
, SCM val
)
198 uvec_fast_set_x (TYPE
, handle
->writable_elements
, pos
, val
);