summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ice-9/boot-9.scm5
-rw-r--r--libguile/goops.c8
-rw-r--r--libguile/goops.h4
-rw-r--r--oop/goops.scm9
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 <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_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 */
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 <method>
#: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 <foreign-object>) initargs))