1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-15 18:20:42 +02:00

add formals', body', and `compile-env' slots to <method>

* ice-9/boot-9.scm (compile-time-environment): Return #f instead of
  erroring under the interpreter, a bit more sane.

* libguile/goops.c (create_standard_classes):
* libguile/goops.h (scm_si_formals, scm_si_body, scm_si_compile_env):
* oop/goops.scm (method, initialize): Add `formals', `body', and
  `compile-env' slots to <method>.
This commit is contained in:
Andy Wingo 2008-10-24 11:56:31 +02:00
parent ae9ce4b786
commit 21497600d2
4 changed files with 20 additions and 6 deletions

View file

@ -126,8 +126,9 @@
(define (compile-time-environment) (define (compile-time-environment)
"A special function known to the compiler that, when compiled, will "A special function known to the compiler that, when compiled, will
return a representation of the lexical environment in place at compile return a representation of the lexical environment in place at compile
time. Useful for supporting some forms of dynamic compilation." time. Useful for supporting some forms of dynamic compilation. Returns
(error "compile-time-environment and the interpreter do not mix")) #f if called from the interpreter."
#f)

View file

@ -2420,10 +2420,14 @@ static void
create_standard_classes (void) create_standard_classes (void)
{ {
SCM slots; SCM slots;
SCM method_slots = scm_list_4 (scm_from_locale_symbol ("generic-function"), SCM method_slots = scm_list_n (scm_from_locale_symbol ("generic-function"),
scm_from_locale_symbol ("specializers"), scm_from_locale_symbol ("specializers"),
sym_procedure, sym_procedure,
scm_from_locale_symbol ("code-table")); scm_from_locale_symbol ("code-table"),
scm_from_locale_symbol ("formals"),
scm_from_locale_symbol ("body"),
scm_from_locale_symbol ("compile-env"),
SCM_UNDEFINED);
SCM amethod_slots = scm_list_1 (scm_list_3 (scm_from_locale_symbol ("slot-definition"), SCM amethod_slots = scm_list_1 (scm_list_3 (scm_from_locale_symbol ("slot-definition"),
k_init_keyword, k_init_keyword,
k_slot_definition)); k_slot_definition));

View file

@ -151,9 +151,11 @@ typedef struct scm_t_method {
#define scm_si_generic_function 0 /* offset of gf slot in a <method> */ #define scm_si_generic_function 0 /* offset of gf slot in a <method> */
#define scm_si_specializers 1 /* offset of spec. slot in a <method> */ #define scm_si_specializers 1 /* offset of spec. slot in a <method> */
#define scm_si_procedure 2 /* offset of proc. slot in a <method> */ #define scm_si_procedure 2 /* offset of proc. slot in a <method> */
#define scm_si_code_table 3 /* offset of code. slot in a <method> */ #define scm_si_code_table 3 /* offset of code. slot in a <method> */
#define scm_si_formals 4 /* offset of form. slot in a <method> */
#define scm_si_body 5 /* offset of body slot in a <method> */
#define scm_si_compile_env 6 /* offset of comp. slot in a <method> */
/* C interface */ /* C interface */
SCM_API SCM scm_class_boolean; SCM_API SCM scm_class_boolean;

View file

@ -484,6 +484,9 @@
ls)))) ls))))
`(make <method> `(make <method>
#:specializers (cons* ,@(specializers args)) #:specializers (cons* ,@(specializers args))
#:formals ',(formals args)
#:body ',body
#:compile-env (compile-time-environment)
#:procedure (lambda ,(formals args) #:procedure (lambda ,(formals args)
,@(if (null? body) ,@(if (null? body)
(list *unspecified*) (list *unspecified*)
@ -1427,7 +1430,11 @@
(slot-set! method 'specializers (get-keyword #:specializers initargs '())) (slot-set! method 'specializers (get-keyword #:specializers initargs '()))
(slot-set! method 'procedure (slot-set! method 'procedure
(get-keyword #:procedure initargs dummy-procedure)) (get-keyword #:procedure initargs dummy-procedure))
(slot-set! method 'code-table '())) (slot-set! method 'code-table '())
(slot-set! method 'formals (get-keyword #:formals initargs '()))
(slot-set! method 'body (get-keyword #:body initargs '()))
(slot-set! method 'compile-env (get-keyword #:compile-env initargs #f)))
(define-method (initialize (obj <foreign-object>) initargs)) (define-method (initialize (obj <foreign-object>) initargs))