summaryrefslogtreecommitdiff
path: root/module/oop
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2011-02-12 05:43:17 -0500
committerAndy Wingo <wingo@pobox.com>2011-02-14 20:33:11 +0100
commit4fb8bc64a0c5d074ab6658b763dfe24449f3d3b4 (patch)
tree7bd7e28fd93093db21f3860cea65b2a0802c325e /module/oop
parent5093e51839bb1246e96547a25ae41b4c4d92e1f7 (diff)
downloadguile-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.scm8
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)))))