* modules.c: Use applicable smobs for eval closures instead of
authorKeisuke Nishida <kxn30@po.cwru.edu>
Sun, 10 Sep 2000 22:22:36 +0000 (22:22 +0000)
committerKeisuke Nishida <kxn30@po.cwru.edu>
Sun, 10 Sep 2000 22:22:36 +0000 (22:22 +0000)
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.

libguile/modules.c
libguile/modules.h
libguile/symbols.c

index ae062ab..04ba854 100644 (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
index 9e7f8eb..cfe4de4 100644 (file)
 #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)
+
 \f
 
 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);
index 6fe4558..b9b1b8c 100644 (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));