diff options
author | Andy Wingo <wingo@pobox.com> | 2009-11-06 10:27:19 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-11-26 00:25:07 +0100 |
commit | ab455d1f1b14347e1445161eeafec919235af92e (patch) | |
tree | 5b32056bfa0860d3fa53090fc9687d282475852f | |
parent | a9a90a8820e6f6a36d0f17cdca5f8ba0d7ca735b (diff) | |
download | guile-ab455d1f1b14347e1445161eeafec919235af92e.tar.gz |
eqv? not a generic, equal? dispatches to generic only for objects
* libguile/eq.c (scm_eqv_p): Not a generic any more. Since eqv? is used
by e.g. `case', which should be able to compile into dispatch tables,
it really doesn't make sense to dispatch out to a generic.
(scm_equal_p): So it was always the case that (equal? 'foo "foo") =>
#f. But (equal? 'foo 'bar) could actually be extended by a generic.
This was a bug, if you follow the other logic of the code. Changed so
that generic functions can only extend the domain of equal? when
operating on goops objects.
* oop/goops.scm: No more eqv? generic.
* test-suite/tests/goops.test: Remove eqv? tests.
-rw-r--r-- | libguile/eq.c | 26 | ||||
-rw-r--r-- | module/oop/goops.scm | 1 | ||||
-rw-r--r-- | test-suite/tests/goops.test | 12 |
3 files changed, 15 insertions, 24 deletions
diff --git a/libguile/eq.c b/libguile/eq.c index 2db4ac022..6cb9bc275 100644 --- a/libguile/eq.c +++ b/libguile/eq.c @@ -104,7 +104,7 @@ real_eqv (double x, double y) } #include <stdio.h> -SCM_PRIMITIVE_GENERIC_1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr, +SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr, (SCM x, SCM y), "Return @code{#t} if @var{x} and @var{y} are the same object, or\n" "for characters and numbers the same value.\n" @@ -173,10 +173,7 @@ SCM_PRIMITIVE_GENERIC_1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr, SCM_COMPLEX_IMAG (y))); } } - if (SCM_UNPACK (g_scm_eqv_p)) - return scm_call_generic_2 (g_scm_eqv_p, x, y); - else - return SCM_BOOL_F; + return SCM_BOOL_F; } #undef FUNC_NAME @@ -294,13 +291,20 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr, case scm_tc7_wvect: return scm_i_vector_equal_p (x, y); } + /* Check equality between structs of equal type (see cell-type test above). */ + if (SCM_STRUCTP (x)) + { + if (SCM_INSTANCEP (x)) + goto generic_equal; + else + return scm_i_struct_equalp (x, y); + } - /* Check equality between structs of equal type (see cell-type test above) - that are not GOOPS instances. GOOPS instances are treated via the - generic function. */ - if ((SCM_STRUCTP (x)) && (!SCM_INSTANCEP (x))) - return scm_i_struct_equalp (x, y); - + /* Otherwise just return false. Dispatching to the generic is the wrong thing + here, as we can hit this case for any two objects of the same type that we + think are distinct, like different symbols. */ + return SCM_BOOL_F; + generic_equal: if (SCM_UNPACK (g_scm_equal_p)) return scm_call_generic_2 (g_scm_equal_p, x, y); diff --git a/module/oop/goops.scm b/module/oop/goops.scm index b67c4d4b0..a1af66654 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -713,7 +713,6 @@ ;;; Methods to compare objects ;;; -(define-method (eqv? x y) #f) (define-method (equal? x y) (eqv? x y)) ;;; diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test index 18b2122be..8a06ad99a 100644 --- a/test-suite/tests/goops.test +++ b/test-suite/tests/goops.test @@ -408,18 +408,6 @@ (define o4 (make <c> #:x '(4) #:y '(3))) (not (eqv? o1 o2))) (current-module))) - (pass-if "eqv?" - (eval '(begin - (define-method (eqv? (a <c>) (b <c>)) - (equal? (x a) (x b))) - (eqv? o1 o2)) - (current-module))) - (pass-if "not eqv?" - (eval '(not (eqv? o2 o3)) - (current-module))) - (pass-if "transfer eqv? => equal?" - (eval '(equal? o1 o2) - (current-module))) (pass-if "equal?" (eval '(begin (define-method (equal? (a <c>) (b <c>)) |