1 /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public License
5 * as published by the Free Software Foundation; either version 3 of
6 * the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
28 #include "libguile/_scm.h"
29 #include "libguile/__scm.h"
31 #include "libguile/uniform.h"
34 const size_t scm_i_array_element_type_sizes
[SCM_ARRAY_ELEMENT_TYPE_LAST
+ 1] = {
47 /* FIXME: return bit size instead of byte size? */
49 scm_array_handle_uniform_element_size (scm_t_array_handle
*h
)
51 size_t ret
= scm_i_array_element_type_sizes
[h
->element_type
];
52 if (ret
&& ret
% 8 == 0)
55 scm_wrong_type_arg_msg (NULL
, 0, h
->array
, "uniform array");
59 scm_array_handle_uniform_elements (scm_t_array_handle
*h
)
61 return scm_array_handle_uniform_writable_elements (h
);
65 scm_array_handle_uniform_writable_elements (scm_t_array_handle
*h
)
70 esize
= scm_array_handle_uniform_element_size (h
);
71 ret
= ((scm_t_uint8
*) h
->writable_elements
) + h
->base
* esize
;
76 scm_is_uniform_vector (SCM obj
)
81 if (scm_is_generalized_vector (obj
))
83 scm_generalized_vector_get_handle (obj
, &h
);
84 ret
= SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED (h
.element_type
);
85 scm_array_handle_release (&h
);
91 scm_c_uniform_vector_length (SCM uvec
)
97 scm_uniform_vector_elements (uvec
, &h
, &len
, &inc
);
98 scm_array_handle_release (&h
);
102 SCM_DEFINE (scm_uniform_vector_p
, "uniform-vector?", 1, 0, 0,
104 "Return @code{#t} if @var{obj} is a uniform vector.")
105 #define FUNC_NAME s_scm_uniform_vector_p
107 return scm_from_bool (scm_is_uniform_vector (obj
));
111 SCM_DEFINE (scm_uniform_vector_element_type
, "uniform-vector-element-type", 1, 0, 0,
113 "Return the number of elements in the uniform vector, @var{v}.")
114 #define FUNC_NAME s_scm_uniform_vector_element_type
116 scm_t_array_handle h
;
120 scm_uniform_vector_elements (v
, &h
, &len
, &inc
);
121 ret
= scm_array_handle_element_type (&h
);
122 scm_array_handle_release (&h
);
127 SCM_DEFINE (scm_uniform_vector_element_size
, "uniform-vector-element-size", 1, 0, 0,
129 "Return the number of bytes allocated to each element in the\n"
130 "uniform vector, @var{v}.")
131 #define FUNC_NAME s_scm_uniform_vector_element_size
133 scm_t_array_handle h
;
137 scm_uniform_vector_elements (v
, &h
, &len
, &inc
);
138 ret
= scm_from_size_t (scm_array_handle_uniform_element_size (&h
));
139 scm_array_handle_release (&h
);
145 scm_c_uniform_vector_ref (SCM v
, size_t idx
)
148 scm_t_array_handle h
;
152 scm_uniform_vector_elements (v
, &h
, &len
, &inc
);
153 ret
= scm_array_handle_ref (&h
, idx
*inc
);
154 scm_array_handle_release (&h
);
158 SCM_DEFINE (scm_uniform_vector_ref
, "uniform-vector-ref", 2, 0, 0,
160 "Return the element at index @var{idx} of the\n"
161 "homogenous numeric vector @var{v}.")
162 #define FUNC_NAME s_scm_uniform_vector_ref
164 return scm_c_uniform_vector_ref (v
, scm_to_size_t (idx
));
169 scm_c_uniform_vector_set_x (SCM v
, size_t idx
, SCM val
)
171 scm_t_array_handle h
;
175 scm_uniform_vector_elements (v
, &h
, &len
, &inc
);
176 scm_array_handle_set (&h
, idx
*inc
, val
);
177 scm_array_handle_release (&h
);
180 SCM_DEFINE (scm_uniform_vector_set_x
, "uniform-vector-set!", 3, 0, 0,
181 (SCM v
, SCM idx
, SCM val
),
182 "Set the element at index @var{idx} of the\n"
183 "homogenous numeric vector @var{v} to @var{val}.")
184 #define FUNC_NAME s_scm_uniform_vector_set_x
186 scm_c_uniform_vector_set_x (v
, scm_to_size_t (idx
), val
);
187 return SCM_UNSPECIFIED
;
191 SCM_DEFINE (scm_uniform_vector_to_list
, "uniform-vector->list", 1, 0, 0,
193 "Convert the uniform numeric vector @var{uvec} to a list.")
194 #define FUNC_NAME s_scm_uniform_vector_to_list
197 scm_t_array_handle h
;
201 scm_uniform_vector_elements (uvec
, &h
, &len
, &inc
);
202 ret
= scm_generalized_vector_to_list (uvec
);
203 scm_array_handle_release (&h
);
209 scm_uniform_vector_elements (SCM uvec
,
210 scm_t_array_handle
*h
,
211 size_t *lenp
, ssize_t
*incp
)
213 return scm_uniform_vector_writable_elements (uvec
, h
, lenp
, incp
);
217 scm_uniform_vector_writable_elements (SCM uvec
,
218 scm_t_array_handle
*h
,
219 size_t *lenp
, ssize_t
*incp
)
222 scm_generalized_vector_get_handle (uvec
, h
);
223 /* FIXME nonlocal exit */
224 ret
= scm_array_handle_uniform_writable_elements (h
);
227 scm_t_array_dim
*dim
= scm_array_handle_dims (h
);
228 *lenp
= dim
->ubnd
- dim
->lbnd
+ 1;
234 SCM_DEFINE (scm_uniform_vector_length
, "uniform-vector-length", 1, 0, 0,
236 "Return the number of elements in the uniform vector @var{v}.")
237 #define FUNC_NAME s_scm_uniform_vector_length
239 return scm_from_size_t (scm_c_uniform_vector_length (v
));
245 scm_init_uniform (void)
247 #include "libguile/uniform.x"