andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: Throw exceptions rather than asserts. 

* lib.c (error): Throw instead of assert.
  (check_formals, check_apply): Update.
* mes.c (scm_symbol_unbound_variable, scm_symbol_not_a_pair,
  scm_symbol_system_error, scm_symbol_wrong_number_of_args,
  scm_symbol_wrong_type_arg, scm_symbol_unbound_variable): New symbols.
  (car, cdr, set_cdr_x, set_env_x, eval_apply, gc_up_arena): Update.
This commit is contained in:
Jan Nieuwenhuizen 2016-12-28 22:26:33 +01:00
parent 2675f711a3
commit cb1fa49767
2 changed files with 26 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
lib.c
View File

@ -71,19 +71,19 @@ string_to_cstring (SCM s)
return buf; return buf;
} }
int SCM
error (char const* msg, SCM x) error (SCM key, SCM x)
{ {
fprintf (stderr, msg); SCM throw;
if (x) stderr_ (x); if ((throw = assq_ref_cache (cell_symbol_throw, r0)) != cell_undefined)
fprintf (stderr, "\n"); return apply (throw, cons (key, cons (x, cell_nil)), r0);
assert(!msg); assert (!"error");
} }
SCM SCM
assert_defined (SCM x, SCM e) assert_defined (SCM x, SCM e)
{ {
if (e == cell_undefined) error ("eval: unbound variable: ", x); if (e == cell_undefined) return error (cell_symbol_unbound_variable, x);
return e; return e;
} }
@ -96,7 +96,8 @@ check_formals (SCM f, SCM formals, SCM args)
{ {
char buf[1024]; char buf[1024];
sprintf (buf, "apply: wrong number of arguments; expected: %d, got: %d: ", flen, alen); sprintf (buf, "apply: wrong number of arguments; expected: %d, got: %d: ", flen, alen);
error (buf, f); SCM e = MAKE_STRING (cstring_to_list (buf));
return error (cell_symbol_wrong_number_of_args, cons (e, f));
} }
return cell_unspecified; return cell_unspecified;
} }
@ -106,11 +107,12 @@ check_apply (SCM f, SCM e)
{ {
char const* type = 0; char const* type = 0;
if (f == cell_f || f == cell_t) type = "bool"; if (f == cell_f || f == cell_t) type = "bool";
if (f == cell_nil) type = "nil";
if (f == cell_unspecified) type = "*unspecified*";
if (f == cell_undefined) type = "*undefined*";
if (TYPE (f) == CHAR) type = "char"; if (TYPE (f) == CHAR) type = "char";
if (TYPE (f) == NUMBER) type = "number"; if (TYPE (f) == NUMBER) type = "number";
if (TYPE (f) == STRING) type = "string"; if (TYPE (f) == STRING) type = "string";
if (f == cell_unspecified) type = "*unspecified*";
if (f == cell_undefined) type = "*undefined*";
if (type) if (type)
{ {
@ -119,7 +121,8 @@ check_apply (SCM f, SCM e)
fprintf (stderr, " ["); fprintf (stderr, " [");
stderr_ (e); stderr_ (e);
fprintf (stderr, "]\n"); fprintf (stderr, "]\n");
error (buf, f); SCM e = MAKE_STRING (cstring_to_list (buf));
return error (cell_symbol_wrong_type_arg, cons (e, f));
} }
return cell_unspecified; return cell_unspecified;
} }

19
mes.c
View File

@ -114,7 +114,13 @@ scm scm_symbol_primitive_load = {SYMBOL, "primitive-load"};
scm scm_symbol_read_input_file = {SYMBOL, "read-input-file"}; scm scm_symbol_read_input_file = {SYMBOL, "read-input-file"};
scm scm_symbol_write = {SYMBOL, "write"}; scm scm_symbol_write = {SYMBOL, "write"};
scm scm_symbol_display = {SYMBOL, "display"}; scm scm_symbol_display = {SYMBOL, "display"};
scm scm_symbol_throw = {SYMBOL, "throw"}; scm scm_symbol_throw = {SYMBOL, "throw"};
scm scm_symbol_not_a_pair = {SYMBOL, "not-a-pair"};
scm scm_symbol_system_error = {SYMBOL, "system-error"};
scm scm_symbol_wrong_number_of_args = {SYMBOL, "wrong-number-of-args"};
scm scm_symbol_wrong_type_arg = {SYMBOL, "wrong-type-arg"};
scm scm_symbol_unbound_variable = {SYMBOL, "unbound-variable"};
scm scm_symbol_argv = {SYMBOL, "%argv"}; scm scm_symbol_argv = {SYMBOL, "%argv"};
scm scm_symbol_mes_prefix = {SYMBOL, "%prefix"}; scm scm_symbol_mes_prefix = {SYMBOL, "%prefix"};
@ -214,7 +220,6 @@ SCM r3 = 0; // continuation
#define MAKE_REF(n) make_cell (tmp_num_ (REF), n, 0) #define MAKE_REF(n) make_cell (tmp_num_ (REF), n, 0)
#define MAKE_STRING(x) make_cell (tmp_num_ (STRING), x, 0) #define MAKE_STRING(x) make_cell (tmp_num_ (STRING), x, 0)
int error (char const* msg, SCM x);
SCM vm_call (function0_t f, SCM p1, SCM a); SCM vm_call (function0_t f, SCM p1, SCM a);
SCM SCM
@ -269,14 +274,14 @@ cons (SCM x, SCM y)
SCM SCM
car (SCM x) car (SCM x)
{ {
if (TYPE (x) != PAIR) error ("car: not pair: ", x); if (TYPE (x) != PAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_car));
return CAR (x); return CAR (x);
} }
SCM SCM
cdr (SCM x) cdr (SCM x)
{ {
if (TYPE (x) != PAIR) error ("cdr: not pair: ", x); if (TYPE (x) != PAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_cdr));
return CDR (x); return CDR (x);
} }
SCM SCM
@ -330,7 +335,7 @@ set_car_x (SCM x, SCM e)
SCM SCM
set_cdr_x (SCM x, SCM e) set_cdr_x (SCM x, SCM e)
{ {
if (TYPE (x) != PAIR) error ("set-cdr!: not pair: ", x); if (TYPE (x) != PAIR) error (cell_symbol_not_a_pair, cons (x, cell_set_cdr_x));
CDR (x) = e; CDR (x) = e;
return cell_unspecified; return cell_unspecified;
} }
@ -339,7 +344,7 @@ SCM
set_env_x (SCM x, SCM e, SCM a) set_env_x (SCM x, SCM e, SCM a)
{ {
SCM p = assert_defined (x, assq (x, a)); SCM p = assert_defined (x, assq (x, a));
if (TYPE (p) != PAIR) error ("set-env!: not pair: ", x); if (TYPE (p) != PAIR) error (cell_symbol_not_a_pair, cons (p, x));
return set_cdr_x (p, e); return set_cdr_x (p, e);
} }
@ -490,7 +495,7 @@ eval_apply ()
r1 = cdr (r1); r1 = cdr (r1);
goto call_with_current_continuation; goto call_with_current_continuation;
} }
default: error ("cannot apply special: ", car (r1)); default: check_apply (cell_f, car (r1));
} }
} }
case SYMBOL: case SYMBOL:
@ -926,7 +931,7 @@ gc_up_arena ()
{ {
ARENA_SIZE *= 2; ARENA_SIZE *= 2;
void *p = realloc (g_cells-1, 2*ARENA_SIZE*sizeof(scm)); void *p = realloc (g_cells-1, 2*ARENA_SIZE*sizeof(scm));
if (!p) error (strerror (errno), MAKE_NUMBER (g_free)); if (!p) error (cell_symbol_system_error, cons (MAKE_STRING (cstring_to_list (strerror (errno))), MAKE_NUMBER (g_free)));
g_cells = (scm*)p; g_cells = (scm*)p;
g_cells++; g_cells++;
gc_init_news (); gc_init_news ();