--- stack/stack.c 2002/03/16 20:09:51 1.112 +++ stack/stack.c 2002/03/17 02:15:01 1.114 @@ -20,8 +20,8 @@ Teddy Hogeborn */ -#define CAR(X) X->content.c->car -#define CDR(X) X->content.c->cdr +#define CAR(X) (X->content.c->car) +#define CDR(X) (X->content.c->cdr) /* printf, sscanf, fgets, fprintf, fopen, perror */ #include @@ -233,7 +233,7 @@ /* Keep values */ env->gc_count += sizeof(value); if(env->gc_ref->item->type==string) - env->gc_count += strlen(env->gc_ref->item->content.ptr); + env->gc_count += strlen(env->gc_ref->item->content.ptr)+1; titem= env->gc_ref->next; env->gc_ref->next= new_head; @@ -476,7 +476,7 @@ push_sym(env, "function"); break; case tcons: - push_sym(env, "list"); + push_sym(env, "pair"); break; } swap(env); @@ -484,38 +484,37 @@ toss(env); } -/* Prints the top element of the stack. */ -void print_h(value *stack_head, int noquote) +/* Print a value */ +void print_val(value *val, int noquote) { - switch(CAR(stack_head)->type) { + switch(val->type) { case empty: printf("[]"); break; case integer: - printf("%d", CAR(stack_head)->content.i); + printf("%d", val->content.i); break; case tfloat: - printf("%f", CAR(stack_head)->content.f); + printf("%f", val->content.f); break; case string: if(noquote) - printf("%s", (char*)(CAR(stack_head)->content.ptr)); + printf("%s", (char*)(val->content.ptr)); else - printf("\"%s\"", (char*)(CAR(stack_head)->content.ptr)); + printf("\"%s\"", (char*)(val->content.ptr)); break; case symb: - printf("%s", CAR(stack_head)->content.sym->id); + printf("%s", val->content.sym->id); break; case func: - printf("#", (funcp)(CAR(stack_head)->content.ptr)); + printf("#", (funcp)(val->content.ptr)); break; case tcons: - /* A list is just a stack, so make stack_head point to it */ - stack_head= CAR(stack_head); printf("[ "); - while(stack_head->type != empty) { - print_h(stack_head, noquote); - switch(CDR(stack_head)->type){ + do { + print_val(CAR(val), noquote); + val= CDR(val); + switch(val->type){ case empty: break; case tcons: @@ -523,9 +522,9 @@ break; default: printf(" . "); /* Improper list */ + print_val(val, noquote); } - stack_head= CDR(stack_head); - } + } while(val->type == tcons); printf(" ]"); break; } @@ -538,7 +537,7 @@ env->err= 1; return; } - print_h(env->head, 0); + print_val(CAR(env->head), 0); nl(); } @@ -557,7 +556,7 @@ env->err= 1; return; } - print_h(env->head, 1); + print_val(CAR(env->head), 1); } /* Prints the top element of the stack and then discards it. */ @@ -574,7 +573,7 @@ if(CDR(stack_head)->type != empty) print_st(CDR(stack_head), counter+1); printf("%ld: ", counter); - print_h(stack_head, 0); + print_val(CAR(stack_head), 0); nl(); } @@ -1050,7 +1049,7 @@ } if(myenv.interactive) { - printf("Stack version $Revision: 1.112 $\n\ + printf("Stack version $Revision: 1.114 $\n\ Copyright (C) 2002 Mats Alritzson and Teddy Hogeborn\n\ Stack comes with ABSOLUTELY NO WARRANTY; for details type 'warranty;'.\n\ This is free software, and you are welcome to redistribute it\n\ @@ -1726,6 +1725,9 @@ } else { push_float(env, ftemp); } + } else if(sscanf(env->in_string, "\"\"%n", &readlength) != EOF + && readlength != -1) { + push_cstring(env, ""); } else if(sscanf(env->in_string, strform, match, &readlength) != EOF && readlength != -1) { push_cstring(env, match); @@ -2281,3 +2283,73 @@ printerr("Bad Argument Type"); env->err= 2; } + +extern void setcar(environment *env) +{ + if(env->head->type==empty || CDR(env->head)->type==empty) { + printerr("Too Few Arguments"); + env->err= 1; + return; + } + + if(CDR(env->head)->type!=tcons) { + printerr("Bad Argument Type"); + env->err= 2; + return; + } + + CAR(CAR(CDR(env->head)))=CAR(env->head); + toss(env); +} + +extern void setcdr(environment *env) +{ + if(env->head->type==empty || CDR(env->head)->type==empty) { + printerr("Too Few Arguments"); + env->err= 1; + return; + } + + if(CDR(env->head)->type!=tcons) { + printerr("Bad Argument Type"); + env->err= 2; + return; + } + + CDR(CAR(CDR(env->head)))=CAR(env->head); + toss(env); +} + +extern void car(environment *env) +{ + if(env->head->type==empty) { + printerr("Too Few Arguments"); + env->err= 1; + return; + } + + if(CAR(env->head)->type!=tcons) { + printerr("Bad Argument Type"); + env->err= 2; + return; + } + + CAR(env->head)=CAR(CAR(env->head)); +} + +extern void cdr(environment *env) +{ + if(env->head->type==empty) { + printerr("Too Few Arguments"); + env->err= 1; + return; + } + + if(CAR(env->head)->type!=tcons) { + printerr("Bad Argument Type"); + env->err= 2; + return; + } + + CAR(env->head)=CDR(CAR(env->head)); +}