10 |
/* Print a newline to a port */ |
/* Print a newline to a port */ |
11 |
extern void nlport(environment *env) |
extern void nlport(environment *env) |
12 |
{ |
{ |
13 |
if(env->head->type==empty) { |
switch(check_args(env, port, empty)) { |
14 |
printerr("Too Few Arguments"); |
case 1: |
15 |
env->err= 1; |
printerr(env, "Too Few Arguments"); |
16 |
return; |
return; |
17 |
} |
case 2: |
18 |
|
printerr(env, "Bad Argument Type"); |
|
if(CAR(env->head)->type!=port) { |
|
|
printerr("Bad Argument Type"); |
|
|
env->err= 2; |
|
19 |
return; |
return; |
20 |
|
default: |
21 |
|
break; |
22 |
} |
} |
23 |
|
|
24 |
if(fprintf(CAR(env->head)->content.p, "\n") < 0){ |
if(fprintf(CAR(env->head)->content.p, "\n") < 0){ |
32 |
/* Gets the type of a value */ |
/* Gets the type of a value */ |
33 |
extern void type(environment *env) |
extern void type(environment *env) |
34 |
{ |
{ |
35 |
if(env->head->type==empty) { |
|
36 |
printerr("Too Few Arguments"); |
switch(check_args(env, unknown, empty)) { |
37 |
env->err= 1; |
case 1: |
38 |
|
printerr(env, "Too Few Arguments"); |
39 |
|
return; |
40 |
|
case 2: |
41 |
|
printerr(env, "Bad Argument Type"); |
42 |
return; |
return; |
43 |
|
default: |
44 |
|
break; |
45 |
} |
} |
46 |
|
|
47 |
switch(CAR(env->head)->type){ |
switch(CAR(env->head)->type){ |
48 |
case empty: |
case empty: |
49 |
push_sym(env, "empty"); |
push_sym(env, "empty"); |
50 |
break; |
break; |
51 |
|
case unknown: |
52 |
|
push_sym(env, "unknown"); |
53 |
|
break; |
54 |
case integer: |
case integer: |
55 |
push_sym(env, "integer"); |
push_sym(env, "integer"); |
56 |
break; |
break; |
81 |
/* Print the top element of the stack but don't discard it */ |
/* Print the top element of the stack but don't discard it */ |
82 |
extern void print_(environment *env) |
extern void print_(environment *env) |
83 |
{ |
{ |
84 |
if(env->head->type==empty) { |
|
85 |
printerr("Too Few Arguments"); |
switch(check_args(env, unknown, empty)) { |
86 |
env->err= 1; |
case 1: |
87 |
|
printerr(env, "Too Few Arguments"); |
88 |
|
return; |
89 |
|
case 2: |
90 |
|
printerr(env, "Bad Argument Type"); |
91 |
return; |
return; |
92 |
|
default: |
93 |
|
break; |
94 |
} |
} |
95 |
|
|
96 |
print_val(env, CAR(env->head), 0, NULL, stdout); |
print_val(env, CAR(env->head), 0, NULL, stdout); |
97 |
if(env->err) return; |
if(env->err) return; |
98 |
nl(env); |
nl(env); |
110 |
discard it. */ |
discard it. */ |
111 |
extern void princ_(environment *env) |
extern void princ_(environment *env) |
112 |
{ |
{ |
113 |
if(env->head->type==empty) { |
|
114 |
printerr("Too Few Arguments"); |
switch(check_args(env, unknown, empty)) { |
115 |
env->err= 1; |
case 1: |
116 |
|
printerr(env, "Too Few Arguments"); |
117 |
|
return; |
118 |
|
case 2: |
119 |
|
printerr(env, "Bad Argument Type"); |
120 |
return; |
return; |
121 |
|
default: |
122 |
|
break; |
123 |
} |
} |
124 |
|
|
125 |
print_val(env, CAR(env->head), 1, NULL, stdout); |
print_val(env, CAR(env->head), 1, NULL, stdout); |
126 |
} |
} |
127 |
|
|
136 |
/* Print a value to a port, but don't discard it */ |
/* Print a value to a port, but don't discard it */ |
137 |
extern void printport_(environment *env) |
extern void printport_(environment *env) |
138 |
{ |
{ |
|
if(env->head->type==empty || CDR(env->head)->type == empty) { |
|
|
printerr("Too Few Arguments"); |
|
|
env->err= 1; |
|
|
return; |
|
|
} |
|
139 |
|
|
140 |
if(CAR(env->head)->type!=port) { |
switch(check_args(env, port, unknown, empty)) { |
141 |
printerr("Bad Argument Type"); |
case 1: |
142 |
env->err= 2; |
printerr(env, "Too Few Arguments"); |
143 |
return; |
return; |
144 |
|
case 2: |
145 |
|
printerr(env, "Bad Argument Type"); |
146 |
|
return; |
147 |
|
default: |
148 |
|
break; |
149 |
} |
} |
150 |
|
|
151 |
print_val(env, CAR(CDR(env->head)), 0, NULL, CAR(env->head)->content.p); |
print_val(env, CAR(CDR(env->head)), 0, NULL, CAR(env->head)->content.p); |
164 |
/* Print, without quotes, to a port, a value, but don't discard it. */ |
/* Print, without quotes, to a port, a value, but don't discard it. */ |
165 |
extern void princport_(environment *env) |
extern void princport_(environment *env) |
166 |
{ |
{ |
|
if(env->head->type==empty || CDR(env->head)->type == empty) { |
|
|
printerr("Too Few Arguments"); |
|
|
env->err= 1; |
|
|
return; |
|
|
} |
|
167 |
|
|
168 |
if(CAR(env->head)->type!=port) { |
switch(check_args(env, port, unknown, empty)) { |
169 |
printerr("Bad Argument Type"); |
case 1: |
170 |
env->err= 2; |
printerr(env, "Too Few Arguments"); |
171 |
return; |
return; |
172 |
|
case 2: |
173 |
|
printerr(env, "Bad Argument Type"); |
174 |
|
return; |
175 |
|
default: |
176 |
|
break; |
177 |
} |
} |
178 |
|
|
179 |
print_val(env, CAR(CDR(env->head)), 1, NULL, CAR(env->head)->content.p); |
print_val(env, CAR(CDR(env->head)), 1, NULL, CAR(env->head)->content.p); |
192 |
extern void rot(environment *env) |
extern void rot(environment *env) |
193 |
{ |
{ |
194 |
value *temp= env->head; |
value *temp= env->head; |
195 |
|
|
196 |
if(env->head->type == empty || CDR(env->head)->type == empty |
switch(check_args(env, unknown, unknown, unknown, empty)) { |
197 |
|| CDR(CDR(env->head))->type == empty) { |
case 1: |
198 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
199 |
env->err= 1; |
return; |
200 |
|
case 2: |
201 |
|
printerr(env, "Bad Argument Type"); |
202 |
return; |
return; |
203 |
|
default: |
204 |
|
break; |
205 |
} |
} |
206 |
|
|
207 |
env->head= CDR(CDR(env->head)); |
env->head= CDR(CDR(env->head)); |
214 |
{ |
{ |
215 |
value *temp, *new_head; |
value *temp, *new_head; |
216 |
|
|
217 |
/* Is top element a list? */ |
switch(check_args(env, tcons, empty)) { |
218 |
if(env->head->type==empty) { |
case 1: |
219 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
|
env->err= 1; |
|
220 |
return; |
return; |
221 |
} |
case 2: |
222 |
|
printerr(env, "Bad Argument Type"); |
|
if(CAR(env->head)->type!=tcons) { |
|
|
printerr("Bad Argument Type"); |
|
|
env->err= 2; |
|
223 |
return; |
return; |
224 |
|
default: |
225 |
|
break; |
226 |
} |
} |
227 |
|
|
228 |
rev(env); |
rev(env); |
235 |
|
|
236 |
toss(env); |
toss(env); |
237 |
|
|
238 |
|
/// XXX |
239 |
/* Find the end of the list */ |
/* Find the end of the list */ |
240 |
while(CDR(temp)->type != empty) { |
while(CDR(temp)->type != empty) { |
241 |
if (CDR(temp)->type == tcons) |
if (CDR(temp)->type == tcons) |
242 |
temp= CDR(temp); |
temp= CDR(temp); |
243 |
else { |
else { |
244 |
printerr("Bad Argument Type"); /* Improper list */ |
printerr(env, "Bad Argument Type"); /* Improper list */ |
245 |
env->err= 2; |
env->err= 2; |
246 |
return; |
return; |
247 |
} |
} |
258 |
{ |
{ |
259 |
void *left, *right; |
void *left, *right; |
260 |
|
|
261 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
switch(check_args(env, unknown, unknown, empty)) { |
262 |
printerr("Too Few Arguments"); |
case 1: |
263 |
env->err= 1; |
printerr(env, "Too Few Arguments"); |
264 |
|
return; |
265 |
|
case 2: |
266 |
|
printerr(env, "Bad Argument Type"); |
267 |
return; |
return; |
268 |
|
default: |
269 |
|
break; |
270 |
} |
} |
271 |
|
|
272 |
left= CAR(env->head)->content.ptr; |
left= CAR(env->head)->content.ptr; |
281 |
{ |
{ |
282 |
int val; |
int val; |
283 |
|
|
284 |
if(env->head->type==empty) { |
switch(check_args(env, integer, empty)) { |
285 |
printerr("Too Few Arguments"); |
case 1: |
286 |
env->err= 1; |
printerr(env, "Too Few Arguments"); |
287 |
return; |
return; |
288 |
} |
case 2: |
289 |
|
printerr(env, "Bad Argument Type"); |
|
if(CAR(env->head)->type!=integer) { |
|
|
printerr("Bad Argument Type"); |
|
|
env->err= 2; |
|
290 |
return; |
return; |
291 |
|
default: |
292 |
|
break; |
293 |
} |
} |
294 |
|
|
295 |
val= CAR(env->head)->content.i; |
val= CAR(env->head)->content.i; |
310 |
symbol *sym; |
symbol *sym; |
311 |
|
|
312 |
/* Needs two values on the stack, the top one must be a symbol */ |
/* Needs two values on the stack, the top one must be a symbol */ |
313 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
switch(check_args(env, symb, unknown, empty)) { |
314 |
printerr("Too Few Arguments"); |
case 1: |
315 |
env->err= 1; |
printerr(env, "Too Few Arguments"); |
316 |
return; |
return; |
317 |
} |
case 2: |
318 |
|
printerr(env, "Bad Argument Type"); |
|
if(CAR(env->head)->type!=symb) { |
|
|
printerr("Bad Argument Type"); |
|
|
env->err= 2; |
|
319 |
return; |
return; |
320 |
|
default: |
321 |
|
break; |
322 |
} |
} |
323 |
|
|
324 |
/* long names are a pain */ |
/* long names are a pain */ |
341 |
{ |
{ |
342 |
char* sym_id; |
char* sym_id; |
343 |
|
|
344 |
if(env->head->type==empty) { |
switch(check_args(env, symb, empty)) { |
345 |
printerr("Too Few Arguments"); |
case 1: |
346 |
env->err= 1; |
printerr(env, "Too Few Arguments"); |
347 |
return; |
return; |
348 |
} |
case 2: |
349 |
|
printerr(env, "Bad Argument Type"); |
|
if(CAR(env->head)->type!=symb) { |
|
|
printerr("Bad Argument Type"); |
|
|
env->err= 2; |
|
350 |
return; |
return; |
351 |
|
default: |
352 |
|
break; |
353 |
} |
} |
354 |
|
|
355 |
sym_id= CAR(env->head)->content.sym->id; |
sym_id= CAR(env->head)->content.sym->id; |
373 |
char* new_string; |
char* new_string; |
374 |
value *a_val, *b_val; |
value *a_val, *b_val; |
375 |
|
|
376 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
if(check_args(env, unknown, unknown, empty)==1) { |
377 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
|
env->err= 1; |
|
378 |
return; |
return; |
379 |
} |
} |
380 |
|
|
381 |
if(CAR(env->head)->type==string |
if(check_args(env, string, string, empty)==0) { |
|
&& CAR(CDR(env->head))->type==string) { |
|
382 |
a_val= CAR(env->head); |
a_val= CAR(env->head); |
383 |
b_val= CAR(CDR(env->head)); |
b_val= CAR(CDR(env->head)); |
384 |
protect(a_val); protect(b_val); |
protect(a_val); protect(b_val); |
396 |
return; |
return; |
397 |
} |
} |
398 |
|
|
399 |
if(CAR(env->head)->type==integer |
if(check_args(env, integer, integer, empty)==0) { |
|
&& CAR(CDR(env->head))->type==integer) { |
|
400 |
a= CAR(env->head)->content.i; |
a= CAR(env->head)->content.i; |
401 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
402 |
b= CAR(env->head)->content.i; |
b= CAR(env->head)->content.i; |
406 |
return; |
return; |
407 |
} |
} |
408 |
|
|
409 |
if(CAR(env->head)->type==tfloat |
if(check_args(env, tfloat, tfloat, empty)==0) { |
|
&& CAR(CDR(env->head))->type==tfloat) { |
|
410 |
fa= CAR(env->head)->content.f; |
fa= CAR(env->head)->content.f; |
411 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
412 |
fb= CAR(env->head)->content.f; |
fb= CAR(env->head)->content.f; |
416 |
return; |
return; |
417 |
} |
} |
418 |
|
|
419 |
if(CAR(env->head)->type==tfloat |
if(check_args(env, tfloat, integer, empty)==0) { |
|
&& CAR(CDR(env->head))->type==integer) { |
|
420 |
fa= CAR(env->head)->content.f; |
fa= CAR(env->head)->content.f; |
421 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
422 |
b= CAR(env->head)->content.i; |
b= CAR(env->head)->content.i; |
426 |
return; |
return; |
427 |
} |
} |
428 |
|
|
429 |
if(CAR(env->head)->type==integer |
if(check_args(env, integer, tfloat, empty)==0) { |
|
&& CAR(CDR(env->head))->type==tfloat) { |
|
430 |
a= CAR(env->head)->content.i; |
a= CAR(env->head)->content.i; |
431 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
432 |
fb= CAR(env->head)->content.f; |
fb= CAR(env->head)->content.f; |
436 |
return; |
return; |
437 |
} |
} |
438 |
|
|
439 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
440 |
env->err=2; |
env->err=2; |
441 |
} |
} |
442 |
|
|
446 |
int a, b; |
int a, b; |
447 |
float fa, fb; |
float fa, fb; |
448 |
|
|
449 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
if(check_args(env, unknown, unknown, empty)==1) { |
450 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
|
env->err=1; |
|
451 |
return; |
return; |
452 |
} |
} |
453 |
|
|
454 |
if(CAR(env->head)->type==integer |
if(check_args(env, integer, integer, empty)==0) { |
|
&& CAR(CDR(env->head))->type==integer) { |
|
455 |
a= CAR(env->head)->content.i; |
a= CAR(env->head)->content.i; |
456 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
457 |
b= CAR(env->head)->content.i; |
b= CAR(env->head)->content.i; |
461 |
return; |
return; |
462 |
} |
} |
463 |
|
|
464 |
if(CAR(env->head)->type==tfloat |
if(check_args(env, tfloat, tfloat, empty)==0) { |
|
&& CAR(CDR(env->head))->type==tfloat) { |
|
465 |
fa= CAR(env->head)->content.f; |
fa= CAR(env->head)->content.f; |
466 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
467 |
fb= CAR(env->head)->content.f; |
fb= CAR(env->head)->content.f; |
471 |
return; |
return; |
472 |
} |
} |
473 |
|
|
474 |
if(CAR(env->head)->type==tfloat |
if(check_args(env, tfloat, integer, empty)==0) { |
|
&& CAR(CDR(env->head))->type==integer) { |
|
475 |
fa= CAR(env->head)->content.f; |
fa= CAR(env->head)->content.f; |
476 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
477 |
b= CAR(env->head)->content.i; |
b= CAR(env->head)->content.i; |
481 |
return; |
return; |
482 |
} |
} |
483 |
|
|
484 |
if(CAR(env->head)->type==integer |
if(check_args(env, integer, tfloat, empty)==0) { |
|
&& CAR(CDR(env->head))->type==tfloat) { |
|
485 |
a= CAR(env->head)->content.i; |
a= CAR(env->head)->content.i; |
486 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
487 |
fb= CAR(env->head)->content.f; |
fb= CAR(env->head)->content.f; |
491 |
return; |
return; |
492 |
} |
} |
493 |
|
|
494 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
495 |
env->err=2; |
env->err=2; |
496 |
} |
} |
497 |
|
|
501 |
int a, b; |
int a, b; |
502 |
float fa, fb; |
float fa, fb; |
503 |
|
|
504 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
if(check_args(env, unknown, unknown, empty)==1) { |
505 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
|
env->err= 1; |
|
506 |
return; |
return; |
507 |
} |
} |
508 |
|
|
509 |
if(CAR(env->head)->type==integer |
if(check_args(env, integer, integer, empty)==0) { |
|
&& CAR(CDR(env->head))->type==integer) { |
|
510 |
a= CAR(env->head)->content.i; |
a= CAR(env->head)->content.i; |
511 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
512 |
b= CAR(env->head)->content.i; |
b= CAR(env->head)->content.i; |
516 |
return; |
return; |
517 |
} |
} |
518 |
|
|
519 |
if(CAR(env->head)->type==tfloat |
if(check_args(env, tfloat, tfloat, empty)==0) { |
|
&& CAR(CDR(env->head))->type==tfloat) { |
|
520 |
fa= CAR(env->head)->content.f; |
fa= CAR(env->head)->content.f; |
521 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
522 |
fb= CAR(env->head)->content.f; |
fb= CAR(env->head)->content.f; |
526 |
return; |
return; |
527 |
} |
} |
528 |
|
|
529 |
if(CAR(env->head)->type==tfloat |
if(check_args(env, tfloat, integer, empty)==0) { |
|
&& CAR(CDR(env->head))->type==integer) { |
|
530 |
fa= CAR(env->head)->content.f; |
fa= CAR(env->head)->content.f; |
531 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
532 |
b= CAR(env->head)->content.i; |
b= CAR(env->head)->content.i; |
536 |
return; |
return; |
537 |
} |
} |
538 |
|
|
539 |
if(CAR(env->head)->type==integer |
if(check_args(env, integer, tfloat, empty)==0) { |
|
&& CAR(CDR(env->head))->type==tfloat) { |
|
540 |
a= CAR(env->head)->content.i; |
a= CAR(env->head)->content.i; |
541 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
542 |
fb= CAR(env->head)->content.f; |
fb= CAR(env->head)->content.f; |
546 |
return; |
return; |
547 |
} |
} |
548 |
|
|
549 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
550 |
env->err= 2; |
env->err= 2; |
551 |
} |
} |
552 |
|
|
574 |
/* "dup"; duplicates an item on the stack */ |
/* "dup"; duplicates an item on the stack */ |
575 |
extern void sx_647570(environment *env) |
extern void sx_647570(environment *env) |
576 |
{ |
{ |
577 |
if(env->head->type==empty) { |
switch(check_args(env, unknown, empty)) { |
578 |
printerr("Too Few Arguments"); |
case 1: |
579 |
env->err= 1; |
printerr(env, "Too Few Arguments"); |
580 |
|
return; |
581 |
|
case 2: |
582 |
|
printerr(env, "Bad Argument Type"); |
583 |
return; |
return; |
584 |
|
default: |
585 |
|
break; |
586 |
} |
} |
587 |
|
|
588 |
push_val(env, copy_val(env, CAR(env->head))); |
push_val(env, copy_val(env, CAR(env->head))); |
589 |
} |
} |
590 |
|
|
593 |
{ |
{ |
594 |
int truth; |
int truth; |
595 |
|
|
596 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
switch(check_args(env, unknown, integer, empty)) { |
597 |
printerr("Too Few Arguments"); |
case 1: |
598 |
env->err= 1; |
printerr(env, "Too Few Arguments"); |
599 |
return; |
return; |
600 |
} |
case 2: |
601 |
|
printerr(env, "Bad Argument Type"); |
|
if(CAR(CDR(env->head))->type != integer) { |
|
|
printerr("Bad Argument Type"); |
|
|
env->err= 2; |
|
602 |
return; |
return; |
603 |
|
default: |
604 |
|
break; |
605 |
} |
} |
606 |
|
|
607 |
swap(env); |
swap(env); |
608 |
if(env->err) return; |
if(env->err) return; |
609 |
|
|
623 |
{ |
{ |
624 |
int truth; |
int truth; |
625 |
|
|
626 |
if(env->head->type==empty || CDR(env->head)->type==empty |
switch(check_args(env, unknown, unknown, integer, empty)) { |
627 |
|| CDR(CDR(env->head))->type==empty) { |
case 1: |
628 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
|
env->err= 1; |
|
629 |
return; |
return; |
630 |
} |
case 2: |
631 |
|
printerr(env, "Bad Argument Type"); |
|
if(CAR(CDR(CDR(env->head)))->type!=integer) { |
|
|
printerr("Bad Argument Type"); |
|
|
env->err= 2; |
|
632 |
return; |
return; |
633 |
|
default: |
634 |
|
break; |
635 |
} |
} |
636 |
|
|
637 |
rot(env); |
rot(env); |
638 |
if(env->err) return; |
if(env->err) return; |
639 |
|
|
655 |
/* "else" */ |
/* "else" */ |
656 |
extern void sx_656c7365(environment *env) |
extern void sx_656c7365(environment *env) |
657 |
{ |
{ |
658 |
if(env->head->type==empty || CDR(env->head)->type==empty |
|
659 |
|| CDR(CDR(env->head))->type==empty || CDR(CDR(CDR(env->head)))->type==empty |
switch(check_args(env, |
660 |
|| CDR(CDR(CDR(CDR(env->head))))->type==empty) { |
unknown, symb, unknown, symb, integer, |
661 |
printerr("Too Few Arguments"); |
empty)) { |
662 |
env->err= 1; |
case 1: |
663 |
|
printerr(env, "Too Few Arguments"); |
664 |
|
return; |
665 |
|
case 2: |
666 |
|
printerr(env, "Bad Argument Type"); |
667 |
return; |
return; |
668 |
|
default: |
669 |
|
break; |
670 |
} |
} |
671 |
|
|
672 |
|
/// XXX |
673 |
|
|
674 |
if(CAR(CDR(env->head))->type!=symb |
if(CAR(CDR(env->head))->type!=symb |
675 |
|| strcmp(CAR(CDR(env->head))->content.sym->id, "then")!=0 |
|| strcmp(CAR(CDR(env->head))->content.sym->id, "then")!=0 |
676 |
|| CAR(CDR(CDR(CDR(env->head))))->type!=symb |
|| CAR(CDR(CDR(CDR(env->head))))->type!=symb |
677 |
|| strcmp(CAR(CDR(CDR(CDR(env->head))))->content.sym->id, "if")!=0) { |
|| strcmp(CAR(CDR(CDR(CDR(env->head))))->content.sym->id, "if")!=0) { |
678 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
679 |
env->err= 2; |
env->err= 2; |
680 |
return; |
return; |
681 |
} |
} |
686 |
|
|
687 |
extern void then(environment *env) |
extern void then(environment *env) |
688 |
{ |
{ |
689 |
if(env->head->type==empty || CDR(env->head)->type==empty |
|
690 |
|| CDR(CDR(env->head))->type==empty) { |
switch(check_args(env, unknown, symb, integer, empty)) { |
691 |
printerr("Too Few Arguments"); |
case 1: |
692 |
env->err= 1; |
printerr(env, "Too Few Arguments"); |
693 |
return; |
return; |
694 |
|
case 2: |
695 |
|
printerr(env, "Bad Argument Type"); |
696 |
|
return; |
697 |
|
default: |
698 |
|
break; |
699 |
} |
} |
700 |
|
|
701 |
|
/// XXX |
702 |
|
|
703 |
if(CAR(CDR(env->head))->type!=symb |
if(CAR(CDR(env->head))->type!=symb |
704 |
|| strcmp(CAR(CDR(env->head))->content.sym->id, "if")!=0) { |
|| strcmp(CAR(CDR(env->head))->content.sym->id, "if")!=0) { |
705 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
706 |
env->err= 2; |
env->err= 2; |
707 |
return; |
return; |
708 |
} |
} |
717 |
int truth; |
int truth; |
718 |
value *loop, *test; |
value *loop, *test; |
719 |
|
|
720 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
switch(check_args(env, unknown, integer, empty)) { |
721 |
printerr("Too Few Arguments"); |
case 1: |
722 |
env->err= 1; |
printerr(env, "Too Few Arguments"); |
723 |
|
return; |
724 |
|
case 2: |
725 |
|
printerr(env, "Bad Argument Type"); |
726 |
return; |
return; |
727 |
|
default: |
728 |
|
break; |
729 |
} |
} |
730 |
|
|
731 |
loop= CAR(env->head); |
loop= CAR(env->head); |
739 |
do { |
do { |
740 |
push_val(env, test); |
push_val(env, test); |
741 |
eval(env); |
eval(env); |
742 |
|
|
743 |
|
/// XXX |
744 |
|
|
745 |
if(CAR(env->head)->type != integer) { |
if(CAR(env->head)->type != integer) { |
746 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
747 |
env->err= 2; |
env->err= 2; |
748 |
return; |
return; |
749 |
} |
} |
770 |
value *loop; |
value *loop; |
771 |
int foo1, foo2; |
int foo1, foo2; |
772 |
|
|
773 |
if(env->head->type==empty || CDR(env->head)->type==empty |
switch(check_args(env, unknown, integer, integer, empty)) { |
774 |
|| CDR(CDR(env->head))->type==empty) { |
case 1: |
775 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
|
env->err= 1; |
|
776 |
return; |
return; |
777 |
} |
case 2: |
778 |
|
printerr(env, "Bad Argument Type"); |
|
if(CAR(CDR(env->head))->type!=integer |
|
|
|| CAR(CDR(CDR(env->head)))->type!=integer) { |
|
|
printerr("Bad Argument Type"); |
|
|
env->err= 2; |
|
779 |
return; |
return; |
780 |
|
default: |
781 |
|
break; |
782 |
} |
} |
783 |
|
|
784 |
loop= CAR(env->head); |
loop= CAR(env->head); |
815 |
{ |
{ |
816 |
value *loop, *foo; |
value *loop, *foo; |
817 |
value *iterator; |
value *iterator; |
|
|
|
|
if(env->head->type==empty || CDR(env->head)->type==empty) { |
|
|
printerr("Too Few Arguments"); |
|
|
env->err= 1; |
|
|
return; |
|
|
} |
|
818 |
|
|
819 |
if(CAR(CDR(env->head))->type!=tcons) { |
switch(check_args(env, unknown, tcons, empty)) { |
820 |
printerr("Bad Argument Type"); |
case 1: |
821 |
env->err= 2; |
printerr(env, "Too Few Arguments"); |
822 |
|
return; |
823 |
|
case 2: |
824 |
|
printerr(env, "Bad Argument Type"); |
825 |
return; |
return; |
826 |
|
default: |
827 |
|
break; |
828 |
} |
} |
829 |
|
|
830 |
loop= CAR(env->head); |
loop= CAR(env->head); |
831 |
protect(loop); |
protect(loop); |
832 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
841 |
push_val(env, CAR(iterator)); |
push_val(env, CAR(iterator)); |
842 |
push_val(env, loop); |
push_val(env, loop); |
843 |
eval(env); if(env->err) return; |
eval(env); if(env->err) return; |
844 |
|
|
845 |
|
/// XXX |
846 |
if (iterator->type == tcons){ |
if (iterator->type == tcons){ |
847 |
iterator= CDR(iterator); |
iterator= CDR(iterator); |
848 |
} else { |
} else { |
849 |
printerr("Bad Argument Type"); /* Improper list */ |
printerr(env, "Bad Argument Type"); /* Improper list */ |
850 |
env->err= 2; |
env->err= 2; |
851 |
break; |
break; |
852 |
} |
} |
860 |
int ending, start, i; |
int ending, start, i; |
861 |
value *iterator, *temp, *end; |
value *iterator, *temp, *end; |
862 |
|
|
863 |
end= new_val(env); |
switch(check_args(env, integer, integer, empty)) { |
864 |
|
case 1: |
865 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
printerr(env, "Too Few Arguments"); |
|
printerr("Too Few Arguments"); |
|
|
env->err= 1; |
|
866 |
return; |
return; |
867 |
} |
case 2: |
868 |
|
printerr(env, "Bad Argument Type"); |
|
if(CAR(env->head)->type!=integer |
|
|
|| CAR(CDR(env->head))->type!=integer) { |
|
|
printerr("Bad Argument Type"); |
|
|
env->err= 2; |
|
869 |
return; |
return; |
870 |
|
default: |
871 |
|
break; |
872 |
} |
} |
873 |
|
|
874 |
|
end= new_val(env); |
875 |
|
|
876 |
ending= CAR(env->head)->content.i; |
ending= CAR(env->head)->content.i; |
877 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
878 |
start= CAR(env->head)->content.i; |
start= CAR(env->head)->content.i; |
926 |
{ |
{ |
927 |
FILE *stream; |
FILE *stream; |
928 |
|
|
929 |
if(env->head->type==empty) { |
switch(check_args(env, port, empty)) { |
930 |
printerr("Too Few Arguments"); |
case 1: |
931 |
env->err= 1; |
printerr(env, "Too Few Arguments"); |
932 |
return; |
return; |
933 |
} |
case 2: |
934 |
|
printerr(env, "Bad Argument Type"); |
|
if(CAR(env->head)->type!=port) { |
|
|
printerr("Bad Argument Type"); |
|
|
env->err= 2; |
|
935 |
return; |
return; |
936 |
|
default: |
937 |
|
break; |
938 |
} |
} |
939 |
|
|
940 |
stream=CAR(env->head)->content.p; |
stream=CAR(env->head)->content.p; |
955 |
{ |
{ |
956 |
FILE *stream; |
FILE *stream; |
957 |
|
|
958 |
if(env->head->type==empty) { |
switch(check_args(env, port, empty)) { |
959 |
printerr("Too Few Arguments"); |
case 1: |
960 |
env->err= 1; |
printerr(env, "Too Few Arguments"); |
961 |
return; |
return; |
962 |
} |
case 2: |
963 |
|
printerr(env, "Bad Argument Type"); |
|
if(CAR(env->head)->type!=port) { |
|
|
printerr("Bad Argument Type"); |
|
|
env->err= 2; |
|
964 |
return; |
return; |
965 |
|
default: |
966 |
|
break; |
967 |
} |
} |
968 |
|
|
969 |
stream=CAR(env->head)->content.p; |
stream=CAR(env->head)->content.p; |
978 |
{ |
{ |
979 |
int freq, dur, period, ticks; |
int freq, dur, period, ticks; |
980 |
|
|
981 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
switch(check_args(env, integer, integer, empty)) { |
982 |
printerr("Too Few Arguments"); |
case 1: |
983 |
env->err= 1; |
printerr(env, "Too Few Arguments"); |
984 |
return; |
return; |
985 |
} |
case 2: |
986 |
|
printerr(env, "Bad Argument Type"); |
|
if(CAR(env->head)->type!=integer |
|
|
|| CAR(CDR(env->head))->type!=integer) { |
|
|
printerr("Bad Argument Type"); |
|
|
env->err= 2; |
|
987 |
return; |
return; |
988 |
|
default: |
989 |
|
break; |
990 |
} |
} |
991 |
|
|
992 |
dur= CAR(env->head)->content.i; |
dur= CAR(env->head)->content.i; |
1021 |
{ |
{ |
1022 |
int dur; |
int dur; |
1023 |
|
|
1024 |
if(env->head->type==empty) { |
switch(check_args(env, integer, empty)) { |
1025 |
printerr("Too Few Arguments"); |
case 1: |
1026 |
env->err= 1; |
printerr(env, "Too Few Arguments"); |
1027 |
return; |
return; |
1028 |
} |
case 2: |
1029 |
|
printerr(env, "Bad Argument Type"); |
|
if(CAR(env->head)->type!=integer) { |
|
|
printerr("Bad Argument Type"); |
|
|
env->err= 2; |
|
1030 |
return; |
return; |
1031 |
|
default: |
1032 |
|
break; |
1033 |
} |
} |
1034 |
|
|
1035 |
dur= CAR(env->head)->content.i; |
dur= CAR(env->head)->content.i; |
1038 |
usleep(dur); |
usleep(dur); |
1039 |
} |
} |
1040 |
|
|
1041 |
|
/// XXXXXX |
1042 |
|
|
1043 |
|
|
1044 |
/* "*" */ |
/* "*" */ |
1045 |
extern void sx_2a(environment *env) |
extern void sx_2a(environment *env) |
1046 |
{ |
{ |
1048 |
float fa, fb; |
float fa, fb; |
1049 |
|
|
1050 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
1051 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
1052 |
env->err= 1; |
env->err= 1; |
1053 |
return; |
return; |
1054 |
} |
} |
1097 |
return; |
return; |
1098 |
} |
} |
1099 |
|
|
1100 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
1101 |
env->err= 2; |
env->err= 2; |
1102 |
} |
} |
1103 |
|
|
1108 |
float fa, fb; |
float fa, fb; |
1109 |
|
|
1110 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
1111 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
1112 |
env->err= 1; |
env->err= 1; |
1113 |
return; |
return; |
1114 |
} |
} |
1157 |
return; |
return; |
1158 |
} |
} |
1159 |
|
|
1160 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
1161 |
env->err= 2; |
env->err= 2; |
1162 |
} |
} |
1163 |
|
|
1167 |
int a, b; |
int a, b; |
1168 |
|
|
1169 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
1170 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
1171 |
env->err= 1; |
env->err= 1; |
1172 |
return; |
return; |
1173 |
} |
} |
1183 |
return; |
return; |
1184 |
} |
} |
1185 |
|
|
1186 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
1187 |
env->err= 2; |
env->err= 2; |
1188 |
} |
} |
1189 |
|
|
1193 |
int a, b; |
int a, b; |
1194 |
|
|
1195 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
1196 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
1197 |
env->err= 1; |
env->err= 1; |
1198 |
return; |
return; |
1199 |
} |
} |
1209 |
return; |
return; |
1210 |
} |
} |
1211 |
|
|
1212 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
1213 |
env->err= 2; |
env->err= 2; |
1214 |
} |
} |
1215 |
|
|
1216 |
extern void setcar(environment *env) |
extern void setcar(environment *env) |
1217 |
{ |
{ |
1218 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
1219 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
1220 |
env->err= 1; |
env->err= 1; |
1221 |
return; |
return; |
1222 |
} |
} |
1223 |
|
|
1224 |
if(CDR(env->head)->type!=tcons) { |
if(CDR(env->head)->type!=tcons) { |
1225 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
1226 |
env->err= 2; |
env->err= 2; |
1227 |
return; |
return; |
1228 |
} |
} |
1234 |
extern void setcdr(environment *env) |
extern void setcdr(environment *env) |
1235 |
{ |
{ |
1236 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
1237 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
1238 |
env->err= 1; |
env->err= 1; |
1239 |
return; |
return; |
1240 |
} |
} |
1241 |
|
|
1242 |
if(CDR(env->head)->type!=tcons) { |
if(CDR(env->head)->type!=tcons) { |
1243 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
1244 |
env->err= 2; |
env->err= 2; |
1245 |
return; |
return; |
1246 |
} |
} |
1252 |
extern void car(environment *env) |
extern void car(environment *env) |
1253 |
{ |
{ |
1254 |
if(env->head->type==empty) { |
if(env->head->type==empty) { |
1255 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
1256 |
env->err= 1; |
env->err= 1; |
1257 |
return; |
return; |
1258 |
} |
} |
1259 |
|
|
1260 |
if(CAR(env->head)->type!=tcons) { |
if(CAR(env->head)->type!=tcons) { |
1261 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
1262 |
env->err= 2; |
env->err= 2; |
1263 |
return; |
return; |
1264 |
} |
} |
1269 |
extern void cdr(environment *env) |
extern void cdr(environment *env) |
1270 |
{ |
{ |
1271 |
if(env->head->type==empty) { |
if(env->head->type==empty) { |
1272 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
1273 |
env->err= 1; |
env->err= 1; |
1274 |
return; |
return; |
1275 |
} |
} |
1276 |
|
|
1277 |
if(CAR(env->head)->type!=tcons) { |
if(CAR(env->head)->type!=tcons) { |
1278 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
1279 |
env->err= 2; |
env->err= 2; |
1280 |
return; |
return; |
1281 |
} |
} |
1288 |
value *val; |
value *val; |
1289 |
|
|
1290 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
1291 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
1292 |
env->err= 1; |
env->err= 1; |
1293 |
return; |
return; |
1294 |
} |
} |
1320 |
/* Needs two values on the stack, the top one must be an association |
/* Needs two values on the stack, the top one must be an association |
1321 |
list */ |
list */ |
1322 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
1323 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
1324 |
env->err= 1; |
env->err= 1; |
1325 |
return; |
return; |
1326 |
} |
} |
1327 |
|
|
1328 |
if(CAR(env->head)->type!=tcons) { |
if(CAR(env->head)->type!=tcons) { |
1329 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
1330 |
env->err= 2; |
env->err= 2; |
1331 |
return; |
return; |
1332 |
} |
} |
1336 |
|
|
1337 |
while(item->type == tcons){ |
while(item->type == tcons){ |
1338 |
if(CAR(item)->type != tcons){ |
if(CAR(item)->type != tcons){ |
1339 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
1340 |
env->err= 2; |
env->err= 2; |
1341 |
return; |
return; |
1342 |
} |
} |
1346 |
|
|
1347 |
/* Check the result of 'eqfunc' */ |
/* Check the result of 'eqfunc' */ |
1348 |
if(env->head->type==empty) { |
if(env->head->type==empty) { |
1349 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
1350 |
env->err= 1; |
env->err= 1; |
1351 |
return; |
return; |
1352 |
} |
} |
1353 |
if(CAR(env->head)->type!=integer) { |
if(CAR(env->head)->type!=integer) { |
1354 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
1355 |
env->err= 2; |
env->err= 2; |
1356 |
return; |
return; |
1357 |
} |
} |
1363 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
1364 |
|
|
1365 |
if(item->type!=tcons) { |
if(item->type!=tcons) { |
1366 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
1367 |
env->err= 2; |
env->err= 2; |
1368 |
return; |
return; |
1369 |
} |
} |
1407 |
FILE *stream; |
FILE *stream; |
1408 |
|
|
1409 |
if(env->head->type == empty || CDR(env->head)->type == empty) { |
if(env->head->type == empty || CDR(env->head)->type == empty) { |
1410 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
1411 |
env->err=1; |
env->err=1; |
1412 |
return; |
return; |
1413 |
} |
} |
1414 |
|
|
1415 |
if(CAR(env->head)->type != string |
if(CAR(env->head)->type != string |
1416 |
|| CAR(CDR(env->head))->type != string) { |
|| CAR(CDR(env->head))->type != string) { |
1417 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
1418 |
env->err= 2; |
env->err= 2; |
1419 |
return; |
return; |
1420 |
} |
} |
1447 |
int ret; |
int ret; |
1448 |
|
|
1449 |
if(env->head->type == empty) { |
if(env->head->type == empty) { |
1450 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
1451 |
env->err=1; |
env->err=1; |
1452 |
return; |
return; |
1453 |
} |
} |
1454 |
|
|
1455 |
if(CAR(env->head)->type != port) { |
if(CAR(env->head)->type != port) { |
1456 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
1457 |
env->err= 2; |
env->err= 2; |
1458 |
return; |
return; |
1459 |
} |
} |
1474 |
char *new_string; |
char *new_string; |
1475 |
|
|
1476 |
if(env->head->type==empty) { |
if(env->head->type==empty) { |
1477 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
1478 |
env->err= 1; |
env->err= 1; |
1479 |
return; |
return; |
1480 |
} |
} |
1481 |
|
|
1482 |
if(CAR(env->head)->type!=string) { |
if(CAR(env->head)->type!=string) { |
1483 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
1484 |
env->err= 2; |
env->err= 2; |
1485 |
return; |
return; |
1486 |
} |
} |
1504 |
{ |
{ |
1505 |
|
|
1506 |
if(env->head->type==empty) { |
if(env->head->type==empty) { |
1507 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
1508 |
env->err= 1; |
env->err= 1; |
1509 |
return; |
return; |
1510 |
} |
} |
1511 |
|
|
1512 |
if(CAR(env->head)->type!=integer) { |
if(CAR(env->head)->type!=integer) { |
1513 |
printerr("Bad Argument Type"); |
printerr(env, "Bad Argument Type"); |
1514 |
env->err= 2; |
env->err= 2; |
1515 |
return; |
return; |
1516 |
} |
} |
1524 |
extern void toss(environment *env) |
extern void toss(environment *env) |
1525 |
{ |
{ |
1526 |
if(env->head->type==empty) { |
if(env->head->type==empty) { |
1527 |
printerr("Too Few Arguments"); |
printerr(env, "Too Few Arguments"); |
1528 |
env->err= 1; |
env->err= 1; |
1529 |
return; |
return; |
1530 |
} |
} |