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

Diff of /stack/stack.c

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

revision 1.33 by teddy, Tue Feb 5 23:00:42 2002 UTC revision 1.46 by masse, Thu Feb 7 03:56:39 2002 UTC
# Line 18  typedef struct { Line 18  typedef struct {
18    enum {    enum {
19      integer,      integer,
20      string,      string,
     ref,                        /* Reference (to an element in the  
                                    hash table) */  
21      func,                       /* Function pointer */      func,                       /* Function pointer */
22      symb,      symb,
23      list      list
# Line 59  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 68  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;
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 77  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 104  symbol **hash(hashtbl in_hashtbl, const Line 105  symbol **hash(hashtbl in_hashtbl, const
105  }  }
106    
107  /* Generic push function. */  /* Generic push function. */
108  int push(stackitem** stack_head, stackitem* in_item)  void push(stackitem** stack_head, stackitem* in_item)
109  {  {
110    in_item->next= *stack_head;    in_item->next= *stack_head;
111    *stack_head= in_item;    *stack_head= in_item;
   return 1;  
112  }  }
113    
114  /* Push a value onto the stack */  /* Push a value onto the stack */
# Line 121  void push_val(stackitem **stack_head, va Line 121  void push_val(stackitem **stack_head, va
121  }  }
122    
123  /* Push an integer onto the stack. */  /* Push an integer onto the stack. */
124  int push_int(stackitem **stack_head, int in_val)  void push_int(stackitem **stack_head, int in_val)
125  {  {
126    value *new_value= malloc(sizeof(value));    value *new_value= malloc(sizeof(value));
127    stackitem *new_item= malloc(sizeof(stackitem));    stackitem *new_item= malloc(sizeof(stackitem));
# Line 132  int push_int(stackitem **stack_head, int Line 132  int push_int(stackitem **stack_head, int
132    new_value->refcount=1;    new_value->refcount=1;
133    
134    push(stack_head, new_item);    push(stack_head, new_item);
   return 1;  
135  }  }
136    
137  /* Copy a string onto the stack. */  /* Copy a string onto the stack. */
138  int push_cstring(stackitem **stack_head, const char *in_string)  void push_cstring(stackitem **stack_head, const char *in_string)
139  {  {
140    value *new_value= malloc(sizeof(value));    value *new_value= malloc(sizeof(value));
141    stackitem *new_item= malloc(sizeof(stackitem));    stackitem *new_item= malloc(sizeof(stackitem));
# Line 148  int push_cstring(stackitem **stack_head, Line 147  int push_cstring(stackitem **stack_head,
147    new_value->refcount=1;    new_value->refcount=1;
148    
149    push(stack_head, new_item);    push(stack_head, new_item);
   return 1;  
150  }  }
151    
152  /* Push a symbol onto the stack. */  /* Push a symbol onto the stack. */
153  int push_sym(environment *env, const char *in_string)  void push_sym(environment *env, const char *in_string)
154  {  {
155    stackitem *new_item;          /* The new stack item */    stackitem *new_item;          /* The new stack item */
156    /* ...which will contain... */    /* ...which will contain... */
# Line 207  int push_sym(environment *env, const cha Line 205  int push_sym(environment *env, const cha
205      }      }
206    }    }
207    push(&(env->head), new_item);    push(&(env->head), new_item);
   return 1;  
208  }  }
209    
210  void printerr(const char* in_string) {  void printerr(const char* in_string) {
# Line 223  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 245  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;
248      return;      return;
249    }    }
250        
# Line 255  extern void toss(environment *env) Line 254  extern void toss(environment *env)
254  }  }
255    
256  /* Print newline. */  /* Print newline. */
257  extern void nl(environment *env)  extern void nl()
258  {  {
259    printf("\n");    printf("\n");
260  }  }
261    
262  /* Prints the top element of the stack. */  /* Gets the type of a value */
263  void print_h(stackitem *stack_head)  extern void type(environment *env){
264  {    int typenum;
265    
266    if(stack_head==NULL) {    if((env->head)==NULL) {
267      printerr("Stack empty");      printerr("Too Few Arguments");
268        env->err=1;
269      return;      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. */
296    void print_h(stackitem *stack_head)
297    {
298    switch(stack_head->item->type) {    switch(stack_head->item->type) {
299    case integer:    case integer:
300      printf("%d", stack_head->item->content.val);      printf("%d", stack_head->item->content.val);
# Line 277  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;
308      case func:
309        printf("#<function %p>", (funcp)(stack_head->item->content.ptr));
310        break;
311      case list:
312        /* 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("%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) {
330        printerr("Too Few Arguments");
331        env->err=1;
332        return;
333      }
334    print_h(env->head);    print_h(env->head);
335  }  }
336    
# Line 293  extern void print_(environment *env) { Line 338  extern void print_(environment *env) {
338  extern void print(environment *env)  extern void print(environment *env)
339  {  {
340    print_(env);    print_(env);
341      if(env->err) return;
342    toss(env);    toss(env);
343  }  }
344    
# Line 306  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) {
359      print_st(env->head, 1);      return;
     nl();  
   } else {  
     printerr("Stack empty");  
360    }    }
361      print_st(env->head, 1);
362      nl();
363  }  }
364    
365  /* Swap the two top elements on the stack. */  /* Swap the two top elements on the stack. */
# Line 324  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");
372      return;      env->err=1;
   }  
   
   if(env->head->next==NULL) {  
     printerr("Not enough arguments");  
373      return;      return;
374    }    }
375    
# Line 339  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;
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=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=3;
402      return;      return;
403    }    }
404    toss(env);            /* toss the symbol */    toss(env);            /* toss the symbol */
405      if(env->err) return;
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* val;    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;
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      /* If it's not bound to anything */      rcl(env);                   /* get its contents */
432      if (((symbol *)(env->head->item->content.ptr))->val == NULL) {      if(env->err) return;
433        printerr("Unbound variable");      if(env->head->item->type!=symb){ /* don't recurse symbols */
434        return;        eval(env);                        /* evaluate the value */
     }  
       
     /* If it contains a function */  
     if (((symbol *)(env->head->item->content.ptr))->val->type == func) {  
       in_func=  
         (funcp)(((symbol *)(env->head->item->content.ptr))->val->content.ptr);  
       toss(env);  
       (*in_func)(env);          /* Run the function */  
435        return;        return;
     } else {                    /* If it's not a function */  
       val=((symbol *)(env->head->item->content.ptr))->val;  
       toss(env);                /* toss the symbol */  
       push_val(&(env->head), val); /* Return its bound value */  
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;
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;      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 457  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 489  int stack_read(environment *env, char *i Line 591  int stack_read(environment *env, char *i
591        break;        break;
592      }      }
593      /* If symbol */      /* If symbol */
594      if((convert= sscanf(in_line, "%[^][ ;\n\r_]%[^\n\r]", temp, rest))) {      if((convert= sscanf(in_line, "%[^][ ;\n\r]%[^\n\r]", temp, rest))) {
595          push_sym(env, temp);          push_sym(env, temp);
596          break;          break;
597      }      }
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 508  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 541  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;
647        return;
648      }
649      if(env->head->item->type!=list) {
650        printerr("Bad Argument Type");
651        env->err=2;
652      return;      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;
662    
# Line 569  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;
685      return;      return;
686    }    }
687    
# Line 587  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;
705        return;
706      }
707    
708      if(env->head->item->type!=integer) {
709        printerr("Bad Argument Type");
710        env->err=2;
711      return;      return;
712    }    }
713    
# 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");
735      printerr("Define what?");      env->err=1;
736        return;
737      }
738    
739      if(env->head->item->type!=symb) {
740        printerr("Bad Argument Type");
741        env->err=2;
742      return;      return;
743    }    }
744    
# Line 659  extern void words(environment *env) Line 784  extern void words(environment *env)
784    }    }
785  }  }
786    
787    /* Forgets a symbol (remove it from the hash table) */
788    extern void forget(environment *env)
789    {
790      char* sym_id;
791      stackitem *stack_head= env->head;
792      symbol **hash_entry, *temp;
793    
794      if(stack_head==NULL) {
795        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;
804      }
805    
806      sym_id= ((symbol*)(stack_head->item->content.ptr))->id;
807      toss(env);
808    
809      hash_entry= hash(env->symbols, sym_id);
810      temp= *hash_entry;
811      *hash_entry= (*hash_entry)->next;
812      
813      if(temp->val!=NULL) {
814        free_val(temp->val);
815      }
816      free(temp->id);
817      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  {  {
827    environment myenv;    environment myenv;
# Line 670  int main() Line 833  int main()
833    
834    while(fgets(in_string, 100, stdin) != NULL) {    while(fgets(in_string, 100, stdin) != NULL) {
835      stack_read(&myenv, in_string);      stack_read(&myenv, in_string);
836        if(myenv.err) {
837          printf("(error %d) ", myenv.err);
838          myenv.err=0;
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.33  
changed lines
  Added in v.1.46
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26