mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-21 20:20:24 +02:00
Code Activity

add generic method-formals; fixes to method-source

Browse 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.
This commit is contained in:
Andy Wingo 2009-03-20 12:06:10 +01:00
parent 17dd267a35
commit 4e2f1e9edd
1 changed files with 12 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

19
module/oop/goops.scm
View 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)
@ -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