diff options
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/eval.c | 23 | ||||
-rw-r--r-- | libguile/init.c | 5 | ||||
-rw-r--r-- | libguile/load.c | 16 | ||||
-rw-r--r-- | libguile/load.h | 1 | ||||
-rw-r--r-- | libguile/modules.c | 12 | ||||
-rw-r--r-- | libguile/vm-engine.c | 4 |
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: |