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

Diff of /stack/stack.c

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

revision 1.35 by teddy, Wed Feb 6 00:30:14 2002 UTC revision 1.46 by masse, Thu Feb 7 03:56:39 2002 UTC
# Line 57  typedef struct { Line 57  typedef struct {
57    stackitem *head;              /* Head of the stack */    stackitem *head;              /* Head of the stack */
58    hashtbl symbols;              /* Hash table of all variable bindings */    hashtbl symbols;              /* Hash table of all variable bindings */
59    int err;                      /* Error flag */    int err;                      /* Error flag */
60      int non_eval_flag;
61  } environment;  } environment;
62    
63  /* A type for pointers to external functions */  /* A type for pointers to external functions */
# Line 66  typedef void (*funcp)(environment *); /* Line 67  typedef void (*funcp)(environment *); /*
67  /* Initialize a newly created environment */  /* Initialize a newly created environment */
68  void init_env(environment *env)  void init_env(environment *env)
69  {  {
70    long i;    int i;
71    
72    env->err=0;    env->err= 0;
73      env->non_eval_flag= 0;
74    for(i= 0; i<HASHTBLSIZE; i++)    for(i= 0; i<HASHTBLSIZE; i++)
75      env->symbols[i]= NULL;      env->symbols[i]= NULL;
76  }  }
# Line 76  void init_env(environment *env) Line 78  void init_env(environment *env)
78  /* Returns a pointer to a pointer to an element in the hash table. */  /* Returns a pointer to a pointer to an element in the hash table. */
79  symbol **hash(hashtbl in_hashtbl, const char *in_string)  symbol **hash(hashtbl in_hashtbl, const char *in_string)
80  {  {
81    long i= 0;    int i= 0;
82    unsigned long out_hash= 0;    unsigned int out_hash= 0;
83    char key= '\0';    char key= '\0';
84    symbol **position;    symbol **position;
85        
# Line 218  void free_val(value *val){ Line 220  void free_val(value *val){
220      switch (val->type){         /* and free the contents if necessary */      switch (val->type){         /* and free the contents if necessary */
221      case string:      case string:
222        free(val->content.ptr);        free(val->content.ptr);
223          break;
224      case list:                  /* lists needs to be freed recursively */      case list:                  /* lists needs to be freed recursively */
225        item=val->content.ptr;        item=val->content.ptr;
226        while(item != NULL) {     /* for all stack items */        while(item != NULL) {     /* for all stack items */
# Line 240  extern void toss(environment *env) Line 243  extern void toss(environment *env)
243    stackitem *temp= env->head;    stackitem *temp= env->head;
244    
245    if((env->head)==NULL) {    if((env->head)==NULL) {
246      printerr("Stack empty");      printerr("Too Few Arguments");
247      env->err=1;      env->err=1;
248      return;      return;
249    }    }
# Line 256  extern void nl() Line 259  extern void nl()
259    printf("\n");    printf("\n");
260  }  }
261    
262    /* Gets the type of a value */
263    extern void type(environment *env){
264      int typenum;
265    
266      if((env->head)==NULL) {
267        printerr("Too Few Arguments");
268        env->err=1;
269        return;
270      }
271      typenum=env->head->item->type;
272      toss(env);
273      switch(typenum){
274      case integer:
275        push_sym(env, "integer");
276        break;
277      case string:
278        push_sym(env, "string");
279        break;
280      case symb:
281        push_sym(env, "symbol");
282        break;
283      case func:
284        push_sym(env, "function");
285        break;
286      case list:
287        push_sym(env, "list");
288        break;
289      default:
290        push_sym(env, "unknown");
291        break;
292      }
293    }    
294    
295  /* Prints the top element of the stack. */  /* Prints the top element of the stack. */
296  void print_h(stackitem *stack_head)  void print_h(stackitem *stack_head)
297  {  {
# Line 267  void print_h(stackitem *stack_head) Line 303  void print_h(stackitem *stack_head)
303      printf("\"%s\"", (char*)stack_head->item->content.ptr);      printf("\"%s\"", (char*)stack_head->item->content.ptr);
304      break;      break;
305    case symb:    case symb:
306      printf("'%s'", ((symbol *)(stack_head->item->content.ptr))->id);      printf("%s", ((symbol *)(stack_head->item->content.ptr))->id);
307      break;      break;
308    case func:    case func:
309      printf("#<function %p>", (funcp)(stack_head->item->content.ptr));      printf("#<function %p>", (funcp)(stack_head->item->content.ptr));
310      break;      break;
311    case list:    case list:
312      printf("#<list %p>", (funcp)(stack_head->item->content.ptr));      /* A list is just a stack, so make stack_head point to it */
313        stack_head=(stackitem *)(stack_head->item->content.ptr);
314        printf("[ ");
315        while(stack_head != NULL) {
316          print_h(stack_head);
317          printf(" ");
318          stack_head=stack_head->next;
319        }
320        printf("]");
321      break;      break;
322    default:    default:
323      printf("#<unknown %p>", (funcp)(stack_head->item->content.ptr));      printf("#<unknown %p>", (stack_head->item->content.ptr));
324      break;      break;
325    }    }
326  }  }
327    
328  extern void print_(environment *env) {  extern void print_(environment *env) {
329    if(env->head==NULL) {    if(env->head==NULL) {
330      printerr("Stack empty");      printerr("Too Few Arguments");
331      env->err=1;      env->err=1;
332      return;      return;
333    }    }
# Line 308  void print_st(stackitem *stack_head, lon Line 352  void print_st(stackitem *stack_head, lon
352    nl();    nl();
353  }  }
354    
   
   
355  /* Prints the stack. */  /* Prints the stack. */
356  extern void printstack(environment *env)  extern void printstack(environment *env)
357  {  {
358    if(env->head == NULL) {    if(env->head == NULL) {
     printerr("Stack empty");  
     env->err=1;  
359      return;      return;
360    }    }
361    print_st(env->head, 1);    print_st(env->head, 1);
# Line 327  extern void swap(environment *env) Line 367  extern void swap(environment *env)
367  {  {
368    stackitem *temp= env->head;    stackitem *temp= env->head;
369        
370    if((env->head)==NULL) {    if(env->head==NULL || env->head->next==NULL) {
371      printerr("Stack empty");      printerr("Too Few Arguments");
     env->err=1;  
     return;  
   }  
   
   if(env->head->next==NULL) {  
     printerr("Not enough arguments");  
372      env->err=1;      env->err=1;
373      return;      return;
374    }    }
# Line 344  extern void swap(environment *env) Line 378  extern void swap(environment *env)
378    env->head->next= temp;    env->head->next= temp;
379  }  }
380    
 stackitem* copy(stackitem* in_item)  
 {  
   stackitem *out_item= malloc(sizeof(stackitem));  
   
   memcpy(out_item, in_item, sizeof(stackitem));  
   out_item->next= NULL;  
   
   return out_item;  
 }  
   
381  /* Recall a value from a symbol, if bound */  /* Recall a value from a symbol, if bound */
382  extern void rcl(environment *env)  extern void rcl(environment *env)
383  {  {
384    value *val;    value *val;
385    
386    if(env->head == NULL) {    if(env->head == NULL) {
387      printerr("Stack empty");      printerr("Too Few Arguments");
388      env->err=1;      env->err=1;
389      return;      return;
390    }    }
391    
392    if(env->head->item->type!=symb) {    if(env->head->item->type!=symb) {
393      printerr("Not a symbol");      printerr("Bad Argument Type");
394      env->err=1;      env->err=2;
395      return;      return;
396    }    }
397    
398    val=((symbol *)(env->head->item->content.ptr))->val;    val=((symbol *)(env->head->item->content.ptr))->val;
399    if(val == NULL){    if(val == NULL){
400      printerr("Unbound variable");      printerr("Unbound Variable");
401      env->err=1;      env->err=3;
402      return;      return;
403    }    }
404    toss(env);            /* toss the symbol */    toss(env);            /* toss the symbol */
# Line 382  extern void rcl(environment *env) Line 406  extern void rcl(environment *env)
406    push_val(&(env->head), val); /* Return its bound value */    push_val(&(env->head), val); /* Return its bound value */
407  }  }
408    
409    extern void pack(environment*);
410    void stack_read(environment*, char*);
411    
412    
413  /* If the top element is a symbol, determine if it's bound to a  /* If the top element is a symbol, determine if it's bound to a
414     function value, and if it is, toss the symbol and execute the     function value, and if it is, toss the symbol and execute the
415     function. */     function. */
416  extern void eval(environment *env)  extern void eval(environment *env)
417  {  {
418    funcp in_func;    funcp in_func;
419      value* temp_val;
420      stackitem* iterator;
421    
422    if(env->head==NULL) {    if(env->head==NULL) {
423      printerr("Stack empty");      printerr("Too Few Arguments");
424      env->err=1;      env->err=1;
425      return;      return;
426    }    }
427    
428    /* if it's a symbol */    switch(env->head->item->type) {
429    if(env->head->item->type==symb) {      /* if it's a symbol */
430      case symb:
431      rcl(env);                   /* get its contents */      rcl(env);                   /* get its contents */
432      if(env->err) return;      if(env->err) return;
433      if(env->head->item->type!=symb){ /* don't recurse symbols */      if(env->head->item->type!=symb){ /* don't recurse symbols */
434        eval(env);                        /* evaluate the value */        eval(env);                        /* evaluate the value */
435        return;        return;
436      }      }
437    }      break;
438    
439    /* If it's a lone function value, run it */      /* If it's a lone function value, run it */
440    if(env->head->item->type==func) {    case func:
441      in_func= (funcp)(env->head->item->content.ptr);      in_func= (funcp)(env->head->item->content.ptr);
442      toss(env);      toss(env);
443      if(env->err) return;      if(env->err) return;
444      (*in_func)(env);      (*in_func)(env);
445        break;
446    
447        /* If it's a list */
448      case list:
449        temp_val= env->head->item;
450        env->head->item->refcount++;
451        toss(env);
452        if(env->err) return;
453        iterator= (stackitem*)temp_val->content.ptr;
454        while(iterator!=NULL && iterator->item!=NULL) {
455          push_val(&(env->head), iterator->item);
456          if(env->head->item->type==symb
457            && strcmp(";", ((symbol*)(env->head->item->content.ptr))->id)==0) {
458            toss(env);
459            if(env->err) return;
460            eval(env);
461            if(env->err) return;
462          }
463          iterator= iterator->next;
464        }
465        free_val(temp_val);
466        break;
467    
468        /* If it's a string */
469      case string:
470        temp_val= env->head->item;
471        env->head->item->refcount++;
472        toss(env);
473        if(env->err) return;
474        push_sym(env, "[");
475        env->non_eval_flag++;
476        stack_read(env, (char*)temp_val->content.ptr);
477        env->non_eval_flag--;
478        push_sym(env, "["); pack(env);
479        if(env->err) return;
480        eval(env);
481        if(env->err) return;
482        free_val(temp_val);
483        break;
484    
485      default:
486      }
487    }
488    
489    /* Reverse (flip) a list */
490    extern void rev(environment *env){
491      stackitem *old_head, *new_head, *item;
492    
493      if((env->head)==NULL) {
494        printerr("Too Few Arguments");
495        env->err=1;
496        return;
497    }    }
498    
499      if(env->head->item->type!=list) {
500        printerr("Bad Argument Type");
501        env->err=2;
502        return;
503      }
504    
505      old_head=(stackitem *)(env->head->item->content.ptr);
506      new_head=NULL;
507      while(old_head != NULL){
508        item=old_head;
509        old_head=old_head->next;
510        item->next=new_head;
511        new_head=item;
512      }
513      env->head->item->content.ptr=new_head;
514  }  }
515    
516  /* Make a list. */  /* Make a list. */
# Line 454  extern void pack(environment *env) Line 553  extern void pack(environment *env)
553    temp->item= pack;    temp->item= pack;
554    
555    push(&(env->head), temp);    push(&(env->head), temp);
556      rev(env);
557  }  }
558    
559  /* Parse input. */  /* Parse input. */
560  int stack_read(environment *env, char *in_line)  void stack_read(environment *env, char *in_line)
561  {  {
562    char *temp, *rest;    char *temp, *rest;
563    int itemp;    int itemp;
564    size_t inlength= strlen(in_line)+1;    size_t inlength= strlen(in_line)+1;
565    int convert= 0;    int convert= 0;
   static int non_eval_flag= 0;  
566    
567    temp= malloc(inlength);    temp= malloc(inlength);
568    rest= malloc(inlength);    rest= malloc(inlength);
569    
570    do {    do {
571        /* If comment */
572        if((convert= sscanf(in_line, "#%[^\n\r]", rest))) {
573          free(temp); free(rest);
574          return;
575        }
576    
577      /* If string */      /* If string */
578      if((convert= sscanf(in_line, "\"%[^\"\n\r]\" %[^\n\r]", temp, rest))) {      if((convert= sscanf(in_line, "\"%[^\"\n\r]\" %[^\n\r]", temp, rest))) {
579        push_cstring(&(env->head), temp);        push_cstring(&(env->head), temp);
# Line 493  int stack_read(environment *env, char *i Line 598  int stack_read(environment *env, char *i
598      /* If single char */      /* If single char */
599      if((convert= sscanf(in_line, "%c%[^\n\r]", temp, rest))) {      if((convert= sscanf(in_line, "%c%[^\n\r]", temp, rest))) {
600        if(*temp==';') {        if(*temp==';') {
601          if(!non_eval_flag) {          if(!env->non_eval_flag) {
602            eval(env);            /* Evaluate top element */            eval(env);            /* Evaluate top element */
603            break;            break;
604          }          }
# Line 505  int stack_read(environment *env, char *i Line 610  int stack_read(environment *env, char *i
610        if(*temp==']') {        if(*temp==']') {
611          push_sym(env, "[");          push_sym(env, "[");
612          pack(env);          pack(env);
613          if(non_eval_flag!=0)          if(env->non_eval_flag)
614            non_eval_flag--;            env->non_eval_flag--;
615          break;          break;
616        }        }
617    
618        if(*temp=='[') {        if(*temp=='[') {
619          push_sym(env, "[");          push_sym(env, "[");
620          non_eval_flag++;          env->non_eval_flag++;
621          break;          break;
622        }        }
623      }      }
624    } while(0);    } while(0);
625    
   
626    free(temp);    free(temp);
627    
628    if(convert<2) {    if(convert<2) {
629      free(rest);      free(rest);
630      return 0;      return;
631    }    }
632        
633    stack_read(env, rest);    stack_read(env, rest);
634        
635    free(rest);    free(rest);
   return 1;  
636  }  }
637    
638  /* Relocate elements of the list on the stack. */  /* Relocate elements of the list on the stack. */
# Line 538  extern void expand(environment *env) Line 641  extern void expand(environment *env)
641    stackitem *temp, *new_head;    stackitem *temp, *new_head;
642    
643    /* Is top element a list? */    /* Is top element a list? */
644    if(env->head==NULL || env->head->item->type!=list) {    if(env->head==NULL) {
645      printerr("Stack empty or not a list");      printerr("Too Few Arguments");
646      env->err=1;      env->err=1;
647      return;      return;
648    }    }
649      if(env->head->item->type!=list) {
650        printerr("Bad Argument Type");
651        env->err=2;
652        return;
653      }
654    
655      rev(env);
656    
657      if(env->err)
658        return;
659    
660    /* The first list element is the new stack head */    /* The first list element is the new stack head */
661    new_head= temp= env->head->item->content.ptr;    new_head= temp= env->head->item->content.ptr;
# Line 567  extern void eq(environment *env) Line 680  extern void eq(environment *env)
680    int result;    int result;
681    
682    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
683      printerr("Not enough elements to compare");      printerr("Too Few Arguments");
684      env->err=1;      env->err=1;
685      return;      return;
686    }    }
# Line 586  extern void not(environment *env) Line 699  extern void not(environment *env)
699  {  {
700    int val;    int val;
701    
702    if((env->head)==NULL || env->head->item->type!=integer) {    if((env->head)==NULL) {
703      printerr("Stack empty or element is not a integer");      printerr("Too Few Arguments");
704      env->err=1;      env->err=1;
705      return;      return;
706    }    }
707    
708      if(env->head->item->type!=integer) {
709        printerr("Bad Argument Type");
710        env->err=2;
711        return;
712      }
713    
714    val= env->head->item->content.val;    val= env->head->item->content.val;
715    toss(env);    toss(env);
716    push_int(&(env->head), !val);    push_int(&(env->head), !val);
# Line 611  extern void def(environment *env) Line 730  extern void def(environment *env)
730    symbol *sym;    symbol *sym;
731    
732    /* Needs two values on the stack, the top one must be a symbol */    /* Needs two values on the stack, the top one must be a symbol */
733    if(env->head==NULL || env->head->next==NULL    if(env->head==NULL || env->head->next==NULL) {
734       || env->head->item->type!=symb) {      printerr("Too Few Arguments");
     printerr("Define what?");  
735      env->err=1;      env->err=1;
736      return;      return;
737    }    }
738    
739      if(env->head->item->type!=symb) {
740        printerr("Bad Argument Type");
741        env->err=2;
742        return;
743      }
744    
745    /* long names are a pain */    /* long names are a pain */
746    sym=env->head->item->content.ptr;    sym=env->head->item->content.ptr;
747    
# Line 667  extern void forget(environment *env) Line 791  extern void forget(environment *env)
791    stackitem *stack_head= env->head;    stackitem *stack_head= env->head;
792    symbol **hash_entry, *temp;    symbol **hash_entry, *temp;
793    
794    if(stack_head==NULL || stack_head->item->type!=symb) {    if(stack_head==NULL) {
795      printerr("Stack empty or not a symbol");      printerr("Too Few Arguments");
796        env->err=1;
797        return;
798      }
799      
800      if(stack_head->item->type!=symb) {
801        printerr("Bad Argument Type");
802        env->err=2;
803      return;      return;
804    }    }
805    
# Line 684  extern void forget(environment *env) Line 815  extern void forget(environment *env)
815    }    }
816    free(temp->id);    free(temp->id);
817    free(temp);    free(temp);
818  }  }
819    
820    /* Returns the current error number to the stack */
821    extern void errn(environment *env){
822      push_int(&(env->head), env->err);
823    }
824    
825  int main()  int main()
826  {  {
# Line 703  int main() Line 839  int main()
839      }      }
840      printf("okidok\n ");      printf("okidok\n ");
841    }    }
842      quit(&myenv);
843    exit(EXIT_SUCCESS);    return EXIT_FAILURE;
844  }  }
Legend:
Removed from v.1.35  
changed lines
  Added in v.1.46
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26