guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 03/23: Unuse array 'contiguous' flag


From: Daniel Llorens
Subject: [Guile-commits] 03/23: Unuse array 'contiguous' flag
Date: Thu, 23 Jun 2016 08:36:40 +0000 (UTC)

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit 867d37ceb99585706d077fb0378873da1a29511a
Author: Daniel Llorens <address@hidden>
Date:   Tue Feb 10 17:21:29 2015 +0100

    Unuse array 'contiguous' flag
    
    SCM_I_ARRAY_FLAG_CONTIGUOUS (arrays.h) was set by all array-creating
    functions (make-typed-array, transpose-array, make-shared-array) but it
    was only used by array-contents, which needed to traverse the dimensions
    anyway.
    
    * libguile/arrays.c (scm_make_typed_array,
      scm_from_contiguous_typed_array): don't set the contiguous flag.
    
      (scm_transpose_array, scm_make_shared_array): don't call
      scm_i_ra_set_contp.
    
      (scm_array_contents): inline scm_i_ra_set_contp() here. Adopt uniform
      type check order. Remove redundant comments.
    
      (scm_i_ra_set_contp): remove.
    
    * libguile/arrays.h: note.
    
    * test-suite/tests/arrays.test: test array-contents with rank 0 array.
---
 libguile/arrays.c            |   77 ++++++++++++++++--------------------------
 libguile/arrays.h            |    2 +-
 test-suite/tests/arrays.test |    6 ++++
 3 files changed, 36 insertions(+), 49 deletions(-)

diff --git a/libguile/arrays.c b/libguile/arrays.c
index 6613542..c852e64 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -188,7 +188,6 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 
1,
   SCM ra;
 
   ra = scm_i_shap2ra (bounds);
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
   s = SCM_I_ARRAY_DIMS (ra);
   k = SCM_I_ARRAY_NDIM (ra);
 
@@ -225,7 +224,6 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, 
const void *bytes,
   size_t sz;
 
   ra = scm_i_shap2ra (bounds);
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
   s = SCM_I_ARRAY_DIMS (ra);
   k = SCM_I_ARRAY_NDIM (ra);
 
@@ -279,27 +277,6 @@ SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1,
 }
 #undef FUNC_NAME
 
-static void
-scm_i_ra_set_contp (SCM ra)
-{
-  size_t k = SCM_I_ARRAY_NDIM (ra);
-  if (k)
-    {
-      ssize_t inc = SCM_I_ARRAY_DIMS (ra)[k - 1].inc;
-      while (k--)
-       {
-         if (inc != SCM_I_ARRAY_DIMS (ra)[k].inc)
-           {
-             SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra);
-             return;
-           }
-         inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd
-                 - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1);
-       }
-    }
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
-}
-
 
 SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
            (SCM oldra, SCM mapfunc, SCM dims),
@@ -413,7 +390,6 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 
0, 1,
        return scm_make_generalized_vector (scm_array_type (ra), SCM_INUM0,
                                             SCM_UNDEFINED);
     }
-  scm_i_ra_set_contp (ra);
   return ra;
 }
 #undef FUNC_NAME
@@ -512,16 +488,12 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 
1,
        }
       if (ndim > 0)
        SCM_MISC_ERROR ("bad argument list", SCM_EOL);
-      scm_i_ra_set_contp (res);
       return res;
     }
 }
 #undef FUNC_NAME
 
-/* attempts to unroll an array into a one-dimensional array.
-   returns the unrolled array or #f if it can't be done.  */
-/* if strict is true, return #f if returned array
-   wouldn't have contiguous elements.  */
+
 SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
            (SCM ra, SCM strict),
            "If @var{ra} may be @dfn{unrolled} into a one dimensional shared\n"
@@ -531,31 +503,38 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
            "@code{make-array} and @code{make-uniform-array} may be unrolled,\n"
            "some arrays made by @code{make-shared-array} may not be.  If\n"
            "the optional argument @var{strict} is provided, a shared array\n"
-           "will be returned only if its elements are stored internally\n"
-           "contiguous in memory.")
+           "will be returned only if its elements are stored contiguously\n"
+           "in memory.")
 #define FUNC_NAME s_scm_array_contents
 {
-  if (!scm_is_array (ra))
-    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-  else if (SCM_I_ARRAYP (ra))
+  if (SCM_I_ARRAYP (ra))
     {
       SCM v;
-      size_t k, ndim = SCM_I_ARRAY_NDIM (ra), len = 1;
-      if (!SCM_I_ARRAY_CONTP (ra))
-       return SCM_BOOL_F;
-      for (k = 0; k < ndim; k++)
-       len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 
1;
+      size_t ndim = SCM_I_ARRAY_NDIM (ra);
+      scm_t_array_dim *s = SCM_I_ARRAY_DIMS (ra);
+      size_t k = ndim;
+      size_t len = 1;
+
+      if (k)
+        {
+          ssize_t last_inc = s[k - 1].inc;
+          while (k--)
+            {
+              if (len*last_inc != s[k].inc)
+                return SCM_BOOL_F;
+              len *= (s[k].ubnd - s[k].lbnd + 1);
+            }
+        }
+
       if (!SCM_UNBNDP (strict) && scm_is_true (strict))
        {
-         if (ndim && (1 != SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc))
+         if (ndim && (1 != s[ndim - 1].inc))
            return SCM_BOOL_F;
-         if (scm_is_bitvector (SCM_I_ARRAY_V (ra)))
-           {
-             if (len != scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) ||
-                 SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT ||
-                 len % SCM_LONG_BIT)
-               return SCM_BOOL_F;
-           }
+         if (scm_is_bitvector (SCM_I_ARRAY_V (ra))
+              && (len != scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) ||
+                  SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT ||
+                  len % SCM_LONG_BIT))
+            return SCM_BOOL_F;
        }
 
       v = SCM_I_ARRAY_V (ra);
@@ -572,8 +551,10 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
           return sra;
         }
     }
-  else
+  else if (scm_is_array (ra))
     return ra;
+  else
+    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
 }
 #undef FUNC_NAME
 
diff --git a/libguile/arrays.h b/libguile/arrays.h
index c486f20..4baa51e 100644
--- a/libguile/arrays.h
+++ b/libguile/arrays.h
@@ -52,7 +52,7 @@ SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM 
lst);
 
 /* internal. */
 
-#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0)
+#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0)  /* currently unused */
 
 #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))
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 7c7b467..fb72e28 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -298,6 +298,12 @@
 
 (with-test-prefix/c&e "array-contents"
 
+  (pass-if "0-rank array"
+    (let ((a (make-vector 1 77)))
+      (and
+       (eq? a (array-contents (make-shared-array a (const '(0)))))
+       (eq? a (array-contents (make-shared-array a (const '(0))) #t)))))
+
   (pass-if "simple vector"
     (let* ((a (make-array 0 4)))
       (eq? a (array-contents a))))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]