From e131e81e72f37d29bd237d0052bb9f6febd7ffd0 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 6 Sep 2017 22:26:31 -0700
Subject: txr -i honored despite parse-time exception.

If an error is thrown while parsing a .txr file
or while reading and evaluating the forms of a .tl
file.

* parser.y (parse_once, parse): Wording change in message when
exception is caught. Only exceptions derived from error are
caught.

* txr.c (parse_once_noerr, read_eval_stream_noerr): New static
functions.
(txr_main): Use parse_once_noerr and read_eval_stream_noerr
instead of parse_once and read_eval_stream.
Don't exit if a TXR file has parser errors; in that situation,
exit only if interactive mode is not requested, otherwise
go interactive. Make sure *self-path* is registered to the
name of the input source in this case also.

* unwind.h (ignerr_func_body): New macro.
---
 parser.y |  4 ++--
 txr.c    | 32 +++++++++++++++++++++++++-------
 unwind.h | 11 +++++++++++
 3 files changed, 38 insertions(+), 9 deletions(-)

diff --git a/parser.y b/parser.y
index 265e4e30..a29403f0 100644
--- a/parser.y
+++ b/parser.y
@@ -1839,7 +1839,7 @@ int parse_once(val stream, val name, parser_t *parser)
   parser_resolve_circ(parser);
 
   uw_catch(esym, eobj) {
-    yyerrorf(parser->scanner, lit("exception during parse"), nao);
+    yyerrorf(parser->scanner, lit("error exception during parse"), nao);
     uw_throw(esym, eobj);
   }
 
@@ -1878,7 +1878,7 @@ int parse(parser_t *parser, val name, enum prime_parser prim)
   parser_resolve_circ(parser);
 
   uw_catch(esym, eobj) {
-    yyerrorf(parser->scanner, lit("exception during parse"), nao);
+    yyerrorf(parser->scanner, lit("error exception during parse"), nao);
     uw_throw(esym, eobj);
   }
 
diff --git a/txr.c b/txr.c
index 2591b339..cee8ac51 100644
--- a/txr.c
+++ b/txr.c
@@ -447,6 +447,20 @@ static void no_dbg_support(val arg)
 }
 #endif
 
+static int parse_once_noerr(val stream, val name, parser_t *parser)
+{
+  val pfx = format(nil, lit("~a:"), name, nao);
+  ignerr_func_body(int, 0, parse_once(stream, name, parser),
+                   exsym, exargs, std_error, pfx);
+}
+
+static val read_eval_stream_noerr(val stream, val name, val error_stream)
+{
+  val pfx = format(nil, lit("~a:"), name, nao);
+  ignerr_func_body(val, nil, read_eval_stream(stream, error_stream),
+                   exsym, exargs, std_error, pfx);
+}
+
 int txr_main(int argc, char **argv)
 {
   uses_or2;
@@ -974,27 +988,30 @@ int txr_main(int argc, char **argv)
   {
     int gc = gc_state(0);
     parser_t parser;
-    parse_once(parse_stream, spec_file_str, &parser);
+    parse_once_noerr(parse_stream, spec_file_str, &parser);
     gc_state(gc);
 
     close_stream(parse_stream, nil);
 
     uw_release_deferred_warnings();
 
-    if (parser.errors)
-      return EXIT_FAILURE;
-
     spec = parser.syntax_tree;
 
     opt_loglevel = match_loglevel;
 
+    reg_var(intern(lit("*self-path*"), user_package), spec_file_str);
+
+    if (parser.errors) {
+      if (enter_repl)
+        goto repl;
+      return EXIT_FAILURE;
+    }
+
     if (opt_loglevel >= 2) {
       format(std_error, lit("spec:\n~s\n"), spec, nao);
       format(std_error, lit("bindings:\n~s\n"), bindings, nao);
     }
 
-    reg_var(intern(lit("*self-path*"), user_package), spec_file_str);
-
     {
       val result = extract(spec, arg_list, bindings);
       cons_bind (new_bindings, success, result);
@@ -1014,7 +1031,8 @@ int txr_main(int argc, char **argv)
   }
 
   {
-    val result = read_eval_stream(parse_stream, std_error);
+    val result = read_eval_stream_noerr(parse_stream, spec_file_str,
+                                        std_error);
 
     close_stream(parse_stream, nil);
 
diff --git a/unwind.h b/unwind.h
index a173e39d..5c4786f3 100644
--- a/unwind.h
+++ b/unwind.h
@@ -276,3 +276,14 @@ noreturn val type_mismatch(val, ...);
     internal_error("assertion "         \
                             #EXPR       \
                             " failed")
+
+#define ignerr_func_body(type, init, expr, exsym,       \
+                         exargs, stream, prefix)        \
+   type (_r_e_t) = (init);                              \
+   uw_catch_begin (cons(error_s, nil), exsym, exargs);  \
+   _r_e_t = expr;                                       \
+   uw_catch(exsym, exargs)                              \
+   error_trace(exsym, exargs, stream, prefix);          \
+   uw_unwind { }                                        \
+   uw_catch_end;                                        \
+   return _r_e_t;
-- 
cgit v1.2.3