mes: Better error reporting.

* src/lib.c (write_error_): New function.
* src/mes.c (error, check_apply): Use it.
  (append2, set_car_x): Upon error, call error (WAS: assert).
This commit is contained in:
Jan Nieuwenhuizen 2018-01-07 16:08:11 +01:00
parent 0fab33da36
commit a5ede4d4d6
3 changed files with 14 additions and 7 deletions

View file

@ -29,7 +29,7 @@
(display "unhandled exception:" (current-error-port))
(display key (current-error-port))
(display ":" (current-error-port))
(display args (current-error-port))
(write args (current-error-port))
(newline (current-error-port))))
(exit 1))))

View file

@ -144,6 +144,13 @@ write_ (SCM x)
return display_helper (x, 0, "", g_stdout, 1);
}
SCM
write_error_ (SCM x)
{
g_depth = 5;
return display_helper (x, 0, "", STDERR, 1);
}
SCM
write_port_ (SCM x, SCM p)
{

View file

@ -510,7 +510,7 @@ error (SCM key, SCM x)
#endif
display_error_ (key);
eputs (": ");
display_error_ (x);
write_error_ (x);
eputs ("\n");
exit (1);
}
@ -571,7 +571,7 @@ check_apply (SCM f, SCM e) ///((internal))
eputs (s);
eputs (type);
eputs ("[");
display_error_ (e);
write_error_ (e);
eputs ("]\n");
SCM e = MAKE_STRING (cstring_to_list (s));
return error (cell_symbol_wrong_type_arg, cons (e, f));
@ -591,7 +591,7 @@ SCM
append2 (SCM x, SCM y)
{
if (x == cell_nil) return y;
assert (TYPE (x) == TPAIR);
if (TYPE (x) != TPAIR) error (cell_symbol_not_a_pair, cons (x, cell_append2));
return cons (car (x), append2 (cdr (x), y));
}
@ -671,7 +671,7 @@ assq_ref_env (SCM x, SCM a)
SCM
set_car_x (SCM x, SCM e)
{
assert (TYPE (x) == TPAIR);
if (TYPE (x) != TPAIR) error (cell_symbol_not_a_pair, cons (x, cell_set_car_x));
CAR (x) = e;
return cell_unspecified;
}
@ -1483,12 +1483,12 @@ main (int argc, char *argv[])
if (g_debug > 1)
{
eputs ("program: ");
display_error_ (r1);
write_error_ (r1);
eputs ("\n");
}
r3 = cell_vm_begin;
r1 = eval_apply ();
display_error_ (r1);
write_error_ (r1);
eputs ("\n");
gc (g_stack);
if (g_debug)