mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-13 17:20:21 +02:00
Code Activity

* goops.c (scm_sys_pre_expand_closure_x): New procedure.

Browse source
This commit is contained in:
Mikael Djurfeldt 2001-03-04 05:27:41 +00:00
parent d19b0aac73
commit 87e7741df7
3 changed files with 25 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

4
libguile/ChangeLog
View file

@ -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> 2001-03-04 Marius Vollmer <mvo@zagadka.ping.de>
* eval.c (scm_s_duplicate_bindings): New error message. * eval.c (scm_s_duplicate_bindings): New error message.

19
libguile/goops.c
View file

@ -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 * 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 * 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 #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
/****************************************************************************** /******************************************************************************
* *

5
libguile/goops.h
View file

@ -2,7 +2,7 @@
#ifndef GOOPSH #ifndef GOOPSH
#define 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 * 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 * 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_generic_function (SCM obj);
SCM scm_method_specializers (SCM obj); SCM scm_method_specializers (SCM obj);
SCM scm_method_procedure (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_ref (SCM obj, SCM index);
SCM scm_sys_fast_slot_set_x (SCM obj, SCM index, SCM value); 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); SCM scm_slot_ref_using_class (SCM cls, SCM obj, SCM slot_name);