fix chaining up from interpreted to compiled methods; allow compiled init-thunk

* libguile/goops.c (scm_sys_initialize_object): Don't assume that an init
  thunk is a closure; just go through scm_call_0 instead.

* oop/goops/compile.scm (make-make-next-method/memoizer): Allow for the
  case that the next method is compiled.

diff --git a/libguile/goops.c b/libguile/goops.c
index f647cca..1b8cdc1 100644 (file)
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -583,13 +583,10 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0,
            {
              slot_value = get_slot_value (class, obj, SCM_CAR (get_n_set));
              if (SCM_GOOPS_UNBOUNDP (slot_value))
-               {
-                 SCM env = SCM_EXTEND_ENV (SCM_EOL, SCM_EOL, SCM_ENV (tmp));
-                 set_slot_value (class,
-                                 obj,
-                                 SCM_CAR (get_n_set),
-                                 scm_eval_body (SCM_CLOSURE_BODY (tmp), env));
-               }
+                set_slot_value (class,
+                                obj,
+                                SCM_CAR (get_n_set),
+                                scm_call_0 (tmp));
            }
        }
     }

diff --git a/oop/goops/compile.scm b/oop/goops/compile.scm
index 2e58365..ecd0232 100644 (file)
--- a/oop/goops/compile.scm
+++ b/oop/goops/compile.scm
@@ -175,8 +175,11 @@
            (set-cdr! vcell (make-final-make-no-next-method gf))
            (no-next-method gf (if (null? args) default-args args)))
          (let* ((cmethod (compute-cmethod methods types))
-                (method (local-eval (cons 'lambda (cmethod-code cmethod))
-                                    (cmethod-environment cmethod))))
+                (method
+                  (if (pair? cmethod)
+                      (local-eval (cons 'lambda (cmethod-code cmethod))
+                                  (cmethod-environment cmethod))
+                      cmethod)))
            (set-cdr! vcell (make-final-make-next-method method))
            (@apply method (if (null? args) default-args args)))))))