add generic method-formals; fixes to method-source
authorAndy Wingo <wingo@pobox.com>
Fri, 20 Mar 2009 11:06:10 +0000 (12:06 +0100)
committerAndy Wingo <wingo@pobox.com>
Fri, 20 Mar 2009 15:20:00 +0000 (16:20 +0100)
* 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

index 429a328..3bbf304 100644 (file)
@@ -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)
 ;;;
 (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