mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-28 16:00:22 +02:00
Code Activity

eqv? not a generic, equal? dispatches to generic only for objects

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2009-11-06 10:27:19 +01:00
parent a9a90a8820
commit ab455d1f1b
3 changed files with 15 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

26
libguile/eq.c
View file

@ -104,7 +104,7 @@ real_eqv (double x, double y)
} }
#include <stdio.h> #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), (SCM x, SCM y),
"Return @code{#t} if @var{x} and @var{y} are the same object, or\n" "Return @code{#t} if @var{x} and @var{y} are the same object, or\n"
"for characters and numbers the same value.\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))); SCM_COMPLEX_IMAG (y)));
} }
} }
if (SCM_UNPACK (g_scm_eqv_p)) return SCM_BOOL_F;
return scm_call_generic_2 (g_scm_eqv_p, x, y);
else
return SCM_BOOL_F;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -294,13 +291,20 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
case scm_tc7_wvect: case scm_tc7_wvect:
return scm_i_vector_equal_p (x, y); 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) /* Otherwise just return false. Dispatching to the generic is the wrong thing
that are not GOOPS instances. GOOPS instances are treated via the here, as we can hit this case for any two objects of the same type that we
generic function. */ think are distinct, like different symbols. */
if ((SCM_STRUCTP (x)) && (!SCM_INSTANCEP (x))) return SCM_BOOL_F;
return scm_i_struct_equalp (x, y);
generic_equal: generic_equal:
if (SCM_UNPACK (g_scm_equal_p)) if (SCM_UNPACK (g_scm_equal_p))
return scm_call_generic_2 (g_scm_equal_p, x, y); return scm_call_generic_2 (g_scm_equal_p, x, y);

1
module/oop/goops.scm
View file

@ -713,7 +713,6 @@
;;; Methods to compare objects ;;; Methods to compare objects
;;; ;;;
(define-method (eqv? x y) #f)
(define-method (equal? x y) (eqv? x y)) (define-method (equal? x y) (eqv? x y))
;;; ;;;

12
test-suite/tests/goops.test
View file

@ -408,18 +408,6 @@
(define o4 (make <c> #:x '(4) #:y '(3))) (define o4 (make <c> #:x '(4) #:y '(3)))
(not (eqv? o1 o2))) (not (eqv? o1 o2)))
(current-module))) (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?" (pass-if "equal?"
(eval '(begin (eval '(begin
(define-method (equal? (a <c>) (b <c>)) (define-method (equal? (a <c>) (b <c>))