diff options
author | Keisuke Nishida <kxn30@po.cwru.edu> | 2000-09-10 22:22:36 +0000 |
---|---|---|
committer | Keisuke Nishida <kxn30@po.cwru.edu> | 2000-09-10 22:22:36 +0000 |
commit | fb43bf74e2a2131ec80bf9e71de2fddab7696ff7 (patch) | |
tree | 2fbcba188edcf7d6d219300b1f2690d982a0825c | |
parent | 4c7cb8ba9447b5d51c88032b2b90eae618e2460e (diff) | |
download | guile-fb43bf74e2a2131ec80bf9e71de2fddab7696ff7.tar.gz |
* modules.c: Use applicable smobs for eval closures instead of
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.
-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)); |