diff --git a/doc/chibi-scheme.1 b/doc/chibi-scheme.1 index ce148dca..505f08b0 100644 --- a/doc/chibi-scheme.1 +++ b/doc/chibi-scheme.1 @@ -89,6 +89,9 @@ and primitives coded in C. .BI -r Run the "main" procedure when the script finishes loading as in SRFI-22. .TP +.BI -s +Strict mode, escalating warnings to fatal errors. +.TP .BI -f Change the reader to case-fold symbols as in R5RS. .TP diff --git a/eval.c b/eval.c index 1c8e8118..3ad188de 100644 --- a/eval.c +++ b/eval.c @@ -35,6 +35,7 @@ sexp sexp_compile_error (sexp ctx, const char *message, sexp o) { void sexp_warn (sexp ctx, char *msg, sexp x) { sexp_gc_var1(out); + int strictp = sexp_truep(sexp_global(ctx, SEXP_G_STRICT_P)); sexp_gc_preserve1(ctx, out); out = sexp_current_error_port(ctx); if (sexp_not(out)) { /* generate a throw-away port */ @@ -42,12 +43,14 @@ void sexp_warn (sexp ctx, char *msg, sexp x) { sexp_port_no_closep(out) = 1; } if (sexp_oportp(out)) { - sexp_write_string(ctx, "WARNING: ", out); + sexp_write_string(ctx, strictp ? "ERROR: " : "WARNING: ", out); sexp_write_string(ctx, msg, out); sexp_write(ctx, x, out); sexp_write_char(ctx, '\n', out); + if (strictp) sexp_stack_trace(ctx, out); } sexp_gc_release1(ctx); + if (strictp) exit(1); } sexp sexp_warn_undefs_op (sexp ctx, sexp self, sexp_sint_t n, sexp from, sexp to, sexp res) { diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index 4df3de3d..a49326be 100755 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -1201,6 +1201,7 @@ enum sexp_context_globals { SEXP_G_ERR_HANDLER, SEXP_G_RESUMECC_BYTECODE, SEXP_G_FINAL_RESUMER, + SEXP_G_STRICT_P, #if SEXP_USE_FOLD_CASE_SYMS SEXP_G_FOLD_CASE_P, #endif diff --git a/main.c b/main.c index 915e094a..4e4c194f 100644 --- a/main.c +++ b/main.c @@ -448,12 +448,16 @@ void run_main (int argc, char **argv) { #if SEXP_USE_FOLD_CASE_SYMS case 'f': fold_case = 1; - if (ctx) sexp_global(ctx, SEXP_G_FOLD_CASE_P) = SEXP_TRUE; + init_context(); + sexp_global(ctx, SEXP_G_FOLD_CASE_P) = SEXP_TRUE; break; #endif case 'r': main_symbol = argv[i][2] == '\0' ? "main" : argv[i]+2; break; + case 's': + init_context(); sexp_global(ctx, SEXP_G_STRICT_P) = SEXP_TRUE; + break; default: fprintf(stderr, "unknown option: %s\n", argv[i]); sexp_usage(1); @@ -490,7 +494,7 @@ void run_main (int argc, char **argv) { /* load the script */ sexp_context_tracep(ctx) = 1; tmp = sexp_env_bindings(env); -#if SEXP_USE_MODULES +#if 0 /* SEXP_USE_MODULES */ /* use scheme load if possible for better stack traces */ sym = sexp_intern(ctx, "load", -1); tmp = sexp_env_ref(sexp_global(ctx, SEXP_G_META_ENV), sym, SEXP_FALSE); diff --git a/sexp.c b/sexp.c index 7e1ddd5e..a79462b0 100644 --- a/sexp.c +++ b/sexp.c @@ -376,6 +376,7 @@ void sexp_init_context_globals (sexp ctx) { #if ! SEXP_USE_GLOBAL_SYMBOLS sexp_global(ctx, SEXP_G_SYMBOLS) = sexp_make_vector(ctx, sexp_make_fixnum(SEXP_SYMBOL_TABLE_SIZE), SEXP_NULL); #endif + sexp_global(ctx, SEXP_G_STRICT_P) = SEXP_FALSE; #if SEXP_USE_FOLD_CASE_SYMS sexp_global(ctx, SEXP_G_FOLD_CASE_P) = sexp_make_boolean(SEXP_DEFAULT_FOLD_CASE_SYMS); #endif