1 /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2013, 2014 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
26 #define SCM_BUILDING_DEPRECATED_CODE
28 #include "libguile/_scm.h"
29 #include "libguile/__scm.h"
31 #include "libguile/uniform.h"
32 #include "libguile/deprecation.h"
35 const size_t scm_i_array_element_type_sizes
[SCM_ARRAY_ELEMENT_TYPE_LAST
+ 1] = {
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
, "byte-aligned uniform array");
57 scm_wrong_type_arg_msg (NULL
, 0, h
->array
, "uniform array");
61 scm_array_handle_uniform_element_bit_size (scm_t_array_handle
*h
)
63 size_t ret
= scm_i_array_element_type_sizes
[h
->element_type
];
67 scm_wrong_type_arg_msg (NULL
, 0, h
->array
, "uniform array");
71 scm_array_handle_uniform_elements (scm_t_array_handle
*h
)
73 return scm_array_handle_uniform_writable_elements (h
);
77 scm_array_handle_uniform_writable_elements (scm_t_array_handle
*h
)
82 esize
= scm_array_handle_uniform_element_size (h
);
83 ret
= ((scm_t_uint8
*) h
->writable_elements
) + h
->base
* esize
;
87 #if SCM_ENABLE_DEPRECATED
90 scm_is_uniform_vector (SCM obj
)
95 scm_c_issue_deprecation_warning
96 ("scm_is_uniform_vector is deprecated. "
97 "Use scm_is_bytevector || scm_is_bitvector instead.");
99 if (scm_is_generalized_vector (obj
))
101 scm_generalized_vector_get_handle (obj
, &h
);
102 ret
= SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED (h
.element_type
);
103 scm_array_handle_release (&h
);
109 scm_c_uniform_vector_length (SCM uvec
)
111 scm_c_issue_deprecation_warning
112 ("scm_c_uniform_vector_length is deprecated. "
113 "Use scm_c_array_length instead.");
115 if (!scm_is_uniform_vector (uvec
))
116 scm_wrong_type_arg_msg ("uniform-vector-length", 1, uvec
,
119 return scm_c_generalized_vector_length (uvec
);
122 SCM_DEFINE (scm_uniform_vector_p
, "uniform-vector?", 1, 0, 0,
124 "Return @code{#t} if @var{obj} is a uniform vector.")
125 #define FUNC_NAME s_scm_uniform_vector_p
127 scm_c_issue_deprecation_warning
128 ("uniform-vector? is deprecated. Use bytevector? and bitvector?, or "
129 "use array-type and array-rank instead.");
131 return scm_from_bool (scm_is_uniform_vector (obj
));
135 SCM_DEFINE (scm_uniform_vector_element_type
, "uniform-vector-element-type", 1, 0, 0,
137 "Return the type of the elements in the uniform vector, @var{v}.")
138 #define FUNC_NAME s_scm_uniform_vector_element_type
140 scm_t_array_handle h
;
143 scm_c_issue_deprecation_warning
144 ("uniform-vector-element-type is deprecated. Use array-type instead.");
146 if (!scm_is_uniform_vector (v
))
147 scm_wrong_type_arg_msg (FUNC_NAME
, SCM_ARG1
, v
, "uniform vector");
148 scm_array_get_handle (v
, &h
);
149 ret
= scm_array_handle_element_type (&h
);
150 scm_array_handle_release (&h
);
155 SCM_DEFINE (scm_uniform_vector_element_size
, "uniform-vector-element-size", 1, 0, 0,
157 "Return the number of bytes allocated to each element in the\n"
158 "uniform vector, @var{v}.")
159 #define FUNC_NAME s_scm_uniform_vector_element_size
161 scm_t_array_handle h
;
166 scm_c_issue_deprecation_warning
167 ("uniform-vector-element-size is deprecated. Instead, treat the "
168 "uniform vector as a bytevector.");
170 scm_uniform_vector_elements (v
, &h
, &len
, &inc
);
171 ret
= scm_from_size_t (scm_array_handle_uniform_element_size (&h
));
172 scm_array_handle_release (&h
);
178 scm_c_uniform_vector_ref (SCM v
, size_t idx
)
180 scm_c_issue_deprecation_warning
181 ("scm_c_uniform_vector_ref is deprecated. Use scm_c_array_ref_1 instead.");
183 if (!scm_is_uniform_vector (v
))
184 scm_wrong_type_arg_msg (NULL
, 0, v
, "uniform vector");
185 return scm_c_generalized_vector_ref (v
, idx
);
188 SCM_DEFINE (scm_uniform_vector_ref
, "uniform-vector-ref", 2, 0, 0,
190 "Return the element at index @var{idx} of the\n"
191 "homogeneous numeric vector @var{v}.")
192 #define FUNC_NAME s_scm_uniform_vector_ref
194 scm_c_issue_deprecation_warning
195 ("uniform-vector-ref is deprecated. Use array-ref instead.");
197 return scm_c_uniform_vector_ref (v
, scm_to_size_t (idx
));
202 scm_c_uniform_vector_set_x (SCM v
, size_t idx
, SCM val
)
204 scm_c_issue_deprecation_warning
205 ("scm_c_uniform_vector_set_x is deprecated. Instead, use "
206 "scm_c_array_set_1_x, but note the change in the order of the arguments.");
208 if (!scm_is_uniform_vector (v
))
209 scm_wrong_type_arg_msg (NULL
, 0, v
, "uniform vector");
210 scm_c_generalized_vector_set_x (v
, idx
, val
);
213 SCM_DEFINE (scm_uniform_vector_set_x
, "uniform-vector-set!", 3, 0, 0,
214 (SCM v
, SCM idx
, SCM val
),
215 "Set the element at index @var{idx} of the\n"
216 "homogeneous numeric vector @var{v} to @var{val}.")
217 #define FUNC_NAME s_scm_uniform_vector_set_x
219 scm_c_issue_deprecation_warning
220 ("uniform-vector-set! is deprecated. Instead, use array-set!, "
221 "but note the change in the order of the arguments.");
223 scm_c_uniform_vector_set_x (v
, scm_to_size_t (idx
), val
);
224 return SCM_UNSPECIFIED
;
228 SCM_DEFINE (scm_uniform_vector_to_list
, "uniform-vector->list", 1, 0, 0,
230 "Convert the uniform numeric vector @var{uvec} to a list.")
231 #define FUNC_NAME s_scm_uniform_vector_to_list
233 scm_c_issue_deprecation_warning
234 ("uniform-vector->list is deprecated. Use array->list instead.");
236 if (!scm_is_uniform_vector (uvec
))
237 scm_wrong_type_arg_msg (FUNC_NAME
, SCM_ARG1
, uvec
, "uniform vector");
238 return scm_array_to_list (uvec
);
243 scm_uniform_vector_elements (SCM uvec
,
244 scm_t_array_handle
*h
,
245 size_t *lenp
, ssize_t
*incp
)
247 scm_c_issue_deprecation_warning
248 ("scm_uniform_vector_elements is deprecated. Use "
249 "scm_array_handle_uniform_elements instead.");
251 return scm_uniform_vector_writable_elements (uvec
, h
, lenp
, incp
);
255 scm_uniform_vector_writable_elements (SCM uvec
,
256 scm_t_array_handle
*h
,
257 size_t *lenp
, ssize_t
*incp
)
261 scm_c_issue_deprecation_warning
262 ("scm_uniform_vector_writable_elements is deprecated. Use "
263 "scm_array_handle_uniform_writable_elements instead.");
265 scm_generalized_vector_get_handle (uvec
, h
);
266 /* FIXME nonlocal exit */
267 ret
= scm_array_handle_uniform_writable_elements (h
);
270 scm_t_array_dim
*dim
= scm_array_handle_dims (h
);
271 *lenp
= dim
->ubnd
- dim
->lbnd
+ 1;
277 SCM_DEFINE (scm_uniform_vector_length
, "uniform-vector-length", 1, 0, 0,
279 "Return the number of elements in the uniform vector @var{v}.")
280 #define FUNC_NAME s_scm_uniform_vector_length
282 scm_c_issue_deprecation_warning
283 ("uniform-vector-length is deprecated. Use array-length instead.");
285 return scm_from_size_t (scm_c_uniform_vector_length (v
));
290 #endif /* SCM_ENABLE_DEPRECATED */
294 scm_init_uniform (void)
296 #include "libguile/uniform.x"