* eval.c (force): Default the new second argument of source_loc_str.

(eval_error): Derive location of error from
the last_form_evaled, if form doesn't have it.
(eval_init): Re-register source-loc-str as binary with an optional arg.

* match.c (debuglf, sem_error, file_err, typed_error): Default new
argument of source_loc_str.

* parser.h (source_loc_str): Declaration updated.

* parser.l (source_loc_str): Take second argument which specifies
alternative value if the source loc info is not found.

* unwind.c (uw_throw): Simplify code thanks to source_loc_str
default argument.

* txr.1: Document new argument of source-loc-str.

1 files changed, 7 insertions, 6 deletions

diff --git a/eval.c b/eval.c
index 453c20fb..1d1ed589 100644
--- a/eval.c
+++ b/eval.c
@@ -151,16 +151,17 @@ static void env_vb_to_fb(val env)
 
 noreturn static val eval_error(val form, val fmt, ...)
 {
+  uses_or2;
   va_list vl;
   val stream = make_string_output_stream();
+  val loc = or2(source_loc_str(form, nil),
+                source_loc_str(last_form_evaled, nil));
 
   va_start (vl, fmt);
 
-  if (!form)
-    form = last_form_evaled;
+  if (loc)
+    format(stream, lit("(~a) "), loc, nao);
 
-  if (form)
-    format(stream, lit("(~a) "), source_loc_str(form), nao);
   (void) vformat(stream, fmt, vl);
   va_end (vl);
 
@@ -3743,7 +3744,7 @@ static val force(val promise)
     return ret;
   } else if (deref(pstate) == promise_inprogress_s) {
     val form = second(cdr(cd));
-    val sloc = source_loc_str(form);
+    val sloc = source_loc_str(form, colon_k);
     eval_error(nil, lit("force: recursion forcing delayed form ~s (~a)"),
                form, sloc, nao);
   } else {
@@ -4627,7 +4628,7 @@ void eval_init(void)
   reg_fun(intern(lit("make-time-utc"), user_package), func_n7(make_time_utc));
 
   reg_fun(intern(lit("source-loc"), user_package), func_n1(source_loc));
-  reg_fun(intern(lit("source-loc-str"), user_package), func_n1(source_loc_str));
+  reg_fun(intern(lit("source-loc-str"), user_package), func_n2o(source_loc_str, 1));
   reg_fun(intern(lit("rlcp"), user_package), func_n2(rlcp));
 
   eval_error_s = intern(lit("eval-error"), user_package);