fix -m handling

svn: r8009
This commit is contained in:
Matthew Flatt 2007-12-14 15:37:24 +00:00
parent 265550c08f
commit 96308d90b6
10 changed files with 41 additions and 5 deletions

View File

@ -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;

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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[])
{

View File

@ -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 */
/*========================================================================*/

View File

@ -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 */
/*========================================================================*/

View File

@ -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;

View File

@ -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)