summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
Diffstat (limited to 'libguile')
-rw-r--r--libguile/eval.c23
-rw-r--r--libguile/init.c5
-rw-r--r--libguile/load.c16
-rw-r--r--libguile/load.h1
-rw-r--r--libguile/modules.c12
-rw-r--r--libguile/vm-engine.c4
6 files changed, 48 insertions, 13 deletions
diff --git a/libguile/eval.c b/libguile/eval.c
index 1f3c36b62..d5405950e 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -848,11 +848,8 @@ scm_closure (SCM code, SCM env)
}
-SCM_DEFINE (scm_primitive_eval, "primitive-eval", 1, 0, 0,
- (SCM exp),
- "Evaluate @var{exp} in the top-level environment specified by\n"
- "the current module.")
-#define FUNC_NAME s_scm_primitive_eval
+static SCM
+scm_c_primitive_eval (SCM exp)
{
SCM transformer = scm_current_module_transformer ();
if (scm_is_true (transformer))
@@ -860,7 +857,14 @@ SCM_DEFINE (scm_primitive_eval, "primitive-eval", 1, 0, 0,
exp = scm_memoize_expression (exp);
return eval (exp, SCM_EOL);
}
-#undef FUNC_NAME
+
+static SCM var_primitive_eval;
+SCM
+scm_primitive_eval (SCM exp)
+{
+ return scm_c_vm_run (scm_the_vm (), scm_variable_ref (var_primitive_eval),
+ &exp, 1);
+}
/* Eval does not take the second arg optionally. This is intentional
@@ -928,6 +932,8 @@ scm_apply (SCM proc, SCM arg1, SCM args)
void
scm_init_eval ()
{
+ SCM primitive_eval;
+
scm_init_opts (scm_evaluator_traps,
scm_evaluator_trap_table);
scm_init_opts (scm_eval_options_interface,
@@ -938,6 +944,11 @@ scm_init_eval ()
f_apply = scm_c_define_subr ("apply", scm_tc7_lsubr_2, scm_apply);
scm_permanent_object (f_apply);
+ primitive_eval = scm_c_make_gsubr ("primitive-eval", 1, 0, 0,
+ scm_c_primitive_eval);
+ var_primitive_eval = scm_define (SCM_SUBR_NAME (primitive_eval),
+ primitive_eval);
+
#include "libguile/eval.x"
}
diff --git a/libguile/init.c b/libguile/init.c
index a7434b33d..3712a9a94 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -551,15 +551,16 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_weaks ();
scm_init_guardians ();
scm_init_vports ();
+ scm_init_standard_ports (); /* Requires fports */
scm_bootstrap_vm ();
scm_init_memoize ();
scm_init_eval ();
+ scm_init_load_path ();
+ scm_init_eval_in_scheme ();
scm_init_evalext ();
scm_init_debug (); /* Requires macro smobs */
scm_init_random ();
scm_init_simpos ();
- scm_init_load_path ();
- scm_init_standard_ports (); /* Requires fports */
scm_init_dynamic_linking ();
scm_bootstrap_i18n ();
#if SCM_ENABLE_ELISP
diff --git a/libguile/load.c b/libguile/load.c
index 5c0c61e20..fd3626f1a 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -837,6 +837,22 @@ scm_c_primitive_load_path (const char *filename)
return scm_primitive_load_path (scm_from_locale_string (filename));
}
+void
+scm_init_eval_in_scheme (void)
+{
+ SCM eval_scm, eval_go;
+ eval_scm = scm_search_path (*scm_loc_load_path,
+ scm_from_locale_string ("ice-9/eval.scm"),
+ SCM_EOL);
+ eval_go = scm_search_path (*scm_loc_load_compiled_path,
+ scm_from_locale_string ("ice-9/eval.go"),
+ SCM_EOL);
+
+ if (scm_is_true (eval_scm) && scm_is_true (eval_go)
+ && compiled_is_fresh (eval_scm, eval_go))
+ scm_load_compiled_with_vm (eval_go);
+}
+
/* Information about the build environment. */
diff --git a/libguile/load.h b/libguile/load.h
index 81fbfbabd..0feabad52 100644
--- a/libguile/load.h
+++ b/libguile/load.h
@@ -39,6 +39,7 @@ SCM_API SCM scm_c_primitive_load_path (const char *filename);
SCM_INTERNAL SCM scm_sys_warn_autocompilation_enabled (void);
SCM_INTERNAL void scm_init_load_path (void);
SCM_INTERNAL void scm_init_load (void);
+SCM_INTERNAL void scm_init_eval_in_scheme (void);
#endif /* SCM_LOAD_H */
diff --git a/libguile/modules.c b/libguile/modules.c
index e653571bb..c48c2e8a0 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -561,8 +561,10 @@ scm_current_module_lookup_closure ()
SCM_SYMBOL (sym_sys_pre_modules_transformer, "%pre-modules-transformer");
-SCM
-scm_module_transformer (SCM module)
+SCM_DEFINE (scm_module_transformer, "module-transformer", 1, 0, 0,
+ (SCM module),
+ "Returns the syntax expander for the given module.")
+#define FUNC_NAME s_scm_module_transformer
{
if (SCM_UNLIKELY (scm_is_false (module)))
{ SCM v = scm_hashq_ref (scm_pre_modules_obarray,
@@ -574,8 +576,12 @@ scm_module_transformer (SCM module)
return SCM_VARIABLE_REF (v);
}
else
- return SCM_MODULE_TRANSFORMER (module);
+ {
+ SCM_VALIDATE_MODULE (SCM_ARG1, module);
+ return SCM_MODULE_TRANSFORMER (module);
+ }
}
+#undef FUNC_NAME
SCM
scm_current_module_transformer ()
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index aaa8884fe..03993ec7e 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -199,8 +199,8 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
vm_error_wrong_type_apply:
SYNC_ALL ();
- scm_error (scm_misc_error_key, FUNC_NAME, "Wrong type to apply: ~S",
- scm_list_1 (program), SCM_BOOL_F);
+ scm_error (scm_arg_type_key, FUNC_NAME, "Wrong type to apply: ~S",
+ scm_list_1 (program), scm_list_1 (program));
goto vm_error;
vm_error_stack_overflow: