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>.

diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index e37cc11..5843865 100644 (file)
--- 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)
 
 \f
 

diff --git a/libguile/goops.c b/libguile/goops.c
index 840ddd6..89556c5 100644 (file)
--- 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 80ba985..49ef535 100644 (file)
--- 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 2a250c7..4062108 100644 (file)
--- 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))