mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 14:00:21 +02:00
(indices_to_pos, scm_array_handle_pos): Renamed
former to latter and made public. Changed all uses. (scm_i_make_ra): Made public, changed tag param to enclosed flag. (scm_make_ra): Deprecated, changed all uses to scm_i_make_ra. (scm_i_shap2ra): New internal version of scm_shap2ra. (scm_shap2ra): Deprecated, changed all uses to scm_i_shap2ra. (scm_i_ra_set_contp): New internal version of scm_ra_set_contp. (scm_ra_set_contp): Deprecated, changed all uses to scm_i_ra_set_contp. (scm_cvref, scm_aind, scm_raprin1): Deprecated.
This commit is contained in:
Marius Vollmer
parent
32ef775128
commit
0cd6cb2fb2
2 changed files with 110 additions and 101 deletions
185
libguile/unif.c
185
libguile/unif.c
|
|
@ -209,7 +209,7 @@ scm_i_get_old_prototype (SCM uvec)
|
|||
scm_misc_error (NULL, "~a has no prototype", scm_list_1 (uvec));
|
||||
}
|
||||
|
||||
SCM
|
||||
SCM
|
||||
scm_make_uve (long k, SCM prot)
|
||||
#define FUNC_NAME "scm_make_uve"
|
||||
{
|
||||
|
|
@ -622,46 +622,8 @@ SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0,
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
static char s_bad_ind[] = "Bad scm_array index";
|
||||
|
||||
|
||||
long
|
||||
scm_aind (SCM ra, SCM args, const char *what)
|
||||
{
|
||||
SCM ind;
|
||||
register long j;
|
||||
register unsigned long pos = SCM_ARRAY_BASE (ra);
|
||||
register unsigned long k = SCM_ARRAY_NDIM (ra);
|
||||
scm_t_array_dim *s = SCM_ARRAY_DIMS (ra);
|
||||
|
||||
if (scm_is_integer (args))
|
||||
{
|
||||
if (k != 1)
|
||||
scm_error_num_args_subr (what);
|
||||
return pos + (scm_to_long (args) - s->lbnd) * (s->inc);
|
||||
}
|
||||
while (k && scm_is_pair (args))
|
||||
{
|
||||
ind = SCM_CAR (args);
|
||||
args = SCM_CDR (args);
|
||||
if (!scm_is_integer (ind))
|
||||
scm_misc_error (what, s_bad_ind, SCM_EOL);
|
||||
j = scm_to_long (ind);
|
||||
if (j < s->lbnd || j > s->ubnd)
|
||||
scm_out_of_range (what, ind);
|
||||
pos += (j - s->lbnd) * (s->inc);
|
||||
k--;
|
||||
s++;
|
||||
}
|
||||
if (k != 0 || !scm_is_null (args))
|
||||
scm_error_num_args_subr (what);
|
||||
|
||||
return pos;
|
||||
}
|
||||
|
||||
static ssize_t
|
||||
indices_to_pos (scm_t_array_handle *h, SCM indices)
|
||||
ssize_t
|
||||
scm_array_handle_pos (scm_t_array_handle *h, SCM indices)
|
||||
{
|
||||
scm_t_array_dim *s = scm_array_handle_dims (h);
|
||||
ssize_t pos = 0, i;
|
||||
|
|
@ -681,9 +643,10 @@ indices_to_pos (scm_t_array_handle *h, SCM indices)
|
|||
return pos;
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_i_make_ra (int ndim, scm_t_bits tag)
|
||||
SCM
|
||||
scm_i_make_ra (int ndim, int enclosed)
|
||||
{
|
||||
scm_t_bits tag = enclosed? scm_tc16_enclosed_array : scm_tc16_array;
|
||||
SCM ra;
|
||||
SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + tag,
|
||||
scm_gc_malloc ((sizeof (scm_t_array) +
|
||||
|
|
@ -693,28 +656,21 @@ scm_i_make_ra (int ndim, scm_t_bits tag)
|
|||
return ra;
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_make_ra (int ndim)
|
||||
{
|
||||
return scm_i_make_ra (ndim, scm_tc16_array);
|
||||
}
|
||||
|
||||
|
||||
static char s_bad_spec[] = "Bad scm_array dimension";
|
||||
|
||||
|
||||
/* Increments will still need to be set. */
|
||||
|
||||
SCM
|
||||
scm_shap2ra (SCM args, const char *what)
|
||||
static SCM
|
||||
scm_i_shap2ra (SCM args)
|
||||
{
|
||||
scm_t_array_dim *s;
|
||||
SCM ra, spec, sp;
|
||||
int ndim = scm_ilength (args);
|
||||
if (ndim < 0)
|
||||
scm_misc_error (what, s_bad_spec, SCM_EOL);
|
||||
scm_misc_error (NULL, s_bad_spec, SCM_EOL);
|
||||
|
||||
ra = scm_make_ra (ndim);
|
||||
ra = scm_i_make_ra (ndim, 0);
|
||||
SCM_ARRAY_BASE (ra) = 0;
|
||||
s = SCM_ARRAY_DIMS (ra);
|
||||
for (; !scm_is_null (args); s++, args = SCM_CDR (args))
|
||||
|
|
@ -723,7 +679,7 @@ scm_shap2ra (SCM args, const char *what)
|
|||
if (scm_is_integer (spec))
|
||||
{
|
||||
if (scm_to_long (spec) < 0)
|
||||
scm_misc_error (what, s_bad_spec, SCM_EOL);
|
||||
scm_misc_error (NULL, s_bad_spec, SCM_EOL);
|
||||
s->lbnd = 0;
|
||||
s->ubnd = scm_to_long (spec) - 1;
|
||||
s->inc = 1;
|
||||
|
|
@ -731,13 +687,13 @@ scm_shap2ra (SCM args, const char *what)
|
|||
else
|
||||
{
|
||||
if (!scm_is_pair (spec) || !scm_is_integer (SCM_CAR (spec)))
|
||||
scm_misc_error (what, s_bad_spec, SCM_EOL);
|
||||
scm_misc_error (NULL, s_bad_spec, SCM_EOL);
|
||||
s->lbnd = scm_to_long (SCM_CAR (spec));
|
||||
sp = SCM_CDR (spec);
|
||||
if (!scm_is_pair (sp)
|
||||
|| !scm_is_integer (SCM_CAR (sp))
|
||||
|| !scm_is_null (SCM_CDR (sp)))
|
||||
scm_misc_error (what, s_bad_spec, SCM_EOL);
|
||||
scm_misc_error (NULL, s_bad_spec, SCM_EOL);
|
||||
s->ubnd = scm_to_long (SCM_CAR (sp));
|
||||
s->inc = 1;
|
||||
}
|
||||
|
|
@ -756,7 +712,7 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
|
|||
SCM ra;
|
||||
|
||||
creator = type_to_creator (type);
|
||||
ra = scm_shap2ra (bounds, FUNC_NAME);
|
||||
ra = scm_i_shap2ra (bounds);
|
||||
SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
|
||||
s = SCM_ARRAY_DIMS (ra);
|
||||
k = SCM_ARRAY_NDIM (ra);
|
||||
|
|
@ -812,8 +768,8 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1,
|
|||
|
||||
#endif
|
||||
|
||||
void
|
||||
scm_ra_set_contp (SCM ra)
|
||||
static void
|
||||
scm_i_ra_set_contp (SCM ra)
|
||||
{
|
||||
size_t k = SCM_ARRAY_NDIM (ra);
|
||||
if (k)
|
||||
|
|
@ -864,7 +820,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
|
|||
|
||||
SCM_VALIDATE_REST_ARGUMENT (dims);
|
||||
SCM_VALIDATE_PROC (2, mapfunc);
|
||||
ra = scm_shap2ra (dims, FUNC_NAME);
|
||||
ra = scm_i_shap2ra (dims);
|
||||
|
||||
scm_array_get_handle (oldra, &old_handle);
|
||||
|
||||
|
|
@ -906,7 +862,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
|
|||
}
|
||||
|
||||
imap = scm_apply_0 (mapfunc, scm_reverse (inds));
|
||||
i = indices_to_pos (&old_handle, imap);
|
||||
i = scm_array_handle_pos (&old_handle, imap);
|
||||
SCM_ARRAY_BASE (ra) = new_min = new_max = i;
|
||||
indptr = inds;
|
||||
k = SCM_ARRAY_NDIM (ra);
|
||||
|
|
@ -916,7 +872,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
|
|||
{
|
||||
SCM_SETCAR (indptr, scm_sum (SCM_CAR (indptr), scm_from_int (1)));
|
||||
imap = scm_apply_0 (mapfunc, scm_reverse (inds));
|
||||
s[k].inc = indices_to_pos (&old_handle, imap) - i;
|
||||
s[k].inc = scm_array_handle_pos (&old_handle, imap) - i;
|
||||
i += s[k].inc;
|
||||
if (s[k].inc > 0)
|
||||
new_max += (s[k].ubnd - s[k].lbnd) * s[k].inc;
|
||||
|
|
@ -941,7 +897,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
|
|||
if (s->ubnd < s->lbnd)
|
||||
return make_typed_vector (scm_array_type (ra), 0);
|
||||
}
|
||||
scm_ra_set_contp (ra);
|
||||
scm_i_ra_set_contp (ra);
|
||||
return ra;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
|
@ -1004,7 +960,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
|
|||
ndim = i;
|
||||
}
|
||||
ndim++;
|
||||
res = scm_make_ra (ndim);
|
||||
res = scm_i_make_ra (ndim, 0);
|
||||
SCM_ARRAY_V (res) = SCM_ARRAY_V (ra);
|
||||
SCM_ARRAY_BASE (res) = SCM_ARRAY_BASE (ra);
|
||||
for (k = ndim; k--;)
|
||||
|
|
@ -1038,7 +994,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
|
|||
}
|
||||
if (ndim > 0)
|
||||
SCM_MISC_ERROR ("bad argument list", SCM_EOL);
|
||||
scm_ra_set_contp (res);
|
||||
scm_i_ra_set_contp (res);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -1080,7 +1036,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
|
|||
ninr = scm_ilength (axes);
|
||||
if (ninr < 0)
|
||||
SCM_WRONG_NUM_ARGS ();
|
||||
ra_inr = scm_make_ra (ninr);
|
||||
ra_inr = scm_i_make_ra (ninr, 0);
|
||||
|
||||
if (scm_is_generalized_vector (ra))
|
||||
{
|
||||
|
|
@ -1105,7 +1061,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
|
|||
if (noutr < 0)
|
||||
SCM_WRONG_NUM_ARGS ();
|
||||
axv = scm_make_string (scm_from_int (ndim), SCM_MAKE_CHAR (0));
|
||||
res = scm_i_make_ra (noutr, scm_tc16_enclosed_array);
|
||||
res = scm_i_make_ra (noutr, 1);
|
||||
SCM_ARRAY_BASE (res) = SCM_ARRAY_BASE (ra_inr);
|
||||
SCM_ARRAY_V (res) = ra_inr;
|
||||
for (k = 0; k < ninr; k++, axes = SCM_CDR (axes))
|
||||
|
|
@ -1128,8 +1084,8 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
|
|||
SCM_ARRAY_DIMS (res)[k].inc = s[j].inc;
|
||||
}
|
||||
scm_remember_upto_here_1 (axv);
|
||||
scm_ra_set_contp (ra_inr);
|
||||
scm_ra_set_contp (res);
|
||||
scm_i_ra_set_contp (ra_inr);
|
||||
scm_i_ra_set_contp (res);
|
||||
return res;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
|
@ -1198,7 +1154,7 @@ scm_i_cvref (SCM v, size_t pos, int enclosed)
|
|||
if (enclosed)
|
||||
{
|
||||
int k = SCM_ARRAY_NDIM (v);
|
||||
SCM res = scm_make_ra (k);
|
||||
SCM res = scm_i_make_ra (k, 0);
|
||||
SCM_ARRAY_V (res) = SCM_ARRAY_V (v);
|
||||
SCM_ARRAY_BASE (res) = pos;
|
||||
while (k--)
|
||||
|
|
@ -1213,12 +1169,6 @@ scm_i_cvref (SCM v, size_t pos, int enclosed)
|
|||
return scm_c_generalized_vector_ref (v, pos);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_cvref (SCM v, unsigned long pos, SCM last)
|
||||
{
|
||||
return scm_i_cvref (v, pos, 0);
|
||||
}
|
||||
|
||||
SCM_DEFINE (scm_array_ref, "array-ref", 1, 0, 1,
|
||||
(SCM v, SCM args),
|
||||
"Return the element at the @code{(index1, index2)} element in\n"
|
||||
|
|
@ -1229,7 +1179,7 @@ SCM_DEFINE (scm_array_ref, "array-ref", 1, 0, 1,
|
|||
SCM res;
|
||||
|
||||
scm_array_get_handle (v, &handle);
|
||||
res = scm_array_handle_ref (&handle, indices_to_pos (&handle, args));
|
||||
res = scm_array_handle_ref (&handle, scm_array_handle_pos (&handle, args));
|
||||
scm_array_handle_release (&handle);
|
||||
return res;
|
||||
}
|
||||
|
|
@ -1245,7 +1195,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
|
|||
scm_t_array_handle handle;
|
||||
|
||||
scm_array_get_handle (v, &handle);
|
||||
scm_array_handle_set (&handle, indices_to_pos (&handle, args), obj);
|
||||
scm_array_handle_set (&handle, scm_array_handle_pos (&handle, args), obj);
|
||||
scm_array_handle_release (&handle);
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
|
@ -1300,7 +1250,7 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
|
|||
return v;
|
||||
}
|
||||
|
||||
sra = scm_make_ra (1);
|
||||
sra = scm_i_make_ra (1, 0);
|
||||
SCM_ARRAY_DIMS (sra)->lbnd = 0;
|
||||
SCM_ARRAY_DIMS (sra)->ubnd = len - 1;
|
||||
SCM_ARRAY_V (sra) = SCM_ARRAY_V (ra);
|
||||
|
|
@ -1334,7 +1284,7 @@ scm_ra2contig (SCM ra, int copy)
|
|||
0 == len % SCM_LONG_BIT))
|
||||
return ra;
|
||||
}
|
||||
ret = scm_make_ra (k);
|
||||
ret = scm_i_make_ra (k, 0);
|
||||
SCM_ARRAY_BASE (ret) = 0;
|
||||
while (k--)
|
||||
{
|
||||
|
|
@ -2244,7 +2194,7 @@ SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0,
|
|||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM
|
||||
SCM
|
||||
scm_istr2bve (SCM str)
|
||||
{
|
||||
scm_t_array_handle handle;
|
||||
|
|
@ -2800,13 +2750,6 @@ scm_i_read_array (SCM port, int c)
|
|||
return scm_list_to_typed_array (tag_to_type (tag, port), shape, elements);
|
||||
}
|
||||
|
||||
int
|
||||
scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate)
|
||||
{
|
||||
scm_iprin1 (exp, port, pstate);
|
||||
return 1;
|
||||
}
|
||||
|
||||
SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0,
|
||||
(SCM ra),
|
||||
"")
|
||||
|
|
@ -2861,6 +2804,70 @@ array_free (SCM ptr)
|
|||
return 0;
|
||||
}
|
||||
|
||||
#if SCM_ENABLE_DEPRECATED
|
||||
|
||||
SCM
|
||||
scm_make_ra (int ndim)
|
||||
{
|
||||
scm_c_issue_deprecation_warning
|
||||
("scm_make_ra is deprecated. Use scm_make_array or similar instead.");
|
||||
return scm_i_make_ra (ndim, 0);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_shap2ra (SCM args, const char *what)
|
||||
{
|
||||
scm_c_issue_deprecation_warning
|
||||
("scm_shap2ra is deprecated. Use scm_make_array or similar instead.");
|
||||
return scm_i_shap2ra (args);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_cvref (SCM v, unsigned long pos, SCM last)
|
||||
{
|
||||
scm_c_issue_deprecation_warning
|
||||
("scm_cvref is deprecated. Use scm_c_generalized_vector_ref instead.");
|
||||
return scm_c_generalized_vector_ref (v, pos);
|
||||
}
|
||||
|
||||
void
|
||||
scm_ra_set_contp (SCM ra)
|
||||
{
|
||||
scm_c_issue_deprecation_warning
|
||||
("scm_ra_set_contp is deprecated. There should be no need for it.");
|
||||
scm_i_ra_set_contp (ra);
|
||||
}
|
||||
|
||||
long
|
||||
scm_aind (SCM ra, SCM args, const char *what)
|
||||
{
|
||||
scm_t_array_handle handle;
|
||||
ssize_t pos;
|
||||
|
||||
scm_c_issue_deprecation_warning
|
||||
("scm_aind is deprecated. Use scm_array_handle_pos instead.");
|
||||
|
||||
if (scm_is_integer (args))
|
||||
args = scm_list_1 (args);
|
||||
|
||||
scm_array_get_handle (ra, &handle);
|
||||
pos = scm_array_handle_pos (&handle, args);
|
||||
scm_array_handle_release (&handle);
|
||||
return pos;
|
||||
}
|
||||
|
||||
int
|
||||
scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate)
|
||||
{
|
||||
scm_c_issue_deprecation_warning
|
||||
("scm_raprin1 is deprecated. Use scm_display or scm_write instead.");
|
||||
|
||||
scm_iprin1 (exp, port, pstate);
|
||||
return 1;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
void
|
||||
scm_init_unif ()
|
||||
{
|
||||
|
|
|
|||
|
|
@ -94,7 +94,7 @@ SCM_API SCM scm_array_type (SCM ra);
|
|||
SCM_API int scm_is_array (SCM obj);
|
||||
SCM_API int scm_is_typed_array (SCM obj, SCM type);
|
||||
|
||||
SCM_API SCM scm_i_read_array (SCM port, int c);
|
||||
SCM_API SCM scm_ra2contig (SCM ra, int copy);
|
||||
|
||||
struct scm_t_array_handle;
|
||||
|
||||
|
|
@ -115,6 +115,7 @@ typedef struct scm_t_array_handle {
|
|||
SCM_API void scm_array_get_handle (SCM array, scm_t_array_handle *h);
|
||||
SCM_API size_t scm_array_handle_rank (scm_t_array_handle *h);
|
||||
SCM_API scm_t_array_dim *scm_array_handle_dims (scm_t_array_handle *h);
|
||||
SCM_API ssize_t scm_array_handle_pos (scm_t_array_handle *h, SCM indices);
|
||||
SCM_API const SCM *scm_array_handle_elements (scm_t_array_handle *h);
|
||||
SCM_API SCM *scm_array_handle_writable_elements (scm_t_array_handle *h);
|
||||
SCM_API void scm_array_handle_release (scm_t_array_handle *h);
|
||||
|
|
@ -139,6 +140,7 @@ SCM_API SCM scm_bit_position (SCM item, SCM v, SCM k);
|
|||
SCM_API SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);
|
||||
SCM_API SCM scm_bit_count_star (SCM v, SCM kv, SCM obj);
|
||||
SCM_API SCM scm_bit_invert_x (SCM v);
|
||||
SCM_API SCM scm_istr2bve (SCM str);
|
||||
|
||||
SCM_API int scm_is_bitvector (SCM obj);
|
||||
SCM_API SCM scm_c_make_bitvector (size_t len, SCM fill);
|
||||
|
|
@ -159,6 +161,12 @@ SCM_API scm_t_uint32 *scm_bitvector_writable_elements (SCM vec,
|
|||
size_t *lenp,
|
||||
ssize_t *incp);
|
||||
|
||||
/* internal. */
|
||||
|
||||
SCM_API SCM scm_i_make_ra (int ndim, int enclosed);
|
||||
SCM_API SCM scm_i_cvref (SCM v, size_t p, int enclosed);
|
||||
SCM_API SCM scm_i_read_array (SCM port, int c);
|
||||
|
||||
/* deprecated. */
|
||||
|
||||
#if SCM_ENABLE_DEPRECATED
|
||||
|
|
@ -167,19 +175,13 @@ SCM_API SCM scm_make_uve (long k, SCM prot);
|
|||
SCM_API SCM scm_array_prototype (SCM ra);
|
||||
SCM_API SCM scm_list_to_uniform_array (SCM ndim, SCM prot, SCM lst);
|
||||
SCM_API SCM scm_dimensions_to_uniform_array (SCM dims, SCM prot, SCM fill);
|
||||
|
||||
#endif
|
||||
|
||||
SCM_API SCM scm_make_ra (int ndim);
|
||||
SCM_API void scm_ra_set_contp (SCM ra);
|
||||
SCM_API SCM scm_cvref (SCM v, unsigned long pos, SCM last);
|
||||
SCM_API SCM scm_istr2bve (SCM str);
|
||||
SCM_API int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate);
|
||||
SCM_API long scm_aind (SCM ra, SCM args, const char *what);
|
||||
SCM_API SCM scm_shap2ra (SCM args, const char *what);
|
||||
SCM_API SCM scm_ra2contig (SCM ra, int copy);
|
||||
|
||||
SCM_API SCM scm_i_cvref (SCM v, size_t p, int enclosed);
|
||||
SCM_API SCM scm_cvref (SCM v, unsigned long pos, SCM last);
|
||||
SCM_API void scm_ra_set_contp (SCM ra);
|
||||
SCM_API long scm_aind (SCM ra, SCM args, const char *what);
|
||||
SCM_API int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate);
|
||||
#endif
|
||||
|
||||
SCM_API void scm_init_unif (void);
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue