--- stack/symbols.c 2003/08/08 14:20:49 1.5 +++ stack/symbols.c 2003/08/18 14:39:16 1.10 @@ -10,39 +10,31 @@ /* Print a newline to a port */ extern void nlport(environment *env) { - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(env->head)->type!=port) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 1, port)) + return printerr(env); - if(fprintf(CAR(env->head)->content.p, "\n") < 0){ - perror("nl"); + if(fprintf(CAR(env->head)->content.p, "\n") < 0) { env->err= 5; - return; + return printerr(env); } + toss(env); } /* Gets the type of a value */ extern void type(environment *env) { - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } + + if(check_args(env, 1, unknown)) + return printerr(env); switch(CAR(env->head)->type){ case empty: push_sym(env, "empty"); break; + case unknown: + push_sym(env, "unknown"); + break; case integer: push_sym(env, "integer"); break; @@ -73,11 +65,10 @@ /* Print the top element of the stack but don't discard it */ extern void print_(environment *env) { - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } + + if(check_args(env, 1, unknown)) + return printerr(env); + print_val(env, CAR(env->head), 0, NULL, stdout); if(env->err) return; nl(env); @@ -95,11 +86,10 @@ discard it. */ extern void princ_(environment *env) { - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } + + if(check_args(env, 1, unknown)) + return printerr(env); + print_val(env, CAR(env->head), 1, NULL, stdout); } @@ -114,17 +104,9 @@ /* Print a value to a port, but don't discard it */ extern void printport_(environment *env) { - if(env->head->type==empty || CDR(env->head)->type == empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - if(CAR(env->head)->type!=port) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 2, port, unknown)) + return printerr(env); print_val(env, CAR(CDR(env->head)), 0, NULL, CAR(env->head)->content.p); if(env->err) return; @@ -142,17 +124,9 @@ /* Print, without quotes, to a port, a value, but don't discard it. */ extern void princport_(environment *env) { - if(env->head->type==empty || CDR(env->head)->type == empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - if(CAR(env->head)->type!=port) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 2, port, unknown)) + return printerr(env); print_val(env, CAR(CDR(env->head)), 1, NULL, CAR(env->head)->content.p); toss(env); if(env->err) return; @@ -170,13 +144,9 @@ extern void rot(environment *env) { value *temp= env->head; - - if(env->head->type == empty || CDR(env->head)->type == empty - || CDR(CDR(env->head))->type == empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } + + if(check_args(env, 3, unknown, unknown, unknown)) + return printerr(env); env->head= CDR(CDR(env->head)); CDR(CDR(temp))= CDR(env->head); @@ -188,18 +158,8 @@ { value *temp, *new_head; - /* Is top element a list? */ - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(env->head)->type!=tcons) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 1, tcons)) + return printerr(env); rev(env); @@ -211,14 +171,14 @@ toss(env); + /// XXX /* Find the end of the list */ while(CDR(temp)->type != empty) { if (CDR(temp)->type == tcons) temp= CDR(temp); else { - printerr("Bad Argument Type"); /* Improper list */ - env->err= 2; - return; + env->err= 2; /* Improper list */ + return printerr(env); } } @@ -233,11 +193,8 @@ { void *left, *right; - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } + if(check_args(env, 2, unknown, unknown)) + return printerr(env); left= CAR(env->head)->content.ptr; right= CAR(CDR(env->head))->content.ptr; @@ -251,17 +208,8 @@ { int val; - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(env->head)->type!=integer) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 1, integer)) + return printerr(env); val= CAR(env->head)->content.i; toss(env); @@ -281,17 +229,8 @@ symbol *sym; /* Needs two values on the stack, the top one must be a symbol */ - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(env->head)->type!=symb) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 2, symb, unknown)) + return printerr(env); /* long names are a pain */ sym= CAR(env->head)->content.sym; @@ -313,17 +252,8 @@ { char* sym_id; - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(env->head)->type!=symb) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 1, symb)) + return printerr(env); sym_id= CAR(env->head)->content.sym->id; toss(env); @@ -346,14 +276,7 @@ char* new_string; value *a_val, *b_val; - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(env->head)->type==string - && CAR(CDR(env->head))->type==string) { + if(check_args(env, 2, string, string)==0) { a_val= CAR(env->head); b_val= CAR(CDR(env->head)); protect(a_val); protect(b_val); @@ -371,8 +294,7 @@ return; } - if(CAR(env->head)->type==integer - && CAR(CDR(env->head))->type==integer) { + if(check_args(env, 2, integer, integer)==0) { a= CAR(env->head)->content.i; toss(env); if(env->err) return; b= CAR(env->head)->content.i; @@ -382,8 +304,7 @@ return; } - if(CAR(env->head)->type==tfloat - && CAR(CDR(env->head))->type==tfloat) { + if(check_args(env, 2, tfloat, tfloat)==0) { fa= CAR(env->head)->content.f; toss(env); if(env->err) return; fb= CAR(env->head)->content.f; @@ -393,8 +314,7 @@ return; } - if(CAR(env->head)->type==tfloat - && CAR(CDR(env->head))->type==integer) { + if(check_args(env, 2, tfloat, integer)==0) { fa= CAR(env->head)->content.f; toss(env); if(env->err) return; b= CAR(env->head)->content.i; @@ -404,8 +324,7 @@ return; } - if(CAR(env->head)->type==integer - && CAR(CDR(env->head))->type==tfloat) { + if(check_args(env, 2, integer, tfloat)==0) { a= CAR(env->head)->content.i; toss(env); if(env->err) return; fb= CAR(env->head)->content.f; @@ -415,8 +334,7 @@ return; } - printerr("Bad Argument Type"); - env->err=2; + return printerr(env); } /* "-" */ @@ -425,14 +343,7 @@ int a, b; float fa, fb; - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err=1; - return; - } - - if(CAR(env->head)->type==integer - && CAR(CDR(env->head))->type==integer) { + if(check_args(env, 2, integer, integer)==0) { a= CAR(env->head)->content.i; toss(env); if(env->err) return; b= CAR(env->head)->content.i; @@ -442,8 +353,7 @@ return; } - if(CAR(env->head)->type==tfloat - && CAR(CDR(env->head))->type==tfloat) { + if(check_args(env, 2, tfloat, tfloat)==0) { fa= CAR(env->head)->content.f; toss(env); if(env->err) return; fb= CAR(env->head)->content.f; @@ -453,8 +363,7 @@ return; } - if(CAR(env->head)->type==tfloat - && CAR(CDR(env->head))->type==integer) { + if(check_args(env, 2, tfloat, integer)==0) { fa= CAR(env->head)->content.f; toss(env); if(env->err) return; b= CAR(env->head)->content.i; @@ -464,8 +373,7 @@ return; } - if(CAR(env->head)->type==integer - && CAR(CDR(env->head))->type==tfloat) { + if(check_args(env, 2, integer, tfloat)==0) { a= CAR(env->head)->content.i; toss(env); if(env->err) return; fb= CAR(env->head)->content.f; @@ -475,8 +383,7 @@ return; } - printerr("Bad Argument Type"); - env->err=2; + return printerr(env); } /* ">" */ @@ -485,14 +392,7 @@ int a, b; float fa, fb; - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(env->head)->type==integer - && CAR(CDR(env->head))->type==integer) { + if(check_args(env, 2, integer, integer)==0) { a= CAR(env->head)->content.i; toss(env); if(env->err) return; b= CAR(env->head)->content.i; @@ -502,8 +402,7 @@ return; } - if(CAR(env->head)->type==tfloat - && CAR(CDR(env->head))->type==tfloat) { + if(check_args(env, 2, tfloat, tfloat)==0) { fa= CAR(env->head)->content.f; toss(env); if(env->err) return; fb= CAR(env->head)->content.f; @@ -513,8 +412,7 @@ return; } - if(CAR(env->head)->type==tfloat - && CAR(CDR(env->head))->type==integer) { + if(check_args(env, 2, tfloat, integer)==0) { fa= CAR(env->head)->content.f; toss(env); if(env->err) return; b= CAR(env->head)->content.i; @@ -524,8 +422,7 @@ return; } - if(CAR(env->head)->type==integer - && CAR(CDR(env->head))->type==tfloat) { + if(check_args(env, 2, integer, tfloat)==0) { a= CAR(env->head)->content.i; toss(env); if(env->err) return; fb= CAR(env->head)->content.f; @@ -535,8 +432,7 @@ return; } - printerr("Bad Argument Type"); - env->err= 2; + return printerr(env); } /* "<" */ @@ -563,11 +459,9 @@ /* "dup"; duplicates an item on the stack */ extern void sx_647570(environment *env) { - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } + if(check_args(env, 1, unknown)) + return printerr(env); + push_val(env, copy_val(env, CAR(env->head))); } @@ -576,18 +470,9 @@ { int truth; - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } + if(check_args(env, 2, unknown, integer)) + return printerr(env); - if(CAR(CDR(env->head))->type != integer) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } - swap(env); if(env->err) return; @@ -607,19 +492,9 @@ { int truth; - if(env->head->type==empty || CDR(env->head)->type==empty - || CDR(CDR(env->head))->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } + if(check_args(env, 3, unknown, unknown, integer)) + return printerr(env); - if(CAR(CDR(CDR(env->head)))->type!=integer) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } - rot(env); if(env->err) return; @@ -641,21 +516,18 @@ /* "else" */ extern void sx_656c7365(environment *env) { - if(env->head->type==empty || CDR(env->head)->type==empty - || CDR(CDR(env->head))->type==empty || CDR(CDR(CDR(env->head)))->type==empty - || CDR(CDR(CDR(CDR(env->head))))->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } + + if(check_args(env, 5, unknown, symb, unknown, symb, integer)) + return printerr(env); + + /// XXX if(CAR(CDR(env->head))->type!=symb || strcmp(CAR(CDR(env->head))->content.sym->id, "then")!=0 || CAR(CDR(CDR(CDR(env->head))))->type!=symb || strcmp(CAR(CDR(CDR(CDR(env->head))))->content.sym->id, "if")!=0) { - printerr("Bad Argument Type"); env->err= 2; - return; + return printerr(env); } swap(env); toss(env); rot(env); toss(env); @@ -664,18 +536,16 @@ extern void then(environment *env) { - if(env->head->type==empty || CDR(env->head)->type==empty - || CDR(CDR(env->head))->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } + + if(check_args(env, 3, unknown, symb, integer)) + return printerr(env); + + /// XXX if(CAR(CDR(env->head))->type!=symb || strcmp(CAR(CDR(env->head))->content.sym->id, "if")!=0) { - printerr("Bad Argument Type"); env->err= 2; - return; + return printerr(env); } swap(env); toss(env); @@ -688,11 +558,8 @@ int truth; value *loop, *test; - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } + if(check_args(env, 2, unknown, integer)) + return printerr(env); loop= CAR(env->head); protect(loop); @@ -705,11 +572,12 @@ do { push_val(env, test); eval(env); + + /// XXX if(CAR(env->head)->type != integer) { - printerr("Bad Argument Type"); env->err= 2; - return; + return printerr(env); } truth= CAR(env->head)->content.i; @@ -734,19 +602,8 @@ value *loop; int foo1, foo2; - if(env->head->type==empty || CDR(env->head)->type==empty - || CDR(CDR(env->head))->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(CDR(env->head))->type!=integer - || CAR(CDR(CDR(env->head)))->type!=integer) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 3, unknown, integer, integer)) + return printerr(env); loop= CAR(env->head); protect(loop); @@ -782,19 +639,10 @@ { value *loop, *foo; value *iterator; - - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(CDR(env->head))->type!=tcons) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 2, unknown, tcons)) + return printerr(env); + loop= CAR(env->head); protect(loop); toss(env); if(env->err) return; @@ -809,15 +657,18 @@ push_val(env, CAR(iterator)); push_val(env, loop); eval(env); if(env->err) return; + + /// XXX if (iterator->type == tcons){ iterator= CDR(iterator); } else { - printerr("Bad Argument Type"); /* Improper list */ - env->err= 2; + env->err= 2; /* Improper list */ break; } } unprotect(loop); unprotect(foo); + + return printerr(env); } /* "to" */ @@ -826,20 +677,10 @@ int ending, start, i; value *iterator, *temp, *end; - end= new_val(env); - - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } + if(check_args(env, 2, integer, integer)) + return printerr(env); - if(CAR(env->head)->type!=integer - || CAR(CDR(env->head))->type!=integer) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + end= new_val(env); ending= CAR(env->head)->content.i; toss(env); if(env->err) return; @@ -894,17 +735,8 @@ { FILE *stream; - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(env->head)->type!=port) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 1, port)) + return printerr(env); stream=CAR(env->head)->content.p; readlinestream(env, stream); if(env->err) return; @@ -924,17 +756,8 @@ { FILE *stream; - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(env->head)->type!=port) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 1, port)) + return printerr(env); stream=CAR(env->head)->content.p; readstream(env, stream); if(env->err) return; @@ -948,18 +771,8 @@ { int freq, dur, period, ticks; - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(env->head)->type!=integer - || CAR(CDR(env->head))->type!=integer) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 2, integer, integer)) + return printerr(env); dur= CAR(env->head)->content.i; toss(env); @@ -979,9 +792,8 @@ usleep(dur); return; case -1: - perror("beep"); env->err= 5; - return; + return printerr(env); default: abort(); } @@ -993,17 +805,8 @@ { int dur; - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(env->head)->type!=integer) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 1, integer)) + return printerr(env); dur= CAR(env->head)->content.i; toss(env); @@ -1011,20 +814,14 @@ usleep(dur); } + /* "*" */ extern void sx_2a(environment *env) { int a, b; float fa, fb; - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(env->head)->type==integer - && CAR(CDR(env->head))->type==integer) { + if(check_args(env, 2, integer, integer)==0) { a= CAR(env->head)->content.i; toss(env); if(env->err) return; b= CAR(env->head)->content.i; @@ -1034,8 +831,7 @@ return; } - if(CAR(env->head)->type==tfloat - && CAR(CDR(env->head))->type==tfloat) { + if(check_args(env, 2, tfloat, tfloat)==0) { fa= CAR(env->head)->content.f; toss(env); if(env->err) return; fb= CAR(env->head)->content.f; @@ -1045,8 +841,7 @@ return; } - if(CAR(env->head)->type==tfloat - && CAR(CDR(env->head))->type==integer) { + if(check_args(env, 2, tfloat, integer)==0) { fa= CAR(env->head)->content.f; toss(env); if(env->err) return; b= CAR(env->head)->content.i; @@ -1056,8 +851,7 @@ return; } - if(CAR(env->head)->type==integer - && CAR(CDR(env->head))->type==tfloat) { + if(check_args(env, 2, integer, tfloat)==0) { a= CAR(env->head)->content.i; toss(env); if(env->err) return; fb= CAR(env->head)->content.f; @@ -1067,8 +861,7 @@ return; } - printerr("Bad Argument Type"); - env->err= 2; + return printerr(env); } /* "/" */ @@ -1077,14 +870,7 @@ int a, b; float fa, fb; - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(env->head)->type==integer - && CAR(CDR(env->head))->type==integer) { + if(check_args(env, 2, integer, integer)==0) { a= CAR(env->head)->content.i; toss(env); if(env->err) return; b= CAR(env->head)->content.i; @@ -1094,8 +880,7 @@ return; } - if(CAR(env->head)->type==tfloat - && CAR(CDR(env->head))->type==tfloat) { + if(check_args(env, 2, tfloat, tfloat)==0) { fa= CAR(env->head)->content.f; toss(env); if(env->err) return; fb= CAR(env->head)->content.f; @@ -1105,8 +890,7 @@ return; } - if(CAR(env->head)->type==tfloat - && CAR(CDR(env->head))->type==integer) { + if(check_args(env, 2, tfloat, integer)==0) { fa= CAR(env->head)->content.f; toss(env); if(env->err) return; b= CAR(env->head)->content.i; @@ -1116,8 +900,7 @@ return; } - if(CAR(env->head)->type==integer - && CAR(CDR(env->head))->type==tfloat) { + if(check_args(env, 2, integer, tfloat)==0) { a= CAR(env->head)->content.i; toss(env); if(env->err) return; fb= CAR(env->head)->content.f; @@ -1127,8 +910,7 @@ return; } - printerr("Bad Argument Type"); - env->err= 2; + return printerr(env); } /* "mod" */ @@ -1136,14 +918,7 @@ { int a, b; - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(env->head)->type==integer - && CAR(CDR(env->head))->type==integer) { + if(check_args(env, 2, integer, integer)==0) { a= CAR(env->head)->content.i; toss(env); if(env->err) return; b= CAR(env->head)->content.i; @@ -1153,49 +928,31 @@ return; } - printerr("Bad Argument Type"); - env->err= 2; + return printerr(env); } + /* "div" */ extern void sx_646976(environment *env) { int a, b; - - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - if(CAR(env->head)->type==integer - && CAR(CDR(env->head))->type==integer) { - a= CAR(env->head)->content.i; - toss(env); if(env->err) return; - b= CAR(env->head)->content.i; - toss(env); if(env->err) return; - push_int(env, (int)b/a); - - return; - } - - printerr("Bad Argument Type"); - env->err= 2; + if(check_args(env, 2, integer, integer)) + return printerr(env); + + a= CAR(env->head)->content.i; + toss(env); if(env->err) return; + b= CAR(env->head)->content.i; + toss(env); if(env->err) return; + push_int(env, (int)b/a); } + extern void setcar(environment *env) { - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - if(CDR(env->head)->type!=tcons) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 2, tcons, unknown)) + return printerr(env); CAR(CAR(CDR(env->head)))=CAR(env->head); toss(env); @@ -1203,17 +960,9 @@ extern void setcdr(environment *env) { - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - if(CDR(env->head)->type!=tcons) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 2, tcons, unknown)) + return printerr(env); CDR(CAR(CDR(env->head)))=CAR(env->head); toss(env); @@ -1221,34 +970,18 @@ extern void car(environment *env) { - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - if(CAR(env->head)->type!=tcons) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 1, tcons)) + return printerr(env); CAR(env->head)=CAR(CAR(env->head)); } extern void cdr(environment *env) { - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - if(CAR(env->head)->type!=tcons) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 1, tcons)) + return printerr(env); CAR(env->head)=CDR(CAR(env->head)); } @@ -1257,11 +990,8 @@ { value *val; - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } + if(check_args(env, 2, unknown, unknown)) + return printerr(env); val=new_val(env); val->content.c= malloc(sizeof(pair)); @@ -1278,7 +1008,7 @@ swap(env); if(env->err) return; toss(env); if(env->err) return; swap(env); if(env->err) return; - toss(env); if(env->err) return; + toss(env); } @@ -1289,42 +1019,25 @@ /* Needs two values on the stack, the top one must be an association list */ - if(env->head->type==empty || CDR(env->head)->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(env->head)->type!=tcons) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 2, tcons, unknown)) + return printerr(env); key=CAR(CDR(env->head)); item=CAR(env->head); while(item->type == tcons){ if(CAR(item)->type != tcons){ - printerr("Bad Argument Type"); env->err= 2; - return; + return printerr(env); } + push_val(env, key); push_val(env, CAR(CAR(item))); - eqfunc(env); if(env->err) return; + eqfunc((void*)env); if(env->err) return; /* Check the result of 'eqfunc' */ - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - if(CAR(env->head)->type!=integer) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 1, integer)) + return printerr(env); if(CAR(env->head)->content.i){ toss(env); if(env->err) return; @@ -1333,9 +1046,8 @@ toss(env); if(env->err) return; if(item->type!=tcons) { - printerr("Bad Argument Type"); env->err= 2; - return; + return printerr(env); } item=CDR(item); @@ -1357,7 +1069,7 @@ /* 1: [ [ 1 . 2 ] [ 3 . 4 ] ] => 1: [ 3 . 4 ] */ extern void assq(environment *env) { - assocgen(env, eq); + assocgen(env, (void*)eq); } @@ -1376,26 +1088,15 @@ value *new_port; FILE *stream; - if(env->head->type == empty || CDR(env->head)->type == empty) { - printerr("Too Few Arguments"); - env->err=1; - return; - } - - if(CAR(env->head)->type != string - || CAR(CDR(env->head))->type != string) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 2, string, string)) + return printerr(env); stream=fopen(CAR(CDR(env->head))->content.ptr, CAR(env->head)->content.ptr); if(stream == NULL) { - perror("open"); env->err= 5; - return; + return printerr(env); } new_port=new_val(env); @@ -1416,44 +1117,26 @@ { int ret; - if(env->head->type == empty) { - printerr("Too Few Arguments"); - env->err=1; - return; - } - - if(CAR(env->head)->type != port) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 1, port)) + return printerr(env); ret= fclose(CAR(env->head)->content.p); if(ret != 0){ - perror("close"); env->err= 5; - return; + return printerr(env); } toss(env); } + extern void mangle(environment *env) { char *new_string; - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(env->head)->type!=string) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 1, string)) + return printerr(env); new_string= mangle_str(CAR(env->head)->content.string); @@ -1473,17 +1156,8 @@ extern void sx_77616974706964(environment *env) { - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - - if(CAR(env->head)->type!=integer) { - printerr("Bad Argument Type"); - env->err= 2; - return; - } + if(check_args(env, 1, integer)) + return printerr(env); push_int(env, waitpid(CAR(env->head)->content.i, NULL, 0)); swap(env); toss(env); @@ -1493,12 +1167,10 @@ /* Discard the top element of the stack. */ extern void toss(environment *env) { - if(env->head->type==empty) { - printerr("Too Few Arguments"); - env->err= 1; - return; - } - + + if(check_args(env, 1, unknown)) + return printerr(env); + env->head= CDR(env->head); /* Remove the top stack item */ } @@ -1579,11 +1251,124 @@ extern void copying(environment *env) { - printf(license_message); + puts(license_message); } extern void warranty(environment *env) { - printf(warranty_message); + puts(warranty_message); +} + + +/* random */ +extern void sx_72616e646f6d(environment *env) +{ + push_int(env, (int)rand()); +} + + +extern void seed(environment *env) +{ + if(check_args(env, 1, integer)) + return printerr(env); + + srand(CAR(env->head)->content.i); + toss(env); +} + + +extern void ticks(environment *env) +{ + int val; + + val= (int)time(NULL); + if(val<0) { + env->err= 5; + return printerr(env); + } + + return push_int(env, val); +} + + +extern void push(environment *env) +{ + symbol *sym; + value *oldval; + value *newval; + + if(check_args(env, 2, symb, unknown)==0) { + sym= CAR(env->head)->content.sym; + oldval= sym->val; + + if(oldval==NULL) + oldval= new_val(env); + + sym->val= new_val(env); + sym->val->content.c= malloc(sizeof(pair)); + assert(sym->val->content.c!=NULL); + env->gc_count += sizeof(pair); + sym->val->type= tcons; + CDR(sym->val)= oldval; + CAR(sym->val)= CAR(CDR(env->head)); + env->head= CDR(CDR(env->head)); + + return; + } + + if(check_args(env, 2, tcons, unknown)==0 + || check_args(env, 2, empty, unknown)==0) { + oldval= CAR(env->head); + env->head= CDR(env->head); + newval= new_val(env); + newval->content.c= malloc(sizeof(pair)); + assert(newval->content.c!=NULL); + env->gc_count += sizeof(pair); + newval->type= tcons; + CDR(newval)= oldval; + CAR(newval)= CAR(env->head); + env->head= CDR(env->head); + push_val(env, newval); + + return; + } + + return printerr(env); +} + + +extern void pop(environment *env) +{ + symbol *sym; + value *val; + + if(check_args(env, 1, symb)==0) { + sym= CAR(env->head)->content.sym; + + if(sym->val==NULL) { + env->err= 3; + return printerr(env); + } + + env->head= CDR(env->head); + if(sym->val->type==tcons) { + push_val(env, CAR(sym->val)); + sym->val= CDR(sym->val); + } else { + env->err= 2; + return printerr(env); + } + + return; + } + + if(check_args(env, 1, tcons)==0) { + val= CAR(env->head); + env->head= CDR(env->head); + push_val(env, CAR(val)); + return; + } + + return printerr(env); }