Simplify the interpreter for trivial inits and no letrec

[bpt/guile.git] / libguile / array-map.c

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 7c051a5..938f0a7 100644 (file)
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -1,6 +1,6 @@
 /* Copyright (C) 1996, 1998, 2000, 2001, 2004, 2005, 2006, 2008, 2009,
  *   2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
- * 
+ *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
  * as published by the Free Software Foundation; either version 3 of
@@ -63,11 +63,11 @@ static SCM
 make1array (SCM v, ssize_t inc)
 {
   SCM a = scm_i_make_array (1);
-  SCM_I_ARRAY_BASE (a) = 0;
+  SCM_I_ARRAY_SET_BASE (a, 0);
   SCM_I_ARRAY_DIMS (a)->lbnd = 0;
   SCM_I_ARRAY_DIMS (a)->ubnd = scm_c_array_length (v) - 1;
   SCM_I_ARRAY_DIMS (a)->inc = inc;
-  SCM_I_ARRAY_V (a) = v;
+  SCM_I_ARRAY_SET_V (a, v);
   return a;
 }
 
@@ -195,9 +195,9 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
       if (k == kroll)
         {
           SCM y = lra;
-          SCM_I_ARRAY_BASE (va0) = cindk (ra0, vi, kroll);
+          SCM_I_ARRAY_SET_BASE (va0, cindk (ra0, vi, kroll));
           for (z = lva; !scm_is_null (z); z = SCM_CDR (z), y = SCM_CDR (y))
-            SCM_I_ARRAY_BASE (SCM_CAR (z)) = cindk (SCM_CAR (y), vi, kroll);
+            SCM_I_ARRAY_SET_BASE (SCM_CAR (z), cindk (SCM_CAR (y), vi, kroll));
           if (! (SCM_UNBNDP (data) ? cproc (va0, lva) : cproc (va0, data, lva)))
             return 0;
           --k;
@@ -574,12 +574,12 @@ ramap (SCM ra0, SCM proc, SCM ras)
   scm_t_array_handle h0;
   size_t n, i0;
   ssize_t i, inc0;
-  scm_array_get_handle (SCM_I_ARRAY_V (ra0), &h0);
   i0 = SCM_I_ARRAY_BASE (ra0);
   inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
   i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
   n = SCM_I_ARRAY_DIMS (ra0)->ubnd - i + 1;
   ra0 = SCM_I_ARRAY_V (ra0);
+  scm_array_get_handle (ra0, &h0);
   if (scm_is_null (ras))
     for (; n--; i0 += inc0)
       h0.vset (h0.vector, i0, scm_call_0 (proc));
@@ -589,11 +589,11 @@ ramap (SCM ra0, SCM proc, SCM ras)
       scm_t_array_handle h1;
       size_t i1;
       ssize_t inc1;
-      scm_array_get_handle (SCM_I_ARRAY_V (ra1), &h1);
       i1 = SCM_I_ARRAY_BASE (ra1);
       inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
       ras = SCM_CDR (ras);
       ra1 = SCM_I_ARRAY_V (ra1);
+      scm_array_get_handle (ra1, &h1);
       if (scm_is_null (ras))
         for (; n--; i0 += inc0, i1 += inc1)
           h0.vset (h0.vector, i0, scm_call_1 (proc, h1.vref (h1.vector, i1)));
@@ -651,9 +651,10 @@ rafe (SCM ra0, SCM proc, SCM ras)
   scm_t_array_handle h0;
   size_t i0;
   ssize_t inc0;
-  scm_array_get_handle (SCM_I_ARRAY_V (ra0), &h0);
   i0 = SCM_I_ARRAY_BASE (ra0);
   inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+  ra0 = SCM_I_ARRAY_V (ra0);
+  scm_array_get_handle (ra0, &h0);
   if (scm_is_null (ras))
     for (; n--; i0 += inc0)
       scm_call_1 (proc, h0.vref (h0.vector, i0));
@@ -706,16 +707,23 @@ array_index_map_n (SCM ra, SCM proc)
 {
   scm_t_array_handle h;
   size_t i;
-  int j, k, kmax = SCM_I_ARRAY_NDIM (ra) - 1;
+  int k, kmax = SCM_I_ARRAY_NDIM (ra) - 1;
   ssize_t *vi;
+  SCM **si;
+  SCM args = SCM_EOL;
+  SCM *p = &args;
 
   vi = scm_gc_malloc_pointerless (sizeof(ssize_t) * (kmax + 1), vi_gc_hint);
+  si = scm_gc_malloc_pointerless (sizeof(SCM *) * (kmax + 1), vi_gc_hint);
 
   for (k = 0; k <= kmax; k++)
     {
       vi[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
       if (vi[k] > SCM_I_ARRAY_DIMS (ra)[k].ubnd)
         return;
+      *p = scm_cons (scm_from_ssize_t (vi[k]), SCM_EOL);
+      si[k] = SCM_CARLOC (*p);
+      p = SCM_CDRLOC (*p);
     }
 
   scm_array_get_handle (ra, &h);
@@ -724,19 +732,11 @@ array_index_map_n (SCM ra, SCM proc)
     {
       if (k == kmax)
         {
-          SCM args = SCM_EOL;
-          SCM *p = &args, *q;
           vi[kmax] = SCM_I_ARRAY_DIMS (ra)[kmax].lbnd;
           i = cindk (ra, vi, kmax+1);
-          for (j = 0; j<=kmax; ++j)
-            {
-              *p = scm_cons (scm_from_ssize_t (vi[j]), SCM_EOL);
-              q = SCM_CARLOC (*p);
-              p = SCM_CDRLOC (*p);
-            }
-          for (; vi[kmax] <= SCM_I_ARRAY_DIMS (ra)[kmax].ubnd;
-               *q = scm_from_ssize_t (++vi[kmax]))
+          for (; vi[kmax] <= SCM_I_ARRAY_DIMS (ra)[kmax].ubnd; ++vi[kmax])
             {
+              *(si[kmax]) = scm_from_ssize_t (vi[kmax]);
               h.vset (h.vector, i, scm_apply_0 (proc, args));
               i += SCM_I_ARRAY_DIMS (ra)[kmax].inc;
             }
@@ -744,7 +744,7 @@ array_index_map_n (SCM ra, SCM proc)
         }
       else if (vi[k] < SCM_I_ARRAY_DIMS (ra)[k].ubnd)
         {
-          vi[k]++;
+          *(si[k]) = scm_from_ssize_t (++vi[k]);
           k++;
         }
       else
@@ -815,7 +815,7 @@ array_compare (scm_t_array_handle *hx, scm_t_array_handle *hy,
         return 0;
 
       i = hx->dims[dim].ubnd - hx->dims[dim].lbnd + 1;
-      
+
       incx = hx->dims[dim].inc;
       incy = hy->dims[dim].inc;
       posx += (i - 1) * incx;
@@ -832,11 +832,11 @@ SCM
 scm_array_equal_p (SCM x, SCM y)
 {
   scm_t_array_handle hx, hy;
-  SCM res;  
-  
+  SCM res;
+
   scm_array_get_handle (x, &hx);
   scm_array_get_handle (y, &hy);
-  
+
   res = scm_from_bool (hx.ndims == hy.ndims
                        && hx.element_type == hy.element_type);
 
@@ -860,7 +860,7 @@ SCM_DEFINE (scm_i_array_equal_p, "array-equal?", 0, 2, 1,
 {
   if (SCM_UNBNDP (ra0) || SCM_UNBNDP (ra1))
     return SCM_BOOL_T;
-  
+
   while (!scm_is_null (rest))
     { if (scm_is_false (scm_array_equal_p (ra0, ra1)))
         return SCM_BOOL_F;