summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/ref/api-compound.texi4
-rw-r--r--libguile/array-map.c154
-rw-r--r--libguile/array-map.h3
-rw-r--r--libguile/bytevectors.c3
-rw-r--r--libguile/deprecated.c10
-rw-r--r--libguile/deprecated.h5
-rw-r--r--libguile/eq.c2
-rw-r--r--test-suite/tests/arrays.test21
8 files changed, 79 insertions, 123 deletions
diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 1bedffdee..6fcc8e960 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
-@code{equal?} (@pxref{Equality}) in that a one dimensional shared
-array may be @code{array-equal?} but not @code{equal?} to a vector or
-uniform vector.
+@code{equal?} (@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 46acb2915..dd8813602 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 a198099f3..471861bee 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 f3a61c1d0..853a3cf9a 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 95f6f4662..76ff355cb 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 7f26f3fa0..b9ea5792b 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 6a533da4e..923fa77a1 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 4eba805cb..2ce961b14 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))