--- stack/stack.c 2003/08/08 14:20:49 1.132 +++ stack/stack.c 2003/08/13 06:12:26 1.134 @@ -23,7 +23,7 @@ #include "stack.h" -const char* start_message= "Stack version $Revision: 1.132 $\n\ +const char* start_message= "Stack version $Revision: 1.134 $\n\ Copyright (C) 2002 Mats Alritzson and Teddy Hogeborn\n\ Stack comes with ABSOLUTELY NO WARRANTY; for details type 'warranty;'.\n\ This is free software, and you are welcome to redistribute it\n\ @@ -50,9 +50,9 @@ } -void printerr(const char* in_string) +void printerr(environment *env, const char* in_string) { - fprintf(stderr, "Err: %s\n", in_string); + fprintf(stderr, "\"%s\":\nErr: %s\n", env->errsymb, in_string); } @@ -167,6 +167,7 @@ break; case port: case empty: + case unknown: case integer: case tfloat: case func: @@ -364,9 +365,7 @@ char *mangled; /* Mangled function name */ new_value= new_val(env); - protect(new_value); new_fvalue= new_val(env); - protect(new_fvalue); /* The new value is a symbol */ new_value->type= symb; @@ -414,7 +413,6 @@ } push_val(env, new_value); - unprotect(new_value); unprotect(new_fvalue); } @@ -433,6 +431,13 @@ return; } break; + case unknown: + if(fprintf(stream, "UNKNOWN") < 0){ + perror("print_val"); + env->err= 5; + return; + } + break; case integer: if(fprintf(stream, "%d", val->content.i) < 0){ perror("print_val"); @@ -580,13 +585,18 @@ extern void swap(environment *env) { value *temp= env->head; - - if(env->head->type == empty || CDR(env->head)->type == empty) { - printerr("Too Few Arguments"); - env->err=1; + + switch(check_args(env, unknown, unknown, empty)) { + case 1: + printerr(env, "Too Few Arguments"); + return; + case 2: + printerr(env, "Bad Argument Type"); return; + default: + break; } - + env->head= CDR(env->head); CDR(temp)= CDR(env->head); CDR(env->head)= temp; @@ -598,21 +608,20 @@ { value *val; - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; + switch(check_args(env, symb, empty)) { + case 1: + printerr(env, "Too Few Arguments"); return; - } - - if(CAR(env->head)->type!=symb) { - printerr("Bad Argument Type"); - env->err= 2; + case 2: + printerr(env, "Bad Argument Type"); return; + default: + break; } val= CAR(env->head)->content.sym->val; if(val == NULL){ - printerr("Unbound Variable"); + printerr(env, "Unbound Variable"); env->err= 3; return; } @@ -636,15 +645,21 @@ gc_maybe(env); - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; + switch(check_args(env, unknown, empty)) { + case 1: + printerr(env, "Too Few Arguments"); return; + case 2: + printerr(env, "Bad Argument Type"); + return; + default: + break; } switch(CAR(env->head)->type) { /* if it's a symbol */ case symb: + env->errsymb= CAR(env->head)->content.sym->id; rcl(env); /* get its contents */ if(env->err) return; if(CAR(env->head)->type!=symb){ /* don't recurse symbols */ @@ -682,7 +697,7 @@ if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons) iterator= CDR(iterator); else { - printerr("Bad Argument Type"); /* Improper list */ + printerr(env, "Bad Argument Type"); /* Improper list */ env->err= 2; return; } @@ -696,6 +711,7 @@ case tfloat: case string: case port: + case unknown: return; } } @@ -752,7 +768,7 @@ } if(myenv.interactive) - printf(start_message); + puts(start_message); while(1) { if(myenv.in_string==NULL) { @@ -803,6 +819,7 @@ case func: case symb: case empty: + case unknown: case port: new_value->content= old_value->content; break; @@ -846,19 +863,18 @@ { value *old_head, *new_head, *item; - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - if(CAR(env->head)->type==empty) return; /* Don't reverse an empty list */ - if(CAR(env->head)->type!=tcons) { - printerr("Bad Argument Type"); - env->err= 2; + switch(check_args(env, tcons, empty)) { + case 1: + printerr(env, "Too Few Arguments"); + return; + case 2: + printerr(env, "Bad Argument Type"); return; + default: + break; } old_head= CAR(env->head); @@ -996,3 +1012,44 @@ if(depth) return readstream(env, env->inputstream); } + + +int check_args(environment *env, ...) +{ + va_list ap; + enum type_enum mytype; + + value *iter= env->head; + int errval= 0; + + va_start(ap, env); + while(1) { + mytype= va_arg(ap, enum type_enum); + // fprintf(stderr, "%s\n", env->errsymb); + + if(mytype==empty) + break; + + if(iter->type==empty || iter==NULL) { + errval= 1; + break; + } + + if(mytype==unknown) { + iter=CDR(iter); + continue; + } + + if(CAR(iter)->type!=mytype) { + errval= 2; + break; + } + + iter= CDR(iter); + } + + va_end(ap); + + env->err= errval; + return errval; +}