diff options
Diffstat (limited to 'ramap.c')
| -rw-r--r-- | ramap.c | 21 |
1 files changed, 14 insertions, 7 deletions
@@ -44,6 +44,8 @@ #include "scm.h" +SCM sc2array P((SCM s, SCM ra, SCM prot)); + typedef struct { char *name; SCM sproc; @@ -206,7 +208,7 @@ int ramapc(cproc, data, ra0, lra, what) long *indv = &auto_indv[0]; if (ARRAY_NDIM(ra0) >= 5) { scm_protect_temp(&hp_indv); - hp_indv = make_uve(ARRAY_NDIM(ra0)+0L, MAKINUM(-1L)); + hp_indv = make_uve(ARRAY_NDIM(ra0)+0L, MAKINUM(-32L)); indv = (long *)VELTS(hp_indv); } vra0 = make_ra(1); @@ -278,7 +280,6 @@ int ramapc(cproc, data, ra0, lra, what) } } -static char s_array_fill[] = "array-fill!"; SCM array_fill(ra, fill) SCM ra, fill; { @@ -444,7 +445,7 @@ SCM array_copy(src, dst) { #ifndef RECKLESS if (INUM0==array_rank(dst)) - ASSERT(NIMP(dst) && ARRAYP(dst) && INUM0==array_rank(src), + ASRTER(NIMP(dst) && ARRAYP(dst) && INUM0==array_rank(src), dst, ARG2, s_array_copy); #endif ramapc(racp, UNDEFINED, src, cons(dst, EOL), s_array_copy); @@ -512,7 +513,7 @@ SCM sc2array(s, ra, prot) SCM s, ra, prot; { SCM res; - ASSERT(NIMP(ra), ra, ARG2, s_sc2array); + ASRTER(NIMP(ra), ra, ARG2, s_sc2array); if ARRAYP(ra) { int k = ARRAY_NDIM(ra); res = make_ra(k); @@ -524,7 +525,7 @@ SCM sc2array(s, ra, prot) ra = ARRAY_V(ra); } else { - ASSERT(BOOL_T==arrayp(ra, UNDEFINED), ra, ARG2, s_sc2array); + ASRTER(BOOL_T==arrayp(ra, UNDEFINED), ra, ARG2, s_sc2array); res = make_ra(1); ARRAY_DIMS(res)->ubnd = LENGTH(ra) - 1; ARRAY_DIMS(res)->lbnd = 0; @@ -1433,7 +1434,7 @@ SCM array_imap(ra, proc) long auto_indv[5]; long *indv = &auto_indv[0]; sizet i; - ASSERT(NIMP(ra), ra, ARG1, s_array_imap); + ASRTER(NIMP(ra), ra, ARG1, s_array_imap); i = INUM(array_rank(ra)); #ifndef RECKLESS scm_arity_check(proc, i+0L, s_array_imap); @@ -1443,7 +1444,7 @@ SCM array_imap(ra, proc) scm_protect_temp(&hp_indv); hp_av = make_vector(MAKINUM(i), BOOL_F); av = VELTS(hp_av); - hp_indv = make_uve(i+0L, MAKINUM(-1L)); + hp_indv = make_uve(i+0L, MAKINUM(-32L)); indv = (long *)VELTS(hp_indv); } switch TYP7(ra) { @@ -1662,6 +1663,8 @@ static void init_raprocs(subra) subra->sproc = CDR(sysintern(subra->name, UNDEFINED)); } +SCM_DLL_EXPORT void init_ramap P((void)); + void init_ramap() { init_raprocs(ra_rpsubrs); @@ -1677,5 +1680,9 @@ scm_ldstr("\n\ (let ((ra0 (apply create-array '#() (array-shape ra))))\n\ (array-index-map! ra0 list)\n\ ra0))\n\ +(define (array-map prototype proc ra1 . ras)\n\ + (define nra (apply create-array prototype (array-shape ra1)))\n\ + (apply array-map! nra proc ra1 ras)\n\ + nra)\n\ "); } |