diff options
-rw-r--r-- | doc/ref/api-compound.texi | 4 | ||||
-rw-r--r-- | libguile/array-map.c | 154 | ||||
-rw-r--r-- | libguile/array-map.h | 3 | ||||
-rw-r--r-- | libguile/bytevectors.c | 3 | ||||
-rw-r--r-- | libguile/deprecated.c | 10 | ||||
-rw-r--r-- | libguile/deprecated.h | 5 | ||||
-rw-r--r-- | libguile/eq.c | 2 | ||||
-rw-r--r-- | 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 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)) |