artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mes: Better error reporting.

Browse source 
* 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
Show stats Download patch file Download diff file Expand all files Collapse all files

2
module/mes/catch.mes
View file

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

7
src/lib.c
View file

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

12
src/mes.c
View file

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