From 4e2f1e9edd1d49b1ed395ca48872bddc25759f30 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 20 Mar 2009 12:06:10 +0100 Subject: [PATCH] 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. --- module/oop/goops.scm | 19 ++++++++++++------- 1 file 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 )) (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 )) + (slot-ref m 'formals)) ;;; ;;; Slots -- 2.20.1