From c7d035ae1a729232579a0fe41ed5affa131d3623 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:27 -0800
Subject: Import Upstream version 5d9

---
 ramap.c | 21 ++++++++++++++-------
 1 file changed, 14 insertions(+), 7 deletions(-)

(limited to 'ramap.c')

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\
 ");
 }
-- 
cgit v1.2.3