diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 2000-04-13 03:44:51 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 2000-04-13 03:44:51 +0000 |
commit | e2d373365bf0962bed7d66b5a5d5d4543caa67a1 (patch) | |
tree | 356f727217695b9caad2c542cfbd4a8fdcca9c9d /libguile/unif.c | |
parent | a401a730c912d1ebbc59d8a04d511458b37a4bee (diff) | |
download | guile-e2d373365bf0962bed7d66b5a5d5d4543caa67a1.tar.gz |
* unif.c, unif.h (shared-array-root, shared-array-offset,
shared-array-increments): New primitives.
Diffstat (limited to 'libguile/unif.c')
-rw-r--r-- | libguile/unif.c | 49 |
1 files changed, 46 insertions, 3 deletions
diff --git a/libguile/unif.c b/libguile/unif.c index 3eeaa85fa..f61f4e3b1 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -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"; |