diff options
author | Mark H Weaver <mhw@netris.org> | 2011-02-12 05:43:17 -0500 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-02-14 20:33:11 +0100 |
commit | 4fb8bc64a0c5d074ab6658b763dfe24449f3d3b4 (patch) | |
tree | 7bd7e28fd93093db21f3860cea65b2a0802c325e /module/oop | |
parent | 5093e51839bb1246e96547a25ae41b4c4d92e1f7 (diff) | |
download | guile-4fb8bc64a0c5d074ab6658b763dfe24449f3d3b4.tar.gz |
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.
Diffstat (limited to 'module/oop')
-rw-r--r-- | 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 70bf37562..2801aa25b 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 <generic> #:name name #:default old-definition)) + (if (generic-capability? old-definition) old-definition + (make <generic> #:name name #:default old-definition))) (else (make <generic> #:name name))))) ;; same semantics as <generic> @@ -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 <generic> #:name name #:default proc) + (ensure-generic proc name)) + name)) (else (make-accessor name))))) |