218 |
switch (val->type){ /* and free the contents if necessary */ |
switch (val->type){ /* and free the contents if necessary */ |
219 |
case string: |
case string: |
220 |
free(val->content.ptr); |
free(val->content.ptr); |
221 |
|
break; |
222 |
case list: /* lists needs to be freed recursively */ |
case list: /* lists needs to be freed recursively */ |
223 |
item=val->content.ptr; |
item=val->content.ptr; |
224 |
while(item != NULL) { /* for all stack items */ |
while(item != NULL) { /* for all stack items */ |
241 |
stackitem *temp= env->head; |
stackitem *temp= env->head; |
242 |
|
|
243 |
if((env->head)==NULL) { |
if((env->head)==NULL) { |
244 |
printerr("Stack empty"); |
printerr("Too Few Arguments"); |
245 |
env->err=1; |
env->err=1; |
246 |
return; |
return; |
247 |
} |
} |
257 |
printf("\n"); |
printf("\n"); |
258 |
} |
} |
259 |
|
|
260 |
|
/* Gets the type of a value */ |
261 |
|
extern void type(environment *env){ |
262 |
|
int typenum; |
263 |
|
|
264 |
|
if((env->head)==NULL) { |
265 |
|
printerr("Too Few Arguments"); |
266 |
|
env->err=1; |
267 |
|
return; |
268 |
|
} |
269 |
|
typenum=env->head->item->type; |
270 |
|
toss(env); |
271 |
|
switch(typenum){ |
272 |
|
case integer: |
273 |
|
push_sym(env, "integer"); |
274 |
|
break; |
275 |
|
case string: |
276 |
|
push_sym(env, "string"); |
277 |
|
break; |
278 |
|
case symb: |
279 |
|
push_sym(env, "symbol"); |
280 |
|
break; |
281 |
|
case func: |
282 |
|
push_sym(env, "function"); |
283 |
|
break; |
284 |
|
case list: |
285 |
|
push_sym(env, "list"); |
286 |
|
break; |
287 |
|
default: |
288 |
|
push_sym(env, "unknown"); |
289 |
|
break; |
290 |
|
} |
291 |
|
} |
292 |
|
|
293 |
/* Prints the top element of the stack. */ |
/* Prints the top element of the stack. */ |
294 |
void print_h(stackitem *stack_head) |
void print_h(stackitem *stack_head) |
295 |
{ |
{ |
307 |
printf("#<function %p>", (funcp)(stack_head->item->content.ptr)); |
printf("#<function %p>", (funcp)(stack_head->item->content.ptr)); |
308 |
break; |
break; |
309 |
case list: |
case list: |
310 |
printf("#<list %p>", (funcp)(stack_head->item->content.ptr)); |
/* A list is just a stack, so make stack_head point to it */ |
311 |
|
stack_head=(stackitem *)(stack_head->item->content.ptr); |
312 |
|
printf("[ "); |
313 |
|
while(stack_head != NULL) { |
314 |
|
print_h(stack_head); |
315 |
|
printf(" "); |
316 |
|
stack_head=stack_head->next; |
317 |
|
} |
318 |
|
printf("]"); |
319 |
break; |
break; |
320 |
default: |
default: |
321 |
printf("#<unknown %p>", (funcp)(stack_head->item->content.ptr)); |
printf("#<unknown %p>", (stack_head->item->content.ptr)); |
322 |
break; |
break; |
323 |
} |
} |
324 |
} |
} |
325 |
|
|
326 |
extern void print_(environment *env) { |
extern void print_(environment *env) { |
327 |
if(env->head==NULL) { |
if(env->head==NULL) { |
328 |
printerr("Stack empty"); |
printerr("Too Few Arguments"); |
329 |
env->err=1; |
env->err=1; |
330 |
return; |
return; |
331 |
} |
} |
356 |
extern void printstack(environment *env) |
extern void printstack(environment *env) |
357 |
{ |
{ |
358 |
if(env->head == NULL) { |
if(env->head == NULL) { |
|
printerr("Stack empty"); |
|
|
env->err=1; |
|
359 |
return; |
return; |
360 |
} |
} |
361 |
print_st(env->head, 1); |
print_st(env->head, 1); |
368 |
stackitem *temp= env->head; |
stackitem *temp= env->head; |
369 |
|
|
370 |
if((env->head)==NULL) { |
if((env->head)==NULL) { |
371 |
printerr("Stack empty"); |
printerr("Too Few Arguments"); |
372 |
env->err=1; |
env->err=1; |
373 |
return; |
return; |
374 |
} |
} |
375 |
|
|
376 |
if(env->head->next==NULL) { |
if(env->head->next==NULL) { |
377 |
printerr("Not enough arguments"); |
printerr("Too Few Arguments"); |
378 |
env->err=1; |
env->err=1; |
379 |
return; |
return; |
380 |
} |
} |
400 |
value *val; |
value *val; |
401 |
|
|
402 |
if(env->head == NULL) { |
if(env->head == NULL) { |
403 |
printerr("Stack empty"); |
printerr("Too Few Arguments"); |
404 |
env->err=1; |
env->err=1; |
405 |
return; |
return; |
406 |
} |
} |
407 |
|
|
408 |
if(env->head->item->type!=symb) { |
if(env->head->item->type!=symb) { |
409 |
printerr("Not a symbol"); |
printerr("Bad Argument Type"); |
410 |
env->err=1; |
env->err=2; |
411 |
return; |
return; |
412 |
} |
} |
413 |
|
|
414 |
val=((symbol *)(env->head->item->content.ptr))->val; |
val=((symbol *)(env->head->item->content.ptr))->val; |
415 |
if(val == NULL){ |
if(val == NULL){ |
416 |
printerr("Unbound variable"); |
printerr("Unbound Variable"); |
417 |
env->err=1; |
env->err=3; |
418 |
return; |
return; |
419 |
} |
} |
420 |
toss(env); /* toss the symbol */ |
toss(env); /* toss the symbol */ |
429 |
{ |
{ |
430 |
funcp in_func; |
funcp in_func; |
431 |
if(env->head==NULL) { |
if(env->head==NULL) { |
432 |
printerr("Stack empty"); |
printerr("Too Few Arguments"); |
433 |
env->err=1; |
env->err=1; |
434 |
return; |
return; |
435 |
} |
} |
497 |
} |
} |
498 |
|
|
499 |
/* Parse input. */ |
/* Parse input. */ |
500 |
int stack_read(environment *env, char *in_line) |
void stack_read(environment *env, char *in_line) |
501 |
{ |
{ |
502 |
char *temp, *rest; |
char *temp, *rest; |
503 |
int itemp; |
int itemp; |
558 |
} |
} |
559 |
} while(0); |
} while(0); |
560 |
|
|
|
|
|
561 |
free(temp); |
free(temp); |
562 |
|
|
563 |
if(convert<2) { |
if(convert<2) { |
564 |
free(rest); |
free(rest); |
565 |
return 0; |
return; |
566 |
} |
} |
567 |
|
|
568 |
stack_read(env, rest); |
stack_read(env, rest); |
569 |
|
|
570 |
free(rest); |
free(rest); |
|
return 1; |
|
571 |
} |
} |
572 |
|
|
573 |
/* Relocate elements of the list on the stack. */ |
/* Relocate elements of the list on the stack. */ |
576 |
stackitem *temp, *new_head; |
stackitem *temp, *new_head; |
577 |
|
|
578 |
/* Is top element a list? */ |
/* Is top element a list? */ |
579 |
if(env->head==NULL || env->head->item->type!=list) { |
if(env->head==NULL) { |
580 |
printerr("Stack empty or not a list"); |
printerr("Too Few Arguments"); |
581 |
env->err=1; |
env->err=1; |
582 |
return; |
return; |
583 |
} |
} |
584 |
|
if(env->head->item->type!=list) { |
585 |
|
printerr("Bad Argument Type"); |
586 |
|
env->err=2; |
587 |
|
return; |
588 |
|
} |
589 |
|
|
590 |
/* The first list element is the new stack head */ |
/* The first list element is the new stack head */ |
591 |
new_head= temp= env->head->item->content.ptr; |
new_head= temp= env->head->item->content.ptr; |
603 |
|
|
604 |
} |
} |
605 |
|
|
606 |
|
/* Reverse a list */ |
607 |
|
extern void rev(environment *env){ |
608 |
|
stackitem *old_head, *new_head, *item; |
609 |
|
|
610 |
|
if((env->head)==NULL) { |
611 |
|
printerr("Too Few Arguments"); |
612 |
|
env->err=1; |
613 |
|
return; |
614 |
|
} |
615 |
|
|
616 |
|
if(env->head->item->type!=list) { |
617 |
|
printerr("Bad Argument Type"); |
618 |
|
env->err=2; |
619 |
|
return; |
620 |
|
} |
621 |
|
|
622 |
|
old_head=(stackitem *)(env->head->item->content.ptr); |
623 |
|
new_head=NULL; |
624 |
|
while(old_head != NULL){ |
625 |
|
item=old_head; |
626 |
|
old_head=old_head->next; |
627 |
|
item->next=new_head; |
628 |
|
new_head=item; |
629 |
|
} |
630 |
|
env->head->item->content.ptr=new_head; |
631 |
|
} |
632 |
|
|
633 |
/* Compares two elements by reference. */ |
/* Compares two elements by reference. */ |
634 |
extern void eq(environment *env) |
extern void eq(environment *env) |
635 |
{ |
{ |
637 |
int result; |
int result; |
638 |
|
|
639 |
if((env->head)==NULL || env->head->next==NULL) { |
if((env->head)==NULL || env->head->next==NULL) { |
640 |
printerr("Not enough elements to compare"); |
printerr("Too Few Arguments"); |
641 |
env->err=1; |
env->err=1; |
642 |
return; |
return; |
643 |
} |
} |
656 |
{ |
{ |
657 |
int val; |
int val; |
658 |
|
|
659 |
if((env->head)==NULL || env->head->item->type!=integer) { |
if((env->head)==NULL) { |
660 |
printerr("Stack empty or element is not a integer"); |
printerr("Too Few Arguments"); |
661 |
env->err=1; |
env->err=1; |
662 |
return; |
return; |
663 |
} |
} |
664 |
|
|
665 |
|
if(env->head->item->type!=integer) { |
666 |
|
printerr("Bad Argument Type"); |
667 |
|
env->err=2; |
668 |
|
return; |
669 |
|
} |
670 |
|
|
671 |
val= env->head->item->content.val; |
val= env->head->item->content.val; |
672 |
toss(env); |
toss(env); |
673 |
push_int(&(env->head), !val); |
push_int(&(env->head), !val); |
687 |
symbol *sym; |
symbol *sym; |
688 |
|
|
689 |
/* 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 */ |
690 |
if(env->head==NULL || env->head->next==NULL |
if(env->head==NULL || env->head->next==NULL) { |
691 |
|| env->head->item->type!=symb) { |
printerr("Too Few Arguments"); |
|
printerr("Define what?"); |
|
692 |
env->err=1; |
env->err=1; |
693 |
return; |
return; |
694 |
} |
} |
695 |
|
|
696 |
|
if(env->head->item->type!=symb) { |
697 |
|
printerr("Bad Argument Type"); |
698 |
|
env->err=2; |
699 |
|
return; |
700 |
|
} |
701 |
|
|
702 |
/* long names are a pain */ |
/* long names are a pain */ |
703 |
sym=env->head->item->content.ptr; |
sym=env->head->item->content.ptr; |
704 |
|
|
748 |
stackitem *stack_head= env->head; |
stackitem *stack_head= env->head; |
749 |
symbol **hash_entry, *temp; |
symbol **hash_entry, *temp; |
750 |
|
|
751 |
if(stack_head==NULL || stack_head->item->type!=symb) { |
if(stack_head==NULL) { |
752 |
printerr("Stack empty or not a symbol"); |
printerr("Too Few Arguments"); |
753 |
|
env->err=1; |
754 |
|
return; |
755 |
|
} |
756 |
|
|
757 |
|
if(stack_head->item->type!=symb) { |
758 |
|
printerr("Bad Argument Type"); |
759 |
|
env->err=2; |
760 |
return; |
return; |
761 |
} |
} |
762 |
|
|
772 |
} |
} |
773 |
free(temp->id); |
free(temp->id); |
774 |
free(temp); |
free(temp); |
775 |
} |
} |
776 |
|
|
777 |
|
/* Returns the current error number to the stack */ |
778 |
|
extern void errn(environment *env){ |
779 |
|
push_int(&(env->head), env->err); |
780 |
|
} |
781 |
|
|
782 |
int main() |
int main() |
783 |
{ |
{ |