60 |
int err; /* Error flag */ |
int err; /* Error flag */ |
61 |
int non_eval_flag; |
int non_eval_flag; |
62 |
char *in_string; /* Input pending to be read */ |
char *in_string; /* Input pending to be read */ |
63 |
|
char *free_string; /* Free this string when all input is |
64 |
|
read from in_string */ |
65 |
} environment; |
} environment; |
66 |
|
|
67 |
/* A type for pointers to external functions */ |
/* A type for pointers to external functions */ |
340 |
} |
} |
341 |
|
|
342 |
/* Prints the top element of the stack. */ |
/* Prints the top element of the stack. */ |
343 |
void print_h(stackitem *stack_head) |
void print_h(stackitem *stack_head, int noquote) |
344 |
{ |
{ |
345 |
switch(stack_head->item->type) { |
switch(stack_head->item->type) { |
346 |
case integer: |
case integer: |
347 |
printf("%d", stack_head->item->content.val); |
printf("%d", stack_head->item->content.val); |
348 |
break; |
break; |
349 |
case string: |
case string: |
350 |
printf("%s", (char*)stack_head->item->content.ptr); |
if(noquote) |
351 |
|
printf("%s", (char*)stack_head->item->content.ptr); |
352 |
|
else |
353 |
|
printf("\"%s\"", (char*)stack_head->item->content.ptr); |
354 |
break; |
break; |
355 |
case symb: |
case symb: |
356 |
printf("%s", ((symbol *)(stack_head->item->content.ptr))->id); |
printf("%s", ((symbol *)(stack_head->item->content.ptr))->id); |
363 |
stack_head=(stackitem *)(stack_head->item->content.ptr); |
stack_head=(stackitem *)(stack_head->item->content.ptr); |
364 |
printf("[ "); |
printf("[ "); |
365 |
while(stack_head != NULL) { |
while(stack_head != NULL) { |
366 |
print_h(stack_head); |
print_h(stack_head, noquote); |
367 |
printf(" "); |
printf(" "); |
368 |
stack_head=stack_head->next; |
stack_head=stack_head->next; |
369 |
} |
} |
378 |
env->err=1; |
env->err=1; |
379 |
return; |
return; |
380 |
} |
} |
381 |
print_h(env->head); |
print_h(env->head, 0); |
382 |
|
nl(); |
383 |
} |
} |
384 |
|
|
385 |
/* Prints the top element of the stack and then discards it. */ |
/* Prints the top element of the stack and then discards it. */ |
390 |
toss(env); |
toss(env); |
391 |
} |
} |
392 |
|
|
393 |
|
extern void princ_(environment *env) { |
394 |
|
if(env->head==NULL) { |
395 |
|
printerr("Too Few Arguments"); |
396 |
|
env->err=1; |
397 |
|
return; |
398 |
|
} |
399 |
|
print_h(env->head, 1); |
400 |
|
} |
401 |
|
|
402 |
|
/* Prints the top element of the stack and then discards it. */ |
403 |
|
extern void princ(environment *env) |
404 |
|
{ |
405 |
|
princ_(env); |
406 |
|
if(env->err) return; |
407 |
|
toss(env); |
408 |
|
} |
409 |
|
|
410 |
/* Only to be called by function printstack. */ |
/* Only to be called by function printstack. */ |
411 |
void print_st(stackitem *stack_head, long counter) |
void print_st(stackitem *stack_head, long counter) |
412 |
{ |
{ |
413 |
if(stack_head->next != NULL) |
if(stack_head->next != NULL) |
414 |
print_st(stack_head->next, counter+1); |
print_st(stack_head->next, counter+1); |
415 |
printf("%ld: ", counter); |
printf("%ld: ", counter); |
416 |
print_h(stack_head); |
print_h(stack_head, 0); |
417 |
nl(); |
nl(); |
418 |
} |
} |
419 |
|
|
421 |
extern void printstack(environment *env) |
extern void printstack(environment *env) |
422 |
{ |
{ |
423 |
if(env->head == NULL) { |
if(env->head == NULL) { |
424 |
|
printf("Stack Empty\n"); |
425 |
return; |
return; |
426 |
} |
} |
427 |
print_st(env->head, 1); |
print_st(env->head, 1); |
|
nl(); |
|
428 |
} |
} |
429 |
|
|
430 |
/* Swap the two top elements on the stack. */ |
/* Swap the two top elements on the stack. */ |
497 |
value* temp_val; |
value* temp_val; |
498 |
stackitem* iterator; |
stackitem* iterator; |
499 |
|
|
500 |
|
eval_start: |
501 |
|
|
502 |
if(env->head==NULL) { |
if(env->head==NULL) { |
503 |
printerr("Too Few Arguments"); |
printerr("Too Few Arguments"); |
504 |
env->err=1; |
env->err=1; |
505 |
return; |
return; |
506 |
} |
} |
507 |
|
|
|
eval_start: |
|
|
|
|
508 |
switch(env->head->item->type) { |
switch(env->head->item->type) { |
509 |
/* if it's a symbol */ |
/* if it's a symbol */ |
510 |
case symb: |
case symb: |
554 |
|
|
555 |
/* Reverse (flip) a list */ |
/* Reverse (flip) a list */ |
556 |
extern void rev(environment *env){ |
extern void rev(environment *env){ |
557 |
stackitem *item, *temp, *prev= NULL; |
stackitem *old_head, *new_head, *item; |
558 |
|
|
559 |
if((env->head)==NULL) { |
if((env->head)==NULL) { |
560 |
printerr("Too Few Arguments"); |
printerr("Too Few Arguments"); |
568 |
return; |
return; |
569 |
} |
} |
570 |
|
|
571 |
item= (stackitem *)(env->head->item->content.ptr); |
old_head=(stackitem *)(env->head->item->content.ptr); |
572 |
while(item->next!=NULL){ |
new_head=NULL; |
573 |
temp= item->next; |
while(old_head != NULL){ |
574 |
item->next= prev; |
item=old_head; |
575 |
prev= item; |
old_head=old_head->next; |
576 |
item= temp; |
item->next=new_head; |
577 |
|
new_head=item; |
578 |
} |
} |
579 |
item->next= prev; |
env->head->item->content.ptr=new_head; |
|
|
|
|
env->head->item->content.ptr=item; |
|
580 |
} |
} |
581 |
|
|
582 |
/* Make a list. */ |
/* Make a list. */ |
750 |
clear(env); |
clear(env); |
751 |
if (env->err) return; |
if (env->err) return; |
752 |
for(i= 0; i<HASHTBLSIZE; i++) { |
for(i= 0; i<HASHTBLSIZE; i++) { |
753 |
if (env->symbols[i]!= NULL) { |
while(env->symbols[i]!= NULL) { |
754 |
forget_sym(&(env->symbols[i])); |
forget_sym(&(env->symbols[i])); |
|
env->symbols[i]= NULL; |
|
755 |
} |
} |
756 |
|
env->symbols[i]= NULL; |
757 |
} |
} |
758 |
exit(EXIT_SUCCESS); |
exit(EXIT_SUCCESS); |
759 |
} |
} |
832 |
init_env(&myenv); |
init_env(&myenv); |
833 |
|
|
834 |
while(1) { |
while(1) { |
835 |
if(myenv.in_string==NULL) |
if(myenv.in_string==NULL) { |
836 |
|
nl(); |
837 |
printstack(&myenv); |
printstack(&myenv); |
838 |
|
printf("> "); |
839 |
|
} |
840 |
read(&myenv); |
read(&myenv); |
841 |
if(myenv.err) { |
if(myenv.err) { |
842 |
printf("(error %d) ", myenv.err); |
printf("(error %d) ", myenv.err); |
1220 |
|
|
1221 |
/* Read a value and place on stack */ |
/* Read a value and place on stack */ |
1222 |
extern void read(environment *env) { |
extern void read(environment *env) { |
1223 |
const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%[\001-\377]"; |
const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%n"; |
1224 |
const char strform[]= "\"%[^\"]\"%[\001-\377]"; |
const char strform[]= "\"%[^\"]\"%n"; |
1225 |
const char intform[]= "%i%[\001-\377]"; |
const char intform[]= "%i%n"; |
1226 |
const char blankform[]= "%*[ \t]%[\001-\377]"; |
const char blankform[]= "%*[ \t]%n"; |
1227 |
const char ebrackform[]= "%*1[]]%[\001-\377]"; |
const char ebrackform[]= "%*1[]]%n"; |
1228 |
const char semicform[]= "%*1[;]%[\001-\377]"; |
const char semicform[]= "%*1[;]%n"; |
1229 |
const char bbrackform[]= "%*1[[]%[\001-\377]"; |
const char bbrackform[]= "%*1[[]%n"; |
1230 |
|
|
1231 |
int itemp; |
int itemp, readlength= -1; |
1232 |
static int depth= 0; |
static int depth= 0; |
1233 |
char *rest, *match; |
char *rest, *match; |
1234 |
size_t inlength; |
size_t inlength; |
1235 |
|
|
1236 |
if(env->in_string==NULL) { |
if(env->in_string==NULL) { |
1237 |
|
if(depth > 0) { |
1238 |
|
printf("]> "); |
1239 |
|
} |
1240 |
readline(env); if(env->err) return; |
readline(env); if(env->err) return; |
1241 |
|
|
1242 |
env->in_string= malloc(strlen(env->head->item->content.ptr)+1); |
env->in_string= malloc(strlen(env->head->item->content.ptr)+1); |
1243 |
|
env->free_string= env->in_string; /* Save the original pointer */ |
1244 |
strcpy(env->in_string, env->head->item->content.ptr); |
strcpy(env->in_string, env->head->item->content.ptr); |
1245 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
1246 |
} |
} |
1249 |
match= malloc(inlength); |
match= malloc(inlength); |
1250 |
rest= malloc(inlength); |
rest= malloc(inlength); |
1251 |
|
|
1252 |
if(sscanf(env->in_string, blankform, rest)) { |
if(sscanf(env->in_string, blankform, &readlength)!=EOF |
1253 |
|
&& readlength != -1) { |
1254 |
; |
; |
1255 |
} else if(sscanf(env->in_string, intform, &itemp, rest) > 0) { |
} else if(sscanf(env->in_string, intform, &itemp, &readlength) != EOF |
1256 |
|
&& readlength != -1) { |
1257 |
push_int(env, itemp); |
push_int(env, itemp); |
1258 |
} else if(sscanf(env->in_string, strform, match, rest) > 0) { |
} else if(sscanf(env->in_string, strform, match, &readlength) != EOF |
1259 |
|
&& readlength != -1) { |
1260 |
push_cstring(env, match); |
push_cstring(env, match); |
1261 |
} else if(sscanf(env->in_string, symbform, match, rest) > 0) { |
} else if(sscanf(env->in_string, symbform, match, &readlength) != EOF |
1262 |
|
&& readlength != -1) { |
1263 |
push_sym(env, match); |
push_sym(env, match); |
1264 |
} else if(sscanf(env->in_string, ebrackform, rest) > 0) { |
} else if(sscanf(env->in_string, ebrackform, &readlength) != EOF |
1265 |
|
&& readlength != -1) { |
1266 |
pack(env); if(env->err) return; |
pack(env); if(env->err) return; |
1267 |
if(depth!=0) depth--; |
if(depth != 0) depth--; |
1268 |
} else if(sscanf(env->in_string, semicform, rest) > 0) { |
} else if(sscanf(env->in_string, semicform, &readlength) != EOF |
1269 |
|
&& readlength != -1) { |
1270 |
push_sym(env, ";"); |
push_sym(env, ";"); |
1271 |
} else if(sscanf(env->in_string, bbrackform, rest) > 0) { |
} else if(sscanf(env->in_string, bbrackform, &readlength) != EOF |
1272 |
|
&& readlength != -1) { |
1273 |
push_sym(env, "["); |
push_sym(env, "["); |
1274 |
depth++; |
depth++; |
1275 |
} else { |
} else { |
1276 |
free(rest); |
free(env->free_string); |
1277 |
rest= NULL; |
env->in_string = env->free_string = NULL; |
1278 |
|
free(match); |
1279 |
|
} |
1280 |
|
if ( env->in_string != NULL) { |
1281 |
|
env->in_string += readlength; |
1282 |
} |
} |
|
|
|
|
free(env->in_string); |
|
|
free(match); |
|
|
|
|
|
env->in_string= rest; |
|
1283 |
|
|
1284 |
if(depth) |
if(depth) |
1285 |
return read(env); |
return read(env); |