mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

* unif.c, unif.h (shared-array-root, shared-array-offset,

Browse source 
shared-array-increments): New primitives.
This commit is contained in:
Mikael Djurfeldt 2000-04-13 03:44:51 +00:00
parent a401a730c9
commit e2d373365b
2 changed files with 49 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

49
libguile/unif.c
View file

@ -406,15 +406,58 @@ SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 0,
k = SCM_ARRAY_NDIM (ra);
s = SCM_ARRAY_DIMS (ra);
while (k--)
res = scm_cons (s[k].lbnd ? scm_cons2 (SCM_MAKINUM (s[k].lbnd), SCM_MAKINUM (s[k].ubnd), SCM_EOL) :
SCM_MAKINUM (1 + (s[k].ubnd))
, res);
res = scm_cons (s[k].lbnd
? scm_cons2 (SCM_MAKINUM (s[k].lbnd),
SCM_MAKINUM (s[k].ubnd),
SCM_EOL)
: SCM_MAKINUM (1 + s[k].ubnd),
res);
return res;
}
}
#undef FUNC_NAME
SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0,
(SCM ra),
"Return the root vector of a shared array.")
#define FUNC_NAME s_scm_shared_array_root
{
SCM_ASSERT (SCM_ARRAYP (ra), ra, SCM_ARG1, FUNC_NAME);
return SCM_ARRAY_V (ra);
}
#undef FUNC_NAME
SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0,
(SCM ra),
"Return the root vector index of the first element in the array.")
#define FUNC_NAME s_scm_shared_array_offset
{
SCM_ASSERT (SCM_ARRAYP (ra), ra, SCM_ARG1, FUNC_NAME);
return SCM_MAKINUM (SCM_ARRAY_BASE (ra));
}
#undef FUNC_NAME
SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0,
(SCM ra),
"For each dimension, return the distance between elements in the root vector.")
#define FUNC_NAME s_scm_shared_array_increments
{
SCM res = SCM_EOL;
scm_sizet k;
scm_array_dim *s;
SCM_ASSERT (SCM_ARRAYP (ra), ra, SCM_ARG1, FUNC_NAME);
k = SCM_ARRAY_NDIM (ra);
s = SCM_ARRAY_DIMS (ra);
while (k--)
res = scm_cons (SCM_MAKINUM (s[k].inc), res);
return res;
}
#undef FUNC_NAME
static char s_bad_ind[] = "Bad scm_array index";

3
libguile/unif.h
View file

@ -101,6 +101,9 @@ extern SCM scm_uniform_vector_length (SCM v);
extern SCM scm_array_p (SCM v, SCM prot);
extern SCM scm_array_rank (SCM ra);
extern SCM scm_array_dimensions (SCM ra);
extern SCM scm_shared_array_root (SCM ra);
extern SCM scm_shared_array_offset (SCM ra);
extern SCM scm_shared_array_increments (SCM ra);
extern long scm_aind (SCM ra, SCM args, const char *what);
extern SCM scm_make_ra (int ndim);
extern SCM scm_shap2ra (SCM args, const char *what);