DRAFT core: Use exceptions instead of asserts.
* src/lib.c (assert_num, assert_struct): New function. * src/struct.c (struct_ref_): Use them. * src/hash.c (make_hash_table): Use assert_number.
This commit is contained in:
parent
1ec55953bc
commit
a1d462ac87
|
@ -177,11 +177,11 @@ along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||||
(loop (acons id e a)))))))))
|
(loop (acons id e a)))))))))
|
||||||
(lambda (key . args)
|
(lambda (key . args)
|
||||||
(if (defined? 'with-output-to-string)
|
(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
|
(begin
|
||||||
(display "exception:" (current-error-port))
|
(display "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))))
|
||||||
(loop a))))))
|
(loop a))))))
|
||||||
|
|
|
@ -211,7 +211,7 @@ make_hash_table (struct scm *x) /*:((arity . n)) */
|
||||||
if (x->type == TPAIR)
|
if (x->type == TPAIR)
|
||||||
{
|
{
|
||||||
x = x->car;
|
x = x->car;
|
||||||
assert_msg (x->type == TNUMBER, "x->type == TNUMBER");
|
assert_number ("make-hash-table size", x);
|
||||||
size = x->value;
|
size = x->value;
|
||||||
}
|
}
|
||||||
return make_hash_table_ (size);
|
return make_hash_table_ (size);
|
||||||
|
|
43
src/lib.c
43
src/lib.c
|
@ -173,3 +173,46 @@ integer_to_char (struct scm *x)
|
||||||
{
|
{
|
||||||
return make_char (x->value);
|
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))));
|
||||||
|
*/
|
||||||
|
}
|
||||||
|
|
|
@ -32,6 +32,7 @@ assert_number (char const *name, struct scm *x)
|
||||||
if (x->type != TNUMBER)
|
if (x->type != TNUMBER)
|
||||||
{
|
{
|
||||||
eputs (name);
|
eputs (name);
|
||||||
|
eputs (": ");
|
||||||
error (cell_symbol_not_a_number, x);
|
error (cell_symbol_not_a_number, x);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
@ -54,11 +54,15 @@ struct_length (struct scm *x)
|
||||||
return make_number (x->length);
|
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 scm *
|
||||||
struct_ref_ (struct scm *x, long i)
|
struct_ref_ (struct scm *x, long i)
|
||||||
{
|
{
|
||||||
assert_msg (x->type == TSTRUCT, "x->type == TSTRUCT");
|
assert_struct (1, x);
|
||||||
assert_msg (i < x->length, "i < x->length");
|
assert_range (i < x->length, i);
|
||||||
struct scm *e = cell_ref (x->structure, i);
|
struct scm *e = cell_ref (x->structure, i);
|
||||||
if (e->type == TREF)
|
if (e->type == TREF)
|
||||||
e = e->ref;
|
e = e->ref;
|
||||||
|
|
Loading…
Reference in New Issue