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

Diff of /stack/stack.c

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

revision 1.118 by teddy, Wed Mar 20 13:20:29 2002 UTC revision 1.119 by teddy, Wed Mar 20 17:19:46 2002 UTC
# Line 2446  extern void cons(environment *env) Line 2446  extern void cons(environment *env)
2446    swap(env); if(env->err) return;    swap(env); if(env->err) return;
2447    toss(env); if(env->err) return;    toss(env); if(env->err) return;
2448  }  }
2449    
2450    /*  2: 3                        =>                */
2451    /*  1: [ [ 1 . 2 ] [ 3 . 4 ] ]  =>  1: [ 3 . 4 ]  */
2452    extern void assq(environment *env)
2453    {
2454      value *key, *item;
2455    
2456      /* Needs two values on the stack, the top one must be an association
2457         list */
2458      if(env->head->type==empty || CDR(env->head)->type==empty) {
2459        printerr("Too Few Arguments");
2460        env->err= 1;
2461        return;
2462      }
2463    
2464      if(CAR(env->head)->type!=tcons) {
2465        printerr("Bad Argument Type");
2466        env->err= 2;
2467        return;
2468      }
2469    
2470      key=CAR(CDR(env->head));
2471      item=CAR(env->head);
2472    
2473      while(item->type == tcons){
2474        if(CAR(item)->type != tcons){
2475          printerr("Bad Argument Type");
2476          env->err= 2;
2477          return;
2478        }
2479        push_val(env, key);
2480        push_val(env, CAR(CAR(item)));
2481        eq(env); if(env->err) return;
2482        
2483        if(CAR(env->head)->content.i){
2484          toss(env);
2485          break;
2486        }
2487        toss(env);
2488        item=CDR(item);
2489      }
2490    
2491      if(item->type == tcons){      /* A match was found */
2492        push_val(env, CAR(item));
2493      } else {
2494        push_int(env, 0);
2495      }
2496      swap(env); if(env->err) return;
2497      toss(env); if(env->err) return;
2498      swap(env); if(env->err) return;
2499      toss(env);
2500    }

Legend:
Removed from v.1.118  
changed lines
  Added in v.1.119

root@recompile.se
ViewVC Help
Powered by ViewVC 1.1.26