Merge branch 'lloda-array-support'

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;
@@ -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;

libguile/arrays.c

@@ -1,6 +1,6 @@
 /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004,2005,
  *   2006, 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
@@ -29,6 +29,8 @@
 #include <string.h>
 #include <assert.h>
 
+#include "verify.h"
+
 #include "libguile/_scm.h"
 #include "libguile/__scm.h"
 #include "libguile/eq.h"
@@ -92,7 +94,7 @@ SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0,
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0, 
+SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0,
            (SCM ra),
 	    "For each dimension, return the distance between elements in the root vector.")
 #define FUNC_NAME s_scm_shared_array_increments
@@ -112,15 +114,19 @@ SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+/* FIXME: to avoid this assumption, fix the accessors in arrays.h,
+   scm_i_make_array, and the array cases in system/vm/assembler.scm. */
+
+verify (sizeof (scm_t_array_dim) == 3*sizeof (scm_t_bits));
+
+/* Matching SCM_I_ARRAY accessors in arrays.h */
 SCM
 scm_i_make_array (int ndim)
 {
-  SCM ra;
+  SCM ra = scm_words (((scm_t_bits) ndim << 17) + scm_tc7_array, 3 + ndim*3);
-  ra = scm_cell (((scm_t_bits) ndim << 17) + scm_tc7_array,
+  SCM_I_ARRAY_SET_V (ra, SCM_BOOL_F);
-		 (scm_t_bits) scm_gc_malloc (sizeof (scm_i_t_array) +
+  SCM_I_ARRAY_SET_BASE (ra, 0);
-					     ndim * sizeof (scm_t_array_dim),
+  /* dimensions are unset */
-					     "array"));
-  SCM_I_ARRAY_V (ra) = SCM_BOOL_F;
   return ra;
 }
 
@@ -139,7 +145,7 @@ scm_i_shap2ra (SCM args)
     scm_misc_error (NULL, s_bad_spec, SCM_EOL);
 
   ra = scm_i_make_array (ndim);
-  SCM_I_ARRAY_BASE (ra) = 0;
+  SCM_I_ARRAY_SET_BASE (ra, 0);
   s = SCM_I_ARRAY_DIMS (ra);
   for (; !scm_is_null (args); s++, args = SCM_CDR (args))
     {
@@ -179,7 +185,7 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
   size_t k, rlen = 1;
   scm_t_array_dim *s;
   SCM ra;
-  
+
   ra = scm_i_shap2ra (bounds);
   SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
   s = SCM_I_ARRAY_DIMS (ra);
@@ -195,8 +201,7 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
   if (scm_is_eq (fill, SCM_UNSPECIFIED))
     fill = SCM_UNDEFINED;
 
-  SCM_I_ARRAY_V (ra) =
+  SCM_I_ARRAY_SET_V (ra, scm_make_generalized_vector (type, scm_from_size_t (rlen), fill));
-    scm_make_generalized_vector (type, scm_from_size_t (rlen), fill);
 
   if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
     if (0 == s->lbnd)
@@ -217,7 +222,7 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
   scm_t_array_handle h;
   void *elts;
   size_t sz;
-  
+
   ra = scm_i_shap2ra (bounds);
   SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
   s = SCM_I_ARRAY_DIMS (ra);
@@ -229,8 +234,7 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
       SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
       rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
     }
-  SCM_I_ARRAY_V (ra) =
+  SCM_I_ARRAY_SET_V (ra, scm_make_generalized_vector (type, scm_from_size_t (rlen), SCM_UNDEFINED));
-    scm_make_generalized_vector (type, scm_from_size_t (rlen), SCM_UNDEFINED);
 
 
   scm_array_get_handle (ra, &h);
@@ -273,7 +277,7 @@ scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len)
   scm_t_array_dim *s;
   SCM ra;
   scm_t_array_handle h;
-  
+
   ra = scm_i_shap2ra (bounds);
   SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
   s = SCM_I_ARRAY_DIMS (ra);
@@ -288,7 +292,7 @@ scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len)
   if (rlen != len)
     SCM_MISC_ERROR ("element length and dimensions do not match", SCM_EOL);
 
-  SCM_I_ARRAY_V (ra) = scm_c_make_vector (rlen, SCM_UNDEFINED);
+  SCM_I_ARRAY_SET_V (ra, scm_c_make_vector (rlen, SCM_UNDEFINED));
   scm_array_get_handle (ra, &h);
   memcpy (h.writable_elements, elts, rlen * sizeof(SCM));
   scm_array_handle_release (&h);
@@ -323,7 +327,7 @@ scm_i_ra_set_contp (SCM ra)
 	      SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra);
 	      return;
 	    }
-	  inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd 
+	  inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd
 		  - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1);
 	}
     }
@@ -368,7 +372,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
 
   if (SCM_I_ARRAYP (oldra))
     {
-      SCM_I_ARRAY_V (ra) = SCM_I_ARRAY_V (oldra);
+      SCM_I_ARRAY_SET_V (ra, SCM_I_ARRAY_V (oldra));
       old_base = old_min = old_max = SCM_I_ARRAY_BASE (oldra);
       s = scm_array_handle_dims (&old_handle);
       k = scm_array_handle_rank (&old_handle);
@@ -382,7 +386,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
     }
   else
     {
-      SCM_I_ARRAY_V (ra) = oldra;
+      SCM_I_ARRAY_SET_V (ra, oldra);
       old_base = old_min = 0;
       old_max = scm_c_array_length (oldra) - 1;
     }
@@ -398,9 +402,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
 	    ra = scm_make_generalized_vector (scm_array_type (ra),
                                               SCM_INUM0, SCM_UNDEFINED);
 	  else
-	    SCM_I_ARRAY_V (ra) =
+	    SCM_I_ARRAY_SET_V (ra, scm_make_generalized_vector (scm_array_type (ra),
-              scm_make_generalized_vector (scm_array_type (ra),
+                                                                SCM_INUM0, SCM_UNDEFINED));
-                                           SCM_INUM0, SCM_UNDEFINED);
 	  scm_array_handle_release (&old_handle);
 	  return ra;
 	}
@@ -408,7 +411,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
 
   imap = scm_apply_0 (mapfunc, scm_reverse (inds));
   i = scm_array_handle_pos (&old_handle, imap);
-  SCM_I_ARRAY_BASE (ra) = new_min = new_max = i + old_base;
+  new_min = new_max = i + old_base;
+  SCM_I_ARRAY_SET_BASE (ra, new_min);
   indptr = inds;
   k = SCM_I_ARRAY_NDIM (ra);
   while (k--)
@@ -450,7 +454,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
 
 
 /* args are RA . DIMS */
-SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, 
+SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
            (SCM ra, SCM args),
 	    "Return an array sharing contents with @var{ra}, but with\n"
 	    "dimensions arranged in a different order.  There must be one\n"
@@ -509,8 +513,8 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
 	}
       ndim++;
       res = scm_i_make_array (ndim);
-      SCM_I_ARRAY_V (res) = SCM_I_ARRAY_V (ra);
+      SCM_I_ARRAY_SET_V (res, SCM_I_ARRAY_V (ra));
-      SCM_I_ARRAY_BASE (res) = SCM_I_ARRAY_BASE (ra);
+      SCM_I_ARRAY_SET_BASE (res, SCM_I_ARRAY_BASE (ra));
       for (k = ndim; k--;)
 	{
 	  SCM_I_ARRAY_DIMS (res)[k].lbnd = 0;
@@ -534,7 +538,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
 		r->ubnd = s->ubnd;
 	      if (r->lbnd < s->lbnd)
 		{
-		  SCM_I_ARRAY_BASE (res) += (s->lbnd - r->lbnd) * r->inc;
+		  SCM_I_ARRAY_SET_BASE (res, SCM_I_ARRAY_BASE (res) + (s->lbnd - r->lbnd) * r->inc);
 		  r->lbnd = s->lbnd;
 		}
 	      r->inc += s->inc;
@@ -596,8 +600,8 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
           SCM sra = scm_i_make_array (1);
           SCM_I_ARRAY_DIMS (sra)->lbnd = 0;
           SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1;
-          SCM_I_ARRAY_V (sra) = v;
+          SCM_I_ARRAY_SET_V (sra, v);
-          SCM_I_ARRAY_BASE (sra) = SCM_I_ARRAY_BASE (ra);
+          SCM_I_ARRAY_SET_BASE (sra, SCM_I_ARRAY_BASE (ra));
           SCM_I_ARRAY_DIMS (sra)->inc = (ndim ? SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc : 1);
           return sra;
         }
@@ -760,7 +764,7 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
     scm_intprint (h.ndims, 10, port);
   if (h.element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
     scm_write (scm_array_handle_element_type (&h), port);
-  
+
   for (i = 0; i < h.ndims; i++)
     {
       if (h.dims[i].lbnd != 0)

libguile/arrays.h

@@ -54,23 +54,18 @@ SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst);
 
 /* 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;
-
 #define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0)
 
 #define SCM_I_ARRAYP(a)	    SCM_TYP16_PREDICATE (scm_tc7_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 << 16))
 
-#define SCM_I_ARRAY_MEM(a)  ((scm_i_t_array *) SCM_CELL_WORD_1 (a))
+#define SCM_I_ARRAY_V(a)    SCM_CELL_OBJECT_1 (a)
-#define SCM_I_ARRAY_V(a)    (SCM_I_ARRAY_MEM (a)->v)
+#define SCM_I_ARRAY_BASE(a) ((size_t) SCM_CELL_WORD_2 (a))
-#define SCM_I_ARRAY_BASE(a) (SCM_I_ARRAY_MEM (a)->base)
+#define SCM_I_ARRAY_DIMS(a) ((scm_t_array_dim *) SCM_CELL_OBJECT_LOC (a, 3))
-#define SCM_I_ARRAY_DIMS(a) \
+
-  ((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array)))
+#define SCM_I_ARRAY_SET_V(a, v)       SCM_SET_CELL_OBJECT_1(a, v)
+#define SCM_I_ARRAY_SET_BASE(a, base) SCM_SET_CELL_WORD_2(a, base)
 
 SCM_INTERNAL SCM scm_i_make_array (int ndim);
 SCM_INTERNAL int scm_i_print_array (SCM array, SCM port, scm_print_state *pstate);

libguile/deprecated.h

@@ -129,7 +129,6 @@ SCM_DEPRECATED SCM scm_internal_dynamic_wind (scm_t_guard before,
 #define scm_substring_move_right_x scm_substring_move_right_x__GONE__REPLACE_WITH__scm_substring_move_x
 #define scm_vtable_index_printer scm_vtable_index_printer__GONE__REPLACE_WITH__scm_vtable_index_instance_printer
 #define scm_vtable_index_vtable scm_vtable_index_vtable__GONE__REPLACE_WITH__scm_vtable_index_self
-typedef scm_i_t_array scm_i_t_array__GONE__REPLACE_WITH__scm_t_array;
 
 #ifndef BUILDING_LIBGUILE
 #define SCM_ASYNC_TICK  SCM_ASYNC_TICK__GONE__REPLACE_WITH__scm_async_tick

module/system/vm/assembler.scm

@@ -900,14 +900,15 @@ table, its existing label is used directly."
                          ,(recur (make-uniform-vector-backing-store
                                   (uniform-array->bytevector obj)
                                   width))))))
+     ((array? obj)
+      `((static-patch! ,label 1 ,(recur (shared-array-root obj)))))
      (else
       (error "don't know how to intern" obj))))
   (cond
    ((immediate? obj) #f)
    ((vhash-assoc obj (asm-constants asm)) => cdr)
    (else
-    ;; Note that calling intern may mutate asm-constants and
+    ;; Note that calling intern may mutate asm-constants and asm-inits.
-    ;; asm-constant-inits.
     (let* ((label (gensym "constant"))
            (inits (intern obj label)))
       (set-asm-constants! asm (vhash-cons obj label (asm-constants asm)))
@@ -1230,6 +1231,7 @@ should be .data or .rodata), and return the resulting linker object.
   (define tc7-program 69)
   (define tc7-bytevector 77)
   (define tc7-bitvector 95)
+  (define tc7-array 93)
 
   (let ((word-size (asm-word-size asm))
         (endianness (asm-endianness asm)))
@@ -1254,6 +1256,8 @@ should be .data or .rodata), and return the resulting linker object.
         (* 4 word-size))
        ((uniform-vector-backing-store? x)
         (bytevector-length (uniform-vector-backing-store-bytes x)))
+       ((array? x)
+        (* word-size (+ 3 (* 3 (array-rank x)))))
        (else
         word-size)))
 
@@ -1310,7 +1314,7 @@ should be .data or .rodata), and return the resulting linker object.
         (write-immediate asm buf pos #f))
 
        ((string? obj)
-        (let ((tag (logior tc7-ro-string (ash (string-length obj) 8))))
+        (let ((tag (logior tc7-ro-string (ash (string-length obj) 8)))) ; FIXME: unused?
           (case word-size
             ((4)
              (bytevector-u32-set! buf pos tc7-ro-string endianness)
@@ -1385,6 +1389,27 @@ should be .data or .rodata), and return the resulting linker object.
             ;; Need to swap units of element-size bytes
             (error "FIXME: Implement byte order swap"))))
 
+       ((array? obj)
+        (let-values
+            ;; array tag + rank + contp flag: see libguile/arrays.h .
+            (((tag) (logior tc7-array (ash (array-rank obj) 17) (ash 1 16)))
+             ((bv-set! bvs-set!)
+              (case word-size
+                ((4) (values bytevector-u32-set! bytevector-s32-set!))
+                ((8) (values bytevector-u64-set! bytevector-s64-set!))
+                (else (error "bad word size")))))
+          (bv-set! buf pos tag endianness)
+          (write-immediate asm buf (+ pos word-size) #f) ; root vector (fixed later)
+          (bv-set! buf (+ pos (* word-size 2)) 0 endianness) ; base
+          (let lp ((pos (+ pos (* word-size 3)))
+                   (bounds (array-shape obj))
+                   (incs (shared-array-increments obj)))
+            (when (pair? bounds)
+              (bvs-set! buf pos (first (first bounds)) endianness)
+              (bvs-set! buf (+ pos word-size) (second (first bounds)) endianness)
+              (bvs-set! buf (+ pos (* word-size 2)) (first incs) endianness)
+              (lp (+ pos (* 3 word-size)) (cdr bounds) (cdr incs))))))
+
        (else
         (error "unrecognized object" obj))))
 

test-suite/test-suite/lib.scm

@@ -465,6 +465,8 @@
 (define-syntax c&e
   (syntax-rules (pass-if pass-if-equal pass-if-exception)
     "Run the given tests both with the evaluator and the compiler/VM."
+    ((_ (pass-if exp))
+     (c&e (pass-if "[unnamed test]" exp)))
     ((_ (pass-if test-name exp))
      (begin (pass-if (string-append test-name " (eval)")
                      (primitive-eval 'exp))

test-suite/tests/arrays.test

@@ -200,7 +200,7 @@
 ;;; array-equal?
 ;;;
 
-(with-test-prefix "array-equal?"
+(with-test-prefix/c&e "array-equal?"
 
   (pass-if "#s16(...)"
     (array-equal? #s16(1 2 3) #s16(1 2 3))))
@@ -212,7 +212,7 @@
 (define exception:mapping-out-of-range
   (cons 'misc-error "^mapping out of range"))  ;; per scm_make_shared_array
 
-(with-test-prefix "make-shared-array"
+(with-test-prefix/c&e "make-shared-array"
 
   ;; this failed in guile 1.8.0
   (pass-if "vector unchanged"
@@ -283,9 +283,9 @@
 ;;; array-contents
 ;;;
 
-(with-test-prefix "array-contents"
+(define (every-two x) (make-shared-array x (lambda (i) (list (* i 2))) 2))
 
-  (define (every-two x) (make-shared-array x (lambda (i) (list (* i 2))) 2))
+(with-test-prefix/c&e "array-contents"
 
   (pass-if "simple vector"
     (let* ((a (make-array 0 4)))
@@ -342,30 +342,33 @@
       (not (array-contents b))))
 
   ;; FIXME maybe this should be allowed.
-  #;
+  ;; (pass-if "broadcast vector -> empty"
-  (pass-if "broadcast vector -> empty"
+  ;;   (let* ((a (make-array 0 4))
-    (let* ((a (make-array 0 4))
+  ;;          (b (make-shared-array a (lambda (i j k) (list k)) 0 1 4)))
-           (b (make-shared-array a (lambda (i j k) (list k)) 0 1 4)))
+  ;;     (if #f #f)))
-      (if #f #f)))
 
   (pass-if "broadcast 2-rank I"
     (let* ((a #2((1 2 3) (4 5 6)))
            (b (make-shared-array a (lambda (i j) (list 0 j)) 2 3)))
       (not (array-contents b))))
 
-  (pass-if "broadcast 2-rank I"
+  (pass-if "broadcast 2-rank II"
     (let* ((a #2((1 2 3) (4 5 6)))
            (b (make-shared-array a (lambda (i j) (list i 0)) 2 3)))
-      (not (array-contents b)))))
+      (not (array-contents b))))
+
+  (pass-if "literal array"
+    (not (not (array-contents #2((1 2 3) (4 5 6)))))))
+
 
 ;;;
 ;;; shared-array-root
 ;;;
 
-(with-test-prefix "shared-array-root"
+(define amap1 (lambda (i) (list (* 2 i))))
+(define amap2 (lambda (i j) (list (+ 1 (* 2 i)) (+ 1 (* 2 j)))))
 
-  (define amap1 (lambda (i) (list (* 2 i))))
+(with-test-prefix/c&e "shared-array-root"
-  (define amap2 (lambda (i j) (list (+ 1 (* 2 i)) (+ 1 (* 2 j)))))
 
   (pass-if "plain vector"
     (let* ((a (make-vector 4 0))
@@ -395,7 +398,7 @@
 (define exception:wrong-type-arg
   (cons #t "Wrong type"))
 
-(with-test-prefix "transpose-array"
+(with-test-prefix/c&e "transpose-array"
 
   (pass-if-exception "non array argument" exception:wrong-type-arg
     (transpose-array 99))
@@ -436,11 +439,11 @@
 ;;; array->list
 ;;;
 
-(with-test-prefix "array->list"
+(with-test-prefix/c&e "array->list"
-  (pass-if-equal '(1 2 3) (array->list #s16(1 2 3)))
+  (pass-if-equal "uniform vector" '(1 2 3) (array->list #s16(1 2 3)))
-  (pass-if-equal '(1 2 3) (array->list #(1 2 3)))
+  (pass-if-equal "vector" '(1 2 3) (array->list #(1 2 3)))
-  (pass-if-equal '((1 2) (3 4) (5 6)) (array->list #2((1 2) (3 4) (5 6))))
+  (pass-if-equal "rank 2 array" '((1 2) (3 4) (5 6)) (array->list #2((1 2) (3 4) (5 6))))
-  (pass-if-equal '()  (array->list #()))
+  (pass-if-equal "empty vector" '()  (array->list #()))
 
   (pass-if-equal "http://bugs.gnu.org/12465 - ok"
       '(3 4)
@@ -531,7 +534,7 @@
 ;;; array-in-bounds?
 ;;;
 
-(with-test-prefix "array-in-bounds?"
+(with-test-prefix/c&e "array-in-bounds?"
 
   (pass-if (let ((a (make-array #f '(425 425))))
 	     (eq? #f (array-in-bounds? a 0)))))
@@ -542,7 +545,7 @@
 
 (with-test-prefix "array-type"
 
-  (with-test-prefix "on make-foo-vector"
+  (with-test-prefix/c&e "on make-foo-vector"
 
     (pass-if "bool"
       (eq? 'b (array-type (make-bitvector 1))))
@@ -728,7 +731,7 @@
 ;;; syntax
 ;;;
 
-(with-test-prefix "syntax"
+(with-test-prefix/c&e "syntax"
 
   (pass-if "rank and lower bounds"
     ;; uniform u32 array of rank 2 with index ranges 2..3 and 7..8.
@@ -770,7 +773,7 @@
 ;;; equal? with vector and one-dimensional array
 ;;;
 
-(with-test-prefix "equal?"
+(with-test-prefix/c&e "equal?"
   (pass-if "array and non-array"
     (not (equal? #2f64((0 1) (2 3)) 100)))
 
@@ -805,12 +808,12 @@
 ;;; slices as generalized vectors
 ;;;
 
-(let ((array #2u32((0 1) (2 3))))
+(define (array-row a i)
-  (define (array-row a i)
+  (make-shared-array a (lambda (j) (list i j))
-    (make-shared-array a (lambda (j) (list i j))
+                     (cadr (array-dimensions a))))
-                       (cadr (array-dimensions a))))
+
-  (with-test-prefix "generalized vector slices"
+(with-test-prefix/c&e "generalized vector slices"
-    (pass-if (equal? (array-row array 1)
+  (pass-if (equal? (array-row #2u32((0 1) (2 3)) 1)
-                     #u32(2 3)))
+                   #u32(2 3)))
-    (pass-if (equal? (array-ref (array-row array 1) 0)
+  (pass-if (equal? (array-ref (array-row #2u32((0 1) (2 3)) 1) 0)
-                     2))))
+                   2)))