mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

(SCM_ARRAYP, SCM_I_ARRAYP): Renamed former to latter internal

Browse source 
version.  Changed all uses.
(scm_tc16_array, scm_i_tc16_array,
scm_tc16_enclosed_array, scm_i_tc16_enclosed_array,
SCM_ARRAY_FLAG_CONTIGUOUS, SCM_I_ARRAY_FLAG_CONTIGUOUS,
SCM_ENCLOSE_ARRAYP, SCM_I_ENCLOSE_ARRAYP,
SCM_ARRAY_NDIM, SCM_I_ARRAY_NDIM,
SCM_ARRAY_CONTP, SCM_I_ARRAY_CONTP,
SCM_ARRAY_MEM, SCM_I_ARRAY_MEM,
SCM_ARRAY_V, SCM_I_ARRAY_V,
SCM_ARRAY_BASE, SCM_I_ARRAY_BASE,
SCM_ARRAY_DIMS, SCM_I_ARRAY_DIMS,
scm_t_array, scm_i_t_array): Likewise.
(SCM_SET_ARRAY_CONTIGUOUS_FLAG, SCM_CLR_ARRAY_CONTIGUOUS_FLAG):
Moved from unif.h to unif.c.
(scm_c_array_rank): New.
(scm_array_rank): Reimplement using it.
This commit is contained in:
Marius Vollmer 2005-01-11 16:55:38 +00:00
parent 1f366ef7f0
commit 04b87de561
6 changed files with 435 additions and 425 deletions
Download patch file Download diff file Expand all files Collapse all files

390
libguile/ramap.c
View file

@ -84,11 +84,11 @@ cind (SCM ra, long *ve)
{ {
unsigned long i; unsigned long i;
int k; int k;
if (!SCM_ARRAYP (ra)) if (!SCM_I_ARRAYP (ra))
return *ve; return *ve;
i = SCM_ARRAY_BASE (ra); i = SCM_I_ARRAY_BASE (ra);
for (k = 0; k < SCM_ARRAY_NDIM (ra); k++) for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
i += (ve[k] - SCM_ARRAY_DIMS (ra)[k].lbnd) * SCM_ARRAY_DIMS (ra)[k].inc; i += (ve[k] - SCM_I_ARRAY_DIMS (ra)[k].lbnd) * SCM_I_ARRAY_DIMS (ra)[k].inc;
return i; return i;
} }
@ -118,11 +118,11 @@ scm_ra_matchp (SCM ra0, SCM ras)
s0->inc = 1; s0->inc = 1;
s0->ubnd = scm_c_generalized_vector_length (ra0) - 1; s0->ubnd = scm_c_generalized_vector_length (ra0) - 1;
} }
else if (SCM_ARRAYP (ra0)) else if (SCM_I_ARRAYP (ra0))
{ {
ndim = SCM_ARRAY_NDIM (ra0); ndim = SCM_I_ARRAY_NDIM (ra0);
s0 = SCM_ARRAY_DIMS (ra0); s0 = SCM_I_ARRAY_DIMS (ra0);
bas0 = SCM_ARRAY_BASE (ra0); bas0 = SCM_I_ARRAY_BASE (ra0);
} }
else else
return 0; return 0;
@ -157,10 +157,10 @@ scm_ra_matchp (SCM ra0, SCM ras)
return 0; return 0;
} }
} }
else if (SCM_ARRAYP (ra1) && ndim == SCM_ARRAY_NDIM (ra1)) else if (SCM_I_ARRAYP (ra1) && ndim == SCM_I_ARRAY_NDIM (ra1))
{ {
s1 = SCM_ARRAY_DIMS (ra1); s1 = SCM_I_ARRAY_DIMS (ra1);
if (bas0 != SCM_ARRAY_BASE (ra1)) if (bas0 != SCM_I_ARRAY_BASE (ra1))
exact = 3; exact = 3;
for (i = 0; i < ndim; i++) for (i = 0; i < ndim; i++)
switch (exact) switch (exact)
@ -211,20 +211,20 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
case 2: case 2:
case 3: case 3:
case 4: /* Try unrolling arrays */ case 4: /* Try unrolling arrays */
kmax = (SCM_ARRAYP (ra0) ? SCM_ARRAY_NDIM (ra0) - 1 : 0); kmax = (SCM_I_ARRAYP (ra0) ? SCM_I_ARRAY_NDIM (ra0) - 1 : 0);
if (kmax < 0) if (kmax < 0)
goto gencase; goto gencase;
vra0 = scm_array_contents (ra0, SCM_UNDEFINED); vra0 = scm_array_contents (ra0, SCM_UNDEFINED);
if (SCM_IMP (vra0)) goto gencase; if (SCM_IMP (vra0)) goto gencase;
if (!SCM_ARRAYP (vra0)) if (!SCM_I_ARRAYP (vra0))
{ {
size_t length = scm_c_generalized_vector_length (vra0); size_t length = scm_c_generalized_vector_length (vra0);
vra1 = scm_i_make_ra (1, 0); vra1 = scm_i_make_ra (1, 0);
SCM_ARRAY_BASE (vra1) = 0; SCM_I_ARRAY_BASE (vra1) = 0;
SCM_ARRAY_DIMS (vra1)->lbnd = 0; SCM_I_ARRAY_DIMS (vra1)->lbnd = 0;
SCM_ARRAY_DIMS (vra1)->ubnd = length - 1; SCM_I_ARRAY_DIMS (vra1)->ubnd = length - 1;
SCM_ARRAY_DIMS (vra1)->inc = 1; SCM_I_ARRAY_DIMS (vra1)->inc = 1;
SCM_ARRAY_V (vra1) = vra0; SCM_I_ARRAY_V (vra1) = vra0;
vra0 = vra1; vra0 = vra1;
} }
lvra = SCM_EOL; lvra = SCM_EOL;
@ -233,21 +233,21 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
{ {
ra1 = SCM_CAR (z); ra1 = SCM_CAR (z);
vra1 = scm_i_make_ra (1, 0); vra1 = scm_i_make_ra (1, 0);
SCM_ARRAY_DIMS (vra1)->lbnd = SCM_ARRAY_DIMS (vra0)->lbnd; SCM_I_ARRAY_DIMS (vra1)->lbnd = SCM_I_ARRAY_DIMS (vra0)->lbnd;
SCM_ARRAY_DIMS (vra1)->ubnd = SCM_ARRAY_DIMS (vra0)->ubnd; SCM_I_ARRAY_DIMS (vra1)->ubnd = SCM_I_ARRAY_DIMS (vra0)->ubnd;
if (!SCM_ARRAYP (ra1)) if (!SCM_I_ARRAYP (ra1))
{ {
SCM_ARRAY_BASE (vra1) = 0; SCM_I_ARRAY_BASE (vra1) = 0;
SCM_ARRAY_DIMS (vra1)->inc = 1; SCM_I_ARRAY_DIMS (vra1)->inc = 1;
SCM_ARRAY_V (vra1) = ra1; SCM_I_ARRAY_V (vra1) = ra1;
} }
else if (!SCM_ARRAY_CONTP (ra1)) else if (!SCM_I_ARRAY_CONTP (ra1))
goto gencase; goto gencase;
else else
{ {
SCM_ARRAY_BASE (vra1) = SCM_ARRAY_BASE (ra1); SCM_I_ARRAY_BASE (vra1) = SCM_I_ARRAY_BASE (ra1);
SCM_ARRAY_DIMS (vra1)->inc = SCM_ARRAY_DIMS (ra1)[kmax].inc; SCM_I_ARRAY_DIMS (vra1)->inc = SCM_I_ARRAY_DIMS (ra1)[kmax].inc;
SCM_ARRAY_V (vra1) = SCM_ARRAY_V (ra1); SCM_I_ARRAY_V (vra1) = SCM_I_ARRAY_V (ra1);
} }
*plvra = scm_cons (vra1, SCM_EOL); *plvra = scm_cons (vra1, SCM_EOL);
plvra = SCM_CDRLOC (*plvra); plvra = SCM_CDRLOC (*plvra);
@ -256,33 +256,33 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
case 1: case 1:
gencase: /* Have to loop over all dimensions. */ gencase: /* Have to loop over all dimensions. */
vra0 = scm_i_make_ra (1, 0); vra0 = scm_i_make_ra (1, 0);
if (SCM_ARRAYP (ra0)) if (SCM_I_ARRAYP (ra0))
{ {
kmax = SCM_ARRAY_NDIM (ra0) - 1; kmax = SCM_I_ARRAY_NDIM (ra0) - 1;
if (kmax < 0) if (kmax < 0)
{ {
SCM_ARRAY_DIMS (vra0)->lbnd = 0; SCM_I_ARRAY_DIMS (vra0)->lbnd = 0;
SCM_ARRAY_DIMS (vra0)->ubnd = 0; SCM_I_ARRAY_DIMS (vra0)->ubnd = 0;
SCM_ARRAY_DIMS (vra0)->inc = 1; SCM_I_ARRAY_DIMS (vra0)->inc = 1;
} }
else else
{ {
SCM_ARRAY_DIMS (vra0)->lbnd = SCM_ARRAY_DIMS (ra0)[kmax].lbnd; SCM_I_ARRAY_DIMS (vra0)->lbnd = SCM_I_ARRAY_DIMS (ra0)[kmax].lbnd;
SCM_ARRAY_DIMS (vra0)->ubnd = SCM_ARRAY_DIMS (ra0)[kmax].ubnd; SCM_I_ARRAY_DIMS (vra0)->ubnd = SCM_I_ARRAY_DIMS (ra0)[kmax].ubnd;
SCM_ARRAY_DIMS (vra0)->inc = SCM_ARRAY_DIMS (ra0)[kmax].inc; SCM_I_ARRAY_DIMS (vra0)->inc = SCM_I_ARRAY_DIMS (ra0)[kmax].inc;
} }
SCM_ARRAY_BASE (vra0) = SCM_ARRAY_BASE (ra0); SCM_I_ARRAY_BASE (vra0) = SCM_I_ARRAY_BASE (ra0);
SCM_ARRAY_V (vra0) = SCM_ARRAY_V (ra0); SCM_I_ARRAY_V (vra0) = SCM_I_ARRAY_V (ra0);
} }
else else
{ {
size_t length = scm_c_generalized_vector_length (ra0); size_t length = scm_c_generalized_vector_length (ra0);
kmax = 0; kmax = 0;
SCM_ARRAY_DIMS (vra0)->lbnd = 0; SCM_I_ARRAY_DIMS (vra0)->lbnd = 0;
SCM_ARRAY_DIMS (vra0)->ubnd = length - 1; SCM_I_ARRAY_DIMS (vra0)->ubnd = length - 1;
SCM_ARRAY_DIMS (vra0)->inc = 1; SCM_I_ARRAY_DIMS (vra0)->inc = 1;
SCM_ARRAY_BASE (vra0) = 0; SCM_I_ARRAY_BASE (vra0) = 0;
SCM_ARRAY_V (vra0) = ra0; SCM_I_ARRAY_V (vra0) = ra0;
ra0 = vra0; ra0 = vra0;
} }
lvra = SCM_EOL; lvra = SCM_EOL;
@ -291,18 +291,18 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
{ {
ra1 = SCM_CAR (z); ra1 = SCM_CAR (z);
vra1 = scm_i_make_ra (1, 0); vra1 = scm_i_make_ra (1, 0);
SCM_ARRAY_DIMS (vra1)->lbnd = SCM_ARRAY_DIMS (vra0)->lbnd; SCM_I_ARRAY_DIMS (vra1)->lbnd = SCM_I_ARRAY_DIMS (vra0)->lbnd;
SCM_ARRAY_DIMS (vra1)->ubnd = SCM_ARRAY_DIMS (vra0)->ubnd; SCM_I_ARRAY_DIMS (vra1)->ubnd = SCM_I_ARRAY_DIMS (vra0)->ubnd;
if (SCM_ARRAYP (ra1)) if (SCM_I_ARRAYP (ra1))
{ {
if (kmax >= 0) if (kmax >= 0)
SCM_ARRAY_DIMS (vra1)->inc = SCM_ARRAY_DIMS (ra1)[kmax].inc; SCM_I_ARRAY_DIMS (vra1)->inc = SCM_I_ARRAY_DIMS (ra1)[kmax].inc;
SCM_ARRAY_V (vra1) = SCM_ARRAY_V (ra1); SCM_I_ARRAY_V (vra1) = SCM_I_ARRAY_V (ra1);
} }
else else
{ {
SCM_ARRAY_DIMS (vra1)->inc = 1; SCM_I_ARRAY_DIMS (vra1)->inc = 1;
SCM_ARRAY_V (vra1) = ra1; SCM_I_ARRAY_V (vra1) = ra1;
} }
*plvra = scm_cons (vra1, SCM_EOL); *plvra = scm_cons (vra1, SCM_EOL);
plvra = SCM_CDRLOC (*plvra); plvra = SCM_CDRLOC (*plvra);
@ -310,32 +310,32 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
scm_frame_begin (0); scm_frame_begin (0);
vinds = scm_malloc (sizeof(long) * SCM_ARRAY_NDIM (ra0)); vinds = scm_malloc (sizeof(long) * SCM_I_ARRAY_NDIM (ra0));
scm_frame_free (vinds); scm_frame_free (vinds);
for (k = 0; k <= kmax; k++) for (k = 0; k <= kmax; k++)
vinds[k] = SCM_ARRAY_DIMS (ra0)[k].lbnd; vinds[k] = SCM_I_ARRAY_DIMS (ra0)[k].lbnd;
k = kmax; k = kmax;
do do
{ {
if (k == kmax) if (k == kmax)
{ {
SCM y = lra; SCM y = lra;
SCM_ARRAY_BASE (vra0) = cind (ra0, vinds); SCM_I_ARRAY_BASE (vra0) = cind (ra0, vinds);
for (z = lvra; SCM_NIMP (z); z = SCM_CDR (z), y = SCM_CDR (y)) for (z = lvra; SCM_NIMP (z); z = SCM_CDR (z), y = SCM_CDR (y))
SCM_ARRAY_BASE (SCM_CAR (z)) = cind (SCM_CAR (y), vinds); SCM_I_ARRAY_BASE (SCM_CAR (z)) = cind (SCM_CAR (y), vinds);
if (0 == (SCM_UNBNDP (data) ? cproc(vra0, lvra) : cproc(vra0, data, lvra))) if (0 == (SCM_UNBNDP (data) ? cproc(vra0, lvra) : cproc(vra0, data, lvra)))
return 0; return 0;
k--; k--;
continue; continue;
} }
if (vinds[k] < SCM_ARRAY_DIMS (ra0)[k].ubnd) if (vinds[k] < SCM_I_ARRAY_DIMS (ra0)[k].ubnd)
{ {
vinds[k]++; vinds[k]++;
k++; k++;
continue; continue;
} }
vinds[k] = SCM_ARRAY_DIMS (ra0)[k].lbnd - 1; vinds[k] = SCM_I_ARRAY_DIMS (ra0)[k].lbnd - 1;
k--; k--;
} }
while (k >= 0); while (k >= 0);
@ -364,11 +364,11 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
#define FUNC_NAME s_scm_array_fill_x #define FUNC_NAME s_scm_array_fill_x
{ {
unsigned long i; unsigned long i;
unsigned long n = SCM_ARRAY_DIMS (ra)->ubnd - SCM_ARRAY_DIMS (ra)->lbnd + 1; unsigned long n = SCM_I_ARRAY_DIMS (ra)->ubnd - SCM_I_ARRAY_DIMS (ra)->lbnd + 1;
long inc = SCM_ARRAY_DIMS (ra)->inc; long inc = SCM_I_ARRAY_DIMS (ra)->inc;
unsigned long base = SCM_ARRAY_BASE (ra); unsigned long base = SCM_I_ARRAY_BASE (ra);
ra = SCM_ARRAY_V (ra); ra = SCM_I_ARRAY_V (ra);
for (i = base; n--; i += inc) for (i = base; n--; i += inc)
GVSET (ra, i, fill); GVSET (ra, i, fill);
@ -382,14 +382,14 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
static int static int
racp (SCM src, SCM dst) racp (SCM src, SCM dst)
{ {
long n = (SCM_ARRAY_DIMS (src)->ubnd - SCM_ARRAY_DIMS (src)->lbnd + 1); long n = (SCM_I_ARRAY_DIMS (src)->ubnd - SCM_I_ARRAY_DIMS (src)->lbnd + 1);
long inc_d, inc_s = SCM_ARRAY_DIMS (src)->inc; long inc_d, inc_s = SCM_I_ARRAY_DIMS (src)->inc;
unsigned long i_d, i_s = SCM_ARRAY_BASE (src); unsigned long i_d, i_s = SCM_I_ARRAY_BASE (src);
dst = SCM_CAR (dst); dst = SCM_CAR (dst);
inc_d = SCM_ARRAY_DIMS (dst)->inc; inc_d = SCM_I_ARRAY_DIMS (dst)->inc;
i_d = SCM_ARRAY_BASE (dst); i_d = SCM_I_ARRAY_BASE (dst);
src = SCM_ARRAY_V (src); src = SCM_I_ARRAY_V (src);
dst = SCM_ARRAY_V (dst); dst = SCM_I_ARRAY_V (dst);
for (; n-- > 0; i_s += inc_s, i_d += inc_d) for (; n-- > 0; i_s += inc_s, i_d += inc_d)
GVSET (dst, i_d, GVREF (src, i_s)); GVSET (dst, i_d, GVREF (src, i_s));
@ -420,14 +420,14 @@ int
scm_ra_eqp (SCM ra0, SCM ras) scm_ra_eqp (SCM ra0, SCM ras)
{ {
SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras)); SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras));
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1; long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2); unsigned long i0 = SCM_I_ARRAY_BASE (ra0), i1 = SCM_I_ARRAY_BASE (ra1), i2 = SCM_I_ARRAY_BASE (ra2);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc; long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
long inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
long inc2 = SCM_ARRAY_DIMS (ra1)->inc; long inc2 = SCM_I_ARRAY_DIMS (ra1)->inc;
ra0 = SCM_ARRAY_V (ra0); ra0 = SCM_I_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_I_ARRAY_V (ra1);
ra2 = SCM_ARRAY_V (ra2); ra2 = SCM_I_ARRAY_V (ra2);
{ {
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
@ -444,14 +444,14 @@ scm_ra_eqp (SCM ra0, SCM ras)
static int static int
ra_compare (SCM ra0, SCM ra1, SCM ra2, int opt) ra_compare (SCM ra0, SCM ra1, SCM ra2, int opt)
{ {
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1; long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2); unsigned long i0 = SCM_I_ARRAY_BASE (ra0), i1 = SCM_I_ARRAY_BASE (ra1), i2 = SCM_I_ARRAY_BASE (ra2);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc; long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
long inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
long inc2 = SCM_ARRAY_DIMS (ra1)->inc; long inc2 = SCM_I_ARRAY_DIMS (ra1)->inc;
ra0 = SCM_ARRAY_V (ra0); ra0 = SCM_I_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_I_ARRAY_V (ra1);
ra2 = SCM_ARRAY_V (ra2); ra2 = SCM_I_ARRAY_V (ra2);
{ {
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
@ -498,16 +498,16 @@ scm_ra_greqp (SCM ra0, SCM ras)
int int
scm_ra_sum (SCM ra0, SCM ras) scm_ra_sum (SCM ra0, SCM ras)
{ {
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1; long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
unsigned long i0 = SCM_ARRAY_BASE (ra0); unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc; long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0); ra0 = SCM_I_ARRAY_V (ra0);
if (!scm_is_null(ras)) if (!scm_is_null(ras))
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
unsigned long i1 = SCM_ARRAY_BASE (ra1); unsigned long i1 = SCM_I_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_I_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0) switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
{ {
default: default:
@ -526,10 +526,10 @@ scm_ra_sum (SCM ra0, SCM ras)
int int
scm_ra_difference (SCM ra0, SCM ras) scm_ra_difference (SCM ra0, SCM ras)
{ {
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1; long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
unsigned long i0 = SCM_ARRAY_BASE (ra0); unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc; long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0); ra0 = SCM_I_ARRAY_V (ra0);
if (scm_is_null (ras)) if (scm_is_null (ras))
{ {
switch (SCM_TYP7 (ra0)) switch (SCM_TYP7 (ra0))
@ -545,9 +545,9 @@ scm_ra_difference (SCM ra0, SCM ras)
else else
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
unsigned long i1 = SCM_ARRAY_BASE (ra1); unsigned long i1 = SCM_I_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_I_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0) switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
{ {
default: default:
@ -567,16 +567,16 @@ scm_ra_difference (SCM ra0, SCM ras)
int int
scm_ra_product (SCM ra0, SCM ras) scm_ra_product (SCM ra0, SCM ras)
{ {
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1; long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
unsigned long i0 = SCM_ARRAY_BASE (ra0); unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc; long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0); ra0 = SCM_I_ARRAY_V (ra0);
if (!scm_is_null (ras)) if (!scm_is_null (ras))
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
unsigned long i1 = SCM_ARRAY_BASE (ra1); unsigned long i1 = SCM_I_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_I_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0) switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
{ {
default: default:
@ -594,10 +594,10 @@ scm_ra_product (SCM ra0, SCM ras)
int int
scm_ra_divide (SCM ra0, SCM ras) scm_ra_divide (SCM ra0, SCM ras)
{ {
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1; long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
unsigned long i0 = SCM_ARRAY_BASE (ra0); unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc; long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0); ra0 = SCM_I_ARRAY_V (ra0);
if (scm_is_null (ras)) if (scm_is_null (ras))
{ {
switch (SCM_TYP7 (ra0)) switch (SCM_TYP7 (ra0))
@ -613,9 +613,9 @@ scm_ra_divide (SCM ra0, SCM ras)
else else
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
unsigned long i1 = SCM_ARRAY_BASE (ra1); unsigned long i1 = SCM_I_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_I_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0) switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
{ {
default: default:
@ -645,11 +645,11 @@ scm_array_identity (SCM dst, SCM src)
static int static int
ramap (SCM ra0, SCM proc, SCM ras) ramap (SCM ra0, SCM proc, SCM ras)
{ {
long i = SCM_ARRAY_DIMS (ra0)->lbnd; long i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
long inc = SCM_ARRAY_DIMS (ra0)->inc; long inc = SCM_I_ARRAY_DIMS (ra0)->inc;
long n = SCM_ARRAY_DIMS (ra0)->ubnd; long n = SCM_I_ARRAY_DIMS (ra0)->ubnd;
long base = SCM_ARRAY_BASE (ra0) - i * inc; long base = SCM_I_ARRAY_BASE (ra0) - i * inc;
ra0 = SCM_ARRAY_V (ra0); ra0 = SCM_I_ARRAY_V (ra0);
if (scm_is_null (ras)) if (scm_is_null (ras))
for (; i <= n; i++) for (; i <= n; i++)
GVSET (ra0, i*inc+base, scm_call_0 (proc)); GVSET (ra0, i*inc+base, scm_call_0 (proc));
@ -657,9 +657,9 @@ ramap (SCM ra0, SCM proc, SCM ras)
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
SCM args; SCM args;
unsigned long k, i1 = SCM_ARRAY_BASE (ra1); unsigned long k, i1 = SCM_I_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_I_ARRAY_V (ra1);
ras = SCM_CDR (ras); ras = SCM_CDR (ras);
if (scm_is_null(ras)) if (scm_is_null(ras))
ras = scm_nullvect; ras = scm_nullvect;
@ -683,11 +683,11 @@ static int
ramap_dsubr (SCM ra0, SCM proc, SCM ras) ramap_dsubr (SCM ra0, SCM proc, SCM ras)
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1); unsigned long i0 = SCM_I_ARRAY_BASE (ra0), i1 = SCM_I_ARRAY_BASE (ra1);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc, inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra1)->lbnd + 1; long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra1)->lbnd + 1;
ra0 = SCM_ARRAY_V (ra0); ra0 = SCM_I_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_I_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0)) switch (SCM_TYP7 (ra0))
{ {
default: default:
@ -704,14 +704,14 @@ static int
ramap_rp (SCM ra0, SCM proc, SCM ras) ramap_rp (SCM ra0, SCM proc, SCM ras)
{ {
SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras)); SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras));
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1; long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2); unsigned long i0 = SCM_I_ARRAY_BASE (ra0), i1 = SCM_I_ARRAY_BASE (ra1), i2 = SCM_I_ARRAY_BASE (ra2);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc; long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
long inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
long inc2 = SCM_ARRAY_DIMS (ra1)->inc; long inc2 = SCM_I_ARRAY_DIMS (ra1)->inc;
ra0 = SCM_ARRAY_V (ra0); ra0 = SCM_I_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_I_ARRAY_V (ra1);
ra2 = SCM_ARRAY_V (ra2); ra2 = SCM_I_ARRAY_V (ra2);
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
if (scm_is_true (scm_c_bitvector_ref (ra0, i0))) if (scm_is_true (scm_c_bitvector_ref (ra0, i0)))
@ -727,11 +727,11 @@ static int
ramap_1 (SCM ra0, SCM proc, SCM ras) ramap_1 (SCM ra0, SCM proc, SCM ras)
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1; long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1); unsigned long i0 = SCM_I_ARRAY_BASE (ra0), i1 = SCM_I_ARRAY_BASE (ra1);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc, inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
ra0 = SCM_ARRAY_V (ra0); ra0 = SCM_I_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_I_ARRAY_V (ra1);
if (scm_tc7_vector == SCM_TYP7 (ra0) || scm_tc7_wvect == SCM_TYP7 (ra0)) if (scm_tc7_vector == SCM_TYP7 (ra0) || scm_tc7_wvect == SCM_TYP7 (ra0))
for (; n-- > 0; i0 += inc0, i1 += inc1) for (; n-- > 0; i0 += inc0, i1 += inc1)
GVSET (ra0, i0, SCM_SUBRF (proc) (GVREF (ra1, i1))); GVSET (ra0, i0, SCM_SUBRF (proc) (GVREF (ra1, i1)));
@ -747,11 +747,11 @@ static int
ramap_2o (SCM ra0, SCM proc, SCM ras) ramap_2o (SCM ra0, SCM proc, SCM ras)
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1; long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1); unsigned long i0 = SCM_I_ARRAY_BASE (ra0), i1 = SCM_I_ARRAY_BASE (ra1);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc, inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
ra0 = SCM_ARRAY_V (ra0); ra0 = SCM_I_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_I_ARRAY_V (ra1);
ras = SCM_CDR (ras); ras = SCM_CDR (ras);
if (scm_is_null (ras)) if (scm_is_null (ras))
{ {
@ -761,9 +761,9 @@ ramap_2o (SCM ra0, SCM proc, SCM ras)
else else
{ {
SCM ra2 = SCM_CAR (ras); SCM ra2 = SCM_CAR (ras);
unsigned long i2 = SCM_ARRAY_BASE (ra2); unsigned long i2 = SCM_I_ARRAY_BASE (ra2);
long inc2 = SCM_ARRAY_DIMS (ra2)->inc; long inc2 = SCM_I_ARRAY_DIMS (ra2)->inc;
ra2 = SCM_ARRAY_V (ra2); ra2 = SCM_I_ARRAY_V (ra2);
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
GVSET (ra0, i0, SCM_SUBRF (proc) (GVREF (ra1, i1), GVREF (ra2, i2))); GVSET (ra0, i0, SCM_SUBRF (proc) (GVREF (ra1, i1), GVREF (ra2, i2)));
} }
@ -775,19 +775,19 @@ ramap_2o (SCM ra0, SCM proc, SCM ras)
static int static int
ramap_a (SCM ra0, SCM proc, SCM ras) ramap_a (SCM ra0, SCM proc, SCM ras)
{ {
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1; long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
unsigned long i0 = SCM_ARRAY_BASE (ra0); unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc; long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0); ra0 = SCM_I_ARRAY_V (ra0);
if (scm_is_null (ras)) if (scm_is_null (ras))
for (; n-- > 0; i0 += inc0) for (; n-- > 0; i0 += inc0)
GVSET (ra0, i0, SCM_SUBRF (proc) (GVREF (ra0, i0), SCM_UNDEFINED)); GVSET (ra0, i0, SCM_SUBRF (proc) (GVREF (ra0, i0), SCM_UNDEFINED));
else else
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
unsigned long i1 = SCM_ARRAY_BASE (ra1); unsigned long i1 = SCM_I_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_I_ARRAY_V (ra1);
for (; n-- > 0; i0 += inc0, i1 += inc1) for (; n-- > 0; i0 += inc0, i1 += inc1)
GVSET (ra0, i0, SCM_SUBRF (proc) (GVREF (ra0, i0), GVREF (ra1, i1))); GVSET (ra0, i0, SCM_SUBRF (proc) (GVREF (ra0, i0), GVREF (ra1, i1)));
} }
@ -865,21 +865,21 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
else else
{ {
SCM tail, ra1 = SCM_CAR (lra); SCM tail, ra1 = SCM_CAR (lra);
SCM v0 = (SCM_ARRAYP (ra0) ? SCM_ARRAY_V (ra0) : ra0); SCM v0 = (SCM_I_ARRAYP (ra0) ? SCM_I_ARRAY_V (ra0) : ra0);
ra_iproc *p; ra_iproc *p;
/* Check to see if order might matter. /* Check to see if order might matter.
This might be an argument for a separate This might be an argument for a separate
SERIAL-ARRAY-MAP! */ SERIAL-ARRAY-MAP! */
if (scm_is_eq (v0, ra1) if (scm_is_eq (v0, ra1)
|| (SCM_ARRAYP (ra1) && scm_is_eq (v0, SCM_ARRAY_V (ra1)))) || (SCM_I_ARRAYP (ra1) && scm_is_eq (v0, SCM_I_ARRAY_V (ra1))))
if (!scm_is_eq (ra0, ra1) if (!scm_is_eq (ra0, ra1)
|| (SCM_ARRAYP(ra0) && !SCM_ARRAY_CONTP(ra0))) || (SCM_I_ARRAYP(ra0) && !SCM_I_ARRAY_CONTP(ra0)))
goto gencase; goto gencase;
for (tail = SCM_CDR (lra); !scm_is_null (tail); tail = SCM_CDR (tail)) for (tail = SCM_CDR (lra); !scm_is_null (tail); tail = SCM_CDR (tail))
{ {
ra1 = SCM_CAR (tail); ra1 = SCM_CAR (tail);
if (scm_is_eq (v0, ra1) if (scm_is_eq (v0, ra1)
|| (SCM_ARRAYP (ra1) && scm_is_eq (v0, SCM_ARRAY_V (ra1)))) || (SCM_I_ARRAYP (ra1) && scm_is_eq (v0, SCM_I_ARRAY_V (ra1))))
goto gencase; goto gencase;
} }
for (p = ra_asubrs; p->name; p++) for (p = ra_asubrs; p->name; p++)
@ -911,11 +911,11 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
static int static int
rafe (SCM ra0, SCM proc, SCM ras) rafe (SCM ra0, SCM proc, SCM ras)
{ {
long i = SCM_ARRAY_DIMS (ra0)->lbnd; long i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
unsigned long i0 = SCM_ARRAY_BASE (ra0); unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc; long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
long n = SCM_ARRAY_DIMS (ra0)->ubnd; long n = SCM_I_ARRAY_DIMS (ra0)->ubnd;
ra0 = SCM_ARRAY_V (ra0); ra0 = SCM_I_ARRAY_V (ra0);
if (scm_is_null (ras)) if (scm_is_null (ras))
for (; i <= n; i++, i0 += inc0) for (; i <= n; i++, i0 += inc0)
scm_call_1 (proc, GVREF (ra0, i0)); scm_call_1 (proc, GVREF (ra0, i0));
@ -923,9 +923,9 @@ rafe (SCM ra0, SCM proc, SCM ras)
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
SCM args; SCM args;
unsigned long k, i1 = SCM_ARRAY_BASE (ra1); unsigned long k, i1 = SCM_I_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_I_ARRAY_V (ra1);
ras = SCM_CDR (ras); ras = SCM_CDR (ras);
if (scm_is_null(ras)) if (scm_is_null(ras))
ras = scm_nullvect; ras = scm_nullvect;
@ -988,10 +988,10 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
GVSET (ra, i, scm_call_1 (proc, scm_from_ulong (i))); GVSET (ra, i, scm_call_1 (proc, scm_from_ulong (i)));
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
else if (SCM_ARRAYP (ra)) else if (SCM_I_ARRAYP (ra))
{ {
SCM args = SCM_EOL; SCM args = SCM_EOL;
int j, k, kmax = SCM_ARRAY_NDIM (ra) - 1; int j, k, kmax = SCM_I_ARRAY_NDIM (ra) - 1;
long *vinds; long *vinds;
if (kmax < 0) if (kmax < 0)
@ -999,35 +999,35 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
scm_frame_begin (0); scm_frame_begin (0);
vinds = scm_malloc (sizeof(long) * SCM_ARRAY_NDIM (ra)); vinds = scm_malloc (sizeof(long) * SCM_I_ARRAY_NDIM (ra));
scm_frame_free (vinds); scm_frame_free (vinds);
for (k = 0; k <= kmax; k++) for (k = 0; k <= kmax; k++)
vinds[k] = SCM_ARRAY_DIMS (ra)[k].lbnd; vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
k = kmax; k = kmax;
do do
{ {
if (k == kmax) if (k == kmax)
{ {
vinds[k] = SCM_ARRAY_DIMS (ra)[k].lbnd; vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
i = cind (ra, vinds); i = cind (ra, vinds);
for (; vinds[k] <= SCM_ARRAY_DIMS (ra)[k].ubnd; vinds[k]++) for (; vinds[k] <= SCM_I_ARRAY_DIMS (ra)[k].ubnd; vinds[k]++)
{ {
for (j = kmax + 1, args = SCM_EOL; j--;) for (j = kmax + 1, args = SCM_EOL; j--;)
args = scm_cons (scm_from_long (vinds[j]), args); args = scm_cons (scm_from_long (vinds[j]), args);
GVSET (SCM_ARRAY_V (ra), i, scm_apply_0 (proc, args)); GVSET (SCM_I_ARRAY_V (ra), i, scm_apply_0 (proc, args));
i += SCM_ARRAY_DIMS (ra)[k].inc; i += SCM_I_ARRAY_DIMS (ra)[k].inc;
} }
k--; k--;
continue; continue;
} }
if (vinds[k] < SCM_ARRAY_DIMS (ra)[k].ubnd) if (vinds[k] < SCM_I_ARRAY_DIMS (ra)[k].ubnd)
{ {
vinds[k]++; vinds[k]++;
k++; k++;
continue; continue;
} }
vinds[k] = SCM_ARRAY_DIMS (ra)[k].lbnd - 1; vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd - 1;
k--; k--;
} }
while (k >= 0); while (k >= 0);
@ -1048,21 +1048,21 @@ raeql_1 (SCM ra0, SCM as_equal, SCM ra1)
long inc0 = 1, inc1 = 1; long inc0 = 1, inc1 = 1;
unsigned long n; unsigned long n;
ra1 = SCM_CAR (ra1); ra1 = SCM_CAR (ra1);
if (SCM_ARRAYP(ra0)) if (SCM_I_ARRAYP(ra0))
{ {
n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1; n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
i0 = SCM_ARRAY_BASE (ra0); i0 = SCM_I_ARRAY_BASE (ra0);
inc0 = SCM_ARRAY_DIMS (ra0)->inc; inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0); ra0 = SCM_I_ARRAY_V (ra0);
} }
else else
n = scm_c_generalized_vector_length (ra0); n = scm_c_generalized_vector_length (ra0);
if (SCM_ARRAYP (ra1)) if (SCM_I_ARRAYP (ra1))
{ {
i1 = SCM_ARRAY_BASE (ra1); i1 = SCM_I_ARRAY_BASE (ra1);
inc1 = SCM_ARRAY_DIMS (ra1)->inc; inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_I_ARRAY_V (ra1);
} }
if (scm_is_generalized_vector (ra0)) if (scm_is_generalized_vector (ra0))
@ -1093,12 +1093,12 @@ raeql (SCM ra0, SCM as_equal, SCM ra1)
scm_t_array_dim *s0 = &dim0, *s1 = &dim1; scm_t_array_dim *s0 = &dim0, *s1 = &dim1;
unsigned long bas0 = 0, bas1 = 0; unsigned long bas0 = 0, bas1 = 0;
int k, unroll = 1, vlen = 1, ndim = 1; int k, unroll = 1, vlen = 1, ndim = 1;
if (SCM_ARRAYP (ra0)) if (SCM_I_ARRAYP (ra0))
{ {
ndim = SCM_ARRAY_NDIM (ra0); ndim = SCM_I_ARRAY_NDIM (ra0);
s0 = SCM_ARRAY_DIMS (ra0); s0 = SCM_I_ARRAY_DIMS (ra0);
bas0 = SCM_ARRAY_BASE (ra0); bas0 = SCM_I_ARRAY_BASE (ra0);
v0 = SCM_ARRAY_V (ra0); v0 = SCM_I_ARRAY_V (ra0);
} }
else else
{ {
@ -1107,13 +1107,13 @@ raeql (SCM ra0, SCM as_equal, SCM ra1)
s0->ubnd = scm_c_generalized_vector_length (v0) - 1; s0->ubnd = scm_c_generalized_vector_length (v0) - 1;
unroll = 0; unroll = 0;
} }
if (SCM_ARRAYP (ra1)) if (SCM_I_ARRAYP (ra1))
{ {
if (ndim != SCM_ARRAY_NDIM (ra1)) if (ndim != SCM_I_ARRAY_NDIM (ra1))
return 0; return 0;
s1 = SCM_ARRAY_DIMS (ra1); s1 = SCM_I_ARRAY_DIMS (ra1);
bas1 = SCM_ARRAY_BASE (ra1); bas1 = SCM_I_ARRAY_BASE (ra1);
v1 = SCM_ARRAY_V (ra1); v1 = SCM_I_ARRAY_V (ra1);
} }
else else
{ {
@ -1173,7 +1173,7 @@ static char s_array_equal_p[] = "array-equal?";
SCM SCM
scm_array_equal_p (SCM ra0, SCM ra1) scm_array_equal_p (SCM ra0, SCM ra1)
{ {
if (SCM_ARRAYP (ra0) || SCM_ARRAYP (ra1)) if (SCM_I_ARRAYP (ra0) || SCM_I_ARRAYP (ra1))
return scm_from_bool(raeql (ra0, SCM_BOOL_F, ra1)); return scm_from_bool(raeql (ra0, SCM_BOOL_F, ra1));
return scm_equal_p (ra0, ra1); return scm_equal_p (ra0, ra1);
} }
@ -1201,7 +1201,7 @@ scm_init_ramap ()
init_raprocs (ra_rpsubrs); init_raprocs (ra_rpsubrs);
init_raprocs (ra_asubrs); init_raprocs (ra_asubrs);
scm_c_define_subr (s_array_equal_p, scm_tc7_rpsubr, scm_array_equal_p); scm_c_define_subr (s_array_equal_p, scm_tc7_rpsubr, scm_array_equal_p);
scm_smobs[SCM_TC2SMOBNUM (scm_tc16_array)].equalp = scm_raequal; scm_smobs[SCM_TC2SMOBNUM (scm_i_tc16_array)].equalp = scm_raequal;
#include "libguile/ramap.x" #include "libguile/ramap.x"
scm_add_feature (s_scm_array_for_each); scm_add_feature (s_scm_array_for_each);
} }

24
libguile/srfi-4.c
View file

@ -237,9 +237,9 @@ is_uvec (int type, SCM obj)
{ {
if (SCM_IS_UVEC (obj)) if (SCM_IS_UVEC (obj))
return SCM_UVEC_TYPE (obj) == type; return SCM_UVEC_TYPE (obj) == type;
if (SCM_ARRAYP (obj) && SCM_ARRAY_NDIM (obj) == 1) if (SCM_I_ARRAYP (obj) && SCM_I_ARRAY_NDIM (obj) == 1)
{ {
SCM v = SCM_ARRAY_V (obj); SCM v = SCM_I_ARRAY_V (obj);
return SCM_IS_UVEC (v) && SCM_UVEC_TYPE (v) == type; return SCM_IS_UVEC (v) && SCM_UVEC_TYPE (v) == type;
} }
return 0; return 0;
@ -374,8 +374,8 @@ uvec_writable_elements (int type, SCM uvec, scm_t_array_handle *handle,
if (type >= 0) if (type >= 0)
{ {
SCM v = uvec; SCM v = uvec;
if (SCM_ARRAYP (v)) if (SCM_I_ARRAYP (v))
v = SCM_ARRAY_V (v); v = SCM_I_ARRAY_V (v);
uvec_assert (type, v); uvec_assert (type, v);
} }
@ -393,8 +393,8 @@ static int
uvec_type (scm_t_array_handle *h) uvec_type (scm_t_array_handle *h)
{ {
SCM v = h->array; SCM v = h->array;
if (SCM_ARRAYP (v)) if (SCM_I_ARRAYP (v))
v = SCM_ARRAY_V (v); v = SCM_I_ARRAY_V (v);
return SCM_UVEC_TYPE (v); return SCM_UVEC_TYPE (v);
} }
@ -531,9 +531,9 @@ scm_is_uniform_vector (SCM obj)
{ {
if (SCM_IS_UVEC (obj)) if (SCM_IS_UVEC (obj))
return 1; return 1;
if (SCM_ARRAYP (obj) && SCM_ARRAY_NDIM (obj) == 1) if (SCM_I_ARRAYP (obj) && SCM_I_ARRAY_NDIM (obj) == 1)
{ {
SCM v = SCM_ARRAY_V (obj); SCM v = SCM_I_ARRAY_V (obj);
return SCM_IS_UVEC (v); return SCM_IS_UVEC (v);
} }
return 0; return 0;
@ -659,8 +659,8 @@ size_t
scm_array_handle_uniform_element_size (scm_t_array_handle *h) scm_array_handle_uniform_element_size (scm_t_array_handle *h)
{ {
SCM vec = h->array; SCM vec = h->array;
if (SCM_ARRAYP (vec)) if (SCM_I_ARRAYP (vec))
vec = SCM_ARRAY_V (vec); vec = SCM_I_ARRAY_V (vec);
if (scm_is_uniform_vector (vec)) if (scm_is_uniform_vector (vec))
return uvec_sizes[SCM_UVEC_TYPE(vec)]; return uvec_sizes[SCM_UVEC_TYPE(vec)];
scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array"); scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
@ -695,8 +695,8 @@ void *
scm_array_handle_uniform_writable_elements (scm_t_array_handle *h) scm_array_handle_uniform_writable_elements (scm_t_array_handle *h)
{ {
SCM vec = h->array; SCM vec = h->array;
if (SCM_ARRAYP (vec)) if (SCM_I_ARRAYP (vec))
vec = SCM_ARRAY_V (vec); vec = SCM_I_ARRAY_V (vec);
if (SCM_IS_UVEC (vec)) if (SCM_IS_UVEC (vec))
{ {
size_t size = uvec_sizes[SCM_UVEC_TYPE(vec)]; size_t size = uvec_sizes[SCM_UVEC_TYPE(vec)];

4
libguile/srfi-4.i.c
View file

@ -148,8 +148,8 @@ CTYPE *
F(scm_array_handle_,TAG,_writable_elements) (scm_t_array_handle *h) F(scm_array_handle_,TAG,_writable_elements) (scm_t_array_handle *h)
{ {
SCM vec = h->array; SCM vec = h->array;
if (SCM_ARRAYP (vec)) if (SCM_I_ARRAYP (vec))
vec = SCM_ARRAY_V (vec); vec = SCM_I_ARRAY_V (vec);
uvec_assert (TYPE, vec); uvec_assert (TYPE, vec);
if (TYPE == SCM_UVEC_C32 || TYPE == SCM_UVEC_C64) if (TYPE == SCM_UVEC_C32 || TYPE == SCM_UVEC_C64)
return ((CTYPE *)SCM_UVEC_BASE (vec)) + 2*h->base; return ((CTYPE *)SCM_UVEC_BASE (vec)) + 2*h->base;

368
libguile/unif.c
View file

@ -79,8 +79,13 @@
* long long llvect s64 * long long llvect s64
*/ */
scm_t_bits scm_tc16_array; scm_t_bits scm_i_tc16_array;
scm_t_bits scm_tc16_enclosed_array; scm_t_bits scm_i_tc16_enclosed_array;
#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \
(SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | SCM_I_ARRAY_FLAG_CONTIGUOUS))
#define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \
(SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & ~SCM_I_ARRAY_FLAG_CONTIGUOUS))
typedef SCM creator_proc (SCM len, SCM fill); typedef SCM creator_proc (SCM len, SCM fill);
@ -225,15 +230,15 @@ scm_make_uve (long k, SCM prot)
int int
scm_is_array (SCM obj) scm_is_array (SCM obj)
{ {
return (SCM_ENCLOSED_ARRAYP (obj) return (SCM_I_ENCLOSED_ARRAYP (obj)
|| SCM_ARRAYP (obj) || SCM_I_ARRAYP (obj)
|| scm_is_generalized_vector (obj)); || scm_is_generalized_vector (obj));
} }
int int
scm_is_typed_array (SCM obj, SCM type) scm_is_typed_array (SCM obj, SCM type)
{ {
if (SCM_ENCLOSED_ARRAYP (obj)) if (SCM_I_ENCLOSED_ARRAYP (obj))
{ {
/* Enclosed arrays are arrays but are not of any type. /* Enclosed arrays are arrays but are not of any type.
*/ */
@ -242,8 +247,8 @@ scm_is_typed_array (SCM obj, SCM type)
/* Get storage vector. /* Get storage vector.
*/ */
if (SCM_ARRAYP (obj)) if (SCM_I_ARRAYP (obj))
obj = SCM_ARRAY_V (obj); obj = SCM_I_ARRAY_V (obj);
/* It must be a generalized vector (which includes vectors, strings, etc). /* It must be a generalized vector (which includes vectors, strings, etc).
*/ */
@ -256,7 +261,7 @@ scm_is_typed_array (SCM obj, SCM type)
static SCM static SCM
enclosed_ref (scm_t_array_handle *h, ssize_t pos) enclosed_ref (scm_t_array_handle *h, ssize_t pos)
{ {
return scm_i_cvref (SCM_ARRAY_V (h->array), pos + h->base, 1); return scm_i_cvref (SCM_I_ARRAY_V (h->array), pos + h->base, 1);
} }
static SCM static SCM
@ -269,8 +274,8 @@ static SCM
string_ref (scm_t_array_handle *h, ssize_t pos) string_ref (scm_t_array_handle *h, ssize_t pos)
{ {
pos += h->base; pos += h->base;
if (SCM_ARRAYP (h->array)) if (SCM_I_ARRAYP (h->array))
return scm_c_string_ref (SCM_ARRAY_V (h->array), pos); return scm_c_string_ref (SCM_I_ARRAY_V (h->array), pos);
else else
return scm_c_string_ref (h->array, pos); return scm_c_string_ref (h->array, pos);
} }
@ -288,14 +293,14 @@ memoize_ref (scm_t_array_handle *h, ssize_t pos)
{ {
SCM v = h->array; SCM v = h->array;
if (SCM_ENCLOSED_ARRAYP (v)) if (SCM_I_ENCLOSED_ARRAYP (v))
{ {
h->ref = enclosed_ref; h->ref = enclosed_ref;
return enclosed_ref (h, pos); return enclosed_ref (h, pos);
} }
if (SCM_ARRAYP (v)) if (SCM_I_ARRAYP (v))
v = SCM_ARRAY_V (v); v = SCM_I_ARRAY_V (v);
if (scm_is_vector (v)) if (scm_is_vector (v))
{ {
@ -338,8 +343,8 @@ static void
string_set (scm_t_array_handle *h, ssize_t pos, SCM val) string_set (scm_t_array_handle *h, ssize_t pos, SCM val)
{ {
pos += h->base; pos += h->base;
if (SCM_ARRAYP (h->array)) if (SCM_I_ARRAYP (h->array))
return scm_c_string_set_x (SCM_ARRAY_V (h->array), pos, val); return scm_c_string_set_x (SCM_I_ARRAY_V (h->array), pos, val);
else else
return scm_c_string_set_x (h->array, pos, val); return scm_c_string_set_x (h->array, pos, val);
} }
@ -361,15 +366,15 @@ memoize_set (scm_t_array_handle *h, ssize_t pos, SCM val)
{ {
SCM v = h->array; SCM v = h->array;
if (SCM_ENCLOSED_ARRAYP (v)) if (SCM_I_ENCLOSED_ARRAYP (v))
{ {
h->set = enclosed_set; h->set = enclosed_set;
enclosed_set (h, pos, val); enclosed_set (h, pos, val);
return; return;
} }
if (SCM_ARRAYP (v)) if (SCM_I_ARRAYP (v))
v = SCM_ARRAY_V (v); v = SCM_I_ARRAY_V (v);
if (scm_is_vector (v)) if (scm_is_vector (v))
{ {
@ -403,10 +408,10 @@ scm_array_get_handle (SCM array, scm_t_array_handle *h)
h->ref = memoize_ref; h->ref = memoize_ref;
h->set = memoize_set; h->set = memoize_set;
if (SCM_ARRAYP (array) || SCM_ENCLOSED_ARRAYP (array)) if (SCM_I_ARRAYP (array) || SCM_I_ENCLOSED_ARRAYP (array))
{ {
h->dims = SCM_ARRAY_DIMS (array); h->dims = SCM_I_ARRAY_DIMS (array);
h->base = SCM_ARRAY_BASE (array); h->base = SCM_I_ARRAY_BASE (array);
} }
else if (scm_is_generalized_vector (array)) else if (scm_is_generalized_vector (array))
{ {
@ -430,8 +435,8 @@ scm_array_handle_release (scm_t_array_handle *h)
size_t size_t
scm_array_handle_rank (scm_t_array_handle *h) scm_array_handle_rank (scm_t_array_handle *h)
{ {
if (SCM_ARRAYP (h->array) || SCM_ENCLOSED_ARRAYP (h->array)) if (SCM_I_ARRAYP (h->array) || SCM_I_ENCLOSED_ARRAYP (h->array))
return SCM_ARRAY_NDIM (h->array); return SCM_I_ARRAY_NDIM (h->array);
else else
return 1; return 1;
} }
@ -446,8 +451,8 @@ const SCM *
scm_array_handle_elements (scm_t_array_handle *h) scm_array_handle_elements (scm_t_array_handle *h)
{ {
SCM vec = h->array; SCM vec = h->array;
if (SCM_ARRAYP (vec)) if (SCM_I_ARRAYP (vec))
vec = SCM_ARRAY_V (vec); vec = SCM_I_ARRAY_V (vec);
if (SCM_I_IS_VECTOR (vec)) if (SCM_I_IS_VECTOR (vec))
return SCM_I_VECTOR_ELTS (vec) + h->base; return SCM_I_VECTOR_ELTS (vec) + h->base;
scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array"); scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
@ -457,8 +462,8 @@ SCM *
scm_array_handle_writable_elements (scm_t_array_handle *h) scm_array_handle_writable_elements (scm_t_array_handle *h)
{ {
SCM vec = h->array; SCM vec = h->array;
if (SCM_ARRAYP (vec)) if (SCM_I_ARRAYP (vec))
vec = SCM_ARRAY_V (vec); vec = SCM_I_ARRAY_V (vec);
if (SCM_I_IS_VECTOR (vec)) if (SCM_I_IS_VECTOR (vec))
return SCM_I_VECTOR_WELTS (vec) + h->base; return SCM_I_VECTOR_WELTS (vec) + h->base;
scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array"); scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
@ -523,19 +528,24 @@ SCM_DEFINE (scm_typed_array_p, "typed-array?", 2, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
size_t
scm_c_array_rank (SCM array)
{
scm_t_array_handle handle;
size_t res;
scm_array_get_handle (array, &handle);
res = scm_array_handle_rank (&handle);
scm_array_handle_release (&handle);
return res;
}
SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0, SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0,
(SCM array), (SCM array),
"Return the number of dimensions of the array @var{array.}\n") "Return the number of dimensions of the array @var{array.}\n")
#define FUNC_NAME s_scm_array_rank #define FUNC_NAME s_scm_array_rank
{ {
scm_t_array_handle handle; return scm_from_size_t (scm_c_array_rank (array));
SCM res;
scm_array_get_handle (array, &handle);
res = scm_from_size_t (scm_array_handle_rank (&handle));
scm_array_handle_release (&handle);
return res;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -577,8 +587,8 @@ SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0,
"Return the root vector of a shared array.") "Return the root vector of a shared array.")
#define FUNC_NAME s_scm_shared_array_root #define FUNC_NAME s_scm_shared_array_root
{ {
if (SCM_ARRAYP (ra) || SCM_ENCLOSED_ARRAYP (ra)) if (SCM_I_ARRAYP (ra) || SCM_I_ENCLOSED_ARRAYP (ra))
return SCM_ARRAY_V (ra); return SCM_I_ARRAY_V (ra);
else if (scm_is_generalized_vector (ra)) else if (scm_is_generalized_vector (ra))
return ra; return ra;
scm_wrong_type_arg_msg (NULL, 0, ra, "array"); scm_wrong_type_arg_msg (NULL, 0, ra, "array");
@ -646,13 +656,13 @@ scm_array_handle_pos (scm_t_array_handle *h, SCM indices)
SCM SCM
scm_i_make_ra (int ndim, int enclosed) scm_i_make_ra (int ndim, int enclosed)
{ {
scm_t_bits tag = enclosed? scm_tc16_enclosed_array : scm_tc16_array; scm_t_bits tag = enclosed? scm_i_tc16_enclosed_array : scm_i_tc16_array;
SCM ra; SCM ra;
SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + tag, SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + tag,
scm_gc_malloc ((sizeof (scm_t_array) + scm_gc_malloc ((sizeof (scm_i_t_array) +
ndim * sizeof (scm_t_array_dim)), ndim * sizeof (scm_t_array_dim)),
"array")); "array"));
SCM_ARRAY_V (ra) = SCM_BOOL_F; SCM_I_ARRAY_V (ra) = SCM_BOOL_F;
return ra; return ra;
} }
@ -671,8 +681,8 @@ scm_i_shap2ra (SCM args)
scm_misc_error (NULL, s_bad_spec, SCM_EOL); scm_misc_error (NULL, s_bad_spec, SCM_EOL);
ra = scm_i_make_ra (ndim, 0); ra = scm_i_make_ra (ndim, 0);
SCM_ARRAY_BASE (ra) = 0; SCM_I_ARRAY_BASE (ra) = 0;
s = SCM_ARRAY_DIMS (ra); s = SCM_I_ARRAY_DIMS (ra);
for (; !scm_is_null (args); s++, args = SCM_CDR (args)) for (; !scm_is_null (args); s++, args = SCM_CDR (args))
{ {
spec = SCM_CAR (args); spec = SCM_CAR (args);
@ -714,8 +724,8 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
creator = type_to_creator (type); creator = type_to_creator (type);
ra = scm_i_shap2ra (bounds); ra = scm_i_shap2ra (bounds);
SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra); SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
s = SCM_ARRAY_DIMS (ra); s = SCM_I_ARRAY_DIMS (ra);
k = SCM_ARRAY_NDIM (ra); k = SCM_I_ARRAY_NDIM (ra);
while (k--) while (k--)
{ {
@ -727,11 +737,11 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
if (scm_is_eq (fill, SCM_UNSPECIFIED)) if (scm_is_eq (fill, SCM_UNSPECIFIED))
fill = SCM_UNDEFINED; fill = SCM_UNDEFINED;
SCM_ARRAY_V (ra) = creator (scm_from_size_t (rlen), fill); SCM_I_ARRAY_V (ra) = creator (scm_from_size_t (rlen), fill);
if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra)) if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc)) if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
return SCM_ARRAY_V (ra); return SCM_I_ARRAY_V (ra);
return ra; return ra;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -771,19 +781,19 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1,
static void static void
scm_i_ra_set_contp (SCM ra) scm_i_ra_set_contp (SCM ra)
{ {
size_t k = SCM_ARRAY_NDIM (ra); size_t k = SCM_I_ARRAY_NDIM (ra);
if (k) if (k)
{ {
long inc = SCM_ARRAY_DIMS (ra)[k - 1].inc; long inc = SCM_I_ARRAY_DIMS (ra)[k - 1].inc;
while (k--) while (k--)
{ {
if (inc != SCM_ARRAY_DIMS (ra)[k].inc) if (inc != SCM_I_ARRAY_DIMS (ra)[k].inc)
{ {
SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra); SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra);
return; return;
} }
inc *= (SCM_ARRAY_DIMS (ra)[k].ubnd inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd
- SCM_ARRAY_DIMS (ra)[k].lbnd + 1); - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1);
} }
} }
SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra); SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
@ -824,10 +834,10 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
scm_array_get_handle (oldra, &old_handle); scm_array_get_handle (oldra, &old_handle);
if (SCM_ARRAYP (oldra)) if (SCM_I_ARRAYP (oldra))
{ {
SCM_ARRAY_V (ra) = SCM_ARRAY_V (oldra); SCM_I_ARRAY_V (ra) = SCM_I_ARRAY_V (oldra);
old_min = old_max = SCM_ARRAY_BASE (oldra); old_min = old_max = SCM_I_ARRAY_BASE (oldra);
s = scm_array_handle_dims (&old_handle); s = scm_array_handle_dims (&old_handle);
k = scm_array_handle_rank (&old_handle); k = scm_array_handle_rank (&old_handle);
while (k--) while (k--)
@ -840,22 +850,22 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
} }
else else
{ {
SCM_ARRAY_V (ra) = oldra; SCM_I_ARRAY_V (ra) = oldra;
old_min = 0; old_min = 0;
old_max = scm_c_generalized_vector_length (oldra) - 1; old_max = scm_c_generalized_vector_length (oldra) - 1;
} }
inds = SCM_EOL; inds = SCM_EOL;
s = SCM_ARRAY_DIMS (ra); s = SCM_I_ARRAY_DIMS (ra);
for (k = 0; k < SCM_ARRAY_NDIM (ra); k++) for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
{ {
inds = scm_cons (scm_from_long (s[k].lbnd), inds); inds = scm_cons (scm_from_long (s[k].lbnd), inds);
if (s[k].ubnd < s[k].lbnd) if (s[k].ubnd < s[k].lbnd)
{ {
if (1 == SCM_ARRAY_NDIM (ra)) if (1 == SCM_I_ARRAY_NDIM (ra))
ra = make_typed_vector (scm_array_type (ra), 0); ra = make_typed_vector (scm_array_type (ra), 0);
else else
SCM_ARRAY_V (ra) = make_typed_vector (scm_array_type (ra), 0); SCM_I_ARRAY_V (ra) = make_typed_vector (scm_array_type (ra), 0);
scm_array_handle_release (&old_handle); scm_array_handle_release (&old_handle);
return ra; return ra;
} }
@ -863,9 +873,9 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
imap = scm_apply_0 (mapfunc, scm_reverse (inds)); imap = scm_apply_0 (mapfunc, scm_reverse (inds));
i = scm_array_handle_pos (&old_handle, imap); i = scm_array_handle_pos (&old_handle, imap);
SCM_ARRAY_BASE (ra) = new_min = new_max = i; SCM_I_ARRAY_BASE (ra) = new_min = new_max = i;
indptr = inds; indptr = inds;
k = SCM_ARRAY_NDIM (ra); k = SCM_I_ARRAY_NDIM (ra);
while (k--) while (k--)
{ {
if (s[k].ubnd > s[k].lbnd) if (s[k].ubnd > s[k].lbnd)
@ -888,9 +898,9 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
if (old_min > new_min || old_max < new_max) if (old_min > new_min || old_max < new_max)
SCM_MISC_ERROR ("mapping out of range", SCM_EOL); SCM_MISC_ERROR ("mapping out of range", SCM_EOL);
if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra)) if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
{ {
SCM v = SCM_ARRAY_V (ra); SCM v = SCM_I_ARRAY_V (ra);
size_t length = scm_c_generalized_vector_length (v); size_t length = scm_c_generalized_vector_length (v);
if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd) if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd)
return v; return v;
@ -946,33 +956,33 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
return ra; return ra;
} }
if (SCM_ARRAYP (ra) || SCM_ENCLOSED_ARRAYP (ra)) if (SCM_I_ARRAYP (ra) || SCM_I_ENCLOSED_ARRAYP (ra))
{ {
vargs = scm_vector (args); vargs = scm_vector (args);
if (SCM_SIMPLE_VECTOR_LENGTH (vargs) != SCM_ARRAY_NDIM (ra)) if (SCM_SIMPLE_VECTOR_LENGTH (vargs) != SCM_I_ARRAY_NDIM (ra))
SCM_WRONG_NUM_ARGS (); SCM_WRONG_NUM_ARGS ();
ndim = 0; ndim = 0;
for (k = 0; k < SCM_ARRAY_NDIM (ra); k++) for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
{ {
i = scm_to_signed_integer (SCM_SIMPLE_VECTOR_REF (vargs, k), i = scm_to_signed_integer (SCM_SIMPLE_VECTOR_REF (vargs, k),
0, SCM_ARRAY_NDIM(ra)); 0, SCM_I_ARRAY_NDIM(ra));
if (ndim < i) if (ndim < i)
ndim = i; ndim = i;
} }
ndim++; ndim++;
res = scm_i_make_ra (ndim, 0); res = scm_i_make_ra (ndim, 0);
SCM_ARRAY_V (res) = SCM_ARRAY_V (ra); SCM_I_ARRAY_V (res) = SCM_I_ARRAY_V (ra);
SCM_ARRAY_BASE (res) = SCM_ARRAY_BASE (ra); SCM_I_ARRAY_BASE (res) = SCM_I_ARRAY_BASE (ra);
for (k = ndim; k--;) for (k = ndim; k--;)
{ {
SCM_ARRAY_DIMS (res)[k].lbnd = 0; SCM_I_ARRAY_DIMS (res)[k].lbnd = 0;
SCM_ARRAY_DIMS (res)[k].ubnd = -1; SCM_I_ARRAY_DIMS (res)[k].ubnd = -1;
} }
for (k = SCM_ARRAY_NDIM (ra); k--;) for (k = SCM_I_ARRAY_NDIM (ra); k--;)
{ {
i = scm_to_int (SCM_SIMPLE_VECTOR_REF (vargs, k)); i = scm_to_int (SCM_SIMPLE_VECTOR_REF (vargs, k));
s = &(SCM_ARRAY_DIMS (ra)[k]); s = &(SCM_I_ARRAY_DIMS (ra)[k]);
r = &(SCM_ARRAY_DIMS (res)[i]); r = &(SCM_I_ARRAY_DIMS (res)[i]);
if (r->ubnd < r->lbnd) if (r->ubnd < r->lbnd)
{ {
r->lbnd = s->lbnd; r->lbnd = s->lbnd;
@ -986,7 +996,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
r->ubnd = s->ubnd; r->ubnd = s->ubnd;
if (r->lbnd < s->lbnd) if (r->lbnd < s->lbnd)
{ {
SCM_ARRAY_BASE (res) += (s->lbnd - r->lbnd) * r->inc; SCM_I_ARRAY_BASE (res) += (s->lbnd - r->lbnd) * r->inc;
r->lbnd = s->lbnd; r->lbnd = s->lbnd;
} }
r->inc += s->inc; r->inc += s->inc;
@ -1032,7 +1042,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (axes); SCM_VALIDATE_REST_ARGUMENT (axes);
if (scm_is_null (axes)) if (scm_is_null (axes))
axes = scm_cons ((SCM_ARRAYP (ra) ? scm_from_size_t (SCM_ARRAY_NDIM (ra) - 1) : SCM_INUM0), SCM_EOL); axes = scm_cons ((SCM_I_ARRAYP (ra) ? scm_from_size_t (SCM_I_ARRAY_NDIM (ra) - 1) : SCM_INUM0), SCM_EOL);
ninr = scm_ilength (axes); ninr = scm_ilength (axes);
if (ninr < 0) if (ninr < 0)
SCM_WRONG_NUM_ARGS (); SCM_WRONG_NUM_ARGS ();
@ -1043,16 +1053,16 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
s->lbnd = 0; s->lbnd = 0;
s->ubnd = scm_c_generalized_vector_length (ra) - 1; s->ubnd = scm_c_generalized_vector_length (ra) - 1;
s->inc = 1; s->inc = 1;
SCM_ARRAY_V (ra_inr) = ra; SCM_I_ARRAY_V (ra_inr) = ra;
SCM_ARRAY_BASE (ra_inr) = 0; SCM_I_ARRAY_BASE (ra_inr) = 0;
ndim = 1; ndim = 1;
} }
else if (SCM_ARRAYP (ra)) else if (SCM_I_ARRAYP (ra))
{ {
s = SCM_ARRAY_DIMS (ra); s = SCM_I_ARRAY_DIMS (ra);
SCM_ARRAY_V (ra_inr) = SCM_ARRAY_V (ra); SCM_I_ARRAY_V (ra_inr) = SCM_I_ARRAY_V (ra);
SCM_ARRAY_BASE (ra_inr) = SCM_ARRAY_BASE (ra); SCM_I_ARRAY_BASE (ra_inr) = SCM_I_ARRAY_BASE (ra);
ndim = SCM_ARRAY_NDIM (ra); ndim = SCM_I_ARRAY_NDIM (ra);
} }
else else
scm_wrong_type_arg_msg (NULL, 0, ra, "array"); scm_wrong_type_arg_msg (NULL, 0, ra, "array");
@ -1062,16 +1072,16 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
SCM_WRONG_NUM_ARGS (); SCM_WRONG_NUM_ARGS ();
axv = scm_make_string (scm_from_int (ndim), SCM_MAKE_CHAR (0)); axv = scm_make_string (scm_from_int (ndim), SCM_MAKE_CHAR (0));
res = scm_i_make_ra (noutr, 1); res = scm_i_make_ra (noutr, 1);
SCM_ARRAY_BASE (res) = SCM_ARRAY_BASE (ra_inr); SCM_I_ARRAY_BASE (res) = SCM_I_ARRAY_BASE (ra_inr);
SCM_ARRAY_V (res) = ra_inr; SCM_I_ARRAY_V (res) = ra_inr;
for (k = 0; k < ninr; k++, axes = SCM_CDR (axes)) for (k = 0; k < ninr; k++, axes = SCM_CDR (axes))
{ {
if (!scm_is_integer (SCM_CAR (axes))) if (!scm_is_integer (SCM_CAR (axes)))
SCM_MISC_ERROR ("bad axis", SCM_EOL); SCM_MISC_ERROR ("bad axis", SCM_EOL);
j = scm_to_int (SCM_CAR (axes)); j = scm_to_int (SCM_CAR (axes));
SCM_ARRAY_DIMS (ra_inr)[k].lbnd = s[j].lbnd; SCM_I_ARRAY_DIMS (ra_inr)[k].lbnd = s[j].lbnd;
SCM_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd; SCM_I_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd;
SCM_ARRAY_DIMS (ra_inr)[k].inc = s[j].inc; SCM_I_ARRAY_DIMS (ra_inr)[k].inc = s[j].inc;
scm_c_string_set_x (axv, j, SCM_MAKE_CHAR (1)); scm_c_string_set_x (axv, j, SCM_MAKE_CHAR (1));
} }
c_axv = scm_i_string_chars (axv); c_axv = scm_i_string_chars (axv);
@ -1079,9 +1089,9 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
{ {
while (c_axv[j]) while (c_axv[j])
j++; j++;
SCM_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd; SCM_I_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd;
SCM_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd; SCM_I_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd;
SCM_ARRAY_DIMS (res)[k].inc = s[j].inc; SCM_I_ARRAY_DIMS (res)[k].inc = s[j].inc;
} }
scm_remember_upto_here_1 (axv); scm_remember_upto_here_1 (axv);
scm_i_ra_set_contp (ra_inr); scm_i_ra_set_contp (ra_inr);
@ -1113,10 +1123,10 @@ SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1,
res = scm_from_bool (ind >= 0 res = scm_from_bool (ind >= 0
&& ind < scm_c_generalized_vector_length (v)); && ind < scm_c_generalized_vector_length (v));
} }
else if (SCM_ARRAYP (v) || SCM_ENCLOSED_ARRAYP (v)) else if (SCM_I_ARRAYP (v) || SCM_I_ENCLOSED_ARRAYP (v))
{ {
size_t k = SCM_ARRAY_NDIM (v); size_t k = SCM_I_ARRAY_NDIM (v);
scm_t_array_dim *s = SCM_ARRAY_DIMS (v); scm_t_array_dim *s = SCM_I_ARRAY_DIMS (v);
while (k > 0) while (k > 0)
{ {
@ -1153,15 +1163,15 @@ scm_i_cvref (SCM v, size_t pos, int enclosed)
{ {
if (enclosed) if (enclosed)
{ {
int k = SCM_ARRAY_NDIM (v); int k = SCM_I_ARRAY_NDIM (v);
SCM res = scm_i_make_ra (k, 0); SCM res = scm_i_make_ra (k, 0);
SCM_ARRAY_V (res) = SCM_ARRAY_V (v); SCM_I_ARRAY_V (res) = SCM_I_ARRAY_V (v);
SCM_ARRAY_BASE (res) = pos; SCM_I_ARRAY_BASE (res) = pos;
while (k--) while (k--)
{ {
SCM_ARRAY_DIMS (res)[k].ubnd = SCM_ARRAY_DIMS (v)[k].ubnd; SCM_I_ARRAY_DIMS (res)[k].ubnd = SCM_I_ARRAY_DIMS (v)[k].ubnd;
SCM_ARRAY_DIMS (res)[k].lbnd = SCM_ARRAY_DIMS (v)[k].lbnd; SCM_I_ARRAY_DIMS (res)[k].lbnd = SCM_I_ARRAY_DIMS (v)[k].lbnd;
SCM_ARRAY_DIMS (res)[k].inc = SCM_ARRAY_DIMS (v)[k].inc; SCM_I_ARRAY_DIMS (res)[k].inc = SCM_I_ARRAY_DIMS (v)[k].inc;
} }
return res; return res;
} }
@ -1223,42 +1233,42 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
if (scm_is_generalized_vector (ra)) if (scm_is_generalized_vector (ra))
return ra; return ra;
if (SCM_ARRAYP (ra)) if (SCM_I_ARRAYP (ra))
{ {
size_t k, ndim = SCM_ARRAY_NDIM (ra), len = 1; size_t k, ndim = SCM_I_ARRAY_NDIM (ra), len = 1;
if (!SCM_ARRAYP (ra) || !SCM_ARRAY_CONTP (ra)) if (!SCM_I_ARRAYP (ra) || !SCM_I_ARRAY_CONTP (ra))
return SCM_BOOL_F; return SCM_BOOL_F;
for (k = 0; k < ndim; k++) for (k = 0; k < ndim; k++)
len *= SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd + 1; len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
if (!SCM_UNBNDP (strict)) if (!SCM_UNBNDP (strict))
{ {
if (ndim && (1 != SCM_ARRAY_DIMS (ra)[ndim - 1].inc)) if (ndim && (1 != SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc))
return SCM_BOOL_F; return SCM_BOOL_F;
if (scm_is_bitvector (SCM_ARRAY_V (ra))) if (scm_is_bitvector (SCM_I_ARRAY_V (ra)))
{ {
if (len != scm_c_bitvector_length (SCM_ARRAY_V (ra)) || if (len != scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) ||
SCM_ARRAY_BASE (ra) % SCM_LONG_BIT || SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT ||
len % SCM_LONG_BIT) len % SCM_LONG_BIT)
return SCM_BOOL_F; return SCM_BOOL_F;
} }
} }
{ {
SCM v = SCM_ARRAY_V (ra); SCM v = SCM_I_ARRAY_V (ra);
size_t length = scm_c_generalized_vector_length (v); size_t length = scm_c_generalized_vector_length (v);
if ((len == length) && 0 == SCM_ARRAY_BASE (ra) && SCM_ARRAY_DIMS (ra)->inc) if ((len == length) && 0 == SCM_I_ARRAY_BASE (ra) && SCM_I_ARRAY_DIMS (ra)->inc)
return v; return v;
} }
sra = scm_i_make_ra (1, 0); sra = scm_i_make_ra (1, 0);
SCM_ARRAY_DIMS (sra)->lbnd = 0; SCM_I_ARRAY_DIMS (sra)->lbnd = 0;
SCM_ARRAY_DIMS (sra)->ubnd = len - 1; SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1;
SCM_ARRAY_V (sra) = SCM_ARRAY_V (ra); SCM_I_ARRAY_V (sra) = SCM_I_ARRAY_V (ra);
SCM_ARRAY_BASE (sra) = SCM_ARRAY_BASE (ra); SCM_I_ARRAY_BASE (sra) = SCM_I_ARRAY_BASE (ra);
SCM_ARRAY_DIMS (sra)->inc = (ndim ? SCM_ARRAY_DIMS (ra)[ndim - 1].inc : 1); SCM_I_ARRAY_DIMS (sra)->inc = (ndim ? SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc : 1);
return sra; return sra;
} }
else if (SCM_ENCLOSED_ARRAYP (ra)) else if (SCM_I_ENCLOSED_ARRAYP (ra))
scm_wrong_type_arg_msg (NULL, 0, ra, "non-enclosed array"); scm_wrong_type_arg_msg (NULL, 0, ra, "non-enclosed array");
else else
scm_wrong_type_arg_msg (NULL, 0, ra, "array"); scm_wrong_type_arg_msg (NULL, 0, ra, "array");
@ -1272,28 +1282,28 @@ scm_ra2contig (SCM ra, int copy)
SCM ret; SCM ret;
long inc = 1; long inc = 1;
size_t k, len = 1; size_t k, len = 1;
for (k = SCM_ARRAY_NDIM (ra); k--;) for (k = SCM_I_ARRAY_NDIM (ra); k--;)
len *= SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd + 1; len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
k = SCM_ARRAY_NDIM (ra); k = SCM_I_ARRAY_NDIM (ra);
if (SCM_ARRAY_CONTP (ra) && ((0 == k) || (1 == SCM_ARRAY_DIMS (ra)[k - 1].inc))) if (SCM_I_ARRAY_CONTP (ra) && ((0 == k) || (1 == SCM_I_ARRAY_DIMS (ra)[k - 1].inc)))
{ {
if (!scm_is_bitvector (SCM_ARRAY_V (ra))) if (!scm_is_bitvector (SCM_I_ARRAY_V (ra)))
return ra; return ra;
if ((len == scm_c_bitvector_length (SCM_ARRAY_V (ra)) && if ((len == scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) &&
0 == SCM_ARRAY_BASE (ra) % SCM_LONG_BIT && 0 == SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT &&
0 == len % SCM_LONG_BIT)) 0 == len % SCM_LONG_BIT))
return ra; return ra;
} }
ret = scm_i_make_ra (k, 0); ret = scm_i_make_ra (k, 0);
SCM_ARRAY_BASE (ret) = 0; SCM_I_ARRAY_BASE (ret) = 0;
while (k--) while (k--)
{ {
SCM_ARRAY_DIMS (ret)[k].lbnd = SCM_ARRAY_DIMS (ra)[k].lbnd; SCM_I_ARRAY_DIMS (ret)[k].lbnd = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
SCM_ARRAY_DIMS (ret)[k].ubnd = SCM_ARRAY_DIMS (ra)[k].ubnd; SCM_I_ARRAY_DIMS (ret)[k].ubnd = SCM_I_ARRAY_DIMS (ra)[k].ubnd;
SCM_ARRAY_DIMS (ret)[k].inc = inc; SCM_I_ARRAY_DIMS (ret)[k].inc = inc;
inc *= SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd + 1; inc *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
} }
SCM_ARRAY_V (ret) = make_typed_vector (scm_array_type (ra), inc); SCM_I_ARRAY_V (ret) = make_typed_vector (scm_array_type (ra), inc);
if (copy) if (copy)
scm_array_copy_x (ra, ret); scm_array_copy_x (ra, ret);
return ret; return ret;
@ -1325,15 +1335,15 @@ SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0,
{ {
return scm_uniform_vector_read_x (ura, port_or_fd, start, end); return scm_uniform_vector_read_x (ura, port_or_fd, start, end);
} }
else if (SCM_ARRAYP (ura)) else if (SCM_I_ARRAYP (ura))
{ {
size_t base, vlen, cstart, cend; size_t base, vlen, cstart, cend;
SCM cra, ans; SCM cra, ans;
cra = scm_ra2contig (ura, 0); cra = scm_ra2contig (ura, 0);
base = SCM_ARRAY_BASE (cra); base = SCM_I_ARRAY_BASE (cra);
vlen = SCM_ARRAY_DIMS (cra)->inc * vlen = SCM_I_ARRAY_DIMS (cra)->inc *
(SCM_ARRAY_DIMS (cra)->ubnd - SCM_ARRAY_DIMS (cra)->lbnd + 1); (SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1);
cstart = 0; cstart = 0;
cend = vlen; cend = vlen;
@ -1344,7 +1354,7 @@ SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0,
cend = scm_to_unsigned_integer (end, cstart, vlen); cend = scm_to_unsigned_integer (end, cstart, vlen);
} }
ans = scm_uniform_vector_read_x (SCM_ARRAY_V (cra), port_or_fd, ans = scm_uniform_vector_read_x (SCM_I_ARRAY_V (cra), port_or_fd,
scm_from_size_t (base + cstart), scm_from_size_t (base + cstart),
scm_from_size_t (base + cend)); scm_from_size_t (base + cend));
@ -1352,7 +1362,7 @@ SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0,
scm_array_copy_x (cra, ura); scm_array_copy_x (cra, ura);
return ans; return ans;
} }
else if (SCM_ENCLOSED_ARRAYP (ura)) else if (SCM_I_ENCLOSED_ARRAYP (ura))
scm_wrong_type_arg_msg (NULL, 0, ura, "non-enclosed array"); scm_wrong_type_arg_msg (NULL, 0, ura, "non-enclosed array");
else else
scm_wrong_type_arg_msg (NULL, 0, ura, "array"); scm_wrong_type_arg_msg (NULL, 0, ura, "array");
@ -1379,15 +1389,15 @@ SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0,
{ {
return scm_uniform_vector_write (ura, port_or_fd, start, end); return scm_uniform_vector_write (ura, port_or_fd, start, end);
} }
else if (SCM_ARRAYP (ura)) else if (SCM_I_ARRAYP (ura))
{ {
size_t base, vlen, cstart, cend; size_t base, vlen, cstart, cend;
SCM cra, ans; SCM cra, ans;
cra = scm_ra2contig (ura, 1); cra = scm_ra2contig (ura, 1);
base = SCM_ARRAY_BASE (cra); base = SCM_I_ARRAY_BASE (cra);
vlen = SCM_ARRAY_DIMS (cra)->inc * vlen = SCM_I_ARRAY_DIMS (cra)->inc *
(SCM_ARRAY_DIMS (cra)->ubnd - SCM_ARRAY_DIMS (cra)->lbnd + 1); (SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1);
cstart = 0; cstart = 0;
cend = vlen; cend = vlen;
@ -1398,13 +1408,13 @@ SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0,
cend = scm_to_unsigned_integer (end, cstart, vlen); cend = scm_to_unsigned_integer (end, cstart, vlen);
} }
ans = scm_uniform_vector_write (SCM_ARRAY_V (cra), port_or_fd, ans = scm_uniform_vector_write (SCM_I_ARRAY_V (cra), port_or_fd,
scm_from_size_t (base + cstart), scm_from_size_t (base + cstart),
scm_from_size_t (base + cend)); scm_from_size_t (base + cend));
return ans; return ans;
} }
else if (SCM_ENCLOSED_ARRAYP (ura)) else if (SCM_I_ENCLOSED_ARRAYP (ura))
scm_wrong_type_arg_msg (NULL, 0, ura, "non-enclosed array"); scm_wrong_type_arg_msg (NULL, 0, ura, "non-enclosed array");
else else
scm_wrong_type_arg_msg (NULL, 0, ura, "array"); scm_wrong_type_arg_msg (NULL, 0, ura, "array");
@ -1550,8 +1560,8 @@ scm_t_uint32 *
scm_array_handle_bit_writable_elements (scm_t_array_handle *h) scm_array_handle_bit_writable_elements (scm_t_array_handle *h)
{ {
SCM vec = h->array; SCM vec = h->array;
if (SCM_ARRAYP (vec)) if (SCM_I_ARRAYP (vec))
vec = SCM_ARRAY_V (vec); vec = SCM_I_ARRAY_V (vec);
if (IS_BITVECTOR (vec)) if (IS_BITVECTOR (vec))
return BITVECTOR_BITS (vec) + h->base/32; return BITVECTOR_BITS (vec) + h->base/32;
scm_wrong_type_arg_msg (NULL, 0, h->array, "bit array"); scm_wrong_type_arg_msg (NULL, 0, h->array, "bit array");
@ -2244,15 +2254,15 @@ ra2l (SCM ra, unsigned long base, unsigned long k)
SCM res = SCM_EOL; SCM res = SCM_EOL;
long inc; long inc;
size_t i; size_t i;
int enclosed = SCM_ENCLOSED_ARRAYP (ra); int enclosed = SCM_I_ENCLOSED_ARRAYP (ra);
if (k == SCM_ARRAY_NDIM (ra)) if (k == SCM_I_ARRAY_NDIM (ra))
return scm_i_cvref (SCM_ARRAY_V (ra), base, enclosed); return scm_i_cvref (SCM_I_ARRAY_V (ra), base, enclosed);
inc = SCM_ARRAY_DIMS (ra)[k].inc; inc = SCM_I_ARRAY_DIMS (ra)[k].inc;
if (SCM_ARRAY_DIMS (ra)[k].ubnd < SCM_ARRAY_DIMS (ra)[k].lbnd) if (SCM_I_ARRAY_DIMS (ra)[k].ubnd < SCM_I_ARRAY_DIMS (ra)[k].lbnd)
return SCM_EOL; return SCM_EOL;
i = base + (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd) * inc; i = base + (1 + SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd) * inc;
do do
{ {
i -= inc; i -= inc;
@ -2271,8 +2281,8 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0,
{ {
if (scm_is_generalized_vector (v)) if (scm_is_generalized_vector (v))
return scm_generalized_vector_to_list (v); return scm_generalized_vector_to_list (v);
else if (SCM_ARRAYP (v) || SCM_ENCLOSED_ARRAYP (v)) else if (SCM_I_ARRAYP (v) || SCM_I_ENCLOSED_ARRAYP (v))
return ra2l (v, SCM_ARRAY_BASE (v), 0); return ra2l (v, SCM_I_ARRAY_BASE (v), 0);
scm_wrong_type_arg_msg (NULL, 0, v, "array"); scm_wrong_type_arg_msg (NULL, 0, v, "array");
} }
@ -2419,18 +2429,18 @@ static int
scm_i_print_array_dimension (SCM array, int dim, int base, int enclosed, scm_i_print_array_dimension (SCM array, int dim, int base, int enclosed,
SCM port, scm_print_state *pstate) SCM port, scm_print_state *pstate)
{ {
scm_t_array_dim *dim_spec = SCM_ARRAY_DIMS (array) + dim; scm_t_array_dim *dim_spec = SCM_I_ARRAY_DIMS (array) + dim;
long idx; long idx;
scm_putc ('(', port); scm_putc ('(', port);
for (idx = dim_spec->lbnd; idx <= dim_spec->ubnd; idx++) for (idx = dim_spec->lbnd; idx <= dim_spec->ubnd; idx++)
{ {
if (dim < SCM_ARRAY_NDIM(array)-1) if (dim < SCM_I_ARRAY_NDIM(array)-1)
scm_i_print_array_dimension (array, dim+1, base, enclosed, scm_i_print_array_dimension (array, dim+1, base, enclosed,
port, pstate); port, pstate);
else else
scm_iprin1 (scm_i_cvref (SCM_ARRAY_V (array), base, enclosed), scm_iprin1 (scm_i_cvref (SCM_I_ARRAY_V (array), base, enclosed),
port, pstate); port, pstate);
if (idx < dim_spec->ubnd) if (idx < dim_spec->ubnd)
scm_putc (' ', port); scm_putc (' ', port);
@ -2447,10 +2457,10 @@ scm_i_print_array_dimension (SCM array, int dim, int base, int enclosed,
static int static int
scm_i_print_array (SCM array, SCM port, scm_print_state *pstate) scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
{ {
long ndim = SCM_ARRAY_NDIM (array); long ndim = SCM_I_ARRAY_NDIM (array);
scm_t_array_dim *dim_specs = SCM_ARRAY_DIMS (array); scm_t_array_dim *dim_specs = SCM_I_ARRAY_DIMS (array);
SCM v = SCM_ARRAY_V (array); SCM v = SCM_I_ARRAY_V (array);
unsigned long base = SCM_ARRAY_BASE (array); unsigned long base = SCM_I_ARRAY_BASE (array);
long i; long i;
int print_lbnds = 0, zero_size = 0, print_lens = 0; int print_lbnds = 0, zero_size = 0, print_lens = 0;
@ -2529,7 +2539,7 @@ scm_i_print_enclosed_array (SCM array, SCM port, scm_print_state *pstate)
size_t base; size_t base;
scm_putc ('#', port); scm_putc ('#', port);
base = SCM_ARRAY_BASE (array); base = SCM_I_ARRAY_BASE (array);
scm_puts ("<enclosed-array ", port); scm_puts ("<enclosed-array ", port);
scm_i_print_array_dimension (array, 0, base, 1, port, pstate); scm_i_print_array_dimension (array, 0, base, 1, port, pstate);
scm_putc ('>', port); scm_putc ('>', port);
@ -2755,11 +2765,11 @@ SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0,
"") "")
#define FUNC_NAME s_scm_array_type #define FUNC_NAME s_scm_array_type
{ {
if (SCM_ARRAYP (ra)) if (SCM_I_ARRAYP (ra))
return scm_i_generalized_vector_type (SCM_ARRAY_V (ra)); return scm_i_generalized_vector_type (SCM_I_ARRAY_V (ra));
else if (scm_is_generalized_vector (ra)) else if (scm_is_generalized_vector (ra))
return scm_i_generalized_vector_type (ra); return scm_i_generalized_vector_type (ra);
else if (SCM_ENCLOSED_ARRAYP (ra)) else if (SCM_I_ENCLOSED_ARRAYP (ra))
scm_wrong_type_arg_msg (NULL, 0, ra, "non-enclosed array"); scm_wrong_type_arg_msg (NULL, 0, ra, "non-enclosed array");
else else
scm_wrong_type_arg_msg (NULL, 0, ra, "array"); scm_wrong_type_arg_msg (NULL, 0, ra, "array");
@ -2775,11 +2785,11 @@ SCM_DEFINE (scm_array_prototype, "array-prototype", 1, 0, 0,
"@code{make-uniform-array}.") "@code{make-uniform-array}.")
#define FUNC_NAME s_scm_array_prototype #define FUNC_NAME s_scm_array_prototype
{ {
if (SCM_ARRAYP (ra)) if (SCM_I_ARRAYP (ra))
return scm_i_get_old_prototype (SCM_ARRAY_V (ra)); return scm_i_get_old_prototype (SCM_I_ARRAY_V (ra));
else if (scm_is_generalized_vector (ra)) else if (scm_is_generalized_vector (ra))
return scm_i_get_old_prototype (ra); return scm_i_get_old_prototype (ra);
else if (SCM_ENCLOSED_ARRAYP (ra)) else if (SCM_I_ENCLOSED_ARRAYP (ra))
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
else else
scm_wrong_type_arg_msg (NULL, 0, ra, "array"); scm_wrong_type_arg_msg (NULL, 0, ra, "array");
@ -2791,15 +2801,15 @@ SCM_DEFINE (scm_array_prototype, "array-prototype", 1, 0, 0,
static SCM static SCM
array_mark (SCM ptr) array_mark (SCM ptr)
{ {
return SCM_ARRAY_V (ptr); return SCM_I_ARRAY_V (ptr);
} }
static size_t static size_t
array_free (SCM ptr) array_free (SCM ptr)
{ {
scm_gc_free (SCM_ARRAY_MEM (ptr), scm_gc_free (SCM_I_ARRAY_MEM (ptr),
(sizeof (scm_t_array) (sizeof (scm_i_t_array)
+ SCM_ARRAY_NDIM (ptr) * sizeof (scm_t_array_dim)), + SCM_I_ARRAY_NDIM (ptr) * sizeof (scm_t_array_dim)),
"array"); "array");
return 0; return 0;
} }
@ -2871,17 +2881,17 @@ scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate)
void void
scm_init_unif () scm_init_unif ()
{ {
scm_tc16_array = scm_make_smob_type ("array", 0); scm_i_tc16_array = scm_make_smob_type ("array", 0);
scm_set_smob_mark (scm_tc16_array, array_mark); scm_set_smob_mark (scm_i_tc16_array, array_mark);
scm_set_smob_free (scm_tc16_array, array_free); scm_set_smob_free (scm_i_tc16_array, array_free);
scm_set_smob_print (scm_tc16_array, scm_i_print_array); scm_set_smob_print (scm_i_tc16_array, scm_i_print_array);
scm_set_smob_equalp (scm_tc16_array, scm_array_equal_p); scm_set_smob_equalp (scm_i_tc16_array, scm_array_equal_p);
scm_tc16_enclosed_array = scm_make_smob_type ("enclosed-array", 0); scm_i_tc16_enclosed_array = scm_make_smob_type ("enclosed-array", 0);
scm_set_smob_mark (scm_tc16_enclosed_array, array_mark); scm_set_smob_mark (scm_i_tc16_enclosed_array, array_mark);
scm_set_smob_free (scm_tc16_enclosed_array, array_free); scm_set_smob_free (scm_i_tc16_enclosed_array, array_free);
scm_set_smob_print (scm_tc16_enclosed_array, scm_i_print_enclosed_array); scm_set_smob_print (scm_i_tc16_enclosed_array, scm_i_print_enclosed_array);
scm_set_smob_equalp (scm_tc16_enclosed_array, scm_array_equal_p); scm_set_smob_equalp (scm_i_tc16_enclosed_array, scm_array_equal_p);
scm_add_feature ("array"); scm_add_feature ("array");

50
libguile/unif.h
View file

@ -41,36 +41,12 @@ typedef struct scm_t_array_dim
ssize_t inc; ssize_t inc;
} scm_t_array_dim; } scm_t_array_dim;
typedef struct scm_t_array
{
SCM v; /* the contents of the array, e.g., a vector or uniform vector. */
unsigned long base;
} scm_t_array;
SCM_API scm_t_bits scm_tc16_array;
SCM_API scm_t_bits scm_tc16_enclosed_array;
#define SCM_ARRAY_FLAG_CONTIGUOUS (1 << 16)
#define SCM_ARRAYP(a) SCM_TYP16_PREDICATE (scm_tc16_array, a)
#define SCM_ENCLOSED_ARRAYP(a) SCM_TYP16_PREDICATE (scm_tc16_enclosed_array, a)
#define SCM_ARRAY_NDIM(x) ((size_t) (SCM_CELL_WORD_0 (x) >> 17))
#define SCM_ARRAY_CONTP(x) (SCM_CELL_WORD_0 (x) & SCM_ARRAY_FLAG_CONTIGUOUS)
#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \
(SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | SCM_ARRAY_FLAG_CONTIGUOUS))
#define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \
(SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & ~SCM_ARRAY_FLAG_CONTIGUOUS))
#define SCM_ARRAY_MEM(a) ((scm_t_array *) SCM_CELL_WORD_1 (a))
#define SCM_ARRAY_V(a) (SCM_ARRAY_MEM (a)->v)
#define SCM_ARRAY_BASE(a) (SCM_ARRAY_MEM (a)->base)
#define SCM_ARRAY_DIMS(a) ((scm_t_array_dim *)((char *) SCM_ARRAY_MEM (a) + sizeof (scm_t_array)))
SCM_API SCM scm_array_p (SCM v, SCM prot); SCM_API SCM scm_array_p (SCM v, SCM prot);
SCM_API SCM scm_typed_array_p (SCM v, SCM type); SCM_API SCM scm_typed_array_p (SCM v, SCM type);
SCM_API SCM scm_make_array (SCM fill, SCM bounds); SCM_API SCM scm_make_array (SCM fill, SCM bounds);
SCM_API SCM scm_make_typed_array (SCM type, SCM fill, SCM bounds); SCM_API SCM scm_make_typed_array (SCM type, SCM fill, SCM bounds);
SCM_API SCM scm_array_rank (SCM ra); SCM_API SCM scm_array_rank (SCM ra);
SCM_API size_t scm_c_array_rank (SCM ra);
SCM_API SCM scm_array_dimensions (SCM ra); SCM_API SCM scm_array_dimensions (SCM ra);
SCM_API SCM scm_shared_array_root (SCM ra); SCM_API SCM scm_shared_array_root (SCM ra);
SCM_API SCM scm_shared_array_offset (SCM ra); SCM_API SCM scm_shared_array_offset (SCM ra);
@ -163,6 +139,29 @@ SCM_API scm_t_uint32 *scm_bitvector_writable_elements (SCM vec,
/* internal. */ /* internal. */
typedef struct scm_i_t_array
{
SCM v; /* the contents of the array, e.g., a vector or uniform vector. */
unsigned long base;
} scm_i_t_array;
SCM_API scm_t_bits scm_i_tc16_array;
SCM_API scm_t_bits scm_i_tc16_enclosed_array;
#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 16)
#define SCM_I_ARRAYP(a) SCM_TYP16_PREDICATE (scm_i_tc16_array, a)
#define SCM_I_ENCLOSED_ARRAYP(a) \
SCM_TYP16_PREDICATE (scm_i_tc16_enclosed_array, a)
#define SCM_I_ARRAY_NDIM(x) ((size_t) (SCM_CELL_WORD_0 (x) >> 17))
#define SCM_I_ARRAY_CONTP(x) (SCM_CELL_WORD_0(x) & SCM_I_ARRAY_FLAG_CONTIGUOUS)
#define SCM_I_ARRAY_MEM(a) ((scm_i_t_array *) SCM_CELL_WORD_1 (a))
#define SCM_I_ARRAY_V(a) (SCM_I_ARRAY_MEM (a)->v)
#define SCM_I_ARRAY_BASE(a) (SCM_I_ARRAY_MEM (a)->base)
#define SCM_I_ARRAY_DIMS(a) \
((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array)))
SCM_API SCM scm_i_make_ra (int ndim, int enclosed); 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_cvref (SCM v, size_t p, int enclosed);
SCM_API SCM scm_i_read_array (SCM port, int c); SCM_API SCM scm_i_read_array (SCM port, int c);
@ -181,6 +180,7 @@ SCM_API SCM scm_cvref (SCM v, unsigned long pos, SCM last);
SCM_API void scm_ra_set_contp (SCM ra); SCM_API void scm_ra_set_contp (SCM ra);
SCM_API long scm_aind (SCM ra, SCM args, const char *what); 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); SCM_API int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate);
#endif #endif
SCM_API void scm_init_unif (void); SCM_API void scm_init_unif (void);

24
libguile/vectors.c
View file

@ -43,9 +43,9 @@ scm_is_vector (SCM obj)
{ {
if (SCM_I_IS_VECTOR (obj)) if (SCM_I_IS_VECTOR (obj))
return 1; return 1;
if (SCM_ARRAYP (obj) && SCM_ARRAY_NDIM (obj) == 1) if (SCM_I_ARRAYP (obj) && SCM_I_ARRAY_NDIM (obj) == 1)
{ {
SCM v = SCM_ARRAY_V (obj); SCM v = SCM_I_ARRAY_V (obj);
return SCM_I_IS_VECTOR (v); return SCM_I_IS_VECTOR (v);
} }
return 0; return 0;
@ -102,9 +102,9 @@ scm_vector_length (SCM v)
{ {
if (SCM_I_IS_VECTOR (v)) if (SCM_I_IS_VECTOR (v))
return scm_from_size_t (SCM_I_VECTOR_LENGTH (v)); return scm_from_size_t (SCM_I_VECTOR_LENGTH (v));
else if (SCM_ARRAYP (v) && SCM_ARRAY_NDIM (v) == 1) else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
{ {
scm_t_array_dim *dim = SCM_ARRAY_DIMS (v); scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v);
return scm_from_size_t (dim->ubnd - dim->lbnd + 1); return scm_from_size_t (dim->ubnd - dim->lbnd + 1);
} }
else else
@ -196,15 +196,15 @@ scm_c_vector_ref (SCM v, size_t k)
scm_out_of_range (NULL, scm_from_size_t (k)); scm_out_of_range (NULL, scm_from_size_t (k));
return (SCM_I_VECTOR_ELTS(v))[k]; return (SCM_I_VECTOR_ELTS(v))[k];
} }
else if (SCM_ARRAYP (v) && SCM_ARRAY_NDIM (v) == 1) else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
{ {
scm_t_array_dim *dim = SCM_ARRAY_DIMS (v); scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v);
SCM vv = SCM_ARRAY_V (v); SCM vv = SCM_I_ARRAY_V (v);
if (SCM_I_IS_VECTOR (vv)) if (SCM_I_IS_VECTOR (vv))
{ {
if (k >= dim->ubnd - dim->lbnd + 1) if (k >= dim->ubnd - dim->lbnd + 1)
scm_out_of_range (NULL, scm_from_size_t (k)); scm_out_of_range (NULL, scm_from_size_t (k));
k = SCM_ARRAY_BASE (v) + k*dim->inc; k = SCM_I_ARRAY_BASE (v) + k*dim->inc;
return (SCM_I_VECTOR_ELTS (vv))[k]; return (SCM_I_VECTOR_ELTS (vv))[k];
} }
scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector"); scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
@ -244,15 +244,15 @@ scm_c_vector_set_x (SCM v, size_t k, SCM obj)
scm_out_of_range (NULL, scm_from_size_t (k)); scm_out_of_range (NULL, scm_from_size_t (k));
(SCM_I_VECTOR_WELTS(v))[k] = obj; (SCM_I_VECTOR_WELTS(v))[k] = obj;
} }
else if (SCM_ARRAYP (v) && SCM_ARRAY_NDIM (v) == 1) else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
{ {
scm_t_array_dim *dim = SCM_ARRAY_DIMS (v); scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v);
SCM vv = SCM_ARRAY_V (v); SCM vv = SCM_I_ARRAY_V (v);
if (SCM_I_IS_VECTOR (vv)) if (SCM_I_IS_VECTOR (vv))
{ {
if (k >= dim->ubnd - dim->lbnd + 1) if (k >= dim->ubnd - dim->lbnd + 1)
scm_out_of_range (NULL, scm_from_size_t (k)); scm_out_of_range (NULL, scm_from_size_t (k));
k = SCM_ARRAY_BASE (v) + k*dim->inc; k = SCM_I_ARRAY_BASE (v) + k*dim->inc;
(SCM_I_VECTOR_WELTS (vv))[k] = obj; (SCM_I_VECTOR_WELTS (vv))[k] = obj;
} }
else else