mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

* modules.c: Use applicable smobs for eval closures instead of

Browse source 
compiled closures.  Include "libguile/smob.h".
(f_eval_closure): Removed.
(scm_eval_closure_tag): New variable.
(scm_eval_closure_lookup): Renamed from eval_closure.
This function now takes a smob instead of a compiled closure.
(scm_standard_eval_closure): Create a smob instead of a compiled
closure.
(scm_init_modules): Initialize the eval closure type as a smob.
* modules.h (SCM_EVAL_CLOSURE_P): New macro.
(scm_eval_closure_tag, scm_eval_closure_lookup): Declare.
* symbols.c: Include "libguile/smob.h".
(scm_sym2vcell): Call scm_eval_closure_lookup directly if THUNK
is an eval closure.
This commit is contained in:
Keisuke Nishida 2000-09-10 22:22:36 +00:00
parent 4c7cb8ba94
commit fb43bf74e2
3 changed files with 18 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

22
libguile/modules.c
View file

@ -47,6 +47,7 @@
#include "libguile/_scm.h"
#include "libguile/eval.h"
#include "libguile/smob.h"
#include "libguile/procprop.h"
#include "libguile/vectors.h"
#include "libguile/hashtab.h"
@ -240,12 +241,14 @@ module_variable (SCM module, SCM sym)
}
}
static SCM f_eval_closure;
SCM scm_eval_closure_tag;
static SCM
eval_closure (SCM cclo, SCM sym, SCM definep)
/* NOTE: This function may be called by a smob application
or from another C function directly. */
SCM
scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep)
{
SCM module = SCM_VELTS (cclo) [1];
SCM module = SCM_PACK (SCM_SMOB_DATA (eclo));
if (SCM_NFALSEP (definep))
return scm_apply (SCM_CDR (module_make_local_var_x),
SCM_LIST2 (module, sym),
@ -259,9 +262,7 @@ SCM_DEFINE (scm_standard_eval_closure, "standard-eval-closure", 1, 0, 0,
"")
#define FUNC_NAME s_scm_standard_eval_closure
{
SCM cclo = scm_makcclo (f_eval_closure, 2);
SCM_VELTS (cclo) [1] = module;
return cclo;
SCM_RETURN_NEWSMOB (scm_eval_closure_tag, SCM_UNPACK (module));
}
#undef FUNC_NAME
@ -271,10 +272,9 @@ scm_init_modules ()
#include "libguile/modules.x"
module_make_local_var_x = scm_sysintern ("module-make-local-var!",
SCM_UNDEFINED);
f_eval_closure = scm_make_subr_opt ("eval-closure",
scm_tc7_subr_3,
eval_closure,
0);
scm_eval_closure_tag = scm_make_smob_type ("eval-closure", 0);
scm_set_smob_mark (scm_eval_closure_tag, scm_markcdr);
scm_set_smob_apply (scm_eval_closure_tag, scm_eval_closure_lookup, 2, 0, 0);
}
void

4
libguile/modules.h
View file

@ -73,10 +73,13 @@
#define SCM_MODULE_EVAL_CLOSURE(module) \
SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_eval_closure])
#define SCM_EVAL_CLOSURE_P(OBJ) SCM_SMOB_PREDICATE (scm_eval_closure_tag, OBJ)
extern SCM scm_module_system_booted_p;
extern SCM scm_module_tag;
extern SCM scm_eval_closure_tag;
extern SCM scm_the_root_module (void);
extern SCM scm_selected_module (void);
@ -90,6 +93,7 @@ extern SCM scm_load_scheme_module (SCM name);
extern SCM scm_env_top_level (SCM env);
extern SCM scm_top_level_env (SCM thunk);
extern SCM scm_system_module_env_p (SCM env);
extern SCM scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep);
extern SCM scm_standard_eval_closure (SCM module);
extern void scm_init_modules (void);
extern void scm_post_boot_init_modules (void);

6
libguile/symbols.c
View file

@ -48,6 +48,7 @@
#include "libguile/_scm.h"
#include "libguile/chars.h"
#include "libguile/eval.h"
#include "libguile/smob.h"
#include "libguile/variable.h"
#include "libguile/alist.h"
#include "libguile/fluids.h"
@ -112,10 +113,9 @@ scm_sym2vcell (SCM sym, SCM thunk, SCM definep)
{
SCM var;
if (SCM_TYP7 (thunk) == scm_tc7_cclo
&& SCM_TYP7 (SCM_CCLO_SUBR (thunk)) == scm_tc7_subr_3)
if (SCM_EVAL_CLOSURE_P (thunk))
/* Bypass evaluator in the standard case. */
var = SCM_SUBRF (SCM_CCLO_SUBR (thunk)) (thunk, sym, definep);
var = scm_eval_closure_lookup (thunk, sym, definep);
else
var = scm_apply (thunk, sym, scm_cons (definep, scm_listofnull));