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).

diff --git a/module/mes/catch.mes b/module/mes/catch.mes
index 31062898ceebfd6b77f57167204644ecce04f855..bc0d5dd811053e5fbb7bb1cc9ba6443b1af94364 100644 (file)
--- a/module/mes/catch.mes
+++ b/module/mes/catch.mes
@@ -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))))
 

diff --git a/src/lib.c b/src/lib.c
index f97ce2134a8c637c73fc8289d492b0c71c2afca4..dd3ee52730647f3cc64e5ceb489837a7c7dc1e82 100644 (file)
--- a/src/lib.c
+++ b/src/lib.c
@@ -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)
 {

diff --git a/src/mes.c b/src/mes.c
index 8f9955f8c48a73021c9b5af8444244f37429ac60..603ace0c674100eb31ed156181ddff1c6306eff7 100644 (file)
--- a/src/mes.c
+++ b/src/mes.c
@@ -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)