mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-15 16:57:35 +02:00
Added more type checking
This commit is contained in:
parent
2c52ca957f
commit
c9ac1cfbe0
1 changed files with 30 additions and 14 deletions
44
runtime.c
44
runtime.c
|
@ -43,10 +43,12 @@ const char *tag_names[20] = { \
|
||||||
}
|
}
|
||||||
|
|
||||||
#define Cyc_check_type(fnc_test, tag, obj) { \
|
#define Cyc_check_type(fnc_test, tag, obj) { \
|
||||||
if (eq(boolean_f, fnc_test(obj))) Cyc_invalid_type_error(cons_tag, obj); }
|
if (eq(boolean_f, fnc_test(obj))) Cyc_invalid_type_error(tag, obj); }
|
||||||
|
|
||||||
|
#define Cyc_check_cons_or_nil(obj) { if (!nullp(obj)) { Cyc_check_cons(obj); }}
|
||||||
#define Cyc_check_cons(obj) Cyc_check_type(Cyc_is_cons, cons_tag, obj);
|
#define Cyc_check_cons(obj) Cyc_check_type(Cyc_is_cons, cons_tag, obj);
|
||||||
#define Cyc_check_num(obj) Cyc_check_type(Cyc_is_number, integer_tag, obj);
|
#define Cyc_check_num(obj) Cyc_check_type(Cyc_is_number, integer_tag, obj);
|
||||||
|
#define Cyc_check_int(obj) Cyc_check_type(Cyc_is_integer, integer_tag, obj);
|
||||||
|
|
||||||
void Cyc_invalid_type_error(int tag, object found) {
|
void Cyc_invalid_type_error(int tag, object found) {
|
||||||
char buf[256];
|
char buf[256];
|
||||||
|
@ -588,11 +590,13 @@ object Cyc_write_char(object c, object port)
|
||||||
|
|
||||||
// TODO: should not be a predicate, may end up moving these to Scheme code
|
// TODO: should not be a predicate, may end up moving these to Scheme code
|
||||||
object memberp(x,l) object x; list l;
|
object memberp(x,l) object x; list l;
|
||||||
{for (; !nullp(l); l = cdr(l)) if (boolean_f != equalp(x,car(l))) return boolean_t;
|
{Cyc_check_cons_or_nil(l);
|
||||||
|
for (; !nullp(l); l = cdr(l)) if (boolean_f != equalp(x,car(l))) return boolean_t;
|
||||||
return boolean_f;}
|
return boolean_f;}
|
||||||
|
|
||||||
object memqp(x,l) object x; list l;
|
object memqp(x,l) object x; list l;
|
||||||
{for (; !nullp(l); l = cdr(l)) if (eq(x,car(l))) return boolean_t;
|
{Cyc_check_cons_or_nil(l);
|
||||||
|
for (; !nullp(l); l = cdr(l)) if (eq(x,car(l))) return boolean_t;
|
||||||
return boolean_f;}
|
return boolean_f;}
|
||||||
|
|
||||||
object get(x,i) object x,i;
|
object get(x,i) object x,i;
|
||||||
|
@ -614,14 +618,19 @@ object equalp(x,y) object x,y;
|
||||||
if (boolean_f == equalp(car(x),car(y))) return boolean_f;}}
|
if (boolean_f == equalp(car(x),car(y))) return boolean_f;}}
|
||||||
|
|
||||||
list assq(x,l) object x; list l;
|
list assq(x,l) object x; list l;
|
||||||
{for (; !nullp(l); l = cdr(l))
|
{if (nullp(l) || is_value_type(l) || type_of(l) != cons_tag) return boolean_f;
|
||||||
{register list la = car(l); if (eq(x,car(la))) return la;}
|
for (; !nullp(l); l = cdr(l))
|
||||||
|
{register list la = car(l);
|
||||||
|
Cyc_check_cons(la);
|
||||||
|
if (eq(x,car(la))) return la;}
|
||||||
return boolean_f;}
|
return boolean_f;}
|
||||||
|
|
||||||
list assoc(x,l) object x; list l;
|
list assoc(x,l) object x; list l;
|
||||||
{if (nullp(l) || is_value_type(l) || type_of(l) != cons_tag) return boolean_f;
|
{if (nullp(l) || is_value_type(l) || type_of(l) != cons_tag) return boolean_f;
|
||||||
for (; !nullp(l); l = cdr(l))
|
for (; !nullp(l); l = cdr(l))
|
||||||
{register list la = car(l); if (boolean_f != equalp(x,car(la))) return la;}
|
{register list la = car(l);
|
||||||
|
Cyc_check_cons(la);
|
||||||
|
if (boolean_f != equalp(x,car(la))) return la;}
|
||||||
return boolean_f;}
|
return boolean_f;}
|
||||||
|
|
||||||
|
|
||||||
|
@ -634,27 +643,30 @@ object __num_eq(x, y) object x, y;
|
||||||
return boolean_f;}
|
return boolean_f;}
|
||||||
|
|
||||||
object __num_gt(x, y) object x, y;
|
object __num_gt(x, y) object x, y;
|
||||||
{//printf("DEBUG cmp %d, x %d, y %d, x tag %d, y tag %d\n",
|
{Cyc_check_num(x);
|
||||||
// (((integer_type *)x)->value > ((integer_type *)y)->value),
|
Cyc_check_num(y);
|
||||||
// ((integer_type *)x)->value, ((integer_type *)y)->value,
|
|
||||||
// ((list)x)->tag, ((list)y)->tag);
|
|
||||||
//exit(1);
|
|
||||||
if (((integer_type *)x)->value > ((integer_type *)y)->value)
|
if (((integer_type *)x)->value > ((integer_type *)y)->value)
|
||||||
return boolean_t;
|
return boolean_t;
|
||||||
return boolean_f;}
|
return boolean_f;}
|
||||||
|
|
||||||
object __num_lt(x, y) object x, y;
|
object __num_lt(x, y) object x, y;
|
||||||
{if (((integer_type *)x)->value < ((integer_type *)y)->value)
|
{Cyc_check_num(x);
|
||||||
|
Cyc_check_num(y);
|
||||||
|
if (((integer_type *)x)->value < ((integer_type *)y)->value)
|
||||||
return boolean_t;
|
return boolean_t;
|
||||||
return boolean_f;}
|
return boolean_f;}
|
||||||
|
|
||||||
object __num_gte(x, y) object x, y;
|
object __num_gte(x, y) object x, y;
|
||||||
{if (((integer_type *)x)->value >= ((integer_type *)y)->value)
|
{Cyc_check_num(x);
|
||||||
|
Cyc_check_num(y);
|
||||||
|
if (((integer_type *)x)->value >= ((integer_type *)y)->value)
|
||||||
return boolean_t;
|
return boolean_t;
|
||||||
return boolean_f;}
|
return boolean_f;}
|
||||||
|
|
||||||
object __num_lte(x, y) object x, y;
|
object __num_lte(x, y) object x, y;
|
||||||
{if (((integer_type *)x)->value <= ((integer_type *)y)->value)
|
{Cyc_check_num(x);
|
||||||
|
Cyc_check_num(y);
|
||||||
|
if (((integer_type *)x)->value <= ((integer_type *)y)->value)
|
||||||
return boolean_t;
|
return boolean_t;
|
||||||
return boolean_f;}
|
return boolean_f;}
|
||||||
|
|
||||||
|
@ -1049,6 +1061,7 @@ integer_type Cyc_char2integer(object chr){
|
||||||
object Cyc_integer2char(object n){
|
object Cyc_integer2char(object n){
|
||||||
int val = 0;
|
int val = 0;
|
||||||
|
|
||||||
|
Cyc_check_int(n);
|
||||||
if (!nullp(n)) {
|
if (!nullp(n)) {
|
||||||
val = ((integer_type *) n)->value;
|
val = ((integer_type *) n)->value;
|
||||||
}
|
}
|
||||||
|
@ -1688,6 +1701,9 @@ object apply(object cont, object func, object args){
|
||||||
Cyc_rt_raise2("Call of non-procedure: ", func);
|
Cyc_rt_raise2("Call of non-procedure: ", func);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// Causes problems...
|
||||||
|
//Cyc_check_cons_or_nil(args);
|
||||||
|
|
||||||
switch(type_of(func)) {
|
switch(type_of(func)) {
|
||||||
case primitive_tag:
|
case primitive_tag:
|
||||||
// TODO: should probably check arg counts and error out if needed
|
// TODO: should probably check arg counts and error out if needed
|
||||||
|
|
Loading…
Add table
Reference in a new issue