[Guile-commits] GNU Guile branch, master, updated. release_1-9-9-36-ga587d6a

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=a587d6a97338a0fd62173e60581ff07f55ec2042

The branch, master has been updated
       via  a587d6a97338a0fd62173e60581ff07f55ec2042 (commit)
      from  92d33877d9f8523eaebab75373a30f161e6cc1e8 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit a587d6a97338a0fd62173e60581ff07f55ec2042
Author: Andy Wingo <address@hidden>
Date:   Thu Apr 1 00:18:44 2010 +0200

    more fixes to equal? for arrays
    
    * libguile/array-map.c (array_compare, scm_array_equal_p): Rewrite as
      something that operates on the generic array handle infrastructure.
      Based on array->list.
      (scm_i_array_equal_p): Change the docs, as array-equal? is now the same
      as equal?, except that it typechecks its args.
    
    * doc/ref/api-compound.texi (Array Procedures): Update array-equal?
      docs.
    
    * libguile/deprecated.h:
    * libguile/deprecated.c (scm_raequal): Deprecate.
    
    * libguile/bytevectors.c (scm_bytevector_eq_p): Bugfix: bytevectors are
      bytevector=? only if their element type is the same.
    
    * libguile/eq.c (scm_equal_p): Only dispatch to scm_array_equal_p if
      both args are arrays (generically).
    
    * test-suite/tests/arrays.test ("equal?"): Add some more tests.

-----------------------------------------------------------------------

Summary of changes:
 doc/ref/api-compound.texi    |    4 +-
 libguile/array-map.c         |  154 ++++++++++-------------------------------
 libguile/array-map.h         |    3 +-
 libguile/bytevectors.c       |    3 +-
 libguile/deprecated.c        |   10 +++
 libguile/deprecated.h        |    5 ++
 libguile/eq.c                |    2 +-
 test-suite/tests/arrays.test |   21 ++++++
 8 files changed, 79 insertions(+), 123 deletions(-)

diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 1bedffd..6fcc8e9 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -1551,9 +1551,7 @@ is unspecified.
 Return @code{#t} if all arguments are arrays with the same shape, the
 same type, and have corresponding elements which are either
 @code{equal?} or @code{array-equal?}.  This function differs from
address@hidden (@pxref{Equality}) in that a one dimensional shared
-array may be @code{array-equal?} but not @code{equal?} to a vector or
-uniform vector.
address@hidden (@pxref{Equality}) in that all arguments must be arrays.
 @end deffn
 
 @c  FIXME: array-map! accepts no source arrays at all, and in that
diff --git a/libguile/array-map.c b/libguile/array-map.c
index 46acb29..dd88136 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -812,121 +812,54 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 
2, 0, 0,
 
 
 static int
-raeql_1 (SCM ra0, SCM as_equal, SCM ra1)
+array_compare (scm_t_array_handle *hx, scm_t_array_handle *hy,
+               size_t dim, unsigned long posx, unsigned long posy)
 {
-  unsigned long i0 = 0, i1 = 0;
-  long inc0 = 1, inc1 = 1;
-  unsigned long n;
-  ra1 = SCM_CAR (ra1);
-  if (SCM_I_ARRAYP(ra0))
-    {
-      n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
-      i0 = SCM_I_ARRAY_BASE (ra0);
-      inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
-      ra0 = SCM_I_ARRAY_V (ra0);
-    }
+  if (dim == scm_array_handle_rank (hx))
+    return scm_is_true (scm_equal_p (scm_array_handle_ref (hx, posx),
+                                     scm_array_handle_ref (hy, posy)));
   else
-    n = scm_c_generalized_vector_length (ra0);
-
-  if (SCM_I_ARRAYP (ra1))
     {
-      i1 = SCM_I_ARRAY_BASE (ra1);
-      inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
-      ra1 = SCM_I_ARRAY_V (ra1);
-    }
+      long incx, incy;
+      size_t i;
 
-  if (scm_is_generalized_vector (ra0))
-    {
-      for (; n--; i0 += inc0, i1 += inc1)
-       {
-         if (scm_is_false (as_equal))
-           {
-             if (scm_is_false (scm_array_equal_p (GVREF (ra0, i0), GVREF (ra1, 
i1))))
-               return 0;
-           }
-         else if (scm_is_false (scm_equal_p (GVREF (ra0, i0), GVREF (ra1, 
i1))))
-           return 0;
-       }
+      if (hx->dims[dim].lbnd != hy->dims[dim].lbnd
+          || hx->dims[dim].ubnd != hy->dims[dim].ubnd)
+        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;
+      posy += (i - 1) * incy;
+
+      for (; i > 0; i--, posx -= incx, posy -= incy)
+        if (!array_compare (hx, hy, dim + 1, posx, posy))
+          return 0;
       return 1;
     }
-  else
-    return 0;
 }
 
-
-
-static int
-raeql (SCM ra0, SCM as_equal, SCM ra1)
+SCM
+scm_array_equal_p (SCM x, SCM y)
 {
-  SCM v0 = ra0, v1 = ra1;
-  scm_t_array_dim dim0, dim1;
-  scm_t_array_dim *s0 = &dim0, *s1 = &dim1;
-  unsigned long bas0 = 0, bas1 = 0;
-  int k, unroll = 1, vlen = 1, ndim = 1;
-
-  if (SCM_I_ARRAYP (ra0))
-    {
-      if (SCM_I_ARRAY_NDIM (ra0) == 0)
-        return scm_is_true (scm_equal_p (scm_array_ref (ra0, SCM_EOL), ra1));
-      ndim = SCM_I_ARRAY_NDIM (ra0);
-      s0 = SCM_I_ARRAY_DIMS (ra0);
-      bas0 = SCM_I_ARRAY_BASE (ra0);
-      v0 = SCM_I_ARRAY_V (ra0);
-    }
-  else if (scm_is_generalized_vector (v0))
-    {
-      s0->inc = 1;
-      s0->lbnd = 0;
-      s0->ubnd = scm_c_generalized_vector_length (v0) - 1;
-      unroll = 0;
-    }
-  else if (SCM_I_ARRAYP (ra1) && SCM_I_ARRAY_NDIM (ra1) == 0)
-    return scm_is_true (scm_equal_p (ra0, scm_array_ref (ra1, SCM_EOL)));
-  else
-    /* It's just not working out, dear. */
-    return 0;
+  scm_t_array_handle hx, hy;
+  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);
 
-  if (SCM_I_ARRAYP (ra1))
-    {
-      if (ndim != SCM_I_ARRAY_NDIM (ra1))
-       return 0;
-      s1 = SCM_I_ARRAY_DIMS (ra1);
-      bas1 = SCM_I_ARRAY_BASE (ra1);
-      v1 = SCM_I_ARRAY_V (ra1);
-    }
-  else if (scm_is_generalized_vector (v1))
-    {
-      s1->inc = 1;
-      s1->lbnd = 0;
-      s1->ubnd = scm_c_generalized_vector_length (v1) - 1;
-      unroll = 0;
-    }
-  else
-    /* It's not you, it's me. */
-    return 0;
-
-  if (SCM_TYP7 (v0) != SCM_TYP7 (v1))
-    return 0;
-  for (k = ndim; k--;)
-    {
-      if (s0[k].lbnd != s1[k].lbnd || s0[k].ubnd != s1[k].ubnd)
-       return 0;
-      if (unroll)
-       {
-         unroll = (s0[k].inc == s1[k].inc);
-         vlen *= s0[k].ubnd - s1[k].lbnd + 1;
-       }
-    }
-  if (unroll && bas0 == bas1 && scm_is_eq (v0, v1))
-    return 1;
-  return scm_ramapc (raeql_1, as_equal, ra0, scm_cons (ra1, SCM_EOL), "");
-}
+  if (scm_is_true (res))
+    res = scm_from_bool (array_compare (&hx, &hy, 0, 0, 0));
 
+  scm_array_handle_release (&hy);
+  scm_array_handle_release (&hx);
 
-SCM
-scm_raequal (SCM ra0, SCM ra1)
-{
-  return scm_from_bool(raeql (ra0, SCM_BOOL_T, ra1));
+  return res;
 }
 
 static SCM scm_i_array_equal_p (SCM, SCM, SCM);
@@ -935,9 +868,7 @@ SCM_DEFINE (scm_i_array_equal_p, "array-equal?", 0, 2, 1,
            "Return @code{#t} iff all arguments are arrays with the same\n"
            "shape, the same type, and have corresponding elements which are\n"
            "either @code{equal?}  or @code{array-equal?}.  This function\n"
-           "differs from @code{equal?} in that a one dimensional shared\n"
-           "array may be @var{array-equal?} but not @var{equal?} to a\n"
-           "vector or uniform vector.")
+           "differs from @code{equal?} in that all arguments must be arrays.")
 #define FUNC_NAME s_scm_i_array_equal_p
 {
   if (SCM_UNBNDP (ra0) || SCM_UNBNDP (ra1))
@@ -955,19 +886,10 @@ SCM_DEFINE (scm_i_array_equal_p, "array-equal?", 0, 2, 1,
 #undef FUNC_NAME
 
 
-SCM
-scm_array_equal_p (SCM ra0, SCM ra1)
-{
-  if (SCM_I_ARRAYP (ra0) || SCM_I_ARRAYP (ra1))
-    return scm_from_bool(raeql (ra0, SCM_BOOL_F, ra1));
-  return scm_equal_p (ra0, ra1);
-}
-
-
 void
 scm_init_array_map (void)
 {
-  scm_smobs[SCM_TC2SMOBNUM (scm_i_tc16_array)].equalp = scm_raequal;
+  scm_smobs[SCM_TC2SMOBNUM (scm_i_tc16_array)].equalp = scm_array_equal_p;
 #include "libguile/array-map.x"
   scm_add_feature (s_scm_array_for_each);
 }
diff --git a/libguile/array-map.h b/libguile/array-map.h
index a198099..471861b 100644
--- a/libguile/array-map.h
+++ b/libguile/array-map.h
@@ -3,7 +3,7 @@
 #ifndef SCM_ARRAY_MAP_H
 #define SCM_ARRAY_MAP_H
 
-/* Copyright (C) 1995,1996,1997,2000, 2006, 2008, 2009 Free Software 
Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,2000, 2006, 2008, 2009, 2010 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
@@ -46,7 +46,6 @@ SCM_API int scm_array_identity (SCM src, SCM dst);
 SCM_API SCM scm_array_map_x (SCM ra0, SCM proc, SCM lra);
 SCM_API SCM scm_array_for_each (SCM proc, SCM ra0, SCM lra);
 SCM_API SCM scm_array_index_map_x (SCM ra, SCM proc);
-SCM_API SCM scm_raequal (SCM ra0, SCM ra1);
 SCM_API SCM scm_array_equal_p (SCM ra0, SCM ra1);
 SCM_INTERNAL void scm_init_array_map (void);
 
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index f3a61c1..853a3cf 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -511,7 +511,8 @@ SCM_DEFINE (scm_bytevector_eq_p, "bytevector=?", 2, 0, 0,
   c_len1 = SCM_BYTEVECTOR_LENGTH (bv1);
   c_len2 = SCM_BYTEVECTOR_LENGTH (bv2);
 
-  if (c_len1 == c_len2)
+  if (c_len1 == c_len2 && (SCM_BYTEVECTOR_ELEMENT_TYPE (bv1)
+                           == SCM_BYTEVECTOR_ELEMENT_TYPE (bv2)))
     {
       signed char *c_bv1, *c_bv2;
 
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 95f6f46..76ff355 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -1866,6 +1866,16 @@ SCM_DEFINE (scm_lazy_catch, "lazy-catch", 3, 0, 0,
 
 
 
+
+
+SCM
+scm_raequal (SCM ra0, SCM ra1)
+{
+  return scm_array_equal_p (ra0, ra1);
+}
+
+
+
 void
 scm_i_init_deprecated ()
 {
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 7f26f3f..b9ea579 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -621,6 +621,11 @@ SCM_DEPRECATED SCM scm_internal_lazy_catch (SCM tag,
 
 
 
+/* Deprecated 2010-03-31, use array-equal? instead */
+SCM_DEPRECATED SCM scm_raequal (SCM ra0, SCM ra1);
+
+
+
 void scm_i_init_deprecated (void);
 
 #endif
diff --git a/libguile/eq.c b/libguile/eq.c
index 6a533da..923fa77 100644
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -321,7 +321,7 @@ scm_equal_p (SCM x, SCM y)
 
       /* Vectors can be equal to one-dimensional arrays.
        */
-      if (SCM_I_ARRAYP (x) || SCM_I_ARRAYP (y))
+      if (scm_is_array (x) && scm_is_array (y))
        return scm_array_equal_p (x, y);
 
       return SCM_BOOL_F;
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 4eba805..2ce961b 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -569,6 +569,27 @@
   (pass-if "array and non-array"
     (not (equal? #2f64((0 1) (2 3)) 100)))
 
+  (pass-if "empty vectors of different types"
+    (not (equal? #s32() #f64())))
+
+  (pass-if "empty arrays of different types"
+    (not (equal? #2s32() #2f64())))
+
+  (pass-if "empty arrays of the same type"
+    (equal? #s32() #s32()))
+
+  (pass-if "identical uniform vectors of the same type"
+    (equal? #s32(1) #s32(1)))
+
+  (pass-if "nonidentical uniform vectors of the same type"
+    (not (equal? #s32(1) #s32(-1))))
+
+  (pass-if "identical uniform vectors of different types"
+    (not (equal? #s32(1) #s64(1))))
+
+  (pass-if "nonidentical uniform vectors of different types"
+    (not (equal? #s32(1) #s64(-1))))
+
   (pass-if "vector and one-dimensional array"
     (equal? (make-shared-array #2((a b c) (d e f) (g h i))
                                (lambda (i) (list i i))


hooks/post-receive
-- 
GNU Guile