diff options
author | Andy Wingo <wingo@pobox.com> | 2009-03-20 12:06:10 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-03-20 16:20:00 +0100 |
commit | 4e2f1e9edd1d49b1ed395ca48872bddc25759f30 (patch) | |
tree | f0bc6faff5b3b4d5406d3d36f257f8573f37a683 /module/oop/goops.scm | |
parent | 17dd267a35806e56195a38006ef51b452a38ae0d (diff) | |
download | guile-4e2f1e9edd1d49b1ed395ca48872bddc25759f30.tar.gz |
add generic method-formals; fixes to method-source
* module/oop/goops.scm (method-source): Don't throw an error if this
method has no source.
(method-formals): New generic function, the complement of
method-specializers for introspection.
Diffstat (limited to 'module/oop/goops.scm')
-rw-r--r-- | module/oop/goops.scm | 19 |
1 files changed, 12 insertions, 7 deletions
diff --git a/module/oop/goops.scm b/module/oop/goops.scm index 429a32822..3bbf3047c 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -68,7 +68,8 @@ class-direct-methods class-direct-slots class-precedence-list class-slots class-environment generic-function-name - generic-function-methods method-generic-function method-specializers + generic-function-methods method-generic-function + method-specializers method-formals primitive-generic-generic enable-primitive-generic! method-procedure accessor-method-slot-definition slot-exists? make find-method get-keyword) @@ -565,12 +566,16 @@ ;;; (define-method (method-source (m <method>)) (let* ((spec (map* class-name (slot-ref m 'specializers))) - (proc (procedure-source (slot-ref m 'procedure))) - (args (cadr proc)) - (body (cddr proc))) - (cons 'method - (cons (map* list args spec) - body)))) + (src (procedure-source (slot-ref m 'procedure)))) + (and src + (let ((args (cadr src)) + (body (cddr src))) + (cons 'method + (cons (map* list args spec) + body)))))) + +(define-method (method-formals (m <method>)) + (slot-ref m 'formals)) ;;; ;;; Slots |