| 21 |
Teddy Hogeborn <teddy@fukt.bth.se> |
Teddy Hogeborn <teddy@fukt.bth.se> |
| 22 |
*/ |
*/ |
| 23 |
|
|
| 24 |
#define CAR(X) (X->content.c->car) |
#define CAR(X) ((X)->content.c->car) |
| 25 |
#define CDR(X) (X->content.c->cdr) |
#define CDR(X) ((X)->content.c->cdr) |
| 26 |
|
|
| 27 |
/* printf, sscanf, fgets, fprintf, fopen, perror */ |
/* printf, sscanf, fgets, fprintf, fopen, perror */ |
| 28 |
#include <stdio.h> |
#include <stdio.h> |
| 62 |
env->gc_ref= NULL; |
env->gc_ref= NULL; |
| 63 |
|
|
| 64 |
env->head= new_val(env); |
env->head= new_val(env); |
|
env->head->type= empty; |
|
| 65 |
for(i= 0; i<HASHTBLSIZE; i++) |
for(i= 0; i<HASHTBLSIZE; i++) |
| 66 |
env->symbols[i]= NULL; |
env->symbols[i]= NULL; |
| 67 |
env->err= 0; |
env->err= 0; |
| 124 |
stackitem *nitem= malloc(sizeof(stackitem)); |
stackitem *nitem= malloc(sizeof(stackitem)); |
| 125 |
|
|
| 126 |
nval->content.ptr= NULL; |
nval->content.ptr= NULL; |
| 127 |
nval->type= integer; |
nval->type= empty; |
| 128 |
|
|
| 129 |
nitem->item= nval; |
nitem->item= nval; |
| 130 |
nitem->next= env->gc_ref; |
nitem->next= env->gc_ref; |
| 498 |
} |
} |
| 499 |
|
|
| 500 |
/* Print a value */ |
/* Print a value */ |
| 501 |
void print_val(value *val, int noquote) |
void print_val(value *val, int noquote, stackitem *stack) |
| 502 |
{ |
{ |
| 503 |
|
stackitem *titem, *tstack; |
| 504 |
|
int depth; |
| 505 |
|
|
| 506 |
switch(val->type) { |
switch(val->type) { |
| 507 |
case empty: |
case empty: |
| 508 |
printf("[]"); |
printf("[]"); |
| 527 |
break; |
break; |
| 528 |
case tcons: |
case tcons: |
| 529 |
printf("[ "); |
printf("[ "); |
| 530 |
|
tstack= stack; |
| 531 |
do { |
do { |
| 532 |
print_val(CAR(val), noquote); |
titem=malloc(sizeof(stackitem)); |
| 533 |
|
titem->item=val; |
| 534 |
|
titem->next=tstack; |
| 535 |
|
tstack=titem; /* Put it on the stack */ |
| 536 |
|
/* Search a stack of values being printed to see if we are already |
| 537 |
|
printing this value */ |
| 538 |
|
titem=tstack; |
| 539 |
|
depth=0; |
| 540 |
|
while(titem != NULL && titem->item != CAR(val)){ |
| 541 |
|
titem=titem->next; |
| 542 |
|
depth++; |
| 543 |
|
} |
| 544 |
|
if(titem != NULL){ /* If we found it on the stack, */ |
| 545 |
|
printf("#%d#", depth); /* print a depth reference */ |
| 546 |
|
} else { |
| 547 |
|
print_val(CAR(val), noquote, tstack); |
| 548 |
|
} |
| 549 |
val= CDR(val); |
val= CDR(val); |
| 550 |
switch(val->type){ |
switch(val->type){ |
| 551 |
case empty: |
case empty: |
| 552 |
break; |
break; |
| 553 |
case tcons: |
case tcons: |
| 554 |
printf(" "); |
/* Search a stack of values being printed to see if we are already |
| 555 |
|
printing this value */ |
| 556 |
|
titem=tstack; |
| 557 |
|
depth=0; |
| 558 |
|
while(titem != NULL && titem->item != val){ |
| 559 |
|
titem=titem->next; |
| 560 |
|
depth++; |
| 561 |
|
} |
| 562 |
|
if(titem != NULL){ /* If we found it on the stack, */ |
| 563 |
|
printf(" . #%d#", depth); /* print a depth reference */ |
| 564 |
|
} else { |
| 565 |
|
printf(" "); |
| 566 |
|
} |
| 567 |
break; |
break; |
| 568 |
default: |
default: |
| 569 |
printf(" . "); /* Improper list */ |
printf(" . "); /* Improper list */ |
| 570 |
print_val(val, noquote); |
print_val(val, noquote, tstack); |
| 571 |
} |
} |
| 572 |
} while(val->type == tcons); |
} while(val->type == tcons && titem == NULL); |
| 573 |
|
titem=tstack; |
| 574 |
|
while(titem != stack){ |
| 575 |
|
tstack=titem->next; |
| 576 |
|
free(titem); |
| 577 |
|
titem=tstack; |
| 578 |
|
} |
| 579 |
printf(" ]"); |
printf(" ]"); |
| 580 |
break; |
break; |
| 581 |
} |
} |
| 588 |
env->err= 1; |
env->err= 1; |
| 589 |
return; |
return; |
| 590 |
} |
} |
| 591 |
print_val(CAR(env->head), 0); |
print_val(CAR(env->head), 0, NULL); |
| 592 |
nl(); |
nl(); |
| 593 |
} |
} |
| 594 |
|
|
| 607 |
env->err= 1; |
env->err= 1; |
| 608 |
return; |
return; |
| 609 |
} |
} |
| 610 |
print_val(CAR(env->head), 1); |
print_val(CAR(env->head), 1, NULL); |
| 611 |
} |
} |
| 612 |
|
|
| 613 |
/* Prints the top element of the stack and then discards it. */ |
/* Prints the top element of the stack and then discards it. */ |
| 624 |
if(CDR(stack_head)->type != empty) |
if(CDR(stack_head)->type != empty) |
| 625 |
print_st(CDR(stack_head), counter+1); |
print_st(CDR(stack_head), counter+1); |
| 626 |
printf("%ld: ", counter); |
printf("%ld: ", counter); |
| 627 |
print_val(CAR(stack_head), 0); |
print_val(CAR(stack_head), 0, NULL); |
| 628 |
nl(); |
nl(); |
| 629 |
} |
} |
| 630 |
|
|
| 801 |
|
|
| 802 |
old_head= CAR(env->head); |
old_head= CAR(env->head); |
| 803 |
new_head= new_val(env); |
new_head= new_val(env); |
|
new_head->type= empty; |
|
| 804 |
while(old_head->type != empty) { |
while(old_head->type != empty) { |
| 805 |
item= old_head; |
item= old_head; |
| 806 |
old_head= CDR(old_head); |
old_head= CDR(old_head); |
| 816 |
value *iterator, *temp, *ending; |
value *iterator, *temp, *ending; |
| 817 |
|
|
| 818 |
ending=new_val(env); |
ending=new_val(env); |
|
ending->type=empty; |
|
| 819 |
|
|
| 820 |
iterator= env->head; |
iterator= env->head; |
| 821 |
if(iterator->type == empty |
if(iterator->type == empty |