mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 14:21:10 +02:00
Code Activity

make sure that when equal? is extended, that the generic has a method

Browse source 
* libguile/goops.h:
* libguile/goops.c (scm_set_primitive_generic_x): New function, for now
  local to the goops module.

* module/oop/goops.scm (equal?): Make sure that when equal? is extended,
  that the generic already has a default method.
This commit is contained in:
Andy Wingo 2009-11-08 11:49:06 +01:00
parent 72d2e7e65f
commit 9f63ce021c
3 changed files with 23 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

13
libguile/goops.c
View file

@ -1915,6 +1915,19 @@ SCM_DEFINE (scm_enable_primitive_generic_x, "enable-primitive-generic!", 0, 0, 1
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (scm_set_primitive_generic_x, "set-primitive-generic!", 2, 0, 0,
(SCM subr, SCM generic),
"")
#define FUNC_NAME s_scm_set_primitive_generic_x
{
SCM_ASSERT (scm_subr_p (subr) && SCM_SUBR_GENERIC (subr),
subr, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (SCM_PUREGENERICP (generic), generic, SCM_ARG2, FUNC_NAME);
*SCM_SUBR_GENERIC (subr) = generic;
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM_DEFINE (scm_primitive_generic_generic, "primitive-generic-generic", 1, 0, 0, SCM_DEFINE (scm_primitive_generic_generic, "primitive-generic-generic", 1, 0, 0,
(SCM subr), (SCM subr),
"") "")

1
libguile/goops.h
View file

@ -305,6 +305,7 @@ SCM_API SCM scm_make_method_cache (SCM gf);
SCM_API SCM scm_sys_invalidate_method_cache_x (SCM gf); SCM_API SCM scm_sys_invalidate_method_cache_x (SCM gf);
SCM_API SCM scm_generic_capability_p (SCM proc); SCM_API SCM scm_generic_capability_p (SCM proc);
SCM_API SCM scm_enable_primitive_generic_x (SCM subrs); SCM_API SCM scm_enable_primitive_generic_x (SCM subrs);
SCM_INTERNAL SCM scm_set_primitive_generic_x (SCM subr, SCM generic);
SCM_API SCM scm_primitive_generic_generic (SCM subr); SCM_API SCM scm_primitive_generic_generic (SCM subr);
SCM_API void scm_c_extend_primitive_generic (SCM subr, SCM extension); SCM_API void scm_c_extend_primitive_generic (SCM subr, SCM extension);
SCM_API SCM stklos_version (void); SCM_API SCM stklos_version (void);

10
module/oop/goops.scm
View file

@ -716,7 +716,15 @@
;;; Methods to compare objects ;;; Methods to compare objects
;;; ;;;
(define-method (equal? x y) (eqv? x y)) ;; Have to do this in a strange order because equal? is used in the
;; add-method! implementation; we need to make sure that when the
;; primitive is extended, that the generic has a method. =
(define g-equal? (make-generic 'equal?))
;; When this generic gets called, we will have already checked eq? and
;; eqv? -- the purpose of this generic is to extend equality. So by
;; default, there is no extension, thus the #f return.
(add-method! g-equal? (method (x y) #f))
(set-primitive-generic! equal? g-equal?)
;;; ;;;
;;; methods to display/write an object ;;; methods to display/write an object