--- stack/stack.c	2002/01/08 00:03:16	1.5
+++ stack/stack.c	2002/02/02 18:11:54	1.22
@@ -6,25 +6,38 @@
 #include <stddef.h>
 /* dlopen, dlsym, dlerror */
 #include <dlfcn.h>
+/* assert */
+#include <assert.h>
 
 #define HASHTBLSIZE 65536
 
 typedef struct stack_item
 {
-  enum {value, string, ref, func, symbol} type;
+  enum {
+    value,			/* Integer */
+    string,
+    ref,			/* Reference (to an element in the
+                                   hash table) */
+    func,			/* Function pointer */
+    symbol, 
+    list
+  } type;			/* Type of stack element */
+
   union {
-    void* ptr;
-    int val;
-  } content;
+    void* ptr;			/* Pointer to the content */
+    int val;			/* ...or an integer */
+  } content;			/* Stores a pointer or an integer */
 
-  char* id;
-  struct stack_item* next;
+  char* id;			/* Symbol name */
+  struct stack_item* next;	/* Next element */
 } stackitem;
 
 
-typedef stackitem* hashtbl[HASHTBLSIZE];
-typedef void (*funcp)(stackitem**);
+typedef stackitem* hashtbl[HASHTBLSIZE]; /* Hash table declaration */
+typedef void (*funcp)(stackitem**); /* funcp is a pointer to a
+				       void function (stackitem **) */
 
+/* Initialize a newly created hash table. */
 void init_hashtbl(hashtbl out_hash)
 {
   long i;
@@ -33,14 +46,15 @@
     out_hash[i]= NULL;
 }
 
+/* Returns a pointer to an element in the hash table. */
 stackitem** hash(hashtbl in_hashtbl, const char* in_string)
 {
   long i= 0;
   unsigned long out_hash= 0;
-  char key= 0;
+  char key= '\0';
   stackitem** position;
   
-  while(1){
+  while(1){			/* Hash in_string */
     key= in_string[i++];
     if(key=='\0')
       break;
@@ -50,18 +64,20 @@
   out_hash= out_hash%HASHTBLSIZE;
   position= &(in_hashtbl[out_hash]);
 
-  while(1){
-    if(*position==NULL)
+  while(position != NULL){
+    if(*position==NULL)		/* If empty */
       return position;
     
-    if(strcmp(in_string, (*position)->id)==0)
+    if(strcmp(in_string, (*position)->id)==0) /* If match */
       return position;
 
-    position= &((*position)->next);
+    position= &((*position)->next); /* Try next */
   }
+  return NULL;			/* end of list reached without finding
+                                   an empty position */
 }
 
-
+/* Generic push function. */
 int push(stackitem** stack_head, stackitem* in_item)
 {
   in_item->next= *stack_head;
@@ -69,9 +85,11 @@
   return 1;
 }
 
+/* Push a value on the stack. */
 int push_val(stackitem** stack_head, int in_val) 
 {
   stackitem* new_item= malloc(sizeof(stackitem));
+  assert(new_item != NULL);
   new_item->content.val= in_val;
   new_item->type= value;
 
@@ -79,6 +97,7 @@
   return 1;
 }
 
+/* Copy a string onto the stack. */
 int push_cstring(stackitem** stack_head, const char* in_string)
 {
   stackitem* new_item= malloc(sizeof(stackitem));
@@ -90,6 +109,7 @@
   return 1;
 }
 
+/* Create a new hash entry. */
 int mk_hashentry(hashtbl in_hashtbl, stackitem* in_item, const char* id)
 {
   in_item->id= malloc(strlen(id)+1);
@@ -100,6 +120,7 @@
   return 1;
 }
 
+/* Define a new function in the hash table. */
 void def_func(hashtbl in_hashtbl, funcp in_func, const char* id)
 {
   stackitem* temp= malloc(sizeof(stackitem));
@@ -110,33 +131,36 @@
   mk_hashentry(in_hashtbl, temp, id);
 }
 
+/* Define a new symbol in the hash table. */
 void def_sym(hashtbl in_hashtbl, const char* id)
 {
   stackitem* temp= malloc(sizeof(stackitem));
   
   temp->type= symbol;
-
   mk_hashentry(in_hashtbl, temp, id);
 }
 
+/* Push a reference to an entry in the hash table onto the stack. */
 int push_ref(stackitem** stack_head, hashtbl in_hash, const char* in_string)
 {
-  void* handle;
+  static void* handle= NULL;
   void* symbol;
-  
+
   stackitem* new_item= malloc(sizeof(stackitem));
   new_item->content.ptr= *hash(in_hash, in_string);
   new_item->type= ref;
 
-  if(new_item->content.ptr==NULL) {
-    handle= dlopen(NULL, RTLD_LAZY);
-    symbol= dlsym(handle, in_string);
-    if(dlerror()==NULL) 
-      def_func(in_hash, symbol, in_string);
+  if(new_item->content.ptr==NULL) { /* If hash entry empty */
+    if(handle==NULL)		/* If no handle */
+      handle= dlopen(NULL, RTLD_LAZY);    
+
+    symbol= dlsym(handle, in_string); /* Get function pointer */
+    if(dlerror()==NULL) 	/* If existing function pointer */
+      def_func(in_hash, symbol, in_string); /* Store function pointer */
     else
-      def_sym(in_hash, in_string);
+      def_sym(in_hash, in_string); /* Make symbol */
       
-    new_item->content.ptr= *hash(in_hash, in_string);
+    new_item->content.ptr= *hash(in_hash, in_string); /* XXX */
     new_item->type= ref;
   }
 
@@ -144,79 +168,210 @@
   return 1;
 }
 
+void printerr(const char* in_string) {
+  fprintf(stderr, "Err: %s\n", in_string);
+}
+
+/* Discard the top element of the stack. */
 extern void toss(stackitem** stack_head)
 {
   stackitem* temp= *stack_head;
 
+  if((*stack_head)==NULL) {
+    printerr("Stack empty");
+    return;
+  }
+  
+  if((*stack_head)->type==string)
+    free((*stack_head)->content.ptr);
+
   *stack_head= (*stack_head)->next;
   free(temp);
 }
 
+/* Print newline. */
+extern void nl()
+{
+  printf("\n");
+}
 
-/* print_stack(stack); */
-void print_st(stackitem* stack_head, long counter)
-{ 
-  if(stack_head->next != NULL)
-    print_st(stack_head->next, counter+1);
+/* Prints the top element of the stack. */
+void print_(stackitem** stack_head)
+{
+  if((*stack_head)==NULL) {
+    printerr("Stack empty");
+    return;
+  }
 
-  switch(stack_head->type){
+  switch((*stack_head)->type) {
   case value:
-    printf("%ld: %d\n", counter, (int)stack_head->content.val);
+    printf("%d", (*stack_head)->content.val);
     break;
   case string:
-    printf("%ld: \"%s\"\n", counter, (char*)stack_head->content.ptr);
+    printf("\"%s\"", (char*)(*stack_head)->content.ptr);
     break;
   case ref:
-  case func:
+    printf("%s", ((stackitem*)(*stack_head)->content.ptr)->id);
+    break;
   case symbol:
-    printf("%ld: %p\n", counter, stack_head->content.ptr);
+  default:
+    printf("%p", (*stack_head)->content.ptr);
     break;
   }
 }
 
+/* Prints the top element of the stack and then discards it. */
+extern void print(stackitem** stack_head)
+{
+  print_(stack_head);
+  toss(stack_head);
+}
+
+/* Only to be called by function printstack. */
+void print_st(stackitem* stack_head, long counter)
+{ 
+  if(stack_head->next != NULL)
+    print_st(stack_head->next, counter+1);
+
+  printf("%ld: ", counter);
+  print_(&stack_head);
+  nl();
+}
+
+/* Prints the stack. */
 extern void printstack(stackitem** stack_head)
 {
   if(*stack_head != NULL) {
     print_st(*stack_head, 1);
-    printf("\n");
+    nl();
+  } else {
+    printerr("Stack empty");
   }
 }
 
-
+/* If the top element is a reference, determine if it's a reference to a
+   function, and if it is, toss the reference and execute the function. */
 extern void eval(stackitem** stack_head)
 {
   funcp in_func;
+  stackitem* temp= *stack_head;
 
-  if((*stack_head)==NULL || (*stack_head)->type!=ref)
+  if(temp==NULL) {
+    printerr("Stack empty");
     return;
+  }
 
-  if(((stackitem*)(*stack_head)->content.ptr)->type==func) {
-    in_func= (funcp)((stackitem*)(*stack_head)->content.ptr)->content.ptr;
+  while(temp->type==ref)
+    temp= temp->content.ptr;
+
+  if(temp->type==func) {
+    in_func= (funcp)(temp->content.ptr);
     toss(stack_head); 
     (*in_func)(stack_head);
     return;
+  } 
+    
+  printerr("Couldn't evaluate");
+}
+
+/* Make a list. */
+extern void pack(stackitem** stack_head)
+{
+  void* delimiter;
+  stackitem *iterator, *temp, *pack;
+
+  if((*stack_head)==NULL) {
+    printerr("Stack empty");
+    return;
   }
+
+  delimiter= (*stack_head)->content.ptr; /* Get delimiter */
+  toss(stack_head);
+
+  iterator= *stack_head;
+
+  /* Search for first delimiter */
+  while(iterator->next!=NULL && iterator->next->content.ptr!=delimiter)
+    iterator= iterator->next;
+
+  /* Extract list */
+  temp= *stack_head;
+  *stack_head= iterator->next;
+  iterator->next= NULL;
+  
+  if(*stack_head!=NULL && (*stack_head)->content.ptr==delimiter)
+    toss(stack_head);
+
+  /* Push list */
+  pack= malloc(sizeof(stackitem));
+  pack->type= list;
+  pack->content.ptr= temp;
+
+  push(stack_head, pack);
 }
 
+/* Parse input. */
 int stack_read(stackitem** stack_head, hashtbl in_hash, char* in_line) 
 {
   char *temp, *rest;
   int itemp;
   size_t inlength= strlen(in_line)+1;
   int convert= 0;
+  static int non_eval_flag= 0;
 
   temp= malloc(inlength);
   rest= malloc(inlength);
 
-  if((convert= sscanf(in_line, "\"%[^\"\n\r]\" %[^\n\r]", temp, rest)) >= 1)
-    push_cstring(stack_head, temp);
-  else if((convert= sscanf(in_line, "%d %[^\n\r]", &itemp, rest)) >= 1)
-    push_val(stack_head, itemp);
-  else if((convert= sscanf(in_line, "%[^ ;\n\r]%[^\n\r]", temp, rest)) >= 1) 
-    push_ref(stack_head, in_hash, temp);
-  else if((convert= sscanf(in_line, "%c%[^\n\r]", temp, rest)) >= 1)
-    if(*temp==';')
-      eval(stack_head);
+  do {
+    /* If string */
+    if((convert= sscanf(in_line, "\"%[^\"\n\r]\" %[^\n\r]", temp, rest))) {
+      push_cstring(stack_head, temp);
+      break;
+    }
+    /* If value */
+    if((convert= sscanf(in_line, "%d %[^\n\r]", &itemp, rest))) {
+      push_val(stack_head, itemp);
+      break;
+    }
+    /* Escape ';' with '\' */
+    if((convert= sscanf(in_line, "\\%c%[^\n\r]", temp, rest))) {
+      temp[1]= '\0'; 
+      push_ref(stack_head, in_hash, temp);
+      break;
+    } 
+    /* If symbol */
+    if((convert= sscanf(in_line, "%[^][ ;\n\r]%[^\n\r]", temp, rest))) {
+	push_ref(stack_head, in_hash, temp);
+	break;
+    }
+    /* If single char */
+    if((convert= sscanf(in_line, "%c%[^\n\r]", temp, rest))) {
+      if(*temp==';') {
+	if(!non_eval_flag) {
+	  eval(stack_head);		/* Evaluate top element */
+	  break;
+	}
+	
+	push_ref(stack_head, in_hash, ";");
+	break;
+      }
+
+      if(*temp==']') {
+	push_ref(stack_head, in_hash, "[");
+	pack(stack_head);
+	if(non_eval_flag!=0)
+	  non_eval_flag--;
+	break;
+      }
+
+      if(*temp=='[') {
+	push_ref(stack_head, in_hash, "[");
+	non_eval_flag++;
+	break;
+      }
+    }
+  } while(0);
+
 
   free(temp);
 
@@ -231,34 +386,112 @@
   return 1;
 }
 
-extern void print(stackitem** stack_head)
+/* Relocate elements of the list on the stack. */
+extern void expand(stackitem** stack_head)
 {
-  if((*stack_head)==NULL)
+  stackitem *temp, *new_head;
+
+  /* Is top element a list? */
+  if((*stack_head)==NULL || (*stack_head)->type!=list) {
+    printerr("Stack empty or not a list");
     return;
+  }
 
-  switch((*stack_head)->type){
-  case value:
-    printf("%d", (*stack_head)->content.val);
-    break;
-  case string:
-    printf("%s", (char*)(*stack_head)->content.ptr);
-    break;
-  case symbol:
-    printf("%s", (*stack_head)->id);
-  case ref:
-  default:
-    printf("%p", (*stack_head)->content.ptr);
-    break;
+  /* The first list element is the new stack head */
+  new_head= temp= (*stack_head)->content.ptr;
+  toss(stack_head);
+
+  /* Search the end of the list */
+  while(temp->next!=NULL)
+    temp= temp->next;
+
+  /* Connect the the tail of the list with the old stack head */
+  temp->next= *stack_head;
+  *stack_head= new_head;	/* ...and voila! */
+}
+
+/* Swap the two top elements on the stack. */
+extern void swap(stackitem** stack_head)
+{
+  stackitem* temp= (*stack_head);
+  
+  if((*stack_head)==NULL) {
+    printerr("Stack empty");
+    return;
+  }
+
+  if((*stack_head)->next==NULL)
+    return;
+
+  *stack_head= (*stack_head)->next;
+  temp->next= (*stack_head)->next;
+  (*stack_head)->next= temp;
+} 
+
+/* Compares two elements by reference. */
+extern void eq(stackitem** stack_head)
+{
+  void *left, *right;
+  int result;
+
+  if((*stack_head)==NULL || (*stack_head)->next==NULL) {
+    printerr("Not enough elements to compare");
+    return;
   }
 
+  left= (*stack_head)->content.ptr;
+  swap(stack_head);
+  right= (*stack_head)->content.ptr;
+  result= (left==right);
+  
+  toss(stack_head); toss(stack_head);
+  push_val(stack_head, (left==right));
+}
+
+/* Negates the top element on the stack. */
+extern void not(stackitem** stack_head)
+{
+  int value;
+
+  if((*stack_head)==NULL || (*stack_head)->type!=value) {
+    printerr("Stack empty or element is not a value");
+    return;
+  }
+
+  value= (*stack_head)->content.val;
   toss(stack_head);
+  push_val(stack_head, !value);
 }
 
-extern void nl()
+/* Compares the two top elements on the stack and return 0 if they're the
+   same. */
+extern void neq(stackitem** stack_head)
 {
-  printf("\n");
+  eq(stack_head);
+  not(stack_head);
 }
 
+/* Give a symbol some content. */
+extern void def(stackitem** stack_head)
+{
+  stackitem *temp, *value;
+
+  if(*stack_head==NULL || (*stack_head)->next==NULL 
+     || (*stack_head)->type!=ref) {
+    printerr("Define what?");
+    return;
+  }
+
+  temp= (*stack_head)->content.ptr;
+  value= (*stack_head)->next;
+  temp->content= value->content;
+  value->content.ptr=NULL;
+  temp->type= value->type;
+
+  toss(stack_head); toss(stack_head);
+} 
+
+/* Quit stack. */
 extern void quit()
 {
   exit(EXIT_SUCCESS);
@@ -279,8 +512,7 @@
     printf("okidok\n ");
   }
 
-
-  return EXIT_SUCCESS;
+  exit(EXIT_SUCCESS);
 }
 
 /* Local Variables: */