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

Diff of /stack/stack.c

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

revision 1.133 by masse, Mon Aug 11 14:31:48 2003 UTC revision 1.135 by masse, Wed Aug 13 11:58:00 2003 UTC
# Line 50  void init_env(environment *env) Line 50  void init_env(environment *env)
50  }  }
51    
52    
53  void printerr(environment *env, const char* in_string)  void printerr(environment *env)
54  {  {
55      char *in_string;
56    
57      switch(env->err) {
58      case 0:
59        return;
60      case 1:
61        in_string= "Too Few Arguments";
62        break;
63      case 2:
64        in_string= "Bad Argument Type";
65        break;
66      case 3:
67        in_string= "Unbound Variable";
68        break;
69      default:
70        in_string= "Unknown error";
71        break;
72      }
73    
74    fprintf(stderr, "\"%s\":\nErr: %s\n", env->errsymb, in_string);    fprintf(stderr, "\"%s\":\nErr: %s\n", env->errsymb, in_string);
75  }  }
76    
# Line 585  void print_val(environment *env, value * Line 604  void print_val(environment *env, value *
604  extern void swap(environment *env)  extern void swap(environment *env)
605  {  {
606    value *temp= env->head;    value *temp= env->head;
     
   if(env->head->type == empty || CDR(env->head)->type == empty) {  
     printerr(env, "Too Few Arguments");  
     env->err=1;  
     return;  
   }  
607    
608      if(check_args(env, unknown, unknown, empty))
609        return printerr(env);
610      
611    env->head= CDR(env->head);    env->head= CDR(env->head);
612    CDR(temp)= CDR(env->head);    CDR(temp)= CDR(env->head);
613    CDR(env->head)= temp;    CDR(env->head)= temp;
# Line 603  extern void rcl(environment *env) Line 619  extern void rcl(environment *env)
619  {  {
620    value *val;    value *val;
621    
622    if(env->head->type==empty) {    if(check_args(env, symb, empty))
623      printerr(env, "Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
   
   if(CAR(env->head)->type!=symb) {  
     printerr(env, "Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
624    
625    val= CAR(env->head)->content.sym->val;    val= CAR(env->head)->content.sym->val;
626    if(val == NULL){    if(val == NULL){
     printerr(env, "Unbound Variable");  
627      env->err= 3;      env->err= 3;
628      return;      return printerr(env);
629    }    }
630    
631    push_val(env, val);           /* Return the symbol's bound value */    push_val(env, val);           /* Return the symbol's bound value */
632    swap(env);    swap(env);
633    if(env->err) return;    if(env->err) return;
# Line 641  extern void eval(environment *env) Line 648  extern void eval(environment *env)
648    
649    gc_maybe(env);    gc_maybe(env);
650    
651    if(env->head->type==empty) {    if(check_args(env, unknown, empty))
652      printerr(env, "Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
653    
654    switch(CAR(env->head)->type) {    switch(CAR(env->head)->type) {
655      /* if it's a symbol */      /* if it's a symbol */
# Line 662  extern void eval(environment *env) Line 666  extern void eval(environment *env)
666    case func:    case func:
667      in_func= CAR(env->head)->content.func;      in_func= CAR(env->head)->content.func;
668      env->head= CDR(env->head);      env->head= CDR(env->head);
669      return in_func(env);      return in_func((void*)env);
670    
671      /* If it's a list */      /* If it's a list */
672    case tcons:    case tcons:
# Line 688  extern void eval(environment *env) Line 692  extern void eval(environment *env)
692        if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons)        if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons)
693          iterator= CDR(iterator);          iterator= CDR(iterator);
694        else {        else {
695          printerr(env, "Bad Argument Type"); /* Improper list */          env->err= 2; /* Improper list */
696          env->err= 2;          return printerr(env);
         return;  
697        }        }
698      }      }
699      unprotect(temp_val);      unprotect(temp_val);
# Line 759  int main(int argc, char **argv) Line 762  int main(int argc, char **argv)
762    }    }
763    
764    if(myenv.interactive)    if(myenv.interactive)
765      printf(start_message);      puts(start_message);
766    
767    while(1) {    while(1) {
768      if(myenv.in_string==NULL) {      if(myenv.in_string==NULL) {
# Line 854  extern void rev(environment *env) Line 857  extern void rev(environment *env)
857  {  {
858    value *old_head, *new_head, *item;    value *old_head, *new_head, *item;
859    
   if(env->head->type==empty) {  
     printerr(env, "Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
   
860    if(CAR(env->head)->type==empty)    if(CAR(env->head)->type==empty)
861      return;                     /* Don't reverse an empty list */      return;                     /* Don't reverse an empty list */
862    
863    if(CAR(env->head)->type!=tcons) {    if(check_args(env, tcons, empty))
864      printerr(env, "Bad Argument Type");      return printerr(env);
     env->err= 2;  
     return;  
   }  
865    
866    old_head= CAR(env->head);    old_head= CAR(env->head);
867    new_head= new_val(env);    new_head= new_val(env);
Legend:
Removed from v.1.133  
changed lines
  Added in v.1.135
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26