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

Diff of /stack/stack.c

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

revision 1.132 by masse, Fri Aug 8 14:20:49 2003 UTC revision 1.134 by masse, Wed Aug 13 06:12:26 2003 UTC
# Line 50  void init_env(environment *env) Line 50  void init_env(environment *env)
50  }  }
51    
52    
53  void printerr(const char* in_string)  void printerr(environment *env, const char* in_string)
54  {  {
55    fprintf(stderr, "Err: %s\n", in_string);    fprintf(stderr, "\"%s\":\nErr: %s\n", env->errsymb, in_string);
56  }  }
57    
58    
# Line 167  extern void gc_init(environment *env) Line 167  extern void gc_init(environment *env)
167          break;          break;
168        case port:        case port:
169        case empty:        case empty:
170          case unknown:
171        case integer:        case integer:
172        case tfloat:        case tfloat:
173        case func:        case func:
# Line 364  void push_sym(environment *env, const ch Line 365  void push_sym(environment *env, const ch
365    char *mangled;                /* Mangled function name */    char *mangled;                /* Mangled function name */
366    
367    new_value= new_val(env);    new_value= new_val(env);
   protect(new_value);  
368    new_fvalue= new_val(env);    new_fvalue= new_val(env);
   protect(new_fvalue);  
369    
370    /* The new value is a symbol */    /* The new value is a symbol */
371    new_value->type= symb;    new_value->type= symb;
# Line 414  void push_sym(environment *env, const ch Line 413  void push_sym(environment *env, const ch
413    }    }
414    
415    push_val(env, new_value);    push_val(env, new_value);
   unprotect(new_value); unprotect(new_fvalue);  
416  }  }
417    
418    
# Line 433  void print_val(environment *env, value * Line 431  void print_val(environment *env, value *
431        return;        return;
432      }      }
433      break;      break;
434      case unknown:
435        if(fprintf(stream, "UNKNOWN") < 0){
436          perror("print_val");
437          env->err= 5;
438          return;
439        }
440        break;
441    case integer:    case integer:
442      if(fprintf(stream, "%d", val->content.i) < 0){      if(fprintf(stream, "%d", val->content.i) < 0){
443        perror("print_val");        perror("print_val");
# Line 580  void print_val(environment *env, value * Line 585  void print_val(environment *env, value *
585  extern void swap(environment *env)  extern void swap(environment *env)
586  {  {
587    value *temp= env->head;    value *temp= env->head;
588      
589    if(env->head->type == empty || CDR(env->head)->type == empty) {    switch(check_args(env, unknown, unknown, empty)) {
590      printerr("Too Few Arguments");    case 1:
591      env->err=1;      printerr(env, "Too Few Arguments");
592        return;
593      case 2:
594        printerr(env, "Bad Argument Type");
595      return;      return;
596      default:
597        break;
598    }    }
599      
600    env->head= CDR(env->head);    env->head= CDR(env->head);
601    CDR(temp)= CDR(env->head);    CDR(temp)= CDR(env->head);
602    CDR(env->head)= temp;    CDR(env->head)= temp;
# Line 598  extern void rcl(environment *env) Line 608  extern void rcl(environment *env)
608  {  {
609    value *val;    value *val;
610    
611    if(env->head->type==empty) {    switch(check_args(env, symb, empty)) {
612      printerr("Too Few Arguments");    case 1:
613      env->err= 1;      printerr(env, "Too Few Arguments");
614      return;      return;
615    }    case 2:
616        printerr(env, "Bad Argument Type");
   if(CAR(env->head)->type!=symb) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
617      return;      return;
618      default:
619        break;
620    }    }
621    
622    val= CAR(env->head)->content.sym->val;    val= CAR(env->head)->content.sym->val;
623    if(val == NULL){    if(val == NULL){
624      printerr("Unbound Variable");      printerr(env, "Unbound Variable");
625      env->err= 3;      env->err= 3;
626      return;      return;
627    }    }
# Line 636  extern void eval(environment *env) Line 645  extern void eval(environment *env)
645    
646    gc_maybe(env);    gc_maybe(env);
647    
648    if(env->head->type==empty) {    switch(check_args(env, unknown, empty)) {
649      printerr("Too Few Arguments");    case 1:
650      env->err= 1;      printerr(env, "Too Few Arguments");
651      return;      return;
652      case 2:
653        printerr(env, "Bad Argument Type");
654        return;
655      default:
656        break;
657    }    }
658    
659    switch(CAR(env->head)->type) {    switch(CAR(env->head)->type) {
660      /* if it's a symbol */      /* if it's a symbol */
661    case symb:    case symb:
662        env->errsymb= CAR(env->head)->content.sym->id;
663      rcl(env);                   /* get its contents */      rcl(env);                   /* get its contents */
664      if(env->err) return;      if(env->err) return;
665      if(CAR(env->head)->type!=symb){ /* don't recurse symbols */      if(CAR(env->head)->type!=symb){ /* don't recurse symbols */
# Line 682  extern void eval(environment *env) Line 697  extern void eval(environment *env)
697        if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons)        if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons)
698          iterator= CDR(iterator);          iterator= CDR(iterator);
699        else {        else {
700          printerr("Bad Argument Type"); /* Improper list */          printerr(env, "Bad Argument Type"); /* Improper list */
701          env->err= 2;          env->err= 2;
702          return;          return;
703        }        }
# Line 696  extern void eval(environment *env) Line 711  extern void eval(environment *env)
711    case tfloat:    case tfloat:
712    case string:    case string:
713    case port:    case port:
714      case unknown:
715      return;      return;
716    }    }
717  }  }
# Line 752  int main(int argc, char **argv) Line 768  int main(int argc, char **argv)
768    }    }
769    
770    if(myenv.interactive)    if(myenv.interactive)
771      printf(start_message);      puts(start_message);
772    
773    while(1) {    while(1) {
774      if(myenv.in_string==NULL) {      if(myenv.in_string==NULL) {
# Line 803  value *copy_val(environment *env, value Line 819  value *copy_val(environment *env, value
819    case func:    case func:
820    case symb:    case symb:
821    case empty:    case empty:
822      case unknown:
823    case port:    case port:
824      new_value->content= old_value->content;      new_value->content= old_value->content;
825      break;      break;
# Line 846  extern void rev(environment *env) Line 863  extern void rev(environment *env)
863  {  {
864    value *old_head, *new_head, *item;    value *old_head, *new_head, *item;
865    
   if(env->head->type==empty) {  
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
   
866    if(CAR(env->head)->type==empty)    if(CAR(env->head)->type==empty)
867      return;                     /* Don't reverse an empty list */      return;                     /* Don't reverse an empty list */
868    
869    if(CAR(env->head)->type!=tcons) {    switch(check_args(env, tcons, empty)) {
870      printerr("Bad Argument Type");    case 1:
871      env->err= 2;      printerr(env, "Too Few Arguments");
872        return;
873      case 2:
874        printerr(env, "Bad Argument Type");
875      return;      return;
876      default:
877        break;
878    }    }
879    
880    old_head= CAR(env->head);    old_head= CAR(env->head);
# Line 996  void readstream(environment *env, FILE * Line 1012  void readstream(environment *env, FILE *
1012    if(depth)    if(depth)
1013      return readstream(env, env->inputstream);      return readstream(env, env->inputstream);
1014  }  }
1015    
1016    
1017    int check_args(environment *env, ...)
1018    {
1019      va_list ap;
1020      enum type_enum mytype;
1021    
1022      value *iter= env->head;
1023      int errval= 0;
1024    
1025      va_start(ap, env);
1026      while(1) {
1027        mytype= va_arg(ap, enum type_enum);
1028        //    fprintf(stderr, "%s\n", env->errsymb);
1029    
1030        if(mytype==empty)
1031          break;
1032        
1033        if(iter->type==empty || iter==NULL) {
1034          errval= 1;
1035          break;
1036        }
1037    
1038        if(mytype==unknown) {
1039          iter=CDR(iter);
1040          continue;
1041        }
1042    
1043        if(CAR(iter)->type!=mytype) {
1044          errval= 2;
1045          break;
1046        }
1047    
1048        iter= CDR(iter);
1049      }
1050    
1051      va_end(ap);
1052    
1053      env->err= errval;
1054      return errval;
1055    }
Legend:
Removed from v.1.132  
changed lines
  Added in v.1.134
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26