mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-30 15:00:21 +02:00
(coerce_to_uvec, scm_any_to_u8vector, etc): New.
(scm_uniform_element_size, scm_uniform_vector_length): Do no longer handle old-style uniform vectors.
This commit is contained in:
Marius Vollmer
parent
f738b51d25
commit
90d4368c88
3 changed files with 67 additions and 61 deletions
|
|
@ -406,6 +406,38 @@ list_to_uvec (int type, SCM list)
|
|||
return uvec;
|
||||
}
|
||||
|
||||
static SCM
|
||||
coerce_to_uvec (int type, SCM obj)
|
||||
{
|
||||
if (is_uvec (type, obj))
|
||||
return obj;
|
||||
else if (scm_is_pair (obj))
|
||||
return list_to_uvec (type, obj);
|
||||
else if (scm_is_true (scm_vector_p (obj)))
|
||||
{
|
||||
SCM len = scm_vector_length (obj);
|
||||
SCM uvec = make_uvec (type, len, SCM_UNDEFINED);
|
||||
size_t clen = scm_to_size_t (len), i;
|
||||
void *base = SCM_UVEC_BASE (uvec);
|
||||
for (i = 0; i < clen; i++)
|
||||
uvec_fast_set_x (type, base, i, SCM_VECTOR_REF (obj, i));
|
||||
return uvec;
|
||||
}
|
||||
else if (scm_is_uniform_vector (obj))
|
||||
{
|
||||
SCM len = scm_uniform_vector_length (obj);
|
||||
SCM uvec = make_uvec (type, len, SCM_UNDEFINED);
|
||||
size_t clen = scm_to_size_t (len), i;
|
||||
void *base = SCM_UVEC_BASE (uvec);
|
||||
for (i = 0; i < clen; i++)
|
||||
uvec_fast_set_x (type, base, i,
|
||||
scm_uniform_vector_ref (obj, scm_from_size_t (i)));
|
||||
return uvec;
|
||||
}
|
||||
else
|
||||
scm_wrong_type_arg_msg (NULL, 0, obj, "list, vector, or uniform vector");
|
||||
}
|
||||
|
||||
static SCM *uvec_proc_vars[12] = {
|
||||
&scm_i_proc_make_u8vector,
|
||||
&scm_i_proc_make_s8vector,
|
||||
|
|
@ -551,45 +583,12 @@ scm_uniform_vector_element_size (SCM uvec)
|
|||
size_t
|
||||
scm_uniform_element_size (SCM obj)
|
||||
{
|
||||
size_t result;
|
||||
|
||||
if (scm_is_uniform_vector (obj))
|
||||
return scm_uniform_vector_element_size (obj);
|
||||
|
||||
switch (SCM_TYP7 (obj))
|
||||
{
|
||||
case scm_tc7_bvect:
|
||||
case scm_tc7_uvect:
|
||||
case scm_tc7_ivect:
|
||||
result = sizeof (long);
|
||||
break;
|
||||
|
||||
case scm_tc7_svect:
|
||||
result = sizeof (short);
|
||||
break;
|
||||
|
||||
#if SCM_SIZEOF_LONG_LONG != 0
|
||||
case scm_tc7_llvect:
|
||||
result = sizeof (long long);
|
||||
break;
|
||||
#endif
|
||||
|
||||
case scm_tc7_fvect:
|
||||
result = sizeof (float);
|
||||
break;
|
||||
|
||||
case scm_tc7_dvect:
|
||||
result = sizeof (double);
|
||||
break;
|
||||
|
||||
case scm_tc7_cvect:
|
||||
result = 2 * sizeof (double);
|
||||
break;
|
||||
|
||||
default:
|
||||
result = 0;
|
||||
}
|
||||
return result;
|
||||
else if (SCM_BITVECTOR_P (obj))
|
||||
return sizeof (long);
|
||||
else
|
||||
return 0;
|
||||
}
|
||||
|
||||
SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0,
|
||||
|
|
@ -599,30 +598,14 @@ SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0,
|
|||
{
|
||||
if (scm_is_uniform_vector (v))
|
||||
return scm_from_size_t (SCM_UVEC_LENGTH (v));
|
||||
|
||||
SCM_ASRTGO (SCM_NIMP (v), badarg1);
|
||||
switch SCM_TYP7 (v)
|
||||
{
|
||||
default:
|
||||
badarg1:SCM_WRONG_TYPE_ARG (1, v);
|
||||
case scm_tc7_vector:
|
||||
case scm_tc7_wvect:
|
||||
return scm_from_size_t (SCM_VECTOR_LENGTH (v));
|
||||
case scm_tc7_string:
|
||||
return scm_from_size_t (scm_i_string_length (v));
|
||||
case scm_tc7_bvect:
|
||||
return scm_from_size_t (SCM_BITVECTOR_LENGTH (v));
|
||||
case scm_tc7_uvect:
|
||||
case scm_tc7_ivect:
|
||||
case scm_tc7_fvect:
|
||||
case scm_tc7_dvect:
|
||||
case scm_tc7_cvect:
|
||||
case scm_tc7_svect:
|
||||
#if SCM_SIZEOF_LONG_LONG != 0
|
||||
case scm_tc7_llvect:
|
||||
#endif
|
||||
return scm_from_size_t (SCM_UVECTOR_LENGTH (v));
|
||||
}
|
||||
else if (scm_is_string (v))
|
||||
return scm_string_length (v);
|
||||
else if (scm_is_true (scm_vector_p (v)))
|
||||
return scm_vector_length (v);
|
||||
else if (SCM_BITVECTOR_P (v))
|
||||
return scm_from_size_t (SCM_BITVECTOR_LENGTH (v));
|
||||
else
|
||||
scm_wrong_type_arg (NULL, 0, v);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
|
|||
|
|
@ -51,6 +51,7 @@ SCM_API SCM scm_u8vector_ref (SCM uvec, SCM index);
|
|||
SCM_API SCM scm_u8vector_set_x (SCM uvec, SCM index, SCM value);
|
||||
SCM_API SCM scm_u8vector_to_list (SCM uvec);
|
||||
SCM_API SCM scm_list_to_u8vector (SCM l);
|
||||
SCM_API SCM scm_any_to_u8vector (SCM obj);
|
||||
SCM_API scm_t_uint8 *scm_u8vector_elements (SCM uvec);
|
||||
|
||||
SCM_API SCM scm_s8vector_p (SCM obj);
|
||||
|
|
@ -62,6 +63,7 @@ SCM_API SCM scm_s8vector_ref (SCM uvec, SCM index);
|
|||
SCM_API SCM scm_s8vector_set_x (SCM uvec, SCM index, SCM value);
|
||||
SCM_API SCM scm_s8vector_to_list (SCM uvec);
|
||||
SCM_API SCM scm_list_to_s8vector (SCM l);
|
||||
SCM_API SCM scm_any_to_s8vector (SCM obj);
|
||||
SCM_API scm_t_int8 *scm_s8vector_elements (SCM uvec);
|
||||
|
||||
SCM_API SCM scm_u16vector_p (SCM obj);
|
||||
|
|
@ -73,6 +75,7 @@ SCM_API SCM scm_u16vector_ref (SCM uvec, SCM index);
|
|||
SCM_API SCM scm_u16vector_set_x (SCM uvec, SCM index, SCM value);
|
||||
SCM_API SCM scm_u16vector_to_list (SCM uvec);
|
||||
SCM_API SCM scm_list_to_u16vector (SCM l);
|
||||
SCM_API SCM scm_any_to_u16vector (SCM obj);
|
||||
SCM_API scm_t_uint16 *scm_u16vector_elements (SCM uvec);
|
||||
|
||||
SCM_API SCM scm_s16vector_p (SCM obj);
|
||||
|
|
@ -84,6 +87,7 @@ SCM_API SCM scm_s16vector_ref (SCM uvec, SCM index);
|
|||
SCM_API SCM scm_s16vector_set_x (SCM uvec, SCM index, SCM value);
|
||||
SCM_API SCM scm_s16vector_to_list (SCM uvec);
|
||||
SCM_API SCM scm_list_to_s16vector (SCM l);
|
||||
SCM_API SCM scm_any_to_s16vector (SCM obj);
|
||||
SCM_API scm_t_int16 *scm_s16vector_elements (SCM uvec);
|
||||
|
||||
SCM_API SCM scm_u32vector_p (SCM obj);
|
||||
|
|
@ -95,6 +99,7 @@ SCM_API SCM scm_u32vector_ref (SCM uvec, SCM index);
|
|||
SCM_API SCM scm_u32vector_set_x (SCM uvec, SCM index, SCM value);
|
||||
SCM_API SCM scm_u32vector_to_list (SCM uvec);
|
||||
SCM_API SCM scm_list_to_u32vector (SCM l);
|
||||
SCM_API SCM scm_any_to_u32vector (SCM obj);
|
||||
SCM_API scm_t_uint32 *scm_u32vector_elements (SCM uvec);
|
||||
|
||||
SCM_API SCM scm_s32vector_p (SCM obj);
|
||||
|
|
@ -106,6 +111,7 @@ SCM_API SCM scm_s32vector_ref (SCM uvec, SCM index);
|
|||
SCM_API SCM scm_s32vector_set_x (SCM uvec, SCM index, SCM value);
|
||||
SCM_API SCM scm_s32vector_to_list (SCM uvec);
|
||||
SCM_API SCM scm_list_to_s32vector (SCM l);
|
||||
SCM_API SCM scm_any_to_s32vector (SCM obj);
|
||||
SCM_API scm_t_int32 *scm_s32vector_elements (SCM uvec);
|
||||
|
||||
SCM_API SCM scm_u64vector_p (SCM obj);
|
||||
|
|
@ -117,6 +123,7 @@ SCM_API SCM scm_u64vector_ref (SCM uvec, SCM index);
|
|||
SCM_API SCM scm_u64vector_set_x (SCM uvec, SCM index, SCM value);
|
||||
SCM_API SCM scm_u64vector_to_list (SCM uvec);
|
||||
SCM_API SCM scm_list_to_u64vector (SCM l);
|
||||
SCM_API SCM scm_any_to_u64vector (SCM obj);
|
||||
SCM_API scm_t_uint64 *scm_u64vector_elements (SCM uvec);
|
||||
|
||||
SCM_API SCM scm_s64vector_p (SCM obj);
|
||||
|
|
@ -128,6 +135,7 @@ SCM_API SCM scm_s64vector_ref (SCM uvec, SCM index);
|
|||
SCM_API SCM scm_s64vector_set_x (SCM uvec, SCM index, SCM value);
|
||||
SCM_API SCM scm_s64vector_to_list (SCM uvec);
|
||||
SCM_API SCM scm_list_to_s64vector (SCM l);
|
||||
SCM_API SCM scm_any_to_s64vector (SCM obj);
|
||||
SCM_API scm_t_int64 *scm_s64vector_elements (SCM uvec);
|
||||
|
||||
SCM_API SCM scm_f32vector_p (SCM obj);
|
||||
|
|
@ -139,6 +147,7 @@ SCM_API SCM scm_f32vector_ref (SCM uvec, SCM index);
|
|||
SCM_API SCM scm_f32vector_set_x (SCM uvec, SCM index, SCM value);
|
||||
SCM_API SCM scm_f32vector_to_list (SCM uvec);
|
||||
SCM_API SCM scm_list_to_f32vector (SCM l);
|
||||
SCM_API SCM scm_any_to_f32vector (SCM obj);
|
||||
SCM_API float *scm_f32vector_elements (SCM uvec);
|
||||
|
||||
SCM_API SCM scm_f64vector_p (SCM obj);
|
||||
|
|
@ -150,6 +159,7 @@ SCM_API SCM scm_f64vector_ref (SCM uvec, SCM index);
|
|||
SCM_API SCM scm_f64vector_set_x (SCM uvec, SCM index, SCM value);
|
||||
SCM_API SCM scm_f64vector_to_list (SCM uvec);
|
||||
SCM_API SCM scm_list_to_f64vector (SCM l);
|
||||
SCM_API SCM scm_any_to_f64vector (SCM obj);
|
||||
SCM_API double *scm_f64vector_elements (SCM uvec);
|
||||
|
||||
SCM_API SCM scm_c32vector_p (SCM obj);
|
||||
|
|
@ -161,6 +171,7 @@ SCM_API SCM scm_c32vector_ref (SCM uvec, SCM index);
|
|||
SCM_API SCM scm_c32vector_set_x (SCM uvec, SCM index, SCM value);
|
||||
SCM_API SCM scm_c32vector_to_list (SCM uvec);
|
||||
SCM_API SCM scm_list_to_c32vector (SCM l);
|
||||
SCM_API SCM scm_any_to_c32vector (SCM obj);
|
||||
SCM_API float *scm_c32vector_elements (SCM uvec);
|
||||
|
||||
SCM_API SCM scm_c64vector_p (SCM obj);
|
||||
|
|
@ -172,6 +183,7 @@ SCM_API SCM scm_c64vector_ref (SCM uvec, SCM index);
|
|||
SCM_API SCM scm_c64vector_set_x (SCM uvec, SCM index, SCM value);
|
||||
SCM_API SCM scm_c64vector_to_list (SCM uvec);
|
||||
SCM_API SCM scm_list_to_c64vector (SCM l);
|
||||
SCM_API SCM scm_any_to_c64vector (SCM obj);
|
||||
SCM_API double *scm_c64vector_elements (SCM uvec);
|
||||
|
||||
SCM_API SCM scm_i_uniform_vector_creator (SCM uvec);
|
||||
|
|
|
|||
|
|
@ -127,6 +127,17 @@ SCM_DEFINE (F(scm_list_to_,TAG,vector), "list->"S(TAG)"vector", 1, 0, 0,
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE (F(scm_any_to_,TAG,vector), "any->"S(TAG)"vector", 1, 0, 0,
|
||||
(SCM obj),
|
||||
"Convert @var{obj}, which can be a list, vector, or\n"
|
||||
"homogenous vector, to a numeric homogenous vector of\n"
|
||||
"type " S(TAG)".")
|
||||
#define FUNC_NAME s_F(scm_any_to_,TAG,vector)
|
||||
{
|
||||
return coerce_to_uvec (TYPE, obj);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
CTYPE *
|
||||
F(scm_,TAG,vector_elements) (SCM obj)
|
||||
{
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue