From 21497600d23534b2878f82401ffaf5551fdb6efd Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 24 Oct 2008 11:56:31 +0200 Subject: [PATCH] add `formals', `body', and `compile-env' slots to * 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 . --- ice-9/boot-9.scm | 5 +++-- libguile/goops.c | 8 ++++++-- libguile/goops.h | 4 +++- oop/goops.scm | 9 ++++++++- 4 files changed, 20 insertions(+), 6 deletions(-) diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index e37cc113e..5843865fa 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -126,8 +126,9 @@ (define (compile-time-environment) "A special function known to the compiler that, when compiled, will return a representation of the lexical environment in place at compile -time. Useful for supporting some forms of dynamic compilation." - (error "compile-time-environment and the interpreter do not mix")) +time. Useful for supporting some forms of dynamic compilation. Returns +#f if called from the interpreter." + #f) diff --git a/libguile/goops.c b/libguile/goops.c index 840ddd694..89556c540 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -2420,10 +2420,14 @@ static void create_standard_classes (void) { 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"), 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"), k_init_keyword, k_slot_definition)); diff --git a/libguile/goops.h b/libguile/goops.h index 80ba98549..49ef5355d 100644 --- a/libguile/goops.h +++ b/libguile/goops.h @@ -151,9 +151,11 @@ typedef struct scm_t_method { #define scm_si_generic_function 0 /* offset of gf slot in a */ #define scm_si_specializers 1 /* offset of spec. slot in a */ - #define scm_si_procedure 2 /* offset of proc. slot in a */ #define scm_si_code_table 3 /* offset of code. slot in a */ +#define scm_si_formals 4 /* offset of form. slot in a */ +#define scm_si_body 5 /* offset of body slot in a */ +#define scm_si_compile_env 6 /* offset of comp. slot in a */ /* C interface */ SCM_API SCM scm_class_boolean; diff --git a/oop/goops.scm b/oop/goops.scm index 2a250c7fa..406210891 100644 --- a/oop/goops.scm +++ b/oop/goops.scm @@ -484,6 +484,9 @@ ls)))) `(make #:specializers (cons* ,@(specializers args)) + #:formals ',(formals args) + #:body ',body + #:compile-env (compile-time-environment) #:procedure (lambda ,(formals args) ,@(if (null? body) (list *unspecified*) @@ -1427,7 +1430,11 @@ (slot-set! method 'specializers (get-keyword #:specializers initargs '())) (slot-set! method '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 ) initargs))