* goops.c (scm_sys_pre_expand_closure_x): New procedure.

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index dda0b49..3c8af20 100644 (file)
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,7 @@
+2001-03-04  Mikael Djurfeldt  <mdj@linnaeus.mit.edu>
+
+       * goops.c (scm_sys_pre_expand_closure_x): New procedure.
+
 2001-03-04  Marius Vollmer  <mvo@zagadka.ping.de>
 
        * eval.c (scm_s_duplicate_bindings): New error message.

diff --git a/libguile/goops.c b/libguile/goops.c
index 02c0acf..d42ff2b 100644 (file)
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+/*     Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -934,6 +934,23 @@ SCM_DEFINE (scm_accessor_method_slot_definition, "accessor-method-slot-definitio
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_sys_pre_expand_closure_x, "%pre-expand-closure!", 1, 0, 0,
+           (SCM closure),
+           "Internal GOOPS magic---don't use this function!")
+#define FUNC_NAME s_scm_sys_pre_expand_closure_x
+{
+  SCM formals, code, env;
+  SCM_VALIDATE_CLOSURE (1, closure);
+  formals = SCM_CAR (SCM_CODE (closure));
+  env = SCM_EXTEND_ENV (formals, formals, SCM_ENV (closure));
+  code = SCM_CDR (SCM_CODE (closure));
+  while (SCM_NNULLP (SCM_CDR (code))
+        && SCM_IMP (SCM_CAR (code))
+        && SCM_ISYMP (SCM_CAR (code)))
+    code = scm_m_expand_body (code, env);
+  return closure;
+}
+#undef FUNC_NAME
 
 /******************************************************************************
  *

diff --git a/libguile/goops.h b/libguile/goops.h
index 3c123c8..a443d4c 100644 (file)
--- a/libguile/goops.h
+++ b/libguile/goops.h
@@ -2,7 +2,7 @@
 
 #ifndef GOOPSH
 #define GOOPSH
-/*     Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+/*     Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -257,7 +257,8 @@ SCM scm_generic_function_methods (SCM obj);
 SCM scm_method_generic_function (SCM obj); 
 SCM scm_method_specializers (SCM obj); 
 SCM scm_method_procedure (SCM obj); 
-SCM scm_accessor_method_slot_definition (SCM obj); 
+SCM scm_accessor_method_slot_definition (SCM obj);
+SCM scm_sys_pre_expand_closure_x (SCM closure);
 SCM scm_sys_fast_slot_ref (SCM obj, SCM index); 
 SCM scm_sys_fast_slot_set_x (SCM obj, SCM index, SCM value); 
 SCM scm_slot_ref_using_class (SCM cls, SCM obj, SCM slot_name);