diff --git a/mes/module/mes/repl.mes b/mes/module/mes/repl.mes index 9f2c3547..f3f2f30f 100644 --- a/mes/module/mes/repl.mes +++ b/mes/module/mes/repl.mes @@ -177,11 +177,11 @@ along with GNU Mes. If not, see . (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)))))) diff --git a/src/hash.c b/src/hash.c index 8195e4a3..ee574c03 100644 --- a/src/hash.c +++ b/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); diff --git a/src/lib.c b/src/lib.c index f8925536..2be271f3 100644 --- a/src/lib.c +++ b/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)))); + */ +} diff --git a/src/math.c b/src/math.c index 8bc3d9c9..db456c92 100644 --- a/src/math.c +++ b/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); } } diff --git a/src/struct.c b/src/struct.c index 19162c70..540bd67d 100644 --- a/src/struct.c +++ b/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;