Show offending form when syntax error happens.

src/CHANGELOG

@@ -194,6 +194,15 @@ ECL 1.0:
 
 * Other visible changes:
 
+ - The interpreter now makes an attempt at showing the offending form
+   when a syntax error happens.
+	>  (progn (setq a 1) (setq b) (setq c 2))
+	In form
+	(SETQ B)
+	Syntax error: list with too few elements or improperly terminated.
+	Broken at SI:EVAL-WITH-ENV.No restarts available.
+	Broken at SI::BREAK-WHERE.
+
  - The documentation shipped with ECL was outdated. To enforce moving on
    to the new manual, the build and installation process now ignores anything
    inside src/doc.

src/c/compiler.d

@@ -289,7 +289,7 @@ FEillegal_variable_name(cl_object v)
 static void
 FEill_formed_input()
 {
-	FEprogram_error("Improper list handled to the compiler.", 0);
+	FEprogram_error("Syntax error: list with too few elements or improperly terminated.", 0);
 }
 
 static int
@@ -1849,6 +1849,7 @@ compile_form(cl_object stmt, int flags) {
 	bool push = flags & FLAG_PUSH;
 	int new_flags;
 
+	bds_bind(@'si::*current-form*', stmt);
  BEGIN:
 	if (code_walker != OBJNULL) {
 		stmt = funcall(3, SYM_VAL(@'si::*code-walker*'), stmt,
@@ -1957,6 +1958,7 @@ for special form ~S.", 1, function);
 	} else if (new_flags & FLAG_PUSH) {
 		FEerror("Internal error in bytecodes compiler", 0);
 	}
+	bds_unwind1();
 	return flags;
 }
 
@@ -2342,6 +2344,9 @@ ecl_make_lambda(cl_object name, cl_object lambda) {
 	cl_index handle;
 	struct cl_compiler_env *old_c_env, new_c_env;
 
+	bds_bind(@'si::*current-form*',
+		 @list*(3, @'ext::lambda-block', name, lambda));
+
 	old_c_env = ENV;
 	new_c_env = *ENV;
 	ENV = &new_c_env;
@@ -2437,6 +2442,8 @@ ecl_make_lambda(cl_object name, cl_object lambda) {
 
 	ENV = old_c_env;
 
+	bds_unwind1();
+
 	return output;
 }
 

src/c/error.d

@@ -82,13 +82,17 @@ CEerror(const char *err, int narg, ...)
 void
 FEprogram_error(const char *s, int narg, ...)
 {
+	cl_object form, real_args;
 	cl_va_list args;
 	cl_va_start(args, narg, narg, 0);
+	real_args = @list(3, SYM_VAL(@'si::*current-form*'),
+			  make_constant_base_string(s),
+			  cl_grab_rest_args(args));
 	si_signal_simple_error(4, 
 			       @'program-error', /* condition name */
 			       Cnil, /* not correctable */
-			       make_constant_base_string(s), /* format control */
-			       cl_grab_rest_args(args)); /* format args */
+			       make_constant_base_string("In form~%~S~%~?"),
+			       real_args);
 }
 
 void

src/c/symbols_list.h

@@ -1657,6 +1657,8 @@ cl_symbols[] = {
 
 {SYS_ "GC-STATS", SI_ORDINARY, si_gc_stats, 1, OBJNULL},
 
+{SYS_ "*CURRENT-FORM*", SI_SPECIAL, NULL, -1, OBJNULL},
+
 /* Tag for end of list */
 {NULL, CL_ORDINARY, NULL, -1, OBJNULL}};
 

src/c/symbols_list2.h

@@ -1657,6 +1657,8 @@ cl_symbols[] = {
 
 {SYS_ "GC-STATS","si_gc_stats"},
 
+{SYS_ "*CURRENT-FORM*",NULL},
+
 /* Tag for end of list */
 {NULL,NULL}};