From fec6528c704ee823ab340e6e71903da7852d9142 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 21 Apr 2010 18:50:50 -0600 Subject: [PATCH] fix command-line parsingand support '-f -' as eval from stdin --- src/racket/cmdline.inc | 17 +++++++++++++---- src/racket/include/mzwin.def | 1 + src/racket/include/mzwin3m.def | 1 + src/racket/include/racket.exp | 1 + src/racket/include/racket3m.exp | 1 + src/racket/src/eval.c | 34 ++++++++++++++++++++++----------- src/racket/src/schemef.h | 1 + src/racket/src/schemex.h | 1 + src/racket/src/schemex.inc | 1 + src/racket/src/schemexm.h | 1 + 10 files changed, 44 insertions(+), 15 deletions(-) diff --git a/src/racket/cmdline.inc b/src/racket/cmdline.inc index 82a00985ec..6f18c77609 100644 --- a/src/racket/cmdline.inc +++ b/src/racket/cmdline.inc @@ -256,12 +256,14 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) mz_jmp_buf * volatile save, newbuf; for (i = 0; i < fa->a->num_enl; i++) { - if (fa->eval_kind[i] == mzcmd_LOAD) { - if (!scheme_load(fa->evals_and_loads[i])) { + if ((fa->eval_kind[i] == mzcmd_LOAD) + && strcmp(fa->evals_and_loads[i], "-")) { + if (!scheme_load(fa->evals_and_loads[i])) { exit_val = 1; break; } } else if ((fa->eval_kind[i] == mzcmd_EVAL) + || (fa->eval_kind[i] == mzcmd_LOAD) /* stdin */ || (fa->eval_kind[i] == mzcmd_REQUIRE_FILE) || (fa->eval_kind[i] == mzcmd_REQUIRE_LIB) || (fa->eval_kind[i] == mzcmd_REQUIRE_PLANET) @@ -274,6 +276,9 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) if (!scheme_setjmp(newbuf)) { if (fa->eval_kind[i] == mzcmd_EVAL) { scheme_eval_string_all_with_prompt(fa->evals_and_loads[i], fa->global_env, 2); + } else if (fa->eval_kind[i] == mzcmd_LOAD) { + /* eval from stdin */ + scheme_eval_all_with_prompt(NULL, fa->global_env, 2); } else if (fa->eval_kind[i] == mzcmd_EMBEDDED) { Scheme_Object *s, *e, *a[3], *eload; eload = scheme_builtin_value("embedded-load"); @@ -712,7 +717,11 @@ static int run_from_cmd_line(int argc, char *_argv[], eval_kind = (int *)malloc(sizeof(int) * argc); num_enl = 0; - while (!no_more_switches && argc && argv[0][0] == '-' && !is_number_arg(argv[0] + 1)) { + while (!no_more_switches + && argc + && argv[0][0] == '-' + && argv[0][1] + && !is_number_arg(argv[0] + 1)) { real_switch = argv[0]; if (!strcmp("--help", argv[0])) @@ -1029,7 +1038,7 @@ static int run_from_cmd_line(int argc, char *_argv[], /* No args => repl */ use_repl = 1; init_ns = 1; - } else if (argv[0][0] != '-') { + } else { /* No switches => -u mode */ script_mode = 1; no_more_switches = 1; diff --git a/src/racket/include/mzwin.def b/src/racket/include/mzwin.def index d6a0b6e560..a7a3663be7 100644 --- a/src/racket/include/mzwin.def +++ b/src/racket/include/mzwin.def @@ -144,6 +144,7 @@ EXPORTS scheme_eval_string_with_prompt scheme_eval_string_multi_with_prompt scheme_eval_string_all_with_prompt + scheme_eval_all_with_prompt scheme_eval_module_string scheme_current_argument_stack scheme_call_with_prompt diff --git a/src/racket/include/mzwin3m.def b/src/racket/include/mzwin3m.def index 2fb6d0fd3b..fe11bcdcbd 100644 --- a/src/racket/include/mzwin3m.def +++ b/src/racket/include/mzwin3m.def @@ -144,6 +144,7 @@ EXPORTS scheme_eval_string_with_prompt scheme_eval_string_multi_with_prompt scheme_eval_string_all_with_prompt + scheme_eval_all_with_prompt scheme_eval_module_string scheme_current_argument_stack scheme_call_with_prompt diff --git a/src/racket/include/racket.exp b/src/racket/include/racket.exp index 49fbd059de..29e7dadae2 100644 --- a/src/racket/include/racket.exp +++ b/src/racket/include/racket.exp @@ -146,6 +146,7 @@ scheme_eval_string_all scheme_eval_string_with_prompt scheme_eval_string_multi_with_prompt scheme_eval_string_all_with_prompt +scheme_eval_all_with_prompt scheme_eval_module_string _scheme_apply_known_prim_closure _scheme_apply_known_prim_closure_multi diff --git a/src/racket/include/racket3m.exp b/src/racket/include/racket3m.exp index 1bb029ade0..4a9927e77e 100644 --- a/src/racket/include/racket3m.exp +++ b/src/racket/include/racket3m.exp @@ -146,6 +146,7 @@ scheme_eval_string_all scheme_eval_string_with_prompt scheme_eval_string_multi_with_prompt scheme_eval_string_all_with_prompt +scheme_eval_all_with_prompt scheme_eval_module_string _scheme_apply_known_prim_closure _scheme_apply_known_prim_closure_multi diff --git a/src/racket/src/eval.c b/src/racket/src/eval.c index fea42d2fe2..4e750e1379 100644 --- a/src/racket/src/eval.c +++ b/src/racket/src/eval.c @@ -11020,15 +11020,18 @@ expand_stx_to_top_form(int argc, Scheme_Object **argv) 1, -1, 1, scheme_false, 0, NULL, 0); } -static Scheme_Object *do_eval_string_all(const char *str, Scheme_Env *env, int cont, int w_prompt) +static Scheme_Object *do_eval_string_all(Scheme_Object *port, const char *str, Scheme_Env *env, + int cont, int w_prompt) /* cont == -2 => module (no result) cont == -1 => single result cont == 1 -> multiple result ok - cont == 2 -> multiple result ok, use current_print to show results */ + cont == 2 -> #%top-interaction, multiple result ok, use current_print to show results */ { - Scheme_Object *port, *expr, *result = scheme_void; + Scheme_Object *expr, *result = scheme_void; + + if (!port) + port = scheme_make_byte_string_input_port(str); - port = scheme_make_byte_string_input_port(str); do { expr = scheme_read_syntax(port, scheme_false); @@ -11055,6 +11058,9 @@ static Scheme_Object *do_eval_string_all(const char *str, Scheme_Env *env, int c else result = scheme_eval(expr, env); } else { + if (cont == 2) + expr = scheme_make_pair(scheme_intern_symbol("#%top-interaction"), expr); + if (w_prompt) result = scheme_eval_multi_with_prompt(expr, env); else @@ -11090,37 +11096,43 @@ static Scheme_Object *do_eval_string_all(const char *str, Scheme_Env *env, int c Scheme_Object *scheme_eval_string_all(const char *str, Scheme_Env *env, int cont) { - return do_eval_string_all(str, env, cont, 0); + return do_eval_string_all(NULL, str, env, cont, 0); } Scheme_Object *scheme_eval_string(const char *str, Scheme_Env *env) { - return do_eval_string_all(str, env, -1, 0); + return do_eval_string_all(NULL, str, env, -1, 0); } Scheme_Object *scheme_eval_module_string(const char *str, Scheme_Env *env) { - return do_eval_string_all(str, env, -2, 0); + return do_eval_string_all(NULL, str, env, -2, 0); } Scheme_Object *scheme_eval_string_multi(const char *str, Scheme_Env *env) { - return do_eval_string_all(str, env, 0, 0); + return do_eval_string_all(NULL, str, env, 0, 0); } Scheme_Object *scheme_eval_string_all_with_prompt(const char *str, Scheme_Env *env, int cont) { - return do_eval_string_all(str, env, cont, 1); + return do_eval_string_all(NULL, str, env, cont, 1); +} + +Scheme_Object *scheme_eval_all_with_prompt(Scheme_Object *port, Scheme_Env *env, int cont) +{ + if (!port) port = scheme_orig_stdin_port; + return do_eval_string_all(port, NULL, env, cont, 1); } Scheme_Object *scheme_eval_string_with_prompt(const char *str, Scheme_Env *env) { - return do_eval_string_all(str, env, -1, 1); + return do_eval_string_all(NULL, str, env, -1, 1); } Scheme_Object *scheme_eval_string_multi_with_prompt(const char *str, Scheme_Env *env) { - return do_eval_string_all(str, env, 0, 1); + return do_eval_string_all(NULL, str, env, 0, 1); } void scheme_init_collection_paths_post(Scheme_Env *global_env, Scheme_Object *extra_dirs, Scheme_Object *post_dirs) diff --git a/src/racket/src/schemef.h b/src/racket/src/schemef.h index 1b9242da43..01ddbf197d 100644 --- a/src/racket/src/schemef.h +++ b/src/racket/src/schemef.h @@ -287,6 +287,7 @@ MZ_EXTERN Scheme_Object *scheme_eval_string_all(const char *str, Scheme_Env *env MZ_EXTERN Scheme_Object *scheme_eval_string_with_prompt(const char *str, Scheme_Env *env); MZ_EXTERN Scheme_Object *scheme_eval_string_multi_with_prompt(const char *str, Scheme_Env *env); MZ_EXTERN Scheme_Object *scheme_eval_string_all_with_prompt(const char *str, Scheme_Env *env, int all); +MZ_EXTERN Scheme_Object *scheme_eval_all_with_prompt(Scheme_Object *port, Scheme_Env *env, int all); MZ_EXTERN Scheme_Object *scheme_eval_module_string(const char *str, Scheme_Env *env); MZ_EXTERN Scheme_Object *_scheme_apply_known_prim_closure(Scheme_Object *rator, int argc, diff --git a/src/racket/src/schemex.h b/src/racket/src/schemex.h index 37c96efc36..d194ef2d2f 100644 --- a/src/racket/src/schemex.h +++ b/src/racket/src/schemex.h @@ -234,6 +234,7 @@ Scheme_Object *(*scheme_eval_string_all)(const char *str, Scheme_Env *env, int a Scheme_Object *(*scheme_eval_string_with_prompt)(const char *str, Scheme_Env *env); Scheme_Object *(*scheme_eval_string_multi_with_prompt)(const char *str, Scheme_Env *env); Scheme_Object *(*scheme_eval_string_all_with_prompt)(const char *str, Scheme_Env *env, int all); +Scheme_Object *(*scheme_eval_all_with_prompt)(Scheme_Object *port, Scheme_Env *env, int all); Scheme_Object *(*scheme_eval_module_string)(const char *str, Scheme_Env *env); Scheme_Object *(*_scheme_apply_known_prim_closure)(Scheme_Object *rator, int argc, Scheme_Object **argv); diff --git a/src/racket/src/schemex.inc b/src/racket/src/schemex.inc index 3c8293bc4f..db10f8760f 100644 --- a/src/racket/src/schemex.inc +++ b/src/racket/src/schemex.inc @@ -154,6 +154,7 @@ scheme_extension_table->scheme_eval_string_with_prompt = scheme_eval_string_with_prompt; scheme_extension_table->scheme_eval_string_multi_with_prompt = scheme_eval_string_multi_with_prompt; scheme_extension_table->scheme_eval_string_all_with_prompt = scheme_eval_string_all_with_prompt; + scheme_extension_table->scheme_eval_all_with_prompt = scheme_eval_all_with_prompt; scheme_extension_table->scheme_eval_module_string = scheme_eval_module_string; scheme_extension_table->_scheme_apply_known_prim_closure = _scheme_apply_known_prim_closure; scheme_extension_table->_scheme_apply_known_prim_closure_multi = _scheme_apply_known_prim_closure_multi; diff --git a/src/racket/src/schemexm.h b/src/racket/src/schemexm.h index aac0c352b5..486066040b 100644 --- a/src/racket/src/schemexm.h +++ b/src/racket/src/schemexm.h @@ -154,6 +154,7 @@ #define scheme_eval_string_with_prompt (scheme_extension_table->scheme_eval_string_with_prompt) #define scheme_eval_string_multi_with_prompt (scheme_extension_table->scheme_eval_string_multi_with_prompt) #define scheme_eval_string_all_with_prompt (scheme_extension_table->scheme_eval_string_all_with_prompt) +#define scheme_eval_all_with_prompt (scheme_extension_table->scheme_eval_all_with_prompt) #define scheme_eval_module_string (scheme_extension_table->scheme_eval_module_string) #define _scheme_apply_known_prim_closure (scheme_extension_table->_scheme_apply_known_prim_closure) #define _scheme_apply_known_prim_closure_multi (scheme_extension_table->_scheme_apply_known_prim_closure_multi)