summaryrefslogtreecommitdiffstats
path: root/ramap.c
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:27 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:27 -0800
commitc7d035ae1a729232579a0fe41ed5affa131d3623 (patch)
treefb387f7c2a8e01cf603d4c75fbbaa68f711df986 /ramap.c
parentdeda2c0fd8689349fea2a900199a76ff7ecb319e (diff)
downloadscm-c7d035ae1a729232579a0fe41ed5affa131d3623.tar.gz
scm-c7d035ae1a729232579a0fe41ed5affa131d3623.zip
Import Upstream version 5d9upstream/5d9
Diffstat (limited to 'ramap.c')
-rw-r--r--ramap.c21
1 files changed, 14 insertions, 7 deletions
diff --git a/ramap.c b/ramap.c
index 08ba177..42181ee 100644
--- a/ramap.c
+++ b/ramap.c
@@ -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\
");
}