50 |
} |
} |
51 |
|
|
52 |
|
|
53 |
void printerr(const char* in_string) |
void printerr(environment *env) |
54 |
{ |
{ |
55 |
fprintf(stderr, "Err: %s\n", in_string); |
char *in_string; |
56 |
|
|
57 |
|
switch(env->err) { |
58 |
|
case 0: |
59 |
|
return; |
60 |
|
case 1: |
61 |
|
in_string= "Too Few Arguments"; |
62 |
|
break; |
63 |
|
case 2: |
64 |
|
in_string= "Bad Argument Type"; |
65 |
|
break; |
66 |
|
case 3: |
67 |
|
in_string= "Unbound Variable"; |
68 |
|
break; |
69 |
|
default: |
70 |
|
in_string= "Unknown error"; |
71 |
|
break; |
72 |
|
} |
73 |
|
|
74 |
|
fprintf(stderr, "\"%s\":\nErr: %s\n", env->errsymb, in_string); |
75 |
} |
} |
76 |
|
|
77 |
|
|
186 |
break; |
break; |
187 |
case port: |
case port: |
188 |
case empty: |
case empty: |
189 |
|
case unknown: |
190 |
case integer: |
case integer: |
191 |
case tfloat: |
case tfloat: |
192 |
case func: |
case func: |
384 |
char *mangled; /* Mangled function name */ |
char *mangled; /* Mangled function name */ |
385 |
|
|
386 |
new_value= new_val(env); |
new_value= new_val(env); |
|
protect(new_value); |
|
387 |
new_fvalue= new_val(env); |
new_fvalue= new_val(env); |
|
protect(new_fvalue); |
|
388 |
|
|
389 |
/* The new value is a symbol */ |
/* The new value is a symbol */ |
390 |
new_value->type= symb; |
new_value->type= symb; |
432 |
} |
} |
433 |
|
|
434 |
push_val(env, new_value); |
push_val(env, new_value); |
|
unprotect(new_value); unprotect(new_fvalue); |
|
435 |
} |
} |
436 |
|
|
437 |
|
|
450 |
return; |
return; |
451 |
} |
} |
452 |
break; |
break; |
453 |
|
case unknown: |
454 |
|
if(fprintf(stream, "UNKNOWN") < 0){ |
455 |
|
perror("print_val"); |
456 |
|
env->err= 5; |
457 |
|
return; |
458 |
|
} |
459 |
|
break; |
460 |
case integer: |
case integer: |
461 |
if(fprintf(stream, "%d", val->content.i) < 0){ |
if(fprintf(stream, "%d", val->content.i) < 0){ |
462 |
perror("print_val"); |
perror("print_val"); |
604 |
extern void swap(environment *env) |
extern void swap(environment *env) |
605 |
{ |
{ |
606 |
value *temp= env->head; |
value *temp= env->head; |
|
|
|
|
if(env->head->type == empty || CDR(env->head)->type == empty) { |
|
|
printerr("Too Few Arguments"); |
|
|
env->err=1; |
|
|
return; |
|
|
} |
|
607 |
|
|
608 |
|
if(check_args(env, unknown, unknown, empty)) |
609 |
|
return printerr(env); |
610 |
|
|
611 |
env->head= CDR(env->head); |
env->head= CDR(env->head); |
612 |
CDR(temp)= CDR(env->head); |
CDR(temp)= CDR(env->head); |
613 |
CDR(env->head)= temp; |
CDR(env->head)= temp; |
619 |
{ |
{ |
620 |
value *val; |
value *val; |
621 |
|
|
622 |
if(env->head->type==empty) { |
if(check_args(env, symb, empty)) |
623 |
printerr("Too Few Arguments"); |
return printerr(env); |
|
env->err= 1; |
|
|
return; |
|
|
} |
|
|
|
|
|
if(CAR(env->head)->type!=symb) { |
|
|
printerr("Bad Argument Type"); |
|
|
env->err= 2; |
|
|
return; |
|
|
} |
|
624 |
|
|
625 |
val= CAR(env->head)->content.sym->val; |
val= CAR(env->head)->content.sym->val; |
626 |
if(val == NULL){ |
if(val == NULL){ |
|
printerr("Unbound Variable"); |
|
627 |
env->err= 3; |
env->err= 3; |
628 |
return; |
return printerr(env); |
629 |
} |
} |
630 |
|
|
631 |
push_val(env, val); /* Return the symbol's bound value */ |
push_val(env, val); /* Return the symbol's bound value */ |
632 |
swap(env); |
swap(env); |
633 |
if(env->err) return; |
if(env->err) return; |
648 |
|
|
649 |
gc_maybe(env); |
gc_maybe(env); |
650 |
|
|
651 |
if(env->head->type==empty) { |
if(check_args(env, unknown, empty)) |
652 |
printerr("Too Few Arguments"); |
return printerr(env); |
|
env->err= 1; |
|
|
return; |
|
|
} |
|
653 |
|
|
654 |
switch(CAR(env->head)->type) { |
switch(CAR(env->head)->type) { |
655 |
/* if it's a symbol */ |
/* if it's a symbol */ |
656 |
case symb: |
case symb: |
657 |
|
env->errsymb= CAR(env->head)->content.sym->id; |
658 |
rcl(env); /* get its contents */ |
rcl(env); /* get its contents */ |
659 |
if(env->err) return; |
if(env->err) return; |
660 |
if(CAR(env->head)->type!=symb){ /* don't recurse symbols */ |
if(CAR(env->head)->type!=symb){ /* don't recurse symbols */ |
666 |
case func: |
case func: |
667 |
in_func= CAR(env->head)->content.func; |
in_func= CAR(env->head)->content.func; |
668 |
env->head= CDR(env->head); |
env->head= CDR(env->head); |
669 |
return in_func(env); |
return in_func((void*)env); |
670 |
|
|
671 |
/* If it's a list */ |
/* If it's a list */ |
672 |
case tcons: |
case tcons: |
692 |
if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons) |
if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons) |
693 |
iterator= CDR(iterator); |
iterator= CDR(iterator); |
694 |
else { |
else { |
695 |
printerr("Bad Argument Type"); /* Improper list */ |
env->err= 2; /* Improper list */ |
696 |
env->err= 2; |
return printerr(env); |
|
return; |
|
697 |
} |
} |
698 |
} |
} |
699 |
unprotect(temp_val); |
unprotect(temp_val); |
705 |
case tfloat: |
case tfloat: |
706 |
case string: |
case string: |
707 |
case port: |
case port: |
708 |
|
case unknown: |
709 |
return; |
return; |
710 |
} |
} |
711 |
} |
} |
762 |
} |
} |
763 |
|
|
764 |
if(myenv.interactive) |
if(myenv.interactive) |
765 |
printf(start_message); |
puts(start_message); |
766 |
|
|
767 |
while(1) { |
while(1) { |
768 |
if(myenv.in_string==NULL) { |
if(myenv.in_string==NULL) { |
813 |
case func: |
case func: |
814 |
case symb: |
case symb: |
815 |
case empty: |
case empty: |
816 |
|
case unknown: |
817 |
case port: |
case port: |
818 |
new_value->content= old_value->content; |
new_value->content= old_value->content; |
819 |
break; |
break; |
857 |
{ |
{ |
858 |
value *old_head, *new_head, *item; |
value *old_head, *new_head, *item; |
859 |
|
|
|
if(env->head->type==empty) { |
|
|
printerr("Too Few Arguments"); |
|
|
env->err= 1; |
|
|
return; |
|
|
} |
|
|
|
|
860 |
if(CAR(env->head)->type==empty) |
if(CAR(env->head)->type==empty) |
861 |
return; /* Don't reverse an empty list */ |
return; /* Don't reverse an empty list */ |
862 |
|
|
863 |
if(CAR(env->head)->type!=tcons) { |
if(check_args(env, tcons, empty)) |
864 |
printerr("Bad Argument Type"); |
return printerr(env); |
|
env->err= 2; |
|
|
return; |
|
|
} |
|
865 |
|
|
866 |
old_head= CAR(env->head); |
old_head= CAR(env->head); |
867 |
new_head= new_val(env); |
new_head= new_val(env); |
998 |
if(depth) |
if(depth) |
999 |
return readstream(env, env->inputstream); |
return readstream(env, env->inputstream); |
1000 |
} |
} |
1001 |
|
|
1002 |
|
|
1003 |
|
int check_args(environment *env, ...) |
1004 |
|
{ |
1005 |
|
va_list ap; |
1006 |
|
enum type_enum mytype; |
1007 |
|
|
1008 |
|
value *iter= env->head; |
1009 |
|
int errval= 0; |
1010 |
|
|
1011 |
|
va_start(ap, env); |
1012 |
|
while(1) { |
1013 |
|
mytype= va_arg(ap, enum type_enum); |
1014 |
|
// fprintf(stderr, "%s\n", env->errsymb); |
1015 |
|
|
1016 |
|
if(mytype==empty) |
1017 |
|
break; |
1018 |
|
|
1019 |
|
if(iter->type==empty || iter==NULL) { |
1020 |
|
errval= 1; |
1021 |
|
break; |
1022 |
|
} |
1023 |
|
|
1024 |
|
if(mytype==unknown) { |
1025 |
|
iter=CDR(iter); |
1026 |
|
continue; |
1027 |
|
} |
1028 |
|
|
1029 |
|
if(CAR(iter)->type!=mytype) { |
1030 |
|
errval= 2; |
1031 |
|
break; |
1032 |
|
} |
1033 |
|
|
1034 |
|
iter= CDR(iter); |
1035 |
|
} |
1036 |
|
|
1037 |
|
va_end(ap); |
1038 |
|
|
1039 |
|
env->err= errval; |
1040 |
|
return errval; |
1041 |
|
} |