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

Diff of /stack/stack.c

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

revision 1.102 by masse, Sun Mar 10 20:08:47 2002 UTC revision 1.103 by teddy, Mon Mar 11 08:52:59 2002 UTC
# Line 78  extern void toss(environment *env) Line 78  extern void toss(environment *env)
78      return;      return;
79    }    }
80        
81    env->head= env->head->cdr->content.c; /* Remove the top stack item */    env->head= env->head->cdr->content.c; /* Remove the top stack item */
82    free(temp);                   /* Free the old top stack item */    free(temp);                   /* Free the old top stack item */
83  }  }
84    
# Line 475  void print_h(cons *stack_head, int noquo Line 475  void print_h(cons *stack_head, int noquo
475      break;      break;
476    case tcons:    case tcons:
477      /* A list is just a stack, so make stack_head point to it */      /* A list is just a stack, so make stack_head point to it */
478      stack_head=(cons*)(stack_head->car->content.ptr);      stack_head=stack_head->car->content.c;
479      printf("[ ");      printf("[ ");
480      while(stack_head != NULL) {      while(stack_head != NULL) {
481        print_h(stack_head, noquote);        print_h(stack_head, noquote);
# Line 567  extern void rot(environment *env) Line 567  extern void rot(environment *env)
567    cons *temp= env->head;    cons *temp= env->head;
568        
569    if(env->head==NULL || env->head->cdr->content.c==NULL    if(env->head==NULL || env->head->cdr->content.c==NULL
570        || env->head->cdr->content.c->cdr->content.c==NULL) {       || env->head->cdr->content.c->cdr->content.c==NULL) {
571      printerr("Too Few Arguments");      printerr("Too Few Arguments");
572      env->err=1;      env->err=1;
573      return;      return;
# Line 660  extern void eval(environment *env) Line 660  extern void eval(environment *env)
660          toss(env);          toss(env);
661          if(env->err) return;          if(env->err) return;
662                    
663          if(iterator->cdr->content.c==NULL){          if(iterator->cdr->content.ptr==NULL){
664            goto eval_start;            goto eval_start;
665          }          }
666          eval(env);          eval(env);
667          if(env->err) return;          if(env->err) return;
668        }        }
669        iterator= iterator->cdr->content.c;        if (iterator->cdr->type == tcons)
670            iterator= iterator->cdr->content.c;
671          else {
672            printerr("Bad Argument Type"); /* Improper list */
673            env->err= 2;
674            return;
675          }
676      }      }
677      unprotect(temp_val);      unprotect(temp_val);
678      return;      return;
# Line 693  extern void rev(environment *env) Line 699  extern void rev(environment *env)
699      return;      return;
700    }    }
701    
702    old_head= (cons*)(env->head->car->content.ptr);    old_head= env->head->car->content.c;
703    new_head= NULL;    new_head= NULL;
704    while(old_head!=NULL) {    while(old_head!=NULL) {
705      item= old_head;      item= old_head;
# Line 723  extern void pack(environment *env) Line 729  extern void pack(environment *env)
729      /* Search for first delimiter */      /* Search for first delimiter */
730      while(iterator->cdr->content.c!=NULL      while(iterator->cdr->content.c!=NULL
731            && (iterator->cdr->content.c->car->type!=symb            && (iterator->cdr->content.c->car->type!=symb
732            || ((symbol*)(iterator->cdr->content.c->car->content.ptr))->id[0]                || ((symbol*)(iterator->cdr->content.c->car->content.ptr))->id[0]
733                !='['))                !='['))
734        iterator= iterator->cdr->content.c;        iterator= iterator->cdr->content.c;
735            
# Line 770  extern void expand(environment *env) Line 776  extern void expand(environment *env)
776      return;      return;
777    
778    /* The first list element is the new stack head */    /* The first list element is the new stack head */
779    new_head= temp= env->head->car->content.ptr;    new_head= temp= env->head->car->content.c;
780    
781    toss(env);    toss(env);
782    
783    /* Find the end of the list */    /* Find the end of the list */
784    while(temp->cdr->content.c!=NULL)    while(temp->cdr->content.ptr != NULL) {
785      temp= temp->cdr->content.c;      if (temp->cdr->type == tcons)
786          temp= temp->cdr->content.c;
787        else {
788          printerr("Bad Argument Type"); /* Improper list */
789          env->err= 2;
790          return;
791        }
792      }
793    
794    /* Connect the tail of the list with the old stack head */    /* Connect the tail of the list with the old stack head */
795    temp->cdr->content.c= env->head;    temp->cdr->content.c= env->head;
# Line 1269  value *copy_val(environment *env, value Line 1282  value *copy_val(environment *env, value
1282      new_value->content.ptr= NULL;      new_value->content.ptr= NULL;
1283    
1284      prev_item= NULL;      prev_item= NULL;
1285      old_item= (cons*)(old_value->content.ptr);      old_item= old_value->content.c;
1286    
1287      while(old_item != NULL) {   /* While list is not empty */      if(old_value->content.ptr != NULL) { /* if list is not empty */
1288        new_item= malloc(sizeof(cons));        new_item= malloc(sizeof(cons));
1289        new_item->car= copy_val(env, old_item->car); /* recurse */        new_item->car= copy_val(env, old_item->car); /* recurse */
1290        new_item->cdr= new_val(env);        new_item->cdr= copy_val(env, old_item->cdr); /* recurse */
1291        new_item->cdr->type= tcons;      }
       new_item->cdr->content.c= NULL;  
       if(prev_item != NULL)     /* If this wasn't the first item */  
         prev_item->cdr->content.c= new_item; /* point the previous item to the  
                                      new item */  
       else  
         new_value->content.ptr= new_item;  
       old_item= old_item->cdr->content.c;  
       prev_item= new_item;  
     }      
1292      break;      break;
1293    }    }
1294    
# Line 1491  extern void foreach(environment *env) Line 1495  extern void foreach(environment *env)
1495    protect(foo);    protect(foo);
1496    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1497    
1498    iterator= foo->content.ptr;    iterator= foo->content.c;
1499    
1500    while(iterator!=NULL) {    while(iterator!=NULL) {
1501      push_val(env, iterator->car);      push_val(env, iterator->car);
1502      push_val(env, loop);      push_val(env, loop);
1503      eval(env); if(env->err) return;      eval(env); if(env->err) return;
1504      iterator= iterator->cdr->content.c;      if (iterator->cdr->type == tcons){
1505          iterator= iterator->cdr->content.c;
1506        } else {
1507          printerr("Bad Argument Type"); /* Improper list */
1508          env->err= 2;
1509          break;
1510        }
1511    }    }
1512    unprotect(loop); unprotect(foo);    unprotect(loop); unprotect(foo);
1513  }  }
# Line 1543  extern void to(environment *env) Line 1553  extern void to(environment *env)
1553    
1554    if(iterator==NULL    if(iterator==NULL
1555       || (iterator->car->type==symb       || (iterator->car->type==symb
1556       && ((symbol*)(iterator->car->content.ptr))->id[0]=='[')) {           && ((symbol*)(iterator->car->content.ptr))->id[0]=='[')) {
1557      temp= NULL;      temp= NULL;
1558      toss(env);      toss(env);
1559    } else {    } else {
1560      /* Search for first delimiter */      /* Search for first delimiter */
1561      while(iterator->cdr->content.c!=NULL      while(iterator->cdr->content.c!=NULL
1562            && (iterator->cdr->content.c->car->type!=symb            && (iterator->cdr->content.c->car->type!=symb
1563            || ((symbol*)(iterator->cdr->content.c->car->content.ptr))->id[0]                || ((symbol*)(iterator->cdr->content.c->car->content.ptr))->id[0]
1564                !='['))                !='['))
1565        iterator= iterator->cdr->content.c;        iterator= iterator->cdr->content.ptr;
1566            
1567      /* Extract list */      /* Extract list */
1568      temp= env->head;      temp= env->head;
Legend:
Removed from v.1.102  
changed lines
  Added in v.1.103
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26