guile-commits
[Top][All Lists]
Advanced

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

[Guile-commits] 01/01: Deprecate scm_from_contiguous_array


From: Daniel Llorens
Subject: [Guile-commits] 01/01: Deprecate scm_from_contiguous_array
Date: Fri, 18 Nov 2016 16:56:25 +0000 (UTC)

lloda pushed a commit to branch lloda-squash1
in repository guile.

commit 180010821dfe27d58ac03f671c4aa39da90dddae
Author: Daniel Llorens <address@hidden>
Date:   Fri Nov 18 16:23:05 2016 +0100

    Deprecate scm_from_contiguous_array
    
    scm_from_contiguous_array() was undocumented, unused within Guile, and
    can be replaced by make-array + array-copy! without requiring contiguity
    and without loss of performance.
    
    * libguile/arrays.c (scm_array_contents): Do not rely on
      SCM_I_ARRAY_CONTP.
    * test-suite/tests/arrays.test: Test array-contents with 0-rank array.
    * libguile/arrays.h: Declare scm_i_shap2ra(),
      SCM_SET_ARRAY_CONTIGUOUS_FLAG, SCM_CLR_ARRAY_CONTIGUOUS_FLAG so that
      scm_from_contiguous_array() can keep using them.
    * libguile/deprecated.c (scm_from_contiguous_array): Move here from
      arrays.c.
    * libguile/deprecated.h (scm_from_contiguous_array): Deprecate.
    * NEWS: Add deprecation notice.
---
 NEWS                         |    5 +++
 libguile/arrays.c            |   91 ++++++++++++++----------------------------
 libguile/arrays.h            |   10 +++--
 libguile/deprecated.c        |   40 +++++++++++++++++++
 libguile/deprecated.h        |   10 +++++
 test-suite/tests/arrays.test |    6 +++
 6 files changed, 98 insertions(+), 64 deletions(-)

diff --git a/NEWS b/NEWS
index 9221739..e36e264 100644
--- a/NEWS
+++ b/NEWS
@@ -102,6 +102,11 @@ scm_dynwind_block_asyncs.
 Use `scm_make_mutex_with_kind' instead.  See "Mutexes and Condition
 Variables" in the manual, for more.
 
+** `scm_from_contiguous_array' deprecated
+
+This function was never documented. Use `scm_make-array' and
+`scm_array_copy_x' instead.
+
 * Bug fixes
 ** cancel-thread uses asynchronous interrupts, not pthread_cancel
 
diff --git a/libguile/arrays.c b/libguile/arrays.c
index 31a1d4f..75e92e1 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -57,12 +57,6 @@
 #include "libguile/uniform.h"
 
 
-#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \
-  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | 
(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16)))
-#define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \
-  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & 
~(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16)))
-
-
 size_t
 scm_c_array_rank (SCM array)
 {
@@ -156,7 +150,7 @@ static char s_bad_spec[] = "Bad scm_array dimension";
 
 /* Increments will still need to be set. */
 
-static SCM
+SCM
 scm_i_shap2ra (SCM args)
 {
   scm_t_array_dim *s;
@@ -290,41 +284,6 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, 
const void *bytes,
 }
 #undef FUNC_NAME
 
-SCM
-scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len)
-#define FUNC_NAME "scm_from_contiguous_array"
-{
-  size_t k, rlen = 1;
-  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);
-  k = SCM_I_ARRAY_NDIM (ra);
-
-  while (k--)
-    {
-      s[k].inc = rlen;
-      SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
-      rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
-    }
-  if (rlen != len)
-    SCM_MISC_ERROR ("element length and dimensions do not match", SCM_EOL);
-
-  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);
-
-  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
-    if (0 == s->lbnd)
-      return SCM_I_ARRAY_V (ra);
-  return ra;
-}
-#undef FUNC_NAME
-
 SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1,
            (SCM fill, SCM bounds),
            "Create and return an array.")
@@ -334,6 +293,7 @@ SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1,
 }
 #undef FUNC_NAME
 
+/* see scm_from_contiguous_array */
 static void
 scm_i_ra_set_contp (SCM ra)
 {
@@ -758,31 +718,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);
@@ -799,8 +766,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 977d307..37eea69 100644
--- a/libguile/arrays.h
+++ b/libguile/arrays.h
@@ -37,8 +37,6 @@
 /** Arrays */
 
 SCM_API SCM scm_make_array (SCM fill, SCM bounds);
-SCM_API SCM scm_from_contiguous_array (SCM bounds, const SCM *elts,
-                                       size_t len);
 SCM_API SCM scm_make_typed_array (SCM type, SCM fill, SCM bounds);
 SCM_API SCM scm_from_contiguous_typed_array (SCM type, SCM bounds,
                                              const void *bytes,
@@ -63,7 +61,12 @@ SCM_API SCM scm_array_rank (SCM ra);
 
 /* internal. */
 
-#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0)
+/* see scm_from_contiguous_array  for these three */
+#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0)  
+#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \
+  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | 
(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16)))
+#define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \
+  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & 
~(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16)))
 
 #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))
@@ -78,6 +81,7 @@ SCM_API SCM scm_array_rank (SCM ra);
 
 SCM_INTERNAL SCM scm_i_make_array (int ndim);
 SCM_INTERNAL int scm_i_print_array (SCM array, SCM port, scm_print_state 
*pstate);
+SCM_INTERNAL SCM scm_i_shap2ra (SCM args);
 
 SCM_INTERNAL void scm_init_arrays (void);
 
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 6da604e..0c7503e 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -729,6 +729,46 @@ scm_unlock_mutex_timed (SCM mx, SCM cond, SCM timeout)
   return scm_unlock_mutex (mx);
 }
 
+
+
+SCM
+scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len)
+#define FUNC_NAME "scm_from_contiguous_array"
+{
+  size_t k, rlen = 1;
+  scm_t_array_dim *s;
+  SCM ra;
+  scm_t_array_handle h;
+
+  scm_c_issue_deprecation_warning
+    ("`scm_from_contiguous_array' is deprecated. Use make-array and 
array-copy!\n"
+     "instead.\n");
+  
+  ra = scm_i_shap2ra (bounds);
+  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
+  s = SCM_I_ARRAY_DIMS (ra);
+  k = SCM_I_ARRAY_NDIM (ra);
+
+  while (k--)
+    {
+      s[k].inc = rlen;
+      SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
+      rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
+    }
+  if (rlen != len)
+    SCM_MISC_ERROR ("element length and dimensions do not match", SCM_EOL);
+
+  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);
+
+  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
+    if (0 == s->lbnd)
+      return SCM_I_ARRAY_V (ra);
+  return ra;
+}
+#undef FUNC_NAME
 
 
 
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 211266f..8f388d2 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -244,6 +244,16 @@ SCM_DEPRECATED SCM scm_lock_mutex_timed (SCM m, SCM 
timeout, SCM owner);
 
 
 
+/* Deprecated 2016-11-18. Never documented. Unnecessary, since
+   array-copy! already unrolls and does it in more general cases. */
+/* With this also remove SCM_I_ARRAY_FLAG_CONTIGUOUS,
+   SCM_SET_ARRAY_CONTIGUOUS_FLAG, SCM_CLR_ARRAY_CONTIGUOUS_FLAG,
+   scm_i_ra_set_contp, and uses thereof. */
+SCM_DEPRECATED SCM scm_from_contiguous_array (SCM bounds, const SCM *elts,
+                                              size_t len);
+
+
+
 void scm_i_init_deprecated (void);
 
 #endif
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 57c5cef..4c943dd 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -413,6 +413,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]