From 87e7741df723f18cf3f6ef56cf7bb258146e9ba2 Mon Sep 17 00:00:00 2001 From: Mikael Djurfeldt Date: Sun, 4 Mar 2001 05:27:41 +0000 Subject: [PATCH] * goops.c (scm_sys_pre_expand_closure_x): New procedure. --- libguile/ChangeLog | 4 ++++ libguile/goops.c | 19 ++++++++++++++++++- libguile/goops.h | 5 +++-- 3 files changed, 25 insertions(+), 3 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index dda0b491f..3c8af2027 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2001-03-04 Mikael Djurfeldt + + * goops.c (scm_sys_pre_expand_closure_x): New procedure. + 2001-03-04 Marius Vollmer * eval.c (scm_s_duplicate_bindings): New error message. diff --git a/libguile/goops.c b/libguile/goops.c index 02c0acf33..d42ff2b51 100644 --- 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 3c123c80b..a443d4cc0 100644 --- 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);