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

Diff of /stack/stack.c

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

revision 1.119 by teddy, Wed Mar 20 17:19:46 2002 UTC revision 1.123 by masse, Wed Mar 27 19:53:01 2002 UTC
# Line 1651  extern void foreach(environment *env) Line 1651  extern void foreach(environment *env)
1651    
1652    iterator= foo;    iterator= foo;
1653    
1654    while(iterator!=NULL) {    while(iterator->type!=empty) {
1655      push_val(env, CAR(iterator));      push_val(env, CAR(iterator));
1656      push_val(env, loop);      push_val(env, loop);
1657      eval(env); if(env->err) return;      eval(env); if(env->err) return;
# Line 1670  extern void foreach(environment *env) Line 1670  extern void foreach(environment *env)
1670  extern void to(environment *env)  extern void to(environment *env)
1671  {  {
1672    int ending, start, i;    int ending, start, i;
1673    value *iterator, *temp;    value *iterator, *temp, *end;
1674    
1675      end= new_val(env);
1676    
1677    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1678      printerr("Too Few Arguments");      printerr("Too Few Arguments");
# Line 1705  extern void to(environment *env) Line 1707  extern void to(environment *env)
1707    if(iterator->type==empty    if(iterator->type==empty
1708       || (CAR(iterator)->type==symb       || (CAR(iterator)->type==symb
1709           && CAR(iterator)->content.sym->id[0]=='[')) {           && CAR(iterator)->content.sym->id[0]=='[')) {
1710      temp= NULL;      temp= end;
1711      toss(env);      toss(env);
1712    } else {    } else {
1713      /* Search for first delimiter */      /* Search for first delimiter */
1714      while(CDR(iterator)!=NULL      while(CDR(iterator)->type!=empty
1715            && (CAR(CDR(iterator))->type!=symb            && (CAR(CDR(iterator))->type!=symb
1716                || CAR(CDR(iterator))->content.sym->id[0]!='['))                || CAR(CDR(iterator))->content.sym->id[0]!='['))
1717        iterator= CDR(iterator);        iterator= CDR(iterator);
# Line 1717  extern void to(environment *env) Line 1719  extern void to(environment *env)
1719      /* Extract list */      /* Extract list */
1720      temp= env->head;      temp= env->head;
1721      env->head= CDR(iterator);      env->head= CDR(iterator);
1722      CDR(iterator)= NULL;      CDR(iterator)= end;
1723    
1724      if(env->head!=NULL)      if(env->head->type!=empty)
1725        toss(env);        toss(env);
1726    }    }
1727    
# Line 2451  extern void cons(environment *env) Line 2453  extern void cons(environment *env)
2453  /*  1: [ [ 1 . 2 ] [ 3 . 4 ] ]  =>  1: [ 3 . 4 ]  */  /*  1: [ [ 1 . 2 ] [ 3 . 4 ] ]  =>  1: [ 3 . 4 ]  */
2454  extern void assq(environment *env)  extern void assq(environment *env)
2455  {  {
2456      assocgen(env, eq);
2457    }
2458    
2459    
2460    /* General assoc function */
2461    void assocgen(environment *env, funcp eqfunc)
2462    {
2463    value *key, *item;    value *key, *item;
2464    
2465    /* Needs two values on the stack, the top one must be an association    /* Needs two values on the stack, the top one must be an association
# Line 2478  extern void assq(environment *env) Line 2487  extern void assq(environment *env)
2487      }      }
2488      push_val(env, key);      push_val(env, key);
2489      push_val(env, CAR(CAR(item)));      push_val(env, CAR(CAR(item)));
2490      eq(env); if(env->err) return;      eqfunc(env); if(env->err) return;
2491        
2492        /* Check the result of 'eqfunc' */
2493        if(env->head->type==empty) {
2494          printerr("Too Few Arguments");
2495          env->err= 1;
2496        return;
2497        }
2498        if(CAR(env->head)->type!=integer) {
2499          printerr("Bad Argument Type");
2500          env->err= 2;
2501          return;
2502        }
2503    
2504      if(CAR(env->head)->content.i){      if(CAR(env->head)->content.i){
2505        toss(env);        toss(env); if(env->err) return;
2506        break;        break;
2507      }      }
2508      toss(env);      toss(env); if(env->err) return;
2509    
2510        if(item->type!=tcons) {
2511          printerr("Bad Argument Type");
2512          env->err= 2;
2513          return;
2514        }
2515    
2516      item=CDR(item);      item=CDR(item);
2517    }    }
2518    
# Line 2498  extern void assq(environment *env) Line 2526  extern void assq(environment *env)
2526    swap(env); if(env->err) return;    swap(env); if(env->err) return;
2527    toss(env);    toss(env);
2528  }  }
2529    
2530    extern void sx_646f(environment *env)
2531    {
2532      swap(env); if(env->err) return;
2533      eval(env);
2534    }
Legend:
Removed from v.1.119  
changed lines
  Added in v.1.123
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26