Sindbad~EG File Manager
/* Second-order unification for Otter */
/* M. Beeson */
/*
11.24.00 original date
7.24.05 last modified
11.27.05 modified at the dated line.
12.18.05 modified code for multiple unifiers
3.20.06 made include filenames lowercase
5.21.06 added code for unifying Ap(r,w) with t, when r is not a variable, at lines 795 ff.
This enables things like Ap(Ap(x,y),z) = 3, yielding x = lambda(u,u), y = lambda(v,v), z = 3.
7.10.06 changes to occur_check2.
*/
// #define DIAGNOSTICS
#include <assert.h>
#include <stdlib.h>
#include "header.h"
#include "unify.h" /* BIND and DEREFERENCE */
#include "bterms.h"
#include "bsym.h"
#include "beta.h"
#include "unify2.h"
#include "proto.h" // occur_check
#include "fsubsto.h"
#include "getconstant.h"
#ifndef max
#define max(a,b) ((a) > (b) ? (a) : (b))
#endif
static int get_var(struct term * w, struct context *c1, struct term * t, struct context *c2, struct trail **trp);
static struct term *getMaskingSubterm(struct term *a, struct context **cp,
struct term *X, struct context *c1,
struct term *t, struct context *c2,
struct term *w);
static void forbid_all_but(struct term *z,struct context *d, struct term *a, struct context *c1, struct term *x, struct context *c2);
/*_____________________________________________________________
This file implements untyped lambda-unification as described in
Beeson's paper in IJCAR-2004.
It presupposes lambda-terms and application terms, and beta-reduction.
It also requires the notion of a variable being "forbidden" to another
variable, so that unification will never assign a value to X that
contains variables forbidden to X.
/*_____________________________________________________________*/
#define BIT(i,r) ((r[i/sizeof(int)] & (1 << (i%r))) >> (i % r))
/*_____________________________________________________________*/
static int is_answer_literal(struct term *t)
/* return 1 if t is (the atom of) an answer literal */
{ if(t->type == COMPLEX && t->varnum == ANSWER)
return 1;
return 0;
}
/*_____________________________________________________________*/
static int variable_free(struct term *t)
/* return 1 if t does not contain any variables, 0 if it does */
{ struct rel *r;
int q;
if(t->type == VARIABLE)
return 0;
if(t->type == NAME)
return 1;
for(r = t->farg; r; r= r->narg)
{ q = variable_free(r->argval);
if(!q)
return 0;
}
return 1;
}
/*_____________________________________________________________*/
void trace(char *x, term t)
/* used for debugging */
{ fprintf(stdout,"\n%s",x);
print_term(stdout,t);
}
/*____________________________________________________________*/
struct term *newvar(struct context *c1, struct context *c2)
/* return a new variable, whose varnum will be the max of k, c1->next_var,
and c2->next_var, and increase c1->next_var and c2->next_var to be one
more than this new varnum.
*/
{ struct term *ans;
if(c1->next_var == -2 || c2->next_var == -2)
abend("newvar called on a context created with get_context instead of get_context2");
if(c1->next_var == -1 || c2->next_var == -1)
{ abend("Too many new variables requested in newvar");
}
ans = get_term();
ans->sym_num = 0; // 6.30.03
ans->type = VARIABLE;
ans->varnum = c1->next_var > c2->next_var ? c1->next_var : c2->next_var;
if(ans->varnum > MAX_VARS) // DEBUG
assert(0); // DEBUG
c1->next_var = ans->varnum + 1;
c2->next_var = ans->varnum + 1;
if(c1->next_var == MAX_VARS)
c1->next_var = -1;
if(c2->next_var == MAX_VARS)
c2->next_var = -1;
return ans;
}
/*____________________________________________________________*/
/* functions to access and set the entries of the 'forbidden' part of a context;
each entry in the 'forbidden' array is of type restrictdata, which is a struct int_ptr *.
Each entry in this list is four bytes long. The low-order byte is the varnum, the
three upper bytes are the context multiplier. More than 4096 contexts will cause
an abend. */
void forbid(term x, struct context *c1, term y, struct context *c2)
/* set an entry in c1 forbidding x to take a value depending on (y, c2).
If c2 is NULL then y is a constant. If c2 is not NULL than (y,c2) is a variable.
*/
{ intlist p = get_int_ptr();
if(x->type != VARIABLE)
assert(0);
if(x->varnum > MAX_VARS)
assert(0);
if(c2)
{ if(y->varnum > 256)
assert(0);
if(y->type != VARIABLE)
assert(0);
FSETVARNUM(p->i,y->varnum);
FSETVAR(p->i);
FSETMULTIPLIER(p->i,c2->multiplier);
p->next = c1->forbidden[x->varnum];
c1->forbidden[x->varnum] = p;
return;
}
else // y is a constant
{ FSETSYMNUM(p->i, y->sym_num);
FSETCONSTANT(p->i);
p->next = c1->forbidden[x->varnum];
c1->forbidden[x->varnum] = p;
return;
}
}
int forbidden2(int vn, struct context *c1, int vn2, struct context *c2)
/* vn and vn2 are variable numbers in contexts c1 and c2 respectively.
Return 1 if (vn2, c2) is forbidden to (vn,c1). Return 0 otherwise.
*/
{ struct int_ptr *marker;
int a;
marker = c1->forbidden[vn];
if(c1 == c2 && vn == vn2)
return 1; // a variable is always forbidden to itself
while(marker)
{ a = marker->i;
if(FISVAR(a))
{ if( FMULTIPLIER(a)==c2->multiplier &&
vn2 == FVARNUM(a)
)
return 1;
}
marker = marker->next;
}
return 0;
}
static int forbidden(term x,struct context *c1, term y, struct context *c2)
/* return 1 if y,c2 is a variable forbidden to x in context c1,
or if y is a constant forbidden to x in context c1,
of if y is a complex term and some subterm of y is forbidden to x in context c1.
*/
{ struct int_ptr *marker;
int a;
struct rel *r;
if(x->type != VARIABLE)
assert(0);
if(y->type == COMPLEX)
{ for(r=y->farg; r; r=r->narg)
{ if(forbidden(x,c1,r->argval,c2))
return 1;
}
return 0;
}
// now y is a constant or variable in context c2
marker = c1->forbidden[x->varnum];
if(y->type == VARIABLE)
{ if(c1 == c2 && y->varnum == x->varnum)
return 1; // a variable is always forbidden to itself
while(marker)
{ a = marker->i;
if(FISVAR(a))
{ if( c2->multiplier == FMULTIPLIER(a) &&
y->varnum == FVARNUM(a)
)
return 1;
}
marker = marker->next;
}
}
else // y->type == NAME, y is a constant
{ while(marker)
{ a = marker->i;
if(!FISVAR(a) && FSYMNUM(a) == y->sym_num)
return 1;
marker = marker->next;
}
}
return 0;
}
/*_____________________________________________________________*/
void validate_context(struct context *c)
// Beeson's function, for debugging only.
{ int i;
for(i=0;i<MAX_VARS;i++)
{ if(c->terms[i])
{ if(c->contexts[i] == NULL)
assert(0);
if(c->contexts[i] == (struct context *) 0xcdcdcdcd)
assert(0);
if(!occur_check(i,c,c->terms[i],c->contexts[i]))
{ occur_check(i,c,c->terms[i],c->contexts[i]); // repeat so we can debug
assert(0);
}
if(c->bound[i] && c->terms[i] &&
!(c->terms[i]->type == VARIABLE && c->contexts[i]->bound[c->terms[i]->varnum] != 0)
)
{ printf("variable %d is bound to ",i),
print_term_nl(stdout, c->terms[i]);
assert(0);
}
}
}
if(c->multiplier < 0)
assert(0);
if(c->next_var < 0)
assert(0);
}
/*________________________________________________________________*/
static int unify2_aux(struct term *s, struct context *c1, struct term *t, struct context * c2, struct trail ** trp)
/* It is presumed that s has the form Ap(X,q) where X is assigned in c1 to some
other term. In particular X might be assigned to a lambda-term lambda(w,p) in
some context c3 (which might or might not be c1).
Handle unify2's job in that case by temporarily labeling w as not lambda-bound in c3
and then assign it to (q,c1), then try to unify (p,c3) and (t,c2), then restore the bound label
for (w,c3) afterwards. In case the dereferenced value of X is not a lambda-term,
just make a recursive call to unify2.
There is a problem here in case q already contains w. Of course Otter-lambda
clauses don't contain the same variable both free and bound, so q can't contain
w free, but it might contain another bound occurrence of w. In that case, having temporarily
labeled w as not-bound, we're in trouble as the convention that the same variable
can't be free and bound will be violated for the duration of this temporary assumption.
There is another problem in that when p and t are unified, some variable in c2
might be bound to (w,c3). That binding, if it occurs, must be removed from the
trail and from c2->terms before exiting.
*/
{ struct trail *savetrail;
struct trail *tp = *trp;
struct trail *prev = NULL;
struct context *c3 = c1;
struct term *p = ARG0(s);
struct term *w;
int failflag = 0;
int rval;
DEREFERENCE(p,c3) // c3 could be different than c1
if(p->type != COMPLEX || FUNCTOR(p) != LAMBDA)
// return unify2(p,c3,t,c2,trp); // FIX THIS--this isn't right
return 0; // 11.29.05
w = ARG0(p);
if(w->type != VARIABLE)
assert(0);
#ifdef DIAGNOSTICS
V(c3,c2); // DEBUG
#endif
if(c3->bound[w->varnum] != 1) // debug
assert(0); // debug
c3->bound[w->varnum]= 0; // until after the unify call
if(!(c3==c2 && ARG1(s)->type == VARIABLE && ARG1(s)->varnum == w->varnum))
{ savetrail = *trp;
BIND(w->varnum,c3,ARG1(s),c3,trp);
#ifdef DIAGNOSTICS
fprintf(stdout,"Binding %d to ", w->varnum); print_term_nl(stdout,ARG1(s)); // DEBUG
#endif
free_trail(*trp);
*trp = savetrail;
}
#ifdef DIAGNOSTICS
// V(c3,c2); // DEBUG
fprintf(stdout,"Calling unify on \n"); // DEBUG
print_term_nl(stdout,ARG1(p)); // DEBUG
print_term_nl(stdout,t); // DEBUG
#endif
rval = unify(ARG1(p),c3,t,c2,trp); // corrected 7.17.03
if(c3->terms[w->varnum]->type != VARIABLE)
failflag = 1;
c3->bound[w->varnum] = 1; // restoring the original value
c3->terms[w->varnum] = NULL; // removing any assignment to the bound variable
// Now, what about an assignment in c2 to (w,c3)?
while(tp)
{ if( tp->context == c2 &&
c2->terms[tp->varnum]->type == VARIABLE &&
c2->contexts[tp->varnum] == c3 &&
c2->terms[tp->varnum]->varnum == w->varnum
)
{ c2->contexts[tp->varnum] = NULL;
c2->terms[tp->varnum] = NULL;
undo_forbidden(tp);
if(prev == NULL)
*trp = tp->next;
else
prev->next = tp->next;
}
tp = tp->next;
}
if(!rval || failflag)
return 0;
return rval;
}
/*_____________________________________________________________*/
int unify2(struct term *s, struct context *c1,struct term *t, struct context *c2, struct trail **trp)
/* lambda unification. t1 and t2 are presumed to be already
dereferenced. For documentation of the parameters see unify in unify.c.
Return 1 for success, 0 for failure, and restore the entrance value of *trp before failing.
Also, if any new terms are created, they must be destroyed on failure.
// FIX THIS--this destruction on failure is not done yet.
Any new terms that are created should NOT be integrated terms.
Since terms arising from previously kept clauses WILL be integrated terms,
they need to be copied first.
If Flags[LAMBDA_FLAG] == 2, that means this is called during para_from, and we
don't want to instantiate new variables by lambda-unification during paramodulation,
so two AP terms should unify only as they normally would. Nevertheless we have to
be careful not to unify a lambda-bound variable with anything.
*/
{ int index;
term w,p,X,z,q,Y,x,b2,r;
struct context *c3;
int rval,k;
int saveit1= -1, saveit2= -1;
struct trail *tpos = *trp; /* save trail position in case of failure */
// V(c1,c2); // DEBUG 7.27.03
if(c1->next_var >= 0)
saveit1 = c1->next_var;
if(c2->next_var >= 0)
saveit2 = c2->next_var;
if(FUNCTOR(s) == AP && FUNCTOR(t) == AP)
{ // see if the args unify by first-order unification. Can't just
// call unify since unify will call unify2.
struct rel *r1 = s->farg;
struct rel *r2 = t->farg;
#ifdef DIAGNOSTICS
{ fprintf(stdout,"Calling unify2 on\n"); // DEBUG 6.16.03
print_term_nl(stdout, s); // DEBUG 6.16.03
fprintf(stdout,"and\n"); // DEBUG 6.16.03
print_term_nl(stdout,t); // DEBUG 6.16.03
V(c1,c2); // DEBUG 7.27.03
}
#endif
while (r1 && unify(r1->argval, c1, r2->argval, c2, trp))
{ r1 = r1->narg;
r2 = r2->narg;
}
if (r1 == NULL)
return 1;
else
{ /* restore trail and continue */
struct trail *tp = *trp;
while (tp != tpos)
{ struct trail *t3 = tp;
undo_forbidden(tp); // Beeson 6.26.03
tp->context->terms[tp->varnum] = NULL;
tp = tp->next;
free_trail(t3);
}
}
*trp = tpos;
// don't return here--go on to second-order unification.
}
#if 0 // DEBUG
{ struct context *last1=c1, *last2=c2;
while(last1->next && last2->next)
{ last1=last1->next;
last2=last2->next;
}
if(last1->next || last2->next)
assert(0); // the two lists must have the same length
}
#endif
if(FUNCTOR(s) == AP && FUNCTOR(ARG0(s)) == LAMBDA)
{ // s permits a top-level beta-reduction
term a = ARG1(s); // corrected 6.24.03
term b = ARG1(ARG0(s));
#ifdef DIAGNOSTICS
{ fprintf(stdout,"Calling unify2 on\n"); // DEBUG 6.16.03
print_term_nl(stdout, s); // DEBUG 6.16.03
fprintf(stdout,"and\n"); // DEBUG 6.16.03
print_term_nl(stdout,t); // DEBUG 6.16.03
V(c1,c2); // DEBUG 7.7.03
}
#endif
/* Now ARG0(ARG0(s)) is lambda-bound in c1
but in b it is free, and it might occur bound elsewhere in c1,
so to keep the property that no variable occurs both free and bound
in the same clause, we have to rename this variable. */
x = newvar(c1,c2);
b2 = copy_term(b);
rename2(ARG0(ARG0(s))->varnum,x->varnum,b2);
BIND(x->varnum,c1,a,c1,trp);
free_term(x); // added 7.13.03
rval = unify(b2,c1,t,c2,trp);
if(!rval)
{ free_term(b2);
goto fail;
}
return 1;
}
if(FUNCTOR(t) == AP && FUNCTOR(ARG0(t)) == LAMBDA)
{ // t permits a top-level beta-reduction
term a = ARG1(t);
term b = ARG1(ARG0(t));
#ifdef DIAGNOSTICS
{ fprintf(stdout,"Calling unify2 on\n"); // DEBUG 6.16.03
print_term_nl(stdout, s); // DEBUG 6.16.03
fprintf(stdout,"and\n"); // DEBUG 6.16.03
print_term_nl(stdout,t); // DEBUG 6.16.03
V(c1,c2); // DEBUG 6.27.03
}
#endif
x = newvar(c1,c2);
b2 = copy_term(b);
rename2(ARG0(ARG0(t))->varnum,x->varnum,b2);
BIND(x->varnum,c2,a,c2,trp);
free_term(x); // added 7.13.03
// V(c1,c2); // DEBUG 7.27.03
rval = unify(s,c1,b2,c2,trp);
if(!rval)
{ free_term(b2);
goto fail;
}
return 1;
}
if(FUNCTOR(s)== AP && t->type == VARIABLE &&
occur_check(t->varnum,c2,s,c1)
)
{ BIND(t->varnum,c2,s,c1,trp)
return 1;
}
if(FUNCTOR(t) == AP && s->type == VARIABLE &&
occur_check(s->varnum,c1,t,c2)
)
{ BIND(s->varnum,c1,t,c2,trp)
return 1;
}
if(Flags[LAMBDA_FLAG].val==2)
goto fail; // this is reached when doing paramodulation
if(FUNCTOR(s) == AP &&
TYPE(ARG0(s)) == VARIABLE // &&
)
{ /*lambda unification */
#ifdef DIAGNOSTICS
fprintf(stdout,"Calling unify2 on\n"); // DEBUG 6.16.03
print_term_nl(stdout, s); // DEBUG 6.16.03
fprintf(stdout,"and\n"); // DEBUG 6.16.03
print_term_nl(stdout,t); // DEBUG 6.16.03
#endif
index = ARG0(s)->varnum;
if(c1->next_var == 0) // DEBUG
assert(0); //DEBUG
if(c1->terms[index])
{ /* alreadyinstantiated */
rval = unify2_aux(s,c1,t,c2,trp);
if(rval)
return rval;
goto fail;
}
// s = ap(X,w) with X not instantiated
if(FUNCTOR(t) == AP &&
TYPE(ARG0(t)) == VARIABLE
)
{ int index2 = ARG0(t)->varnum;
if(!c2->terms[index2] && !(c1==c2 && index == index2))
{ // ARG(0,t) is not already instantiated,
// and is not the same variable as ARG(0,s)
BIND(index,c1,ARG0(t),c2,trp);
// V(c1,c2); // DEBUG 7.27.03
rval = unify(ARG1(s),c1,ARG1(t),c2,trp);
if(!rval)
goto fail;
return rval;
}
else
{ rval = unify2_aux(t,c2,s,c1,trp);
if(rval) // if ARG(0,t) dereferences to a lambda-term
return rval;
goto fail;
}
}
w = ARG1(s);
X = ARG0(s);
if(c1->bound[X->varnum])
goto fail; /* this definitely can legally happen,
e.g. when unifying Ap(X,w) with something containing a lambda term
that contains another Ap in the body of the lambda term
then getConstant returns some c and call fsubst3(z for c in the Ap term),
which in turn tries to unify c with the Ap term. The first arg in that
inner Ap term can be bound by the outer lambda. */
if(is_answer_literal(t))
return 0; // example, Ap(X,s) unifying with $ANS(X).
// don't put an occurs check here, since in case t is forbidden to X,
// t may actually be allowed to contain X, e.g. t = g(X).
if(Flags[CASES_FLAG].val &&
// variable_free(t) && // added and removed several times
// this causes us to generate cases terms only using constants for the
// case distinctions. It prevents example-CADE.in from working right.
!forbidden(X,c1,t,c2) && !forbidden(X,c1,w,c1)
)
{ if(! occur_check(ARG0(s)->varnum,c1,t,c2))
goto fail;
if(c1->next_var == -2 || c2->next_var == -2)
{ fprintf(stdout, "unify2 called with contexts created by get_context instead of get_context2\n"); // DEBUG 7.14.03
// don't let it go to an abend in next_var--this is called e.g. from para_from, so
// just don't use unify2 for paramodulation.
goto fail;
}
/* take X == lambda z. cases(z,w,t,Y(z)) where Y is a new variable
z needs to be a variable that is not bound in t; but newvar() only
avoids free vars. */
for(k=max(c1->next_var,c2->next_var); c2->bound[k] || c1->bound[k];k++)
{ if(k==MAX_VARS)
abend("can't create a new variable for lambda-unification.");
}
// be sure that newvar will avoid the bound variables of t
/* if(k < c2->next_var)
c2->next_var = k;
if(k < c1->next_var)
c1->next_var = k; */ // commented out as candidate for removal 5.21.06
Y = newvar(c1,c2);
z = newvar(c1,c2);
if(variable_free(t))
{ /* t may be an atom, not a term, which means that its superterm
list points to a literal, not a list of
superterms. Therefore we make a copy of it. */
struct term *t3 = copy_term(t);
struct term *w3 = copy_term(w);
t3->occ.rel = NULL;
/* t is in context c2, but it's variable-free, so it's really
in no context at all. */
p = lambda(z,cases(z,w3,t3,ap(Y,z)));
c1->bound[z->varnum] = 1;
}
else // with variable-free in the code above, we wouldn't ever get here.
{ /* t is in context c2, so we can't create cases(z,w,t,Y(z)) sensibly,
as it wouldn't belong in context c1 or in context c2. Instead we
create a new variable in context c1 and bind it to (t,c2). After
the inference step, when rename_variables is called, this variable
will disappear. */
struct term *w4 = copy_term(w);
q = newvar(c1,c2);
BIND(q->varnum,c1,t,c2,trp)
++t->fpa_id;
p = lambda(z,cases(z,w4,q,ap(Y,z)));
c1->bound[z->varnum] = 1;
}
// V(c1,c2); // DEBUG 7.22.03
BIND(X->varnum,c1,p,c1,trp);
++p->fpa_id;
// V(c1,c2); // DEBUG 6.27.03
return 1;
}
else
{ struct term *rr;
int oflag;
int W;
/* now t is forbidden to X, or cases terms are not wanted.
To unify Ap(X,W) with t, produce
X = lambda z. t[W:=z].
*/
for(k=max(c1->next_var,c2->next_var); c2->bound[k] || c1->bound[k];k++)
{ if(k==MAX_VARS)
abend("can't create a new variable for lambda-unification.");
}
// be sure that newvar will avoid the bound variables of t
if(k < c2->next_var)
c2->next_var = k;
if(k < c1->next_var)
c1->next_var = k;
z = newvar(c1,c2);
rr = copy_term(t);
oflag = occur_check(X->varnum,c1,t,c2);
if(w->type == VARIABLE && oflag &&
(W = get_var(w,c1,t,c2,trp)) >= 0
)
rename2(W,z->varnum,rr); // simpler than fsubst3
else if(w->type == VARIABLE && oflag)
{ /* t is variable-free and w is unassigned.
We're unifying Ap(X,w) with t,and we don't want cases terms.
Example: t is pow(b,c)=0 in proving
by induction that integral domains have no nilpotents.
In that example we want to produce rr = pow(z,c).
In general we want rr to be the result of substituting
z for a constant in t. If INDUCTION_FLAG is set,
that variable should be of type NatNum. We bind
w to n. Thus Ap(X,w) = Ap(lambda(z,t[n:=z]),w) =
t[n:=z][z:=w]) = t since w is bound to n.
*/
struct term *n = getConstant(t);
if(n == NULL)
{ if(FUNCTOR(t) == LAMBDA)
n = t; /* example, t = lambda(u,u) as arises when unifying
Ap(Ap(x,y),z) with 3; first we create Z and unify
Ap(Z,z) with 3 getting Z := lamba(u,u), and then
we unify Ap(x,y) with Z, that is, with lambda(u,u),
getting x:= lambda(v,v), y:= lambda(u,u), z:= 3.
See test file curry1.in */
else
goto fail;
}
#ifdef DIAGNOSTICS
fprintf(stdout,"getConstant returns: "), print_term_nl(stdout,n); // DEBUG
#endif
if(Flags[INDUCTION_FLAG].val)
{ int max_unifiers = Parms[MAX_UNIFIERS].val;
int mask;
int success = 0;
struct context *c3,*c4;
struct context *savec1next = c1->next;
struct context *savec2next = c2->next;
if(max_unifiers > 1)
{ c3 = copy_context(c2);
c2->next = c3;
c3 = c2;
c4 = copy_context(c1);
c1->next = c4;
c4 = c1;
}
else
{ c3 = c2;
c4 = c1;
}
for(mask=1;mask<=max_unifiers;mask++)
{
rr = fsubst5(z,n,c3,t,c3,trp,mask);
#ifdef DIAGNOSTICS
fprintf(stdout, "fsubst5 called on \n"); // DEBUG
print_term_nl(stdout,z),// DEBUG
print_term_nl(stdout,n),// DEBUG
print_term_nl(stdout,t),// DEBUG
fprintf(stdout, "yielding \n");// DEBUG
print_term_nl(stdout,rr);// DEBUG
#endif
if(!occur_check(X->varnum,c1,rr,c3))
{ free_term(rr);
continue;
}
else
{ success = 1;
#ifdef DIAGNOSTICS
printf("mask = %d ",mask); print_term_nl(stdout,rr); // DEBUG
#endif
BIND(w->varnum,c4,n,c3,trp);
q = lambda(z,rr);
c3->bound[z->varnum] = 1;
BIND(X->varnum,c4,q ,c3,trp);
#ifdef DIAGNOSTICS
fprintf(stdout,"unify2 succeeds with: \n"); // DEBUG 7.3.03
print_term_nl(stdout,q); // DEBUG 7.3.03
#endif
c3 = c3->next;
c4 = c4->next;
if(mask + 1 <= max_unifiers)
{ c3->next = copy_context(c2);
c4->next = copy_context(c1);
}
}
}
if(!success)
{ c1->next = savec1next;
c2->next = savec2next;
goto fail;
}
if(max_unifiers > 1)
{ assert(c3->next == NULL);
assert(c4->next == NULL);
c3->next = savec2next;
// thus the new unifiers are inserted in the pre-existing list of unifiers, if any
}
#if 0 // DEBUG
{ struct context *last1=c1, *last2=c2;
while(last1->next && last2->next)
{ last1=last1->next;
last2=last2->next;
}
if(last1->next || last2->next)
assert(0); // the two lists must have the same length
}
#endif
return 1;
}
else
{ // V(c1,c2); // DEBUG
rr = fsubst3(z,n,c2,t,c2,trp);
// V(c1,c2); // DEBUG
BIND(w->varnum,c1,n,c2,trp);
}
}
else if (w->type == VARIABLE && // and the occurs check failed
(r = getMaskingSubterm(NULL,&c3,X,c1,t,c2,w)) != NULL
)
{ /* the next clause would produce X = lambda z.z and
w = t, which is a solution since X(w) = t then,
but not the one we want. Instead we want a subterm
r of t such that r contains all the occurrences of
X or variables forbidden to X in t, and r occurs
as the second arg of an Ap subterm in t, and no
proper subterm of r has those properties. We then
get rr by substituting z for r in t. If there
is no such term then BIND z in c2 to (w,c1) and
BIND X to lambda(z,z) and w to t. If there is,
BIND w to r and X to lambda(z,rr).
*/
#ifdef DIAGNOSTICS
fprintf(stdout, "getMaskingSubterm returned:\n"); // DEBUG
print_term_nl(stdout,r); // DEBUG
#endif
rr = fsubst3(z,r,c3,t,c2,trp);
#ifdef DIAGNOSTICS
fprintf(stdout,"rr = \n"); // DEBUG
print_term_nl(stdout,rr); // DEBUG
#endif
if(!rr || !occur_check(X->varnum,c1,rr,c2))
assert(0);
// V(c1,c2); // DEBUG
// Maybe r is a variable in c3 that's already bound to w.
// If so, we don't want to bind w to r.
if(r->type == VARIABLE && c3->terms[r->varnum] != 0 &&
c3->terms[r->varnum]->type == VARIABLE &&
c3->contexts[r->varnum] == c1 &&
c3->terms[r->varnum]->varnum == w->varnum
)
; // do nothing
else
BIND(w->varnum,c1,r,c3,trp);
// V(c1,c2); // DEBUG
}
else // w is not a variable
{ rr = fsubst3(z,w,c1,t,c2,trp);
if(rr == NULL ||
(rr->sym_num == '=' && occur_check(z->varnum,c2,rr,c2)) //7.3.04
)
goto fail;
#ifdef DIAGNOSTICS
fprintf(stdout, "fsubst3 called on \n"); // DEBUG
print_term_nl(stdout,z),// DEBUG
print_term_nl(stdout,w),// DEBUG
print_term_nl(stdout,t),// DEBUG
fprintf(stdout, "yielding \n");// DEBUG
print_term_nl(stdout,rr);// DEBUG
V(c1,c2);
#endif
if(c1->terms[X->varnum])
{ struct context *c3 = c1;
struct term * tt = X;
DEREFERENCE(tt,c3);
if(c3 != c2 || !term_ident(tt,rr))
goto fail;
}
if(!occur_check2(X->varnum,c1,rr,c2) ||
c1->terms[X->varnum] || // 6.13.04
c1->terms[z->varnum] // 6.13.04
)
{ free_term(rr);
goto fail;
}
}
if(forbidden(X,c1,rr,c2))
{ zap_term_special(rr); // fsubst3 made a copy
goto fail; // the substitution must have eliminated all forbidden constants/variables, or we fail.
}
# if 0
// the following lines implement weak unification, see Solving For Functions by Beeson
// produce X = lambda z. or(t[w:= z], Y(z))
Y = newvar(c1,c2);
rr = otter_or(rr,ap(Y,z));
#endif
q = lambda(z,rr);
c2->bound[z->varnum] = 1;
if(!occur_check2(X->varnum,c1,q,c2))
{ free_term(q);
goto fail;
}
BIND(X->varnum,c1,q ,c2,trp);
#ifdef DIAGNOSTICS
fprintf(stdout,"unify2 succeeds with: \n"); // DEBUG 7.3.03
print_term_nl(stdout,q); // DEBUG 7.3.03
#endif
return 1;
}
}
if(FUNCTOR(t)== AP &&
FUNCTOR(s) != AP
// TYPE(ARG0(t)) == VARIABLE commented out 5.22.06
)
// switch the order of the arguments
return unify(t,c2,s,c1,trp);
if(FUNCTOR(s) == AP && TYPE(ARG0(s)) != VARIABLE)
{ struct term *r = ARG0(s);
struct term *w = ARG1(s);
/* Create a fresh variable Z, unify Ap(Z,w) with t, producing sigma;
unify Z sigma with r sigma, producing tau; undefine sigma tau on Z and return the result. */
struct term *Z = newvar(c1,c2);
struct term *left = ap(Z,w);
if(!unify2(left,c1,t,c2,trp) || !unify(Z,c1,r,c1,trp))
{ free_term(left);
free_term(Z);
goto fail;
}
// now c1,c2 specify sigma tau
// There's no need to remove the value given to Z in c1; it just won't be used.
return 1; // success
}
fail: /* restore trail and fail */
{ struct trail *tp = *trp;
while (tp != tpos)
{ struct trail *t3 = tp;
undo_forbidden(tp);
tp->context->terms[tp->varnum] = NULL;
tp = tp->next;
free_trail(t3);
}
*trp = tpos;
restore_vars(c1,c2,saveit1,saveit2);
return 0;
}
}
/*________________________________________________*/
void restore_vars(struct context *c1, struct context *c2, int saveit1, int saveit2)
// restore the bound arrays in the two contexts, and restore next_var.
{ int i;
if(c1->next_var >= 0)
{ for(i=saveit1; i<c1->next_var; i++)
c1->bound[i] = 0;
c1->next_var = saveit1;
}
if(c2->next_var >= 0)
{ for(i=saveit2; i<c2->next_var; i++)
c2->bound[i] = 0;
c2->next_var = saveit2;
}
}
/*__________________________________________________________________*/
void split_not_or(struct clause *c)
/* From -or(a,b) | c infer -a | c and -b | c. Similarly for -or(a1,...an).
From -or(and(a1,a2),b) | c infer -a1 | -a2 | c and -b | c.
Append the new inferences to sos.
*/
{ struct literal *marker = c->first_lit;
struct literal *marker2, *prev;
struct literal *q;
struct term *t;
struct clause *aclause;
struct rel *r;
struct int_ptr *ip0,*ip1;
while(marker)
{ if(!marker->sign && marker->atom->sym_num == OR)
break; // the rule will apply.
marker=marker->next_lit;
}
if(!marker)
return; // not applicable
t = marker->atom; // the OR term
for(r=t->farg;r;r=r->narg) // go through the args of t
{ aclause = get_clause();
// copy c into aclause, but put r->argval in at the place corresponding to marker,
// with a negation sign.
prev = NULL;
for(marker2 = c->first_lit;marker2; marker2=marker2->next_lit)
{ if(marker2 == marker)
{ q = get_literal();
q->sign = 0;
q->atom = copy_term(r->argval);
if(!prev)
aclause->first_lit = q;
else
prev->next_lit = q;
q->next_lit = NULL;
q->container = aclause;
prev = q;
continue;
}
// make a copy of the next literal in c and append it to aclause
q = get_literal();
q->atom = copy_term(marker2->atom);
q->container = marker2->container;
if(prev)
prev->next_lit = q;
else
aclause->first_lit = q;
prev = q;
q->next_lit = NULL;
q->sign = marker2->sign;
q->target = marker2->target;
q->container = aclause;
}
// set the parents of aclause
ip0 = get_int_ptr();
ip1 = get_int_ptr();
ip1->next = NULL;
ip0->i = SPLIT_NOT_OR;
ip0->next = ip1;
ip1->i = c->id;
aclause->parents = ip0;
// now append aclause to sos
pre_process(aclause,0,Sos);
}
}
/*__________________________________________________________________*/
void split_and(struct clause *c)
/* From and(a,b) | c infer a | c and b | c. Similarly for and(a1,...an) | c.
From and(or(a1,a2),b) | c infer a1 | a2 | c and b | c.
Append the new inferences to sos.
*/
{ struct literal *marker = c->first_lit;
struct literal *marker2, *prev;
struct literal *q;
struct term *t;
struct clause *aclause;
struct rel *r;
struct int_ptr *ip0,*ip1;
while(marker)
{ if(marker->sign && marker->atom->sym_num == AND)
break; // the rule will apply.
marker=marker->next_lit;
}
if(!marker)
return; // not applicable
t = marker->atom; // the AND term
for(r=t->farg;r;r=r->narg) // go through the args of t
{ aclause = get_clause();
// copy c into aclause, but put r->argval in at the place corresponding to marker
prev = NULL;
for(marker2 = c->first_lit;marker2; marker2=marker2->next_lit)
{ if(marker2 == marker)
{ q = get_literal();
q->sign = 1;
q->atom = copy_term(r->argval);
if(!prev)
aclause->first_lit = q;
else
prev->next_lit = q;
q->next_lit = NULL;
q->container = aclause;
prev = q;
continue;
}
// make a copy of the next literal in c and append it to aclause
q = get_literal();
q->atom = copy_term(marker2->atom);
q->container = marker2->container;
if(prev)
prev->next_lit = q;
else
aclause->first_lit = q;
prev = q;
q->next_lit = NULL;
q->sign = marker2->sign;
q->target = marker2->target;
q->container = aclause;
}
// set the parents of aclause
ip0 = get_int_ptr();
ip1 = get_int_ptr();
ip1->next = NULL;
ip0->i = SPLIT_AND;
ip0->next = ip1;
ip1->i = c->id;
aclause->parents = ip0;
// now append aclause to sos
pre_process(aclause,0,Sos);
}
}
/*________________________________________________________________________________*/
void split_or(struct clause *c)
/* From or(a,b) | c infer a | b | c.
Similarly for or(a1,...,an).
Append the new clause to sos.
*/
{ struct literal *marker = c->first_lit;
struct literal *marker2, *prev;
struct literal *q;
struct term *t;
struct clause *aclause;
struct rel *r;
struct int_ptr *ip0,*ip1;
while(marker)
{ if(marker->sign && marker->atom->sym_num == OR)
break; // the rule will apply.
marker=marker->next_lit;
}
if(!marker)
return; // not applicable
t = marker->atom; // the OR term
aclause = get_clause(); // we only need one new clause.
// copy c into aclause, but put in new literals at the place corresponding to marker,
prev = NULL;
for(marker2 = c->first_lit;marker2; marker2=marker2->next_lit)
{ if(marker2 == marker)
{ for(r = t->farg;r;r=r->narg)
{ q = get_literal();
q->sign = 1;
q->atom = copy_term(r->argval);
if(!prev)
aclause->first_lit = q;
else
prev->next_lit = q;
q->next_lit = NULL;
q->container = aclause;
prev = q;
continue;
}
}
else
{ // make a copy of the next literal in c and append it to aclause
q = get_literal();
q->atom = copy_term(marker2->atom); // what about ref counts, etc? Should I copy this term?
q->container = marker2->container;
if(prev)
prev->next_lit = q;
else
aclause->first_lit = q;
prev = q;
q->next_lit = NULL;
q->sign = marker2->sign;
q->target = marker2->target;
q->container = aclause;
}
}
// set the parents of aclause
ip0 = get_int_ptr();
ip1 = get_int_ptr();
ip1->next = NULL;
ip0->i = SPLIT_OR;
ip0->next = ip1;
ip1->i = c->id;
aclause->parents = ip0;
// now append aclause to sos
pre_process(aclause,0,Sos);
}
/*________________________________________________________________________________*/
void split_not_and(struct clause *c)
/* From -and(a,b) | c infer -a | -b | c.
Similarly for -and(a1,...,an).
Append the new clause to sos.
*/
{ struct literal *marker = c->first_lit;
struct literal *marker2, *prev;
struct literal *q;
struct term *t;
struct clause *aclause;
struct rel *r;
struct int_ptr *ip0,*ip1;
while(marker)
{ if(!marker->sign && marker->atom->sym_num == AND)
break; // the rule will apply.
marker=marker->next_lit;
}
if(!marker)
return; // not applicable
t = marker->atom; // the AND term
aclause = get_clause(); // we only need one new clause.
// copy c into aclause, but put in new literals at the place corresponding to marker,
// with a negation sign, corresponding to the args of t.
prev = NULL;
for(marker2 = c->first_lit;marker2; marker2=marker2->next_lit)
{ if(marker2 == marker)
{ for(r = t->farg;r;r=r->narg)
{ q = get_literal();
q->sign = 0;
q->atom = copy_term(r->argval);
if(!prev)
aclause->first_lit = q;
else
prev->next_lit = q;
q->next_lit = NULL;
q->container = aclause;
prev = q;
continue;
}
}
else
{ // make a copy of the next literal in c and append it to aclause
q = get_literal();
q->atom = copy_term(marker2->atom); // what about ref counts, etc? Should I copy this term?
q->container = marker2->container;
if(prev)
prev->next_lit = q;
else
aclause->first_lit = q;
prev = q;
q->next_lit = NULL;
q->sign = marker2->sign;
q->target = marker2->target;
q->container = aclause;
}
}
// set the parents of aclause
ip0 = get_int_ptr();
ip1 = get_int_ptr();
ip1->next = NULL;
ip0->i = SPLIT_NOT_AND;
ip0->next = ip1;
ip1->i = c->id;
aclause->parents = ip0;
// now append aclause to sos
pre_process(aclause,0,Sos);
}
/*________________________________________________________________________________*/
int max_vars(struct clause *c, struct term *t)
/* return the least number larger than the maximum varnum in c and larger than
the maximum varnum in the clause containing t.
If this is MAX_VARS, cause an abend. You can pass
either c or t as NULL if you want to consider only a clause, or only a term.
*/
{ int max = 0;
struct clause *other;
other = getContainingClause(t);
if(!other)
return c->next_var; // happens when t = $T or $F
if(!c)
return other->next_var;
return c->next_var > other->next_var ? c->next_var : other->next_var;
}
/*________________________________________________________________________________*/
void undo_forbidden(struct trail *tp)
// undo the changes to the forbidden list of the variable that was bound when
// this tp was created.
{ struct term *bound = tp->context->terms[tp->varnum];
if(bound == NULL)
return; // nothing to do. Variable was a bound variable that went out of scope?
if(bound->type == VARIABLE && Flags[LAMBDA_FLAG].val)
{ restrictdata marker, marker2;
struct context *context2 = tp->context->contexts[tp->varnum];
int varnum2 = bound->varnum;
marker = context2->forbidden[varnum2];
while( marker != tp->fp)
{ marker2 = marker;
marker = marker->next;
free_int_ptr(marker2);
}
context2->forbidden[varnum2] = tp->fp;
}
}
/* _________________________________________________________________________*/
struct int_ptr *prepend(struct int_ptr *a, struct int_ptr *b)
/* make a copy of a, and make its last member point to *b, and
return a pointer to the front of this new list */
{ struct int_ptr *marker, *marker2;
struct int_ptr *ans;
if(a == NULL)
return b;
marker = a;
ans = get_int_ptr();
marker2 = ans;
while(marker->next)
{ marker2->i = marker->i;
marker2->next = get_int_ptr();
marker = marker->next;
marker2 = marker2->next;
}
marker2->i = marker->i;
marker2->next = b;
return ans;
}
/* _________________________________________________________________________*/
void fix_forbidden(int i, struct context *c1, int j, struct context *c2, struct trail *tr)
/* variable number i in c1 is being bound to variable number j in c2.
Change the forbidden list in c2 accordingly and store the old one in tr
*/
{ tr->fp = c2->forbidden[j];
if(c1->forbidden[i])
c2->forbidden[j] = prepend(c1->forbidden[i], c2->forbidden[j]);
}
/*_____________________________________________________________________________*/
static void freevars(struct term *t, int varnums[MAX_VARS])
/* fill in 1 for the entries in varnums corresponding to free variables
of t, and -1 for the bound variables, and 0 for variables that don't occur. */
{ struct rel *r;
if(t->type == VARIABLE && varnums[t->varnum] != -1)
{ varnums[t->varnum] = 1;
return;
}
if(t->type == NAME)
return;
if(BINDER(t->sym_num))
varnums[ARG0(t)->varnum] = -1;
for(r = t->farg;r;r=r->narg)
freevars(r->argval,varnums);
}
/*_____________________________________________________________________________*/
static int get_var(struct term *w, struct context *c1, struct term * t, struct context *c2, struct trail **trp)
/* If w is already assigned in c1 to a variable in c2, return that variable's
varnum.
Otherwise, if there are free variables in t that are not yet assigned a value in c2,
and are free in t, return one of them, assigning it in c2 to (w,c1).
Otherwise, dereference one of the variables in (t,c2) and
return a variable contained in the dereferenced value. If no such variable exists
return NULL.
*/
{ int varnums[MAX_VARS];
int i,j;
if(w->type == VARIABLE)
{ struct term *W = c1->terms[w->varnum];
if(W != NULL)
{ // w has been assigned a value in c1->terms[w->varnum]
struct context *c3 = c1;
if(W->type == VARIABLE)
{ DEREFERENCE(W,c3)
if(W->type == VARIABLE && c3==c2)
return W->varnum;
}
}
// maybe some variable in c2 has been assigned w as a value
for(j=0;j<MAX_VARS;j++)
{ if(c2->terms[j] == w && c2->contexts[j] == c1)
return w->varnum;
if(j == c2->next_var)
break;
}
}
memset(varnums,0,MAX_VARS*sizeof(int));
freevars(t,varnums);
for(i=0; i < c2->next_var;i++)
{ if(varnums[i] == 1 &&
occur_check(i,c2,w,c1) &&
c2->bound[i] == 0 && // not a lambda-bound variable
c2->terms[i] == NULL // not already assigned in c2
)
{ BIND(i,c2,w,c1,trp);
return i;
}
}
return -1;
}
/*_______________________________________________________*/
struct rel * unify_lambda(struct term *t1, struct context *c1,
struct term *t2, struct context *c2, struct trail **trp, struct trail *tpos)
/* t1 and t2 have the same functor and it satisfies BINDER, e.g. is LAMBDA.
This is called from unify and should return NULL if unification is to
succeed, and non-NULL if it is to fail. The trail will be restored in
unify after this function returns.
*/
{ struct term *saveboundval1, *saveboundval2;
int savebound1, savebound2;
intlist saveforbidden1, saveforbidden2;
int bindflag = 0;
struct rel *r1 = t1->farg;
struct rel *r2 = t2->farg;
struct context *c4;
struct term *pq;
if(t1 == t2 && c1 == c2)
return NULL; // happens fairly often, so speed up.
if(ARG0(t1)->type != VARIABLE || ARG0(t2)->type != VARIABLE) // 7.18.03
assert(0); // 7.18.03
#ifdef DIAGNOSTICS
V(c1,c2); // 7.18.03
fprintf(stdout,"Trying to unify\n"); // DEBUG
print_term_nl(stdout,t1); print_term_nl(stdout,t2); // DEBUG
#endif
saveboundval1 = c1->terms[ARG0(t1)->varnum];
saveboundval2 = c2->terms[ARG0(t2)->varnum];
savebound1 = c1->bound[ARG0(t1)->varnum];
savebound2 = c2->bound[ARG0(t2)->varnum];
c1->bound[ARG0(t1)->varnum] = 1; // 7.2.04; was 0 since 7.18.03
c2->bound[ARG0(t2)->varnum] = 1; //7.2.04; was 0 since 7.18.03
saveforbidden1 = c1->forbidden[ARG0(t1)->varnum]; //6.13.04
c1->forbidden[ARG0(t1)->varnum] = NULL; //6.13.04
saveforbidden2 = c1->forbidden[ARG0(t2)->varnum]; //6.13.04
c1->forbidden[ARG0(t2)->varnum] = NULL; //6.13.04
if(c1 != c2 || ARG0(t1)->varnum != ARG0(t2)->varnum)
{ BIND(ARG0(t1)->varnum,c1,ARG0(t2),c2,trp); // 7.19.03
bindflag = 1;
free_trail(*trp); // 7.19.03
*trp = tpos; // 7.19.03
}
#ifdef DIAGNOSTICS
V(c1,c2); // DEBUG 7.17.03
#endif
// example: Unify lambda(x,y) with lambda(x,f(x)). The "solution" y = f(x)
// is wrong since substituting y = f(x) in lambda(x,y) gives lambda(z,f(x)),
// because the bound variable is renamed to avoid capture. Therefore:
forbid_all_but(ARG0(t2),c2,t1,c1,ARG0(t2),c2); // Added 8.01.03; changed 6.1.04
// forbid_all_but(ARG0(t2),c2,t2,c2,ARG0(t1),c1); // Added 4.29.04
forbid_all(t2,c2,ARG0(t2),c2);
#ifdef DIAGNOSTICS
V(c1,c2); // DEBUG 8.01.03
#endif
r1 = r1->narg;
r2 = r2->narg; // we've already unified the first arguments
while (r1 && unify(r1->argval, c1, r2->argval, c2, trp))
{ r1 = r1->narg;
r2 = r2->narg;
}
pq = c1->terms[ARG0(t1)->varnum]; // which is a variable in c2 if bindflag
if(pq && pq->type == VARIABLE)
{ // catch a loop in which pq is assigned back to ARG0(t1)->varnum in c1
struct term *w = c2->terms[pq->varnum];
if(w != NULL && c2->contexts[pq->varnum] == c1 &&
w->type == VARIABLE && w->varnum == ARG0(t1)->varnum)
assert(0); // this shouldn't happen
else
{ c4 = c2;
DEREFERENCE(pq,c4);
}
}
if(pq && pq->type != VARIABLE)
{ r1 = (struct rel *) 1; // not zero, so unification will fail
goto out;
}
pq = c2->terms[ARG0(t2)->varnum];
if(pq && pq->type == VARIABLE)
{ struct term *w = c1->terms[pq->varnum];
if(w != NULL && c1->contexts[pq->varnum] == c2 &&
w->type == VARIABLE && w->varnum == ARG0(t2)->varnum)
assert(0);
else
{ c4 = c1;
DEREFERENCE(pq,c4);
}
}
if(pq && pq->type != VARIABLE)
{ r1 = (struct rel *) 1; // not zero, so unification will fail
goto out;
}
out:
if(c1->forbidden[ARG0(t1)->varnum])
free_int_list(c1->forbidden[ARG0(t1)->varnum]);
c1->forbidden[ARG0(t1)->varnum] = saveforbidden1;
if(c2->forbidden[ARG0(t2)->varnum])
free_int_list(c2->forbidden[ARG0(t2)->varnum]);
c2->forbidden[ARG0(t2)->varnum] = saveforbidden2;
c1->bound[ARG0(t1)->varnum] = savebound1; // Beeson 7.19.03 restore original value
c2->bound[ARG0(t2)->varnum] = savebound2; // Beeson 7.19.03
c1->terms[ARG0(t1)->varnum] = saveboundval1; // Beeson 7.19.03
/* but don't try to restore c2->terms[ARG0(t2)->varnum] this way, since it either
hasn't changed, or was assigned by unify, and will be reset when unify fails below. */
// c2->terms[ARG0(t2)->varnum] = saveboundval2; // Beeson 7.19.03 WRONG
if(r1 == NULL && c2->terms[ARG0(t2)->varnum])
{ // unify is going to succeed, so we do need to get rid of the
// entry c2->terms[ARG0(t2)->varnum]. But it has to be done through
// the trail.
struct trail *t3 = *trp;
struct trail *prev = NULL;
while(t3 && (t3->varnum != ARG0(t2)->varnum || t3->context != c2))
{ prev = t3;
t3 = t3->next;
}
if(!t3)
assert(0); // that assignment had to be made somewhere in the trail
// Now remove that entry in the trail.
if(prev)
prev->next = t3->next;
else
*trp = t3 ->next;
undo_forbidden(t3);
t3->context->terms[t3->varnum] = NULL;
free_trail(t3);
}
#ifdef DIAGNOSTICS
if(FUNCTOR(ARG1(t1)) != AP && FUNCTOR(ARG1(t2)) != AP) //DEBUG
{
if(r1) // DEBUG
fprintf(stdout, "unify failed\n"); // DEBUG
else // DEBUG
{ V(c1,c2); // DEBUG
fprintf(stdout, "unify succeeded\n"); // DEBUG
}
}
#endif
return r1;
}
/*________________________________________________________________________________*/
static struct term *getMaskingSubterm(struct term *a, struct context **cp,
struct term *X, struct context *c1,
struct term *t, struct context *c2,
struct term *w)
/* (X,c1) is a variable; t contains X or some variable(s) forbidden to X.
Return a subterm r of t that
(1) contains all the occurrences in t of X or variables forbidden to X;
(2) occurs as the second arg of an Ap term;
(3) r does not contain any variables marked as lambda-bound in context c2,
or any variables forbidden to w in c1.
(4) no subterm of r has properties (1)-(3).
If there is no such subterm, and a is NULL, return NULL;
else return ARG1(a). Precondition: a is passed in as either NULL
(for the toplevel call) or as an Ap term containing t as a subterm of its
second arg.
*/
{ struct rel *r,*q;
int oflag;
int count = 0;
int argnumber = 0;
int whicharg;
if(t->type == NAME ||
(t->type == VARIABLE && c2->terms[t->varnum] == NULL)
)
{ if(c2->bound[t->varnum]) // 7.5.05
return NULL; // 7.5.05
if(forbidden(t,c2,w,c1)) // 7.5.05
return NULL; // 7.5.05
return a ? ARG1(a) : NULL;
}
if(t->type == VARIABLE)
return getMaskingSubterm(a,cp,X,c1,c2->terms[t->varnum],c2->contexts[t->varnum],w);
for(r = t->farg;r;r = r->narg, ++argnumber)
{ oflag = occur_check2(X->varnum,c1,r->argval,c2);
if(!oflag)
{ ++count;
if(count == 1)
{ q = r;
whicharg = argnumber;
}
}
}
if(count == 1)
{ if(FUNCTOR(t) == AP && whicharg == 1)
{ a = t;
*cp = c2;
}
return getMaskingSubterm(a,cp,X,c1,q->argval,c2,w);
}
if(a== NULL)
return NULL;
return ARG1(a); // can't go deeper
}
/*_________________________________________________*/
void free_int_list(struct int_ptr *p)
{ if(p->next == NULL)
{ free_int_ptr(p);
return;
}
free_int_list(p->next);
free_int_ptr(p);
}
/*_________________________________________________*/
void free_forbidden(struct context *c)
// free the linked lists in c->forbidden and reset each entry to NULL
{ int i;
for(i=0;i<MAX_VARS;i++)
{ if(c->forbidden[i])
free_int_list(c->forbidden[i]);
}
memset(c->forbidden,0,MAX_VARS*sizeof(unsigned char));
}
/*_________________________________________________*/
int term_ident2(struct term *t1,struct term *t2, int depthflag)
// return 1 if t1 and t2 are identical except for
// renaming of bound variables. This is only applied
// to well-formed terms that are either in the same context
// or are constant (contain only lambda-bound variables).
{ static int matched[MAX_VARS];
int oldmatch,v;
if(depthflag == 0)
memset(matched,0,MAX_VARS*sizeof(int));
if (t1->type != t2->type)
return 0;
if (t1->type == COMPLEX)
{ if (t1->sym_num != t2->sym_num)
return 0;
else
{ struct rel *r1 = t1->farg;
struct rel *r2 = t2->farg;
if (BINDER(t1->sym_num))
{ v = r1->argval->varnum % MAX_VARS;
oldmatch = matched[v]; // entering scope of this bound variable
matched[v] = r2->argval->varnum + 1;
}
while (r1 && r2 && term_ident2(r1->argval,r2->argval,1))
{ r1 = r1->narg;
r2 = r2->narg;
}
if(BINDER(t1->sym_num))
matched[v] = oldmatch; // leaving scope of this bound variable
return (r1 == NULL && r2 == NULL);
}
}
if (t1->type == VARIABLE)
{ if(matched[t1->varnum % MAX_VARS] == t2->varnum+1)
return 1;
return (t1->varnum == t2->varnum);
}
else /* NAME */
return (t1->sym_num == t2->sym_num);
} /* term_ident2 */
/*_______________________________________________*/
static void distinct_free_vars_rec(struct term *t,
int *a, int *b,
int *max)
// similar to McCune's distinct_free_vars_rec in clause.c
// but does not count lambda-bound variables
{
struct rel *r;
int i, vn;
if (t->type == VARIABLE)
{ vn = t->varnum;
// first check that it's not in the b array
for(i=0;i<MAX_VARS && b[i] != -1 && b[i] != vn; i++);
if(i != MAX_VARS && b[i]!= vn)
{ // it's not bound, so enter it in the a array
for (i = 0; i < MAX_VARS && a[i] != -1 && a[i] != vn; i++);
if (i != MAX_VARS && a[i] == -1)
{ a[i] = vn;
*max = i+1;
}
}
}
else if (t->type == COMPLEX)
{ if(BINDER(t->sym_num))
{ int vn = t->farg->argval->varnum;
// enter vn in the b array if it's not already there
for(i=0;i < MAX_VARS && b[i] != -1 && b[i] != vn; i++);
if(i != MAX_VARS && b[i] == -1)
b[i] = vn;
// check for an error:
for(i=0;i < MAX_VARS && a[i] != -1 && a[i] != vn;i++);
if(i<MAX_VARS && a[i] == vn)
assert(0);
}
for (r = t->farg; r && *max < MAX_VARS; r = r->narg)
distinct_free_vars_rec(r->argval, a,b, max);
}
} /* distinct_vars_rec */
int distinct_free_vars(struct clause *c)
// replacement for McCune's distinct_vars, that does not count
// lambda-bound variables.
{
struct literal *lit;
int a[MAX_VARS], i,j, max;
int b[MAX_VARS]; // for the bound variables
for (i = 0; i < MAX_VARS; i++)
{ a[i] = -1;
b[i] = -1;
}
for (lit = c->first_lit, max = 0; lit; lit = lit->next_lit)
distinct_free_vars_rec(lit->atom, a,b, &max);
// Now just check that no variable occurs both free and bound.
for(i=0;a[i]!= -1 && i < MAX_VARS; i++)
for(j=0;b[j]!= -1 && j < MAX_VARS; j++)
{ if(a[i] == b[j])
{ // printf("Got here\n");
abend("variable occurs both free and lambda-bound in the same clause.");
}
}
return(max);
} /* distinct_free_vars */
/*_______________________________________________________*/
/* match2 is a substitute for McCune's 'match' in unify.c
That needs to be supplemented to handle examples like the following.
Let c = g(n,lambda(x,a+x=x+a)) and c' like c but with y in place of x.
Then we want c+a = a+c' to match c+a = a+c since they differ only
by renaming bound variables. McCune's match will work one way
but not the other, giving c+a=a+c as an instance of c+a = a+c'
but not the other way around, since when it comes to the second
occurrence of x, it fails because x has already been bound to x and
cannot now be bound to y.
*/
int match2(struct term *t1,
struct context *c1,
struct term *t2,
struct trail **trp)
{ int vn;
struct term *saveit;
intlist saveforbidden;
struct trail *tpos,*tp;
struct rel *r1,*r2;
if (t1->type == VARIABLE)
{ /* t1 variable */
vn = t1->varnum;
if (c1->terms[vn] == NULL)
{ BIND(vn, c1, t2,NULL , trp);
return 1;
}
return term_ident(c1->terms[vn], t2);
// term_ident now counts two terms as equivalent if they
// differ only by renaming lambda-bound variables
}
if (t2->type == VARIABLE) /* t1 not variable, t2 variable, so fail */
return 0;
/* Now neither term is a variable */
if (t1->sym_num != t2->sym_num)
return 0; /* fail because of symbol clash */
if(BINDER(t1->sym_num))
{ vn = ARG0(t1)->sym_num;
saveit = c1->terms[vn];
// saveit could be non-null if the same lambda-bound variable
// is bound again inside the scope of the outer binding
saveforbidden = c1->forbidden[vn];
c1->forbidden[vn] = NULL;
c1->terms[vn] = ARG0(t2);
}
/* following handles both names and complex terms */
tpos = *trp; /* save trail position in case of failure */
r1 = t1->farg;
r2 = t2->farg;
while (r1 && r2 && match2(r1->argval, c1, r2->argval, trp))
{ r1 = r1->narg;
r2 = r2->narg;
}
if(BINDER(t1->sym_num))
{ c1->terms[vn] = saveit;
if(c1->forbidden[vn])
free_int_list(c1->forbidden[vn]);
c1->forbidden[vn] = saveforbidden;
}
if (r1 == NULL && r2 == NULL)
return 1;
/* restore from trail and fail */
tp = *trp;
while (tp != tpos)
{ struct trail *t3 = tp;
tp->context->terms[tp->varnum] = NULL;
tp = tp->next;
free_trail(t3);
}
*trp = tpos;
return 0;
} /* match */
/*___________________________________________________________________________*/
int occur_check2(int vn,
struct context *vc,
struct term *t,
struct context *c)
/* Return 0 iff variable vn occurs in term t under substitution
(including vn = t).
or if t is forbidden to vn (and Flags[SECOND_ORDER_FLAG].val)
Also, if Flags[SECOND_ORDER_FLAG].val, variable CAN occur in t,
if its occurrence is bound.
*/
{ if (t->type == NAME)
return 1;
else if (t->type == COMPLEX) {
struct rel *r = t->farg;
if(BINDER(t->sym_num)) // Beeson 7.6.03
{ // assert(r->argval->type == VARIABLE);
int savebound;
// if( vn == r->argval->varnum) 7.10.06 commented this out
// return 1; // bound occurrences are allowed
savebound = c->bound[r->argval->varnum];
c->bound[r->argval->varnum] = 1;
while (r != NULL && occur_check2(vn, vc, r->argval, c))
r = r->narg;
c->bound[t->farg->argval->varnum] = savebound;
}
else
{ while (r != NULL && occur_check2(vn, vc, r->argval, c))
r = r->narg;
}
return (r == NULL);
}
else { /* variable */
int tvn = t->varnum;
if (tvn == vn && c == vc)
return 0; /* fail occur_check here */
else if(forbidden2(vn,vc,tvn,c))
return 0;
else if (c->terms[tvn] == NULL)
return 1; /* uninstantiated variable */
else if (c->bound[tvn] && c->terms[tvn]->type == VARIABLE && c->contexts[tvn]->bound) // 7.10.2006
return 1; /* a temporarily instantiated variable as described in the comments above */
else
return occur_check2(vn, vc, c->terms[tvn], c->contexts[tvn]);
}
} /* occur_check2 */
/*__________________________________________________________________________*/
static void forbid_all_but(struct term *z,struct context *d, struct term *a, struct context *c1, struct term *x, struct context *c2)
/* forbid all uninstantiated free variables in a, other than x itself, and z, to take the value x */
/* presumes z is a variable. When a == x, return without doing anything, even if
a is already instantiated. */
{ struct rel *r;
int savebound,vn;
if(z->type != VARIABLE)
assert(0);
if(a->type == VARIABLE &&
((a->varnum == z->varnum)||c1->bound[a->varnum])
)
return; // doing nothing
if(a->type == VARIABLE && (TYPE(x) != VARIABLE || a->varnum != x->varnum || c1 != c2))
{ if(c1->terms[a->varnum])
{ // a is already instantiated
forbid_all_but(z,d,c1->terms[a->varnum],c1->contexts[a->varnum],x,c2);
return;
}
// now a is an uninstantiated variable
if(c1->bound[a->varnum] == 0 && !forbidden2(a->varnum,c1,x->varnum,c2))
forbid(a,c1,x,c2);
return;
}
else if(a->type == NAME ||
(a->type == VARIABLE &&
(a->varnum == x->varnum || a->varnum == z->varnum)
)
)
return;
// now a->type == COMPLEX
if(BINDER(a->sym_num))
{ vn = ARG0(a)->varnum;
savebound = c1->bound[vn];
c1->bound[vn] = 1;
}
r = a->farg;
while(r != NULL)
{ forbid_all_but(z,d,r->argval,c1,x,c2);
r = r->narg;
}
if(BINDER(a->sym_num))
c1->bound[vn] = savebound;
}
/*__________________________________________________*/
static int bd_aux(struct term *t)
/* return the binding depth of t, i.e the max number
of nested lambdas contained in c. One lambda with
no lambdas inside counts as binding depth 1.
*/
{ int ans = 0;
struct rel *r;
int k;
if(t->type == NAME || t->type == VARIABLE)
return 0;
if(t->sym_num == LAMBDA)
return 1 + bd_aux(ARG1(t));
for(r= t->farg; r; r=r->narg)
{ k = bd_aux(r->argval);
if( ans < k)
ans = k;
}
return ans;
}
/*__________________________________________________*/
int binding_depth(struct clause *c)
/* return the maximum number of nested lambdas contained in c.
One lambda with no lambdas inside counts as binding depth 1.
*/
{ struct literal *l;
int ans=0,k;
for(l = c->first_lit; l ; l = l->next_lit)
{ if(l == c->first_lit)
ans = bd_aux(l->atom);
else
{ k = bd_aux(l->atom);
if(k > ans)
ans = k;
}
}
return ans;
}
/*_______________________________________________________*/
void rename3(struct term *t, struct context *c)
/* If t contains lambda-bound variables that occur free in c,
rename them, and adjust c->nextvar accordingly. Specifically,
if variable with varnum k is encountered, check if
c->bound[k], and if so do nothing; if not check if
k >= c->next_var, and if so do nothing except adjust
c->next_var = k+1; and if k < c->next_var, rename k to
c->next_var and increment c->next_var.
*/
{ if(t->type != COMPLEX)
return;
//if(BINDER(t->sym_num))
}
/*______________________________________________________*/
static int count33;
static struct context *hey;
#define MY_BIT 04
int verify(struct term *t, struct context *c)
/* check whether t occurs as a subterm of itself. Return 0
if it does, 1 if it is OK. */
{ struct rel *r;
++count33;
if(t->type == VARIABLE && c->terms[t->varnum])
{ int rval = verify(c->terms[t->varnum], c->contexts[t->varnum]);
if(!rval)
printf("Hey");
return rval;
}
if(t->type != COMPLEX) return 1;
if(TP_BIT (t->bits, MY_BIT))
{ print_term(stdout,t);
return 0;
}
if(t == (struct term *) 0x012889b4)
{ printf("Straw's cheaper\n");
hey = c;
}
SET_BIT(t->bits,MY_BIT);
r = t->farg;
if(r == 0)
printf("Ooops!");
while(r && verify(r->argval, c))
r = r->narg;
CLEAR_BIT(t->bits,MY_BIT);
if(r)
print_term(stdout,t);
return r ? 0 : 1;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists