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

Diff of /stack/stack.c

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

revision 1.135 by masse, Wed Aug 13 11:58:00 2003 UTC revision 1.136 by masse, Mon Aug 18 14:39:16 2003 UTC
# Line 27  const char* start_message= "Stack versio Line 27  const char* start_message= "Stack versio
27  Copyright (C) 2002  Mats Alritzson and Teddy Hogeborn\n\  Copyright (C) 2002  Mats Alritzson and Teddy Hogeborn\n\
28  Stack comes with ABSOLUTELY NO WARRANTY; for details type 'warranty;'.\n\  Stack comes with ABSOLUTELY NO WARRANTY; for details type 'warranty;'.\n\
29  This is free software, and you are welcome to redistribute it\n\  This is free software, and you are welcome to redistribute it\n\
30  under certain conditions; type 'copying;' for details.\n";  under certain conditions; type 'copying;' for details.";
31    
32    
33  /* Initialize a newly created environment */  /* Initialize a newly created environment */
# Line 66  void printerr(environment *env) Line 66  void printerr(environment *env)
66    case 3:    case 3:
67      in_string= "Unbound Variable";      in_string= "Unbound Variable";
68      break;      break;
69      case 5:
70        return perror(env->errsymb);
71    default:    default:
72      in_string= "Unknown error";      in_string= "Unknown error";
73      break;      break;
# Line 444  void print_val(environment *env, value * Line 446  void print_val(environment *env, value *
446    
447    switch(val->type) {    switch(val->type) {
448    case empty:    case empty:
449      if(fprintf(stream, "[]") < 0){      if(fprintf(stream, "[]") < 0)
       perror("print_val");  
450        env->err= 5;        env->err= 5;
       return;  
     }  
451      break;      break;
452    case unknown:    case unknown:
453      if(fprintf(stream, "UNKNOWN") < 0){      if(fprintf(stream, "UNKNOWN") < 0)
       perror("print_val");  
454        env->err= 5;        env->err= 5;
       return;  
     }  
455      break;      break;
456    case integer:    case integer:
457      if(fprintf(stream, "%d", val->content.i) < 0){      if(fprintf(stream, "%d", val->content.i) < 0)
       perror("print_val");  
458        env->err= 5;        env->err= 5;
       return;  
     }  
459      break;      break;
460    case tfloat:    case tfloat:
461      if(fprintf(stream, "%f", val->content.f) < 0){      if(fprintf(stream, "%f", val->content.f) < 0)
       perror("print_val");  
462        env->err= 5;        env->err= 5;
       return;  
     }  
463      break;      break;
464    case string:    case string:
465      if(noquote){      if(noquote){
466        if(fprintf(stream, "%s", val->content.string) < 0){        if(fprintf(stream, "%s", val->content.string) < 0)
         perror("print_val");  
467          env->err= 5;          env->err= 5;
         return;  
       }  
468      } else {                    /* quote */      } else {                    /* quote */
469        if(fprintf(stream, "\"%s\"", val->content.string) < 0){        if(fprintf(stream, "\"%s\"", val->content.string) < 0)
         perror("print_val");  
470          env->err= 5;          env->err= 5;
         return;  
       }  
471      }      }
472      break;      break;
473    case symb:    case symb:
474      if(fprintf(stream, "%s", val->content.sym->id) < 0){      if(fprintf(stream, "%s", val->content.sym->id) < 0)
       perror("print_val");  
475        env->err= 5;        env->err= 5;
       return;  
     }  
476      break;      break;
477    case func:    case func:
478      if(fprintf(stream, "#<function %p>", val->content.func) < 0){      if(fprintf(stream, "#<function %p>", val->content.func) < 0)
       perror("print_val");  
479        env->err= 5;        env->err= 5;
       return;  
     }  
480      break;      break;
481    case port:    case port:
482      if(fprintf(stream, "#<port %p>", val->content.p) < 0){      if(fprintf(stream, "#<port %p>", val->content.p) < 0)
       perror("print_val");  
483        env->err= 5;        env->err= 5;
       return;  
     }  
484      break;      break;
485    case tcons:    case tcons:
486      if(fprintf(stream, "[ ") < 0){      if(fprintf(stream, "[ ") < 0) {
       perror("print_val");  
487        env->err= 5;        env->err= 5;
488        return;        return printerr(env);
489      }      }
490      tstack= stack;      tstack= stack;
491    
# Line 533  void print_val(environment *env, value * Line 507  void print_val(environment *env, value *
507    
508        if(titem != NULL){        /* If we found it on the stack, */        if(titem != NULL){        /* If we found it on the stack, */
509          if(fprintf(stream, "#%d#", depth) < 0){ /* print a depth reference */          if(fprintf(stream, "#%d#", depth) < 0){ /* print a depth reference */
           perror("print_val");  
510            env->err= 5;            env->err= 5;
511            free(titem);            free(titem);
512            return;            return printerr(env);
513          }          }
514        } else {        } else {
515          print_val(env, CAR(val), noquote, tstack, stream);          print_val(env, CAR(val), noquote, tstack, stream);
# Line 558  void print_val(environment *env, value * Line 531  void print_val(environment *env, value *
531          }          }
532          if(titem != NULL){      /* If we found it on the stack, */          if(titem != NULL){      /* If we found it on the stack, */
533            if(fprintf(stream, " . #%d#", depth) < 0){ /* print a depth reference */            if(fprintf(stream, " . #%d#", depth) < 0){ /* print a depth reference */
             perror("print_val");  
534              env->err= 5;              env->err= 5;
535                printerr(env);
536              goto printval_end;              goto printval_end;
537            }            }
538          } else {          } else {
539            if(fprintf(stream, " ") < 0){            if(fprintf(stream, " ") < 0){
             perror("print_val");  
540              env->err= 5;              env->err= 5;
541                printerr(env);
542              goto printval_end;              goto printval_end;
543            }            }
544          }          }
545          break;          break;
546        default:        default:
547          if(fprintf(stream, " . ") < 0){ /* Improper list */          if(fprintf(stream, " . ") < 0){ /* Improper list */
           perror("print_val");  
548            env->err= 5;            env->err= 5;
549              printerr(env);
550            goto printval_end;            goto printval_end;
551          }          }
552          print_val(env, val, noquote, tstack, stream);          print_val(env, val, noquote, tstack, stream);
# Line 591  void print_val(environment *env, value * Line 564  void print_val(environment *env, value *
564    
565      if(! (env->err)){      if(! (env->err)){
566        if(fprintf(stream, " ]") < 0){        if(fprintf(stream, " ]") < 0){
         perror("print_val");  
567          env->err= 5;          env->err= 5;
568        }        }
569      }      }
570      break;      break;
571    }    }
572      
573      if(env->err)
574        return printerr(env);
575  }  }
576    
577    
# Line 605  extern void swap(environment *env) Line 580  extern void swap(environment *env)
580  {  {
581    value *temp= env->head;    value *temp= env->head;
582    
583    if(check_args(env, unknown, unknown, empty))    if(check_args(env, 2, unknown, unknown))
584      return printerr(env);      return printerr(env);
585        
586    env->head= CDR(env->head);    env->head= CDR(env->head);
# Line 619  extern void rcl(environment *env) Line 594  extern void rcl(environment *env)
594  {  {
595    value *val;    value *val;
596    
597    if(check_args(env, symb, empty))    if(check_args(env, 1, symb))
598      return printerr(env);      return printerr(env);
599    
600    val= CAR(env->head)->content.sym->val;    val= CAR(env->head)->content.sym->val;
# Line 648  extern void eval(environment *env) Line 623  extern void eval(environment *env)
623    
624    gc_maybe(env);    gc_maybe(env);
625    
626    if(check_args(env, unknown, empty))    if(check_args(env, 1, unknown))
627      return printerr(env);      return printerr(env);
628    
629    switch(CAR(env->head)->type) {    switch(CAR(env->head)->type) {
# Line 843  void readlinestream(environment *env, FI Line 818  void readlinestream(environment *env, FI
818    if(fgets(in_string, 100, stream)==NULL) {    if(fgets(in_string, 100, stream)==NULL) {
819      push_cstring(env, "");      push_cstring(env, "");
820      if (! feof(stream)){      if (! feof(stream)){
       perror("readline");  
821        env->err= 5;        env->err= 5;
822          return printerr(env);
823      }      }
824    } else {    } else {
825      push_cstring(env, in_string);      push_cstring(env, in_string);
# Line 860  extern void rev(environment *env) Line 835  extern void rev(environment *env)
835    if(CAR(env->head)->type==empty)    if(CAR(env->head)->type==empty)
836      return;                     /* Don't reverse an empty list */      return;                     /* Don't reverse an empty list */
837    
838    if(check_args(env, tcons, empty))    if(check_args(env, 1, tcons))
839      return printerr(env);      return printerr(env);
840    
841    old_head= CAR(env->head);    old_head= CAR(env->head);
# Line 1000  void readstream(environment *env, FILE * Line 975  void readstream(environment *env, FILE *
975  }  }
976    
977    
978  int check_args(environment *env, ...)  int check_args(environment *env, int num_args, ...)
979  {  {
980    va_list ap;    va_list ap;
981    enum type_enum mytype;    enum type_enum mytype;
982      int i;
983    
984    value *iter= env->head;    value *iter= env->head;
985    int errval= 0;    int errval= 0;
986    
987    va_start(ap, env);    va_start(ap, num_args);
988    while(1) {    for(i=1; i<=num_args; i++) {
989      mytype= va_arg(ap, enum type_enum);      mytype= va_arg(ap, enum type_enum);
990      //    fprintf(stderr, "%s\n", env->errsymb);      //    fprintf(stderr, "%s\n", env->errsymb);
991    
     if(mytype==empty)  
       break;  
       
992      if(iter->type==empty || iter==NULL) {      if(iter->type==empty || iter==NULL) {
993        errval= 1;        errval= 1;
994        break;        break;
995      }      }
996    
997      if(mytype==unknown) {      if(mytype!=unknown && CAR(iter)->type!=mytype) {
       iter=CDR(iter);  
       continue;  
     }  
   
     if(CAR(iter)->type!=mytype) {  
998        errval= 2;        errval= 2;
999        break;        break;
1000      }      }
Legend:
Removed from v.1.135  
changed lines
  Added in v.1.136
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26