/[cvs]/stack/stack.c
ViewVC logotype

Diff of /stack/stack.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.116 by teddy, Sun Mar 17 12:49:27 2002 UTC revision 1.117 by teddy, Wed Mar 20 05:29:29 2002 UTC
# Line 21  Line 21 
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>
# Line 62  void init_env(environment *env) Line 62  void init_env(environment *env)
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;
# Line 125  value* new_val(environment *env) Line 124  value* new_val(environment *env)
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;
# Line 499  extern void type(environment *env) Line 498  extern void type(environment *env)
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("[]");
# Line 525  void print_val(value *val, int noquote) Line 527  void print_val(value *val, int noquote)
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    }    }
# Line 551  extern void print_(environment *env) Line 588  extern void print_(environment *env)
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    
# Line 570  extern void princ_(environment *env) Line 607  extern void princ_(environment *env)
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. */
# Line 587  void print_st(value *stack_head, long co Line 624  void print_st(value *stack_head, long co
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    
# Line 764  extern void rev(environment *env) Line 801  extern void rev(environment *env)
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);
# Line 780  extern void pack(environment *env) Line 816  extern void pack(environment *env)
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

Legend:
Removed from v.1.116  
changed lines
  Added in v.1.117

root@recompile.se
ViewVC Help
Powered by ViewVC 1.1.26