Sindbad~EG File Manager

/* Author: M. Beeson */

#include <assert.h>
#include "header.h"
#include "beta.h"
#include "bterms.h"
#include "bsym.h"
#include "unify2.h"  // forbid
#include "fsubsto.h"
#include "unify.h"   // BIND
static struct term *apply2(struct term *t,struct context *c);

/*_________________________________________________________________________________________*/
struct term * fsubst3(struct term *a, struct term *x, struct context * c1, struct term *b, struct context *c2, struct trail **trp)
/* substitute a for (x,c1) in (b,c2).  It is assumed that a is a variable that does not 
occur in contexts c1 or c2.  
   If x is not a variable,  then substituting a for (x,c1) in b  should yield a if 
x equals b ;  but more generally if x,c1 UNIFIES with b,c2  it should 
yield a.  Example:  substitute z for g(X) in g(Y),  should succeed with result z,
recording the substitution X = Y in the context(s) and adding to the trail appropriately.
   If x is an unassigned variable, we
call unify.   But otherwise we just return a copy of b.
   The return value must be a term that makes sense in context c2.  
Hence the BIND call at the end.
   After this returns, the variable a is going to become a lambda-bound variable,  so 
the bindings that are made in c2 during fsubst3 should neither bind a, nor bind any
other variable to a term depending on a.
*/
{ term t, w, ans;
  struct rel *r,*s; 
  struct context *d;
  if(x->type == COMPLEX || x->type == NAME)
     { if(term_ident2(x,b,0))  // constant terms, equal except for renaming of bound variables
          return copy_term(a);
       if(c1==c2 && term_ident2(x,b,0))
          return copy_term(a);
       if(unify(x,c1,b,c2,trp))
          return copy_term(a);  // this can't bind a or bind to a since a doesn't occur in c1 or c2.
     }
  if(b->type == COMPLEX)
     { if(BINDER(b->sym_num) && VARNUM(ARG0(b))== VARNUM(a) && c1 == c2)
           return copy_term(b);  // should never happen since a doesn't occur in c1, c2.
           // without that hypothesis, we should rename the bound variable of b first
       ans = get_term();
       ans->sym_num = b->sym_num;
       ans->type = COMPLEX;
       s = get_rel();
       ans->farg = s;
       for(r = b->farg; r; r=r->narg)
          { s->argval = fsubst3(a,x,c1,r->argval,c2,trp);
            if(r->narg)
              { s->narg = get_rel();
                s = s->narg;
              }
          }
       return ans;
     }
  if(b->type == NAME)
      return copy_term(b);
  // now b->type == VARIABLE 

  if(c2->bound[b->varnum])
      return copy_term(b);  // do not substitute for a lambda bound variable!
  if(x->varnum == b->varnum && c1 == c2)
      return copy_term(a);  // even if b has a value in c2
  t = c2->terms[b->varnum];
  d = c2->contexts[b->varnum];
  if(!t)
     return copy_term(b);
  DEREFERENCE(t,d);
  w = fsubst3(a,x,c1,t,d,trp);
  if(w->type == VARIABLE && w->varnum == a->varnum)
     return w;  // a->varnum must be a,  since it didn't occur in either c1 or c2 to begin with.
  if(d == c2)
     return w;
  /* Originally I was going to create a new variable and BIND it to w.
     But that will violate the specification that nothing should be bound in c2
     to a term containing a.  Instead we must actually carry out the substitutions in d: */
  return apply2(w,d);
}
/*__________________________________________________________*/
struct clause *getContainingClause(struct term *t)
// If you can get to a clause by repeatedly taking t->occ.rel->argof
// until this is NULL and then t->occ.lit->container,  return that clause.
// If not (which will happen e.g. it t is TRUE or FALSE) return NULL.
{ struct term *p = t;
  while(p->occ.rel && p->occ.rel->argof && 
        (p->type == VARIABLE || p->varnum == 0)
       )
     p=p->occ.rel->argof;
  if(p->occ.lit == NULL)
       return NULL;
  return p->occ.lit->container;
}  
/*__________________________________________________________*/
static struct term *getContainingAtom(struct term *t)
{ struct term *p = t;
  while(p->occ.rel && p->occ.rel->argof && 
        (p->type == VARIABLE || p->varnum == 0)
       )
     p=p->occ.rel->argof;
  return p;
}  

/*__________________________________________________________*/
void prepare_context(struct term *t1, struct context *c1, int max)
/* set the forbid and next_var fields in c1 and c2 so that all bound variables in t1 are 
marked bound in c1, and all bound variables in t2 are marked bound in c2, and 
next_var exceeds all varnums in t1 and also is at least max.
*/
{ struct clause *cl1 = getContainingClause(t1); 
  struct literal *lit;
  memset(c1->forbidden,0,MAX_VARS *sizeof(int));
  memset(c1->bound,0,MAX_VARS *sizeof(int));
  for(lit =  cl1->first_lit; lit; lit = lit->next_lit)
     forbid_bound(c1,lit->atom);
  c1->next_var  = max_vars(cl1,t1);
  if(c1->next_var < max)
     c1->next_var = max;
}  
/*_______________________________________________________*/
 //static  // temporarily exposed for debugging
 int check_lambda(struct term *t)
/* return 0 if t has a subterm of the form lambda(s,.. where s is not a variable. 
Otherwise return 1. */
{ struct rel *r;
  if(t->type != COMPLEX)
     return 1;
  if(FUNCTOR(t)== LAMBDA && ARG0(t)->type != VARIABLE)
     return 0;
  for(r=t->farg;r;r=r->narg)
     { if(!check_lambda(r->argval))
          return 0;
     }
  return 1;
}  

/*_______________________________________________________*/
int check_lambdas(struct clause *c)
/* return 0 if there are any terms lambda(s,.. where s is not a variable.
Before returning, free the clause, its literals, and all their terms.  
If there are no such illegal lambda-terms, return 1.
*/
  
{ struct literal *q, *p = NULL;
  for(q = c->first_lit;q;q=q->next_lit)
     { if( !check_lambda(q->atom))
           goto fail;
     }
  return 1;
  fail:
  for(q = c->first_lit;q;q=q->next_lit)
		 { free_term(q->atom);
		   if(p) free_literal(p);
		   p = q;
		 }
  free_literal(p);
  free_clause(c);
  return 0;
}
/*_________________________________________________________________________*/
int blocking_functor(int f)
/* return 1 if f is the sym_num of "ind", "ind1", "ind2", ..."ind5",
or of none of those have sym_nums, of "g" or "e"  Return 0 otherwise.
Arity of these functors could be 1 or 2 depending on the formulation 
of induction.
*/
{
  static int g[5];  // space for the induction functors
  static int k;     // number of induction functors
  struct sym_ent *se;
  int j;
  char buffer[5];
  if(k == -1)       // no induction functors, already checked
     return 0;
  if(k==0)
     { // first call;  get the induction functors
       se = sym_tab_member("ind", 2);
       if(se)
         { g[k] = se->sym_num;
           ++k;
         }
       se = sym_tab_member("ind",1);
       if(se)
         { g[k] = se->sym_num;
           ++k;
         }
       strcpy(buffer,"ind");
       buffer[4] = 0;
       for(j=0;j<4;j++)
          { buffer[3] = '1' + j;
            se = sym_tab_member(buffer,2);
            if(se)
               { g[k] = se->sym_num;
                 ++k;
               }
              se = sym_tab_member(buffer,1);
            if(se)
               { g[k] = se->sym_num;
                 ++k;
               }   
          }
       if(k==0)
          { se = sym_tab_member("g",2);
            if(se)
               { g[k] = se->sym_num;
                 ++k;
               }
            se = sym_tab_member("g",1);   
            if(se)
               { g[k] = se->sym_num;
                 ++k;
               } 
            se = sym_tab_member("e",1);   // used for Hilbert's epsilon symbol
            if(se)
               { g[k] = se->sym_num;
                 ++k;
               }   
          }
       if(k==0)
         { k = -1;
           return 0;
         }
     }  
   for(j=0;j<k;j++)
   if(g[j] == f)
      return 1;
   return 0;
}
/*_________________________________________________________________________*/
static struct term * fsubst6(struct term *a,struct term *x, struct context * c1, struct term *b, struct context *c2, struct trail **trp, int mask, int first, int *last)
/* Presumes that x is a constant or Skolem term (in induction proofs)
 and  that a is a variable that does not 
occur in contexts c1 or c2.  Substitute a for occurrences of x in b that are not
subterms of a term with an "induction functor" g, AND are not subterms of any
lambda term.   Presumes that INDUCTION_FLAG
is set, and it looks for a function symbol (of arity 2) "ind" or "induction", or failing that, 
"g". 
   Like fsubst3,  this must return a term that makes sense in 
context c2.   
   The parameter mask is used when backtracking is desired.  A value of 1 for mask 
indicates no backtracking; just substitute for all occurrences of x in b.  But if mask
is nonzero, then number the occurrences of x in b and substitute for those whose 
numbers match the bits of mask.  For example, if mask is (in binary)  001001,  and there
are six occurrences of x,   substitute for the third and sixth occurrences.   
First and *last are used to count the occurrences of x that have been checked.
*/
{ term t, w, ans;
  struct rel *r,*s; 
  struct context *d;
  int next;
  *last = first;
  if(term_ident2(x,b,0))
     { *last = first + 1;
       if( (1 << first) & mask )
          return copy_term(a);
       else
          return copy_term(b);
     }
  if(x->type == VARIABLE && unify(x,c1,b,c2,trp))
     { *last = first+1;
       if( (1 << first) & mask)
          return copy_term(a);
       else
          return copy_term(b);
     }
  if(b->type == NAME)
      return copy_term(b);  
  if(b->type == COMPLEX)
      { if(BINDER(b->sym_num) && VARNUM(ARG0(b))== VARNUM(a) && c1 == c2)
           return copy_term(b);  // should never happen since a doesn't occur in c1, c2.
        if(blocking_functor(b->sym_num))
           return copy_term(b);  // per the specs
        ans = get_term();
        ans->sym_num = b->sym_num;
        ans->type = COMPLEX;
        s = get_rel();
        ans->farg = s;
        r = b->farg;      
        for(r = b->farg; r; r=r->narg)
           { s->argval = fsubst6(a,x,c1,r->argval,c2,trp,mask,first,&next);
             first = next;
             if(r->narg)
               { s->narg = get_rel();
                 s = s->narg;
               }
           }
        *last = next;
        return ans;
      }
  // now b->type == VARIABLE 
  t = c2->terms[b->varnum];
  if(c2->bound[b->varnum])
     return copy_term(b);    // added  6.26.05
  if(!t)
     { if(x->varnum == b->varnum)
         { *last = 1 + first;
           if( (1 << first) & mask)
              return copy_term(a);
           return copy_term(b);
         }
     }
  d = c2->contexts[b->varnum];
  w = fsubst6(a,x,c1,t,d,trp,mask,first,last);
  BIND(a->varnum,c1,w,c2,trp);
  return copy_term(a);
}

/*_________________________________________________________________________*/
struct term * fsubst5(struct term *a,struct term *x, struct context * c1, struct term *b, struct context *c2, struct trail **trp, int mask)
/* Presumes that x is a constant or Skolem term (in induction proofs)
 and  that a is a variable that does not 
occur in contexts c1 or c2.  Substitute a for occurrences of x in b that are not
subterms of a term with an "induction functor" g, AND are not subterms of any
lambda term.   Presumes that INDUCTION_FLAG
is set, and it looks for a function symbol (of arity 2) "ind" or "induction", or failing that, 
"g". 
   Like fsubst3,  this must return a term that makes sense in 
context c2.   
   The parameter mask is used when backtracking is desired.  A value of 1 for mask 
indicates no backtracking; just substitute for all occurrences of x in b.  But if mask
is nonzero, then number the occurrences of x in b and substitute for those whose 
numbers match the bits of mask.  For example, if mask is (in binary)  001001,  and there
are six occurrences of x,   substitute for the third and sixth occurrences.   
*/
{ term t, w, ans;
  struct rel *r,*s; 
  struct context *d;
  int last;
  if(Parms[MAX_UNIFIERS].val != 1)
      return fsubst6(a,x,c1,b,c2, trp, mask,0,&last);
  if(term_ident2(x,b,0))
     return copy_term(a);
  if(x->type == VARIABLE && unify(x,c1,b,c2,trp))
     return copy_term(a);
  if(b->type == NAME)
      return copy_term(b);  
  if(b->type == COMPLEX)
      { if(BINDER(b->sym_num) && VARNUM(ARG0(b))== VARNUM(a) && c1 == c2)
           return copy_term(b);  // should never happen since a doesn't occur in c1, c2.
        if(blocking_functor(b->sym_num))
           return copy_term(b);  // per the specs
        ans = get_term();
        ans->sym_num = b->sym_num;
        ans->type = COMPLEX;
        s = get_rel();
        ans->farg = s;
        r = b->farg;      
        for(r = b->farg; r; r=r->narg)
           { s->argval = fsubst5(a,x,c1,r->argval,c2,trp,mask);
             if(r->narg)
               { s->narg = get_rel();
                 s = s->narg;
               }
           }
        return ans;
      }
  // now b->type == VARIABLE 
  t = c2->terms[b->varnum];
  if(c2->bound[b->varnum])
     return copy_term(b);    // added  6.26.05
  if(!t)
     { if(x->varnum == b->varnum)
           return copy_term(a);
       return copy_term(b);
     }
  d = c2->contexts[b->varnum];
  w = fsubst5(a,x,c1,t,d,trp,mask);
  BIND(a->varnum,c1,w,c2,trp);
  return copy_term(a);
}


/*_______________________________________________________*/

static struct term *apply2(struct term *t,
                   struct context *c)
/* Like McCune's apply, but keeps varnums below MAX_VARS, using next_var */                   
{
  /* dereference if variable */

  /* A NULL context means that the subst was generated by match. */
  /* If the context is NULL, then apply just copies the term.    */

  while (t->type == VARIABLE && c != NULL && c->terms[t->varnum] != NULL) {
    int vn = t->varnum;
    t = c->terms[vn];
    c = c->contexts[vn];
  }

  if (t->type == VARIABLE) {  /* unbound variable */
    struct term *t2 = get_term();
    t2->type = VARIABLE;
    if (c == NULL)
      t2->varnum = t->varnum;
    else
      { t2->varnum = c->next_var;  // here's where apply2 differs from apply
        ++c->next_var;
        if(c->next_var == MAX_VARS)
           abend("Too many variables.");
      }
    return t2;
  }
  else if (t->type == NAME) {  /* name */
    struct term *t2 = get_term();
    t2->type = NAME;
    t2->sym_num = t->sym_num;
    return t2;
  }
  else {  /* complex term */
    struct rel *r1, *r2, *r3;
    struct term *t2;
    int  vv;
    struct term *saveit;
    if(Flags[LAMBDA_FLAG].val && BINDER(t->sym_num))        
        { vv = t->farg->argval->varnum;                     
          saveit = c->terms[vv];                            
          c->terms[vv] = NULL;                            
        }
    t2 = get_term();
    t2->type = COMPLEX;
    t2->sym_num = t->sym_num;
    r3 = NULL;
    r1 = t->farg;
    while (r1 != NULL ) {
      r2 = get_rel();
      if (r3 == NULL)
        t2->farg = r2;
      else
        r3->narg = r2;
      r2->argval = apply2(r1->argval, c);
      r3 = r2;
      r1 = r1->narg;
    }
    if(Flags[LAMBDA_FLAG].val && BINDER(t->sym_num)) // Beeson
        c->terms[vv] = saveit;  // Beeson
    return t2;
  }
}  /* apply2 */