diff options
-rw-r--r-- | libguile/modules.c | 22 | ||||
-rw-r--r-- | libguile/modules.h | 4 | ||||
-rw-r--r-- | libguile/symbols.c | 6 |
3 files changed, 18 insertions, 14 deletions
diff --git a/libguile/modules.c b/libguile/modules.c index ae062ab74..04ba8546d 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -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 diff --git a/libguile/modules.h b/libguile/modules.h index 9e7f8eb11..cfe4de442 100644 --- a/libguile/modules.h +++ b/libguile/modules.h @@ -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); diff --git a/libguile/symbols.c b/libguile/symbols.c index 6fe45589d..b9b1b8c85 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -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)); |