From 96308d90b691a7ad8da5dbe008bc0615dc2f3c03 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 14 Dec 2007 15:37:24 +0000 Subject: [PATCH] fix -m handling svn: r8009 --- src/mzscheme/cmdline.inc | 28 +++++++++++++++++++++++++--- src/mzscheme/include/mzscheme.exp | 1 + src/mzscheme/include/mzscheme3m.exp | 1 + src/mzscheme/include/mzwin.def | 1 + src/mzscheme/include/mzwin3m.def | 1 + src/mzscheme/src/eval.c | 5 +++++ src/mzscheme/src/schemef.h | 4 +++- src/mzscheme/src/schemex.h | 3 ++- src/mzscheme/src/schemex.inc | 1 + src/mzscheme/src/schemexm.h | 1 + 10 files changed, 41 insertions(+), 5 deletions(-) diff --git a/src/mzscheme/cmdline.inc b/src/mzscheme/cmdline.inc index 2ea9f5dac2..3f6c5712c5 100644 --- a/src/mzscheme/cmdline.inc +++ b/src/mzscheme/cmdline.inc @@ -292,9 +292,31 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) save = p->error_buf; p->error_buf = &newbuf; if (!scheme_setjmp(newbuf)) { - Scheme_Object *e; - - e = scheme_make_pair(scheme_intern_symbol("main"), scheme_vector_to_list(fa->main_args)); + Scheme_Object *e, *a[2], *d2s, *nsi, *idb, *b; + + d2s = scheme_builtin_value("datum->syntax"); + a[0] = scheme_make_false(); + e = scheme_intern_symbol("main"); + a[1] = e; + e = scheme_apply(d2s, 2, a); + + nsi = scheme_builtin_value("namespace-syntax-introduce"); + a[0] = e; + e = scheme_apply(nsi, 1, a); + + /* Check that `main' is imported and/or defined: */ + idb = scheme_builtin_value("identifier-binding"); + a[0] = e; + b = scheme_apply(idb, 1, a); + if (b == scheme_make_false()) { + if (!scheme_lookup_global(scheme_intern_symbol("main"), fa->global_env)) { + scheme_signal_error("main: not defined or required into the top-level environment"); + } + } + + e = scheme_make_pair(e, scheme_vector_to_list(fa->main_args)); + e = scheme_datum_to_kernel_stx(e); + (void)scheme_eval_with_prompt(e, fa->global_env); } else { exit_val = 1; diff --git a/src/mzscheme/include/mzscheme.exp b/src/mzscheme/include/mzscheme.exp index 739628aef8..76ef47574b 100644 --- a/src/mzscheme/include/mzscheme.exp +++ b/src/mzscheme/include/mzscheme.exp @@ -464,6 +464,7 @@ scheme_apply_for_syntax_in_env scheme_dynamic_require scheme_namespace_require scheme_is_module_path +scheme_datum_to_kernel_stx scheme_intern_symbol scheme_intern_exact_symbol scheme_intern_exact_char_symbol diff --git a/src/mzscheme/include/mzscheme3m.exp b/src/mzscheme/include/mzscheme3m.exp index 70e3f075bc..f928966583 100644 --- a/src/mzscheme/include/mzscheme3m.exp +++ b/src/mzscheme/include/mzscheme3m.exp @@ -474,6 +474,7 @@ scheme_apply_for_syntax_in_env scheme_dynamic_require scheme_namespace_require scheme_is_module_path +scheme_datum_to_kernel_stx scheme_intern_symbol scheme_intern_exact_symbol scheme_intern_exact_char_symbol diff --git a/src/mzscheme/include/mzwin.def b/src/mzscheme/include/mzwin.def index 7be8138196..0670b6beac 100644 --- a/src/mzscheme/include/mzwin.def +++ b/src/mzscheme/include/mzwin.def @@ -452,6 +452,7 @@ EXPORTS scheme_dynamic_require scheme_namespace_require scheme_is_module_path + scheme_datum_to_kernel_stx scheme_intern_symbol scheme_intern_exact_symbol scheme_intern_exact_char_symbol diff --git a/src/mzscheme/include/mzwin3m.def b/src/mzscheme/include/mzwin3m.def index dfeac7d5bd..924fb92a17 100644 --- a/src/mzscheme/include/mzwin3m.def +++ b/src/mzscheme/include/mzwin3m.def @@ -466,6 +466,7 @@ EXPORTS scheme_dynamic_require scheme_namespace_require scheme_is_module_path + scheme_datum_to_kernel_stx scheme_intern_symbol scheme_intern_exact_symbol scheme_intern_exact_char_symbol diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index fe981c3f5f..89582106f4 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -7778,6 +7778,11 @@ top_introduce_stx(int argc, Scheme_Object **argv) return form; } +Scheme_Object *scheme_datum_to_kernel_stx(Scheme_Object *e) +{ + scheme_datum_to_syntax(e, scheme_false, scheme_sys_wraps(NULL), 0, 0); +} + static Scheme_Object * compile(int argc, Scheme_Object *argv[]) { diff --git a/src/mzscheme/src/schemef.h b/src/mzscheme/src/schemef.h index a117262616..e839ee55e9 100644 --- a/src/mzscheme/src/schemef.h +++ b/src/mzscheme/src/schemef.h @@ -882,7 +882,7 @@ MZ_EXTERN Scheme_Bucket *scheme_module_bucket(Scheme_Object *mod, Scheme_Object MZ_EXTERN Scheme_Object *scheme_builtin_value(const char *name); /* convenience */ MZ_EXTERN void scheme_set_global_bucket(char *proc, Scheme_Bucket *var, Scheme_Object *val, - int set_undef); + int set_undef); MZ_EXTERN void scheme_install_macro(Scheme_Bucket *b, Scheme_Object *v); @@ -902,6 +902,8 @@ MZ_EXTERN Scheme_Object *scheme_namespace_require(Scheme_Object *); MZ_EXTERN int scheme_is_module_path(Scheme_Object *); +MZ_EXTERN Scheme_Object *scheme_datum_to_kernel_stx(Scheme_Object *e); + /*========================================================================*/ /* symbols */ /*========================================================================*/ diff --git a/src/mzscheme/src/schemex.h b/src/mzscheme/src/schemex.h index e4698d6b08..c2128da7a9 100644 --- a/src/mzscheme/src/schemex.h +++ b/src/mzscheme/src/schemex.h @@ -734,7 +734,7 @@ Scheme_Bucket *(*scheme_global_keyword_bucket)(Scheme_Object *symbol, Scheme_Env Scheme_Bucket *(*scheme_module_bucket)(Scheme_Object *mod, Scheme_Object *var, int pos, Scheme_Env *env); Scheme_Object *(*scheme_builtin_value)(const char *name); /* convenience */ void (*scheme_set_global_bucket)(char *proc, Scheme_Bucket *var, Scheme_Object *val, - int set_undef); + int set_undef); void (*scheme_install_macro)(Scheme_Bucket *b, Scheme_Object *v); void (*scheme_save_initial_module_set)(Scheme_Env *env); Scheme_Env *(*scheme_primitive_module)(Scheme_Object *name, Scheme_Env *for_env); @@ -747,6 +747,7 @@ Scheme_Object *(*scheme_apply_for_syntax_in_env)(Scheme_Object *proc, Scheme_Env Scheme_Object *(*scheme_dynamic_require)(int argc, Scheme_Object *argv[]); Scheme_Object *(*scheme_namespace_require)(Scheme_Object *); int (*scheme_is_module_path)(Scheme_Object *); +Scheme_Object *(*scheme_datum_to_kernel_stx)(Scheme_Object *e); /*========================================================================*/ /* symbols */ /*========================================================================*/ diff --git a/src/mzscheme/src/schemex.inc b/src/mzscheme/src/schemex.inc index 8de13e1e73..82e9f7b402 100644 --- a/src/mzscheme/src/schemex.inc +++ b/src/mzscheme/src/schemex.inc @@ -516,6 +516,7 @@ scheme_extension_table->scheme_dynamic_require = scheme_dynamic_require; scheme_extension_table->scheme_namespace_require = scheme_namespace_require; scheme_extension_table->scheme_is_module_path = scheme_is_module_path; + scheme_extension_table->scheme_datum_to_kernel_stx = scheme_datum_to_kernel_stx; scheme_extension_table->scheme_intern_symbol = scheme_intern_symbol; scheme_extension_table->scheme_intern_exact_symbol = scheme_intern_exact_symbol; scheme_extension_table->scheme_intern_exact_char_symbol = scheme_intern_exact_char_symbol; diff --git a/src/mzscheme/src/schemexm.h b/src/mzscheme/src/schemexm.h index 162a8103e7..e8fba70094 100644 --- a/src/mzscheme/src/schemexm.h +++ b/src/mzscheme/src/schemexm.h @@ -516,6 +516,7 @@ #define scheme_dynamic_require (scheme_extension_table->scheme_dynamic_require) #define scheme_namespace_require (scheme_extension_table->scheme_namespace_require) #define scheme_is_module_path (scheme_extension_table->scheme_is_module_path) +#define scheme_datum_to_kernel_stx (scheme_extension_table->scheme_datum_to_kernel_stx) #define scheme_intern_symbol (scheme_extension_table->scheme_intern_symbol) #define scheme_intern_exact_symbol (scheme_extension_table->scheme_intern_exact_symbol) #define scheme_intern_exact_char_symbol (scheme_extension_table->scheme_intern_exact_char_symbol)