>From 5f1d36475883316a1830596302dd26172a86d9d7 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sat, 12 Feb 2011 05:43:17 -0500 Subject: [PATCH 9/9] Allow GOOPS getters to add methods to primitive generics * module/oop/goops.scm (ensure-generic): If the old definition of a desired getter is a primitive generic, let the new method be added to it instead of creating a fresh new generic. (ensure-accessor): Modify as necessary to keep the old behavior. Maybe something more optimal can be done here, but it's not yet obvious to me how to do it. --- module/oop/goops.scm | 8 ++++++-- 1 files changed, 6 insertions(+), 2 deletions(-) diff --git a/module/oop/goops.scm b/module/oop/goops.scm index 70bf375..2801aa2 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -391,7 +391,8 @@ #:default (procedure old-definition) #:setter (setter old-definition))) ((procedure? old-definition) - (make #:name name #:default old-definition)) + (if (generic-capability? old-definition) old-definition + (make #:name name #:default old-definition))) (else (make #:name name))))) ;; same semantics as @@ -428,7 +429,10 @@ #:default (procedure proc) #:setter (ensure-generic (setter proc) name))) ((procedure? proc) - (ensure-accessor (ensure-generic proc name) name)) + (ensure-accessor (if (generic-capability? proc) + (make #:name name #:default proc) + (ensure-generic proc name)) + name)) (else (make-accessor name))))) -- 1.7.1