DRAFT core: Use exceptions instead of asserts.

XXX prototypes

* src/lib.c (assert_num, assert_struct, (assert_range): New functions.
* src/struct.c (struct_ref_): Use them.
* src/hash.c (make_hash_table): Use assert_number.

mes/module/mes/repl.mes

@@ -177,11 +177,11 @@ along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
                           (loop (acons id e a)))))))))
         (lambda (key . args)
           (if (defined? 'with-output-to-string)
-              (simple-format (current-error-port) "exception:~a:~a\n" key args)
+              (simple-format (current-error-port) "exception: ~a: ~s\n" key args)
               (begin
-                (display "exception:" (current-error-port))
+                (display "exception: " (current-error-port))
                 (display key (current-error-port))
-                (display ":" (current-error-port))
-                (display args (current-error-port))
+                (display ": " (current-error-port))
+                (write args (current-error-port))
                 (newline (current-error-port))))
           (loop a))))))

src/hash.c

@@ -211,7 +211,7 @@ make_hash_table (struct scm *x)              /*:((arity . n)) */
   if (x->type == TPAIR)
     {
       x = x->car;
-      assert_msg (x->type == TNUMBER, "x->type == TNUMBER");
+      assert_number ("make-hash-table size", x);
       size = x->value;
     }
   return make_hash_table_ (size);

src/lib.c

@@ -173,3 +173,46 @@ integer_to_char (struct scm *x)
 {
   return make_char (x->value);
 }
+
+/*
+void
+assert_type (long type, char const *name_name, struct scm *x)
+{
+  if (x->type != type)
+    {
+      eputs (name);
+      eputs (": ");
+      error (cell_wrong_type_arg, cons (x, cell_nil));
+    }
+}
+*/
+
+void
+assert_num (long pos, struct scm *x)
+{
+  if (x->type != TNUMBER)
+    error (cell_symbol_wrong_type_arg, cons (cell_type_number, cons (make_number (pos), x)));
+}
+
+void
+assert_struct (long pos, struct scm *x)
+{
+  if (x->type != TSTRUCT)
+    error (cell_symbol_wrong_type_arg, cons (cell_type_struct, cons (make_number (pos), x)));
+}
+
+void
+assert_range (int assert, long i)
+{
+  if (assert == 0)
+    {
+      eputs ("value out of range: ");
+      eputs (ltoa (i));
+      eputs (": ");
+      assert_msg (assert, "value out of range");
+    }
+  /*
+  if (assert != 0)
+    error (cell_symbol_out_of_range, cons (cell_type_struct, cons (make_number (pos), cons (x, cell_nil))));
+  */
+}

src/math.c

@@ -32,6 +32,7 @@ assert_number (char const *name, struct scm *x)
   if (x->type != TNUMBER)
     {
       eputs (name);
+      eputs (": ");
       error (cell_symbol_not_a_number, x);
     }
 }

src/struct.c

@@ -54,11 +54,15 @@ struct_length (struct scm *x)
   return make_number (x->length);
 }
 
+void assert_num (long pos, struct scm *x);
+void assert_struct (long pos, struct scm *x);
+void assert_range (int assert, long x);
+
 struct scm *
 struct_ref_ (struct scm *x, long i)
 {
-  assert_msg (x->type == TSTRUCT, "x->type == TSTRUCT");
-  assert_msg (i < x->length, "i < x->length");
+  assert_struct (1, x);
+  assert_range (i < x->length, i);
   struct scm *e = cell_ref (x->structure, i);
   if (e->type == TREF)
     e = e->ref;