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

Diff of /stack/stack.c

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

revision 1.128 by masse, Mon Aug 4 13:50:53 2003 UTC revision 1.129 by masse, Mon Aug 4 14:13:16 2003 UTC
# Line 1350  PROGRAMS), EVEN IF SUCH HOLDER OR OTHER Line 1350  PROGRAMS), EVEN IF SUCH HOLDER OR OTHER
1350  POSSIBILITY OF SUCH DAMAGES.\n");  POSSIBILITY OF SUCH DAMAGES.\n");
1351  }  }
1352    
 /* General assoc function */  
 void assocgen(environment *env, funcp eqfunc)  
 {  
   value *key, *item;  
   
   /* Needs two values on the stack, the top one must be an association  
      list */  
   if(env->head->type==empty || CDR(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;  
   }  
   
   key=CAR(CDR(env->head));  
   item=CAR(env->head);  
   
   while(item->type == tcons){  
     if(CAR(item)->type != tcons){  
       printerr("Bad Argument Type");  
       env->err= 2;  
       return;  
     }  
     push_val(env, key);  
     push_val(env, CAR(CAR(item)));  
     eqfunc(env); if(env->err) return;  
   
     /* Check the result of 'eqfunc' */  
     if(env->head->type==empty) {  
       printerr("Too Few Arguments");  
       env->err= 1;  
     return;  
     }  
     if(CAR(env->head)->type!=integer) {  
       printerr("Bad Argument Type");  
       env->err= 2;  
       return;  
     }  
   
     if(CAR(env->head)->content.i){  
       toss(env); if(env->err) return;  
       break;  
     }  
     toss(env); if(env->err) return;  
   
     if(item->type!=tcons) {  
       printerr("Bad Argument Type");  
       env->err= 2;  
       return;  
     }  
   
     item=CDR(item);  
   }  
   
   if(item->type == tcons){      /* A match was found */  
     push_val(env, CAR(item));  
   } else {  
     push_int(env, 0);  
   }  
   swap(env); if(env->err) return;  
   toss(env); if(env->err) return;  
   swap(env); if(env->err) return;  
   toss(env);  
 }  
   
1353  /* Discard the top element of the stack. */  /* Discard the top element of the stack. */
1354  extern void toss(environment *env)  extern void toss(environment *env)
1355  {  {
Legend:
Removed from v.1.128  
changed lines
  Added in v.1.129
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26