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

Diff of /stack/stack.c

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

revision 1.112 by teddy, Sat Mar 16 20:09:51 2002 UTC revision 1.113 by teddy, Sun Mar 17 00:55:58 2002 UTC
# Line 20  Line 20 
20               Teddy Hogeborn <teddy@fukt.bth.se>               Teddy Hogeborn <teddy@fukt.bth.se>
21  */  */
22    
23  #define CAR(X) X->content.c->car  #define CAR(X) (X->content.c->car)
24  #define CDR(X) X->content.c->cdr  #define CDR(X) (X->content.c->cdr)
25    
26  /* printf, sscanf, fgets, fprintf, fopen, perror */  /* printf, sscanf, fgets, fprintf, fopen, perror */
27  #include <stdio.h>  #include <stdio.h>
# Line 476  extern void type(environment *env) Line 476  extern void type(environment *env)
476      push_sym(env, "function");      push_sym(env, "function");
477      break;      break;
478    case tcons:    case tcons:
479      push_sym(env, "list");      push_sym(env, "pair");
480      break;      break;
481    }    }
482    swap(env);    swap(env);
# Line 485  extern void type(environment *env) Line 485  extern void type(environment *env)
485  }      }    
486    
487  /* Prints the top element of the stack. */  /* Prints the top element of the stack. */
488  void print_h(value *stack_head, int noquote)  void print_val(value *val, int noquote)
489  {  {
490    switch(CAR(stack_head)->type) {    switch(val->type) {
491    case empty:    case empty:
492      printf("[]");      printf("[]");
493      break;      break;
494    case integer:    case integer:
495      printf("%d", CAR(stack_head)->content.i);      printf("%d", val->content.i);
496      break;      break;
497    case tfloat:    case tfloat:
498      printf("%f", CAR(stack_head)->content.f);      printf("%f", val->content.f);
499      break;      break;
500    case string:    case string:
501      if(noquote)      if(noquote)
502        printf("%s", (char*)(CAR(stack_head)->content.ptr));        printf("%s", (char*)(val->content.ptr));
503      else      else
504        printf("\"%s\"", (char*)(CAR(stack_head)->content.ptr));        printf("\"%s\"", (char*)(val->content.ptr));
505      break;      break;
506    case symb:    case symb:
507      printf("%s", CAR(stack_head)->content.sym->id);      printf("%s", val->content.sym->id);
508      break;      break;
509    case func:    case func:
510      printf("#<function %p>", (funcp)(CAR(stack_head)->content.ptr));      printf("#<function %p>", (funcp)(val->content.ptr));
511      break;      break;
512    case tcons:    case tcons:
     /* A list is just a stack, so make stack_head point to it */  
     stack_head= CAR(stack_head);  
513      printf("[ ");      printf("[ ");
514      while(stack_head->type != empty) {      do {
515        print_h(stack_head, noquote);        print_val(CAR(val), noquote);
516        switch(CDR(stack_head)->type){        switch(CDR(val)->type){
517        case empty:        case empty:
518          break;          break;
519        case tcons:        case tcons:
# Line 523  void print_h(value *stack_head, int noqu Line 521  void print_h(value *stack_head, int noqu
521          break;          break;
522        default:        default:
523          printf(" . ");          /* Improper list */          printf(" . ");          /* Improper list */
524            print_val(CDR(val), noquote);
525        }        }
526        stack_head= CDR(stack_head);        val= CDR(val);
527      }      } while(val->type == tcons);
528      printf(" ]");      printf(" ]");
529      break;      break;
530    }    }
# Line 538  extern void print_(environment *env) Line 537  extern void print_(environment *env)
537      env->err= 1;      env->err= 1;
538      return;      return;
539    }    }
540    print_h(env->head, 0);    print_val(CAR(env->head), 0);
541    nl();    nl();
542  }  }
543    
# Line 557  extern void princ_(environment *env) Line 556  extern void princ_(environment *env)
556      env->err= 1;      env->err= 1;
557      return;      return;
558    }    }
559    print_h(env->head, 1);    print_val(CAR(env->head), 1);
560  }  }
561    
562  /* Prints the top element of the stack and then discards it. */  /* Prints the top element of the stack and then discards it. */
# Line 574  void print_st(value *stack_head, long co Line 573  void print_st(value *stack_head, long co
573    if(CDR(stack_head)->type != empty)    if(CDR(stack_head)->type != empty)
574      print_st(CDR(stack_head), counter+1);      print_st(CDR(stack_head), counter+1);
575    printf("%ld: ", counter);    printf("%ld: ", counter);
576    print_h(stack_head, 0);    print_val(CAR(stack_head), 0);
577    nl();    nl();
578  }  }
579    
# Line 2281  extern void sx_646976(environment *env) Line 2280  extern void sx_646976(environment *env)
2280    printerr("Bad Argument Type");    printerr("Bad Argument Type");
2281    env->err= 2;    env->err= 2;
2282  }  }
2283    
2284    extern void setcar(environment *env)
2285    {
2286      if(env->head->type==empty || CDR(env->head)->type==empty) {
2287        printerr("Too Few Arguments");
2288        env->err= 1;
2289        return;
2290      }
2291    
2292      if(CDR(env->head)->type!=tcons) {
2293        printerr("Bad Argument Type");
2294        env->err= 2;
2295        return;
2296      }
2297    
2298      CAR(CAR(CDR(env->head)))=CAR(env->head);
2299      toss(env);
2300    }
2301    
2302    extern void setcdr(environment *env)
2303    {
2304      if(env->head->type==empty || CDR(env->head)->type==empty) {
2305        printerr("Too Few Arguments");
2306        env->err= 1;
2307        return;
2308      }
2309    
2310      if(CDR(env->head)->type!=tcons) {
2311        printerr("Bad Argument Type");
2312        env->err= 2;
2313        return;
2314      }
2315    
2316      CDR(CAR(CDR(env->head)))=CAR(env->head);
2317      toss(env);
2318    }
2319    
2320    extern void car(environment *env)
2321    {
2322      if(env->head->type==empty) {
2323        printerr("Too Few Arguments");
2324        env->err= 1;
2325        return;
2326      }
2327    
2328      if(CAR(env->head)->type!=tcons) {
2329        printerr("Bad Argument Type");
2330        env->err= 2;
2331        return;
2332      }
2333    
2334      CAR(env->head)=CAR(CAR(env->head));
2335    }
2336    
2337    extern void cdr(environment *env)
2338    {
2339      if(env->head->type==empty) {
2340        printerr("Too Few Arguments");
2341        env->err= 1;
2342        return;
2343      }
2344    
2345      if(CAR(env->head)->type!=tcons) {
2346        printerr("Bad Argument Type");
2347        env->err= 2;
2348        return;
2349      }
2350    
2351      CAR(env->head)=CDR(CAR(env->head));
2352    }
Legend:
Removed from v.1.112  
changed lines
  Added in v.1.113
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26