Sindbad~EG File Manager

/* M. Beeson, 4.27.04
   retrieval from an is_tree of subsuming terms.
   This function, based on McCune's is_retrieve, has been written 
   for Otter-lambda so that it properly handles the complications
   resulting from the fact that the scope of lambda-bound  variables 
   is only the lambda term that contains them, rather than the whole 
   clause.   The changes are quite extensive and tricky.
3.27.06  made two dated changes that prevented segmentation faults on Unix   
   
*/     

#include <assert.h>
#include "header.h"
#include "is2.h"
#include "beta.h"   // for Beeson's BINDER macro
#include "bsym.h"   // LAMBDA
// #define DIAGNOSTICS  // for debug printout

struct term_ptr *is_retrieve2(struct term *t,
			     struct context *subst,
			     struct is_tree *is,
			     struct is_pos **is_pos)
{
  struct rel *rel_stack[MAX_FS_TERM_DEPTH];
  struct is_tree *i1 = NULL;
  struct is_pos *pos, *ip2;
  int found, backup, varnum, j, reset, sym;
  int top = 0;
  int lflag=0;
  int varstack2[MAX_FS_TERM_DEPTH];
  int varstack3[MAX_FS_TERM_DEPTH];
  int varstack_top=0;
#ifdef DIAGNOSTICS  
  if(t == NULL)
    fprintf(stdout,"Coming back to is_retrieve for more\n");
  else
    fprintf(stdout,"Entering is_retrieve with :");print_term_nl(stdout, t); // DEBUG
#endif  
  

  if (t != NULL) {  /* first call */
    pos = NULL;
    top = -1;
    i1 = is->u.kids;
    backup = 0;
  }
  else if (*is_pos != NULL) {  /* continuation with more to try */
    pos = *is_pos;  /* must remember to set is_pos on return */
    backup = 1;
  }
  else  /* continuation with nothing more to try */
    return(NULL);

  while (1) {  /* loop until a leaf is found or done with tree */
    if (backup) {
      if (pos == NULL)
	      return(NULL);
      else {  /* pop top of stack (most recent variable node)
		           and restore state */
		  // we may have been inside one more more lambda terms when backtracking occurred.
		  // In that case some of the values of 'top-1' stored on varstack3
		  // are between the present value of top-1 and the new value  pos->stack_pos-1.
		  // On the other hand we may be backtracking INTO a lambda term that we had 
		  // already passed through.  
		  while(varstack_top > 0 &&                  // Beeson 3.27.06 
		        varstack3[varstack_top-1] <= top-1 &&
		        varstack3[varstack_top-1] >= pos->stack_pos-1
		       )
	        { // just finished last arg of a lambda term
	          int vn = varstack2[varstack_top-1];   // Beeson 4.25.04
	          subst->terms[vn] = NULL;
	          varstack_top--;
#ifdef DIAGNOSTICS	
              printf("Leaving lambda term\n");                // DEBUG              
	           fprintf(stdout,"Resetting variable %d\n to NULL",vn);   // DEBUG
#endif
	        }
	      top = pos->stack_pos;
	      for (j = 0; j <= top; j++)
	         rel_stack[j] = pos->rel_stack[j];
	      memcpy(subst->terms,pos->varvals,MAX_VARS*sizeof(struct term *));
	      i1 = pos->is;
	      t = subst->terms[i1->lab];
	      if ( pos->reset)  /* undo variable binding */
	         { subst->terms[i1->lab] = NULL;
#ifdef DIAGNOSTICS
              fprintf(stdout, "Unbinding %d \n", i1->lab);	            
#endif                 
            }
	      i1 = i1->next;
	      ip2 = pos;
	      pos = pos->next;
	      free_is_pos(ip2);
      }
    }

    /* at this point, i1 is the next node to try */
    found = 0;
    /* first try to match input term t with a variable node */
    while (found == 0 && i1 != NULL && i1->type == VARIABLE) {
      varnum = i1->lab;
      if (subst->terms[varnum] == NULL || lflag) 
        { /* if not bound, bind it; also if it's a lambda-variable that was bound, bind it anew */
	      subst->terms[varnum] = t;
	      subst->contexts[varnum] = NULL;
#ifdef DIAGNOSTICS	      
	      fprintf(stdout,"Binding %d to ",varnum); print_term_nl(stdout,t);  // DEBUG
	      fprintf(stdout,"varstack_top = %d and top = %d\n", varstack_top, top);
#endif	      
	      found = 1;
	      reset = 1;
	      if(lflag)
	         { lflag = 0;
	         
	       #ifdef DIAGNOSTICS
	           fprintf(stdout,"Setting lflag to 0\n");
	           fprintf(stdout, "storing variable %d in varstack2[%d]\n", varnum, varstack_top-1);
	       #endif

	           varstack2[varstack_top-1] = varnum;  // the variable being bound to lambda term
	           if(t->type != VARIABLE)
	               assert(0);
	         }
      }
      else {  /* bound variable, succeed iff identical */
              /* that is, identical up to renaming lambda-bound variables!--Beeson */
         found = term_ident(subst->terms[varnum], t);
	      reset = 0;  
      }

      if (found) {  /* save state */
	      ip2 = get_is_pos();
	      ip2->next = pos;
	      pos = ip2;
	      pos->is = i1;
	      pos->reset = reset;
	      for (j = 0; j <= top; j++)
	          pos->rel_stack[j] = rel_stack[j];
	      memcpy(pos->varvals,subst,MAX_VARS*sizeof(struct term *));
	      pos->stack_pos = top;
      }
      else  /* try next variable */
	      i1 = i1->next;
    }

    backup = 0;
    if (found == 0) {  /* couldn't match t with (another) variable */
      if (t->type == VARIABLE)
	       backup = 1;  /* because we can't instantiate given term */
      else {  /* NAME or COMPLEX */
	         sym = t->sym_num;
	         while (i1 != NULL && (int) i1->lab < sym)
	             i1 = i1->next;
	         if (i1 == NULL || i1->lab != sym)
	            backup = 1;
	         else if (t->type == COMPLEX && t->sym_num != Ignore_sym_num) {
	            top++;
	            if (top >= MAX_FS_TERM_DEPTH)
	               abend("is_retrieve, increase MAX_FS_TERM_DEPTH.");
	            rel_stack[top] = t->farg;  /* save pointer to subterms */
#ifdef DIAGNOSTICS	            
	            fprintf(stdout,"Pushing "); print_term_nl(stdout,t->farg->argval); // DEBUG
	            fprintf(stdout,"Now t is "); print_term_nl(stdout,t); // DEBUG
#endif 	            
	            if(BINDER(t->sym_num))
	                { 
	                  int vn =  t->farg->argval->varnum; // the lambda variable
	                  varstack3[varstack_top] = top-1; // where the list of args of the lambda term is stored
   #ifdef DIAGNOSTICS	                  
	                  fprintf(stdout, "Setting varstack3[%d] = %d", varstack_top, top-1);
   #endif	                  
	                  ++varstack_top;
	                  lflag = 1;  // used when we go to bind the lambda-variable.
	                  
   #ifdef DIAGNOSTICS
                     fprintf(stdout,"Setting lflag to 1\n");
                     fprintf(stdout, "Entering lambda term\n");     // DEBUG	                   
   #endif  	                   
	                }
	         }
      }
    }

    if (backup == 0) {  /* get next term from rel_stack */
      while (top >= 0 && rel_stack[top] == NULL)
	      { if(varstack_top > 0 &&                     // Beeson 3.27.06
	           varstack3[varstack_top-1] == top - 1)   // Beeson 4.2.04
	            { // just finished last arg of a lambda term
	              int vn = varstack2[varstack_top-1];   // Beeson 4.2.04
#ifdef DIAGNOSTICS	
                 printf("Leaving lambda term\n");                // DEBUG              
	              fprintf(stdout,"Resetting variable %d to NULL ",vn);   // DEBUG
#endif	         
                
	              subst->terms[vn] = NULL;     
	              varstack_top--;                                 // Beeson 4.2.04
	            }                                                 // Beeson 4.2.04
	        top--;
	      }                                                        // Beeson 4.2.04
	        
      if (top == -1) {  /* found a term */
	      *is_pos = pos;
	      return(i1->u.terms);
      }
      else {  /* pop a term and continue */
	         t = rel_stack[top]->argval;
#ifdef DIAGNOSTICS	         
	         fprintf(stdout,"just popped "), print_term_nl(stdout,t);  // DEBUG
#endif	         
	         rel_stack[top] = rel_stack[top]->narg;
	         i1 = i1->u.kids;
      }
    }
  }  /* end of while(1) loop */

}  /* is_retrieve2 */