50 |
} |
} |
51 |
|
|
52 |
|
|
53 |
void printerr(const char* in_string) |
void printerr(environment *env, const char* in_string) |
54 |
{ |
{ |
55 |
fprintf(stderr, "Err: %s\n", in_string); |
fprintf(stderr, "\"%s\":\nErr: %s\n", env->errsymb, in_string); |
56 |
} |
} |
57 |
|
|
58 |
|
|
167 |
break; |
break; |
168 |
case port: |
case port: |
169 |
case empty: |
case empty: |
170 |
|
case unknown: |
171 |
case integer: |
case integer: |
172 |
case tfloat: |
case tfloat: |
173 |
case func: |
case func: |
365 |
char *mangled; /* Mangled function name */ |
char *mangled; /* Mangled function name */ |
366 |
|
|
367 |
new_value= new_val(env); |
new_value= new_val(env); |
|
protect(new_value); |
|
368 |
new_fvalue= new_val(env); |
new_fvalue= new_val(env); |
|
protect(new_fvalue); |
|
369 |
|
|
370 |
/* The new value is a symbol */ |
/* The new value is a symbol */ |
371 |
new_value->type= symb; |
new_value->type= symb; |
413 |
} |
} |
414 |
|
|
415 |
push_val(env, new_value); |
push_val(env, new_value); |
|
unprotect(new_value); unprotect(new_fvalue); |
|
416 |
} |
} |
417 |
|
|
418 |
|
|
431 |
return; |
return; |
432 |
} |
} |
433 |
break; |
break; |
434 |
|
case unknown: |
435 |
|
if(fprintf(stream, "UNKNOWN") < 0){ |
436 |
|
perror("print_val"); |
437 |
|
env->err= 5; |
438 |
|
return; |
439 |
|
} |
440 |
|
break; |
441 |
case integer: |
case integer: |
442 |
if(fprintf(stream, "%d", val->content.i) < 0){ |
if(fprintf(stream, "%d", val->content.i) < 0){ |
443 |
perror("print_val"); |
perror("print_val"); |
585 |
extern void swap(environment *env) |
extern void swap(environment *env) |
586 |
{ |
{ |
587 |
value *temp= env->head; |
value *temp= env->head; |
588 |
|
|
589 |
if(env->head->type == empty || CDR(env->head)->type == empty) { |
switch(check_args(env, unknown, unknown, empty)) { |
590 |
printerr("Too Few Arguments"); |
case 1: |
591 |
env->err=1; |
printerr(env, "Too Few Arguments"); |
592 |
|
return; |
593 |
|
case 2: |
594 |
|
printerr(env, "Bad Argument Type"); |
595 |
return; |
return; |
596 |
|
default: |
597 |
|
break; |
598 |
} |
} |
599 |
|
|
600 |
env->head= CDR(env->head); |
env->head= CDR(env->head); |
601 |
CDR(temp)= CDR(env->head); |
CDR(temp)= CDR(env->head); |
602 |
CDR(env->head)= temp; |
CDR(env->head)= temp; |
608 |
{ |
{ |
609 |
value *val; |
value *val; |
610 |
|
|
611 |
if(env->head->type==empty) { |
switch(check_args(env, symb, empty)) { |
612 |
printerr("Too Few Arguments"); |
case 1: |
613 |
env->err= 1; |
printerr(env, "Too Few Arguments"); |
614 |
return; |
return; |
615 |
} |
case 2: |
616 |
|
printerr(env, "Bad Argument Type"); |
|
if(CAR(env->head)->type!=symb) { |
|
|
printerr("Bad Argument Type"); |
|
|
env->err= 2; |
|
617 |
return; |
return; |
618 |
|
default: |
619 |
|
break; |
620 |
} |
} |
621 |
|
|
622 |
val= CAR(env->head)->content.sym->val; |
val= CAR(env->head)->content.sym->val; |
623 |
if(val == NULL){ |
if(val == NULL){ |
624 |
printerr("Unbound Variable"); |
printerr(env, "Unbound Variable"); |
625 |
env->err= 3; |
env->err= 3; |
626 |
return; |
return; |
627 |
} |
} |
645 |
|
|
646 |
gc_maybe(env); |
gc_maybe(env); |
647 |
|
|
648 |
if(env->head->type==empty) { |
switch(check_args(env, unknown, empty)) { |
649 |
printerr("Too Few Arguments"); |
case 1: |
650 |
env->err= 1; |
printerr(env, "Too Few Arguments"); |
651 |
return; |
return; |
652 |
|
case 2: |
653 |
|
printerr(env, "Bad Argument Type"); |
654 |
|
return; |
655 |
|
default: |
656 |
|
break; |
657 |
} |
} |
658 |
|
|
659 |
switch(CAR(env->head)->type) { |
switch(CAR(env->head)->type) { |
660 |
/* if it's a symbol */ |
/* if it's a symbol */ |
661 |
case symb: |
case symb: |
662 |
|
env->errsymb= CAR(env->head)->content.sym->id; |
663 |
rcl(env); /* get its contents */ |
rcl(env); /* get its contents */ |
664 |
if(env->err) return; |
if(env->err) return; |
665 |
if(CAR(env->head)->type!=symb){ /* don't recurse symbols */ |
if(CAR(env->head)->type!=symb){ /* don't recurse symbols */ |
697 |
if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons) |
if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons) |
698 |
iterator= CDR(iterator); |
iterator= CDR(iterator); |
699 |
else { |
else { |
700 |
printerr("Bad Argument Type"); /* Improper list */ |
printerr(env, "Bad Argument Type"); /* Improper list */ |
701 |
env->err= 2; |
env->err= 2; |
702 |
return; |
return; |
703 |
} |
} |
711 |
case tfloat: |
case tfloat: |
712 |
case string: |
case string: |
713 |
case port: |
case port: |
714 |
|
case unknown: |
715 |
return; |
return; |
716 |
} |
} |
717 |
} |
} |
768 |
} |
} |
769 |
|
|
770 |
if(myenv.interactive) |
if(myenv.interactive) |
771 |
printf(start_message); |
puts(start_message); |
772 |
|
|
773 |
while(1) { |
while(1) { |
774 |
if(myenv.in_string==NULL) { |
if(myenv.in_string==NULL) { |
819 |
case func: |
case func: |
820 |
case symb: |
case symb: |
821 |
case empty: |
case empty: |
822 |
|
case unknown: |
823 |
case port: |
case port: |
824 |
new_value->content= old_value->content; |
new_value->content= old_value->content; |
825 |
break; |
break; |
863 |
{ |
{ |
864 |
value *old_head, *new_head, *item; |
value *old_head, *new_head, *item; |
865 |
|
|
|
if(env->head->type==empty) { |
|
|
printerr("Too Few Arguments"); |
|
|
env->err= 1; |
|
|
return; |
|
|
} |
|
|
|
|
866 |
if(CAR(env->head)->type==empty) |
if(CAR(env->head)->type==empty) |
867 |
return; /* Don't reverse an empty list */ |
return; /* Don't reverse an empty list */ |
868 |
|
|
869 |
if(CAR(env->head)->type!=tcons) { |
switch(check_args(env, tcons, empty)) { |
870 |
printerr("Bad Argument Type"); |
case 1: |
871 |
env->err= 2; |
printerr(env, "Too Few Arguments"); |
872 |
|
return; |
873 |
|
case 2: |
874 |
|
printerr(env, "Bad Argument Type"); |
875 |
return; |
return; |
876 |
|
default: |
877 |
|
break; |
878 |
} |
} |
879 |
|
|
880 |
old_head= CAR(env->head); |
old_head= CAR(env->head); |
1012 |
if(depth) |
if(depth) |
1013 |
return readstream(env, env->inputstream); |
return readstream(env, env->inputstream); |
1014 |
} |
} |
1015 |
|
|
1016 |
|
|
1017 |
|
int check_args(environment *env, ...) |
1018 |
|
{ |
1019 |
|
va_list ap; |
1020 |
|
enum type_enum mytype; |
1021 |
|
|
1022 |
|
value *iter= env->head; |
1023 |
|
int errval= 0; |
1024 |
|
|
1025 |
|
va_start(ap, env); |
1026 |
|
while(1) { |
1027 |
|
mytype= va_arg(ap, enum type_enum); |
1028 |
|
// fprintf(stderr, "%s\n", env->errsymb); |
1029 |
|
|
1030 |
|
if(mytype==empty) |
1031 |
|
break; |
1032 |
|
|
1033 |
|
if(iter->type==empty || iter==NULL) { |
1034 |
|
errval= 1; |
1035 |
|
break; |
1036 |
|
} |
1037 |
|
|
1038 |
|
if(mytype==unknown) { |
1039 |
|
iter=CDR(iter); |
1040 |
|
continue; |
1041 |
|
} |
1042 |
|
|
1043 |
|
if(CAR(iter)->type!=mytype) { |
1044 |
|
errval= 2; |
1045 |
|
break; |
1046 |
|
} |
1047 |
|
|
1048 |
|
iter= CDR(iter); |
1049 |
|
} |
1050 |
|
|
1051 |
|
va_end(ap); |
1052 |
|
|
1053 |
|
env->err= errval; |
1054 |
|
return errval; |
1055 |
|
} |