Sindbad~EG File Manager
/*
* unify.c -- unification and matching routines
*
*/
/* Modifications by Beeson:
7.23.02 moved BIND and DEREFERENCE to unify.h and added include commands
8.7.02
12.4.05 modified unify to return multiple unifiers.
*/
#include "header.h"
#include "unify.h" // Beeson
#include "unify2.h" // Beeson
#include "bsym.h" // Beeson
#include "bterms.h" // Beeson
#include "beta.h" // Beeson
#include <assert.h> // Beeson
// #define DIAGNOSTICS // DEBUG
/*************
*
* int occur_check(varnum, var_context, term, term_context)
*
* Return 0 iff variable occurs in term under substitution
* (including var==term).
* or if term is forbidden to variable (and Flags[LAMBDA_FLAG].val)
* Also, if Flags[LAMBDA_FLAG].val, variable CAN occur in term,
* if its occurrence is bound.
*
*************/
int occur_check(int vn,
struct context *vc,
struct term *t,
struct context *c)
{ if(Flags[LAMBDA_FLAG].val)
return occur_check2(vn,vc,t,c); // Beeson 7.6.06, see file unify2.c
if (t->type == NAME)
return 1;
else if (t->type == COMPLEX) {
struct rel *r = t->farg;
while (r != NULL && occur_check(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 (c->terms[tvn] == NULL)
return 1; /* uninstantiated variable */
else
return occur_check(vn, vc, c->terms[tvn], c->contexts[tvn]);
}
} /* occur_check */
/*************
*
* int unify(t1, c1, t2, c2, trail_address)
*
* Attempt to unify t1 in context c1 with t2 in context c2.
* If successful, return 1 and and a pointer to the trail (a record
* of the substitutions). The trail is extended by adding new
* entries to the front, and the front is returned. On entry,
* *trail_address must be either NULL or the result of a previous
* call to unify. If unification fails, the trail is unchanged.
* A context is a substitution table along with a multiplier for
* the variables. The multiplier need not be present for
* unification, but it is needed for `apply'.
*
* An example of its use:
*
* c1 = get_context(); c1->multiplier = 0;
* c2 = get_context(); c2->multiplier = 1;
* tr = NULL;
* if (unify(t1, c1, t2, c2, &tr)) {
* print_subst(stdout, c1);
* print_subst(stdout, c2);
* print_trail(stdout, tr);
* t3 = apply(t1, c1);
* t4 = apply(t2, c2);
* printf("apply substitution: ");
* print_term(stdout, t3); printf(" ");
* print_term(stdout, t4); printf("\n");
* clear_subst_1(tr);
* zap_term(t3);
* zap_term(t4);
* }
* else
* printf("unify fails\n");
* free_context(c1);
* free_context(c2);
*
*************/
/*______________________________________________________________*/
int unify(struct term *t1,
struct context *c1,
struct term *t2,
struct context *c2,
struct trail **trp)
{ int saveit1, saveit2; // Beeson
DEREFERENCE(t1, c1)
DEREFERENCE(t2, c2)
/* Now, neither t1 nor t2 is an assigned variable. */
if( Flags[LAMBDA_FLAG].val) // Beeson 6.16.03
{ if(t1->type == VARIABLE && c1->bound[t1->varnum] != 0)
{ if(t2->type == VARIABLE && c1 == c2 && t2->varnum == t1->varnum)
return 1;
else
return 0;
}
if(t2->type == VARIABLE && c2->bound[t2->varnum] != 0)
return 0;
saveit1 = c1->next_var;
saveit2 = c2->next_var;
}
if (t1->type == VARIABLE){
// The bound[] array is filled with zeroes unless Flags[LAMBDA_FLAG].val is set.
int vn1 = t1->varnum;
if (t2->type == VARIABLE) {
/* both t1 and t2 are variables */
if (vn1 == t2->varnum && c1 == c2)
return 1; /* identical */
else if(Flags[LAMBDA_FLAG].val && // Beeson 6.26.03
(forbidden2(vn1,c1,t2->varnum,c2) || forbidden2(t2->varnum,c2,vn1,c1)) // Beeson 6.26.03
) // Beeson 6.26.03
return 0; // Beeson 6.26.03
else {
BIND(vn1, c1, t2, c2, trp);
return 1;
}
}
else {
/* t1 variable, t2 not variable */
if (occur_check(vn1, c1, t2, c2)) {
BIND(vn1, c1, t2, c2, trp);
return 1;
}
else
return 0; /* failed occur_check */
}
}
else if (t2->type == VARIABLE){
/* t2 variable, t1 not variable */
int vn2 = t2->varnum;
if (occur_check(vn2, c2, t1, c1)) {
BIND(vn2, c2, t1, c1, trp);
return 1;
}
else
return 0; /* failed occur_check */
}
else if(Flags[LAMBDA_FLAG].val && (t1->sym_num == AP || t2->sym_num == AP) &&
unify2(t1,c1,t2,c2,trp) // Beeson
)
return 1;
else if (t1->sym_num != t2->sym_num )
return 0; /* fail because of symbol clash */
else if (t1->type == NAME)
return 1;
else { /* both COMPLEX with same functor */
struct trail *tpos = *trp; /* save trail position in case of failure */
struct rel *r1, *r2;
if(Flags[LAMBDA_FLAG].val && BINDER(t1->sym_num)) // Beeson 8.7.02
/* It isn't necessary to rename the lambda-bound variable(s),
even if there is a nested bound occurrence inside this one.
When entering the nested occurrence, the variable will be
re-assigned. But therefore, if THIS is a nested occurrence,
the variable might already be bound to something, and we
should save the binding and restore it, rather than assume it is NULL.
*/
r1 = unify_lambda(t1,c1,t2,c2,trp,tpos);
else if(c1->next == NULL && c2->next == NULL) // normal unification
{ r1 = t1->farg;
r2 = t2->farg;
while (r1 && unify(r1->argval, c1, r2->argval, c2, trp)) {
r1 = r1->narg;
r2 = r2->narg;
}
}
else // multiple unifiers possible
{ int flag1=0, flag2=0;
struct context *m1,*m2, *prev1 = NULL, *prev2=NULL;
int count_unifiers = 0;
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
for(m1=c1,m2=c2; m1!= last1; prev1 = m1, prev2 = m2, m1 = m1->next,m2=m2->next)
{ flag2 = 0;
r1 = t1->farg;
r2 = t2->farg;
while(r1 && unify(r1->argval,m1,r2->argval,m2,trp))
{ r1 = r1->narg;
r2 = r2->narg;
}
if(r1)
{ // this (m1,m2) doesn't unify; delete it from the list
if(prev1)
{ prev1->next = m1->next;
prev2->next = m2->next;
}
else
{ // it was the first in the list
*c1 = *(m1->next);
*c2 = *(m2->next);
}
free_context(m1);
free_context(m2);
}
}
}
if (r1 == NULL)
return 1;
else { /* restore trail and fail */
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;
if(Flags[LAMBDA_FLAG].val)
restore_vars(c1,c2,saveit1, saveit2); // Beeson 1.29.04
return 0;
}
}
} /* unify */
/*************
*
* int unify_no_occur_check(t1, c1, t2, c2, trp)
*
*************/
int unify_no_occur_check(struct term *t1,
struct context *c1,
struct term *t2,
struct context *c2,
struct trail **trp)
{
DEREFERENCE(t1, c1);
DEREFERENCE(t2, c2);
/* Now, neither t1 nor t2 is a bound variable. */
if (t1->type == VARIABLE) {
int vn1 = t1->varnum;
if (t2->type == VARIABLE && vn1 == t2->varnum && c1 == c2)
return 1; /* identical */
else {
/* occur check would be here */
BIND(vn1, c1, t2, c2, trp);
return 1;
}
}
else if (t2->type == VARIABLE) {
int vn2 = t2->varnum;
/* occur check would be here */
BIND(vn2, c2, t1, c1, trp);
return 1;
}
else if (t1->sym_num != t2->sym_num)
return 0; /* fail because of symbol clash */
else if (t1->type == NAME)
return 1;
else { /* both COMPLEX with same functor */
struct trail *tpos = *trp; /* save trail position in case of failure */
struct rel *r1 = t1->farg;
struct rel *r2 = t2->farg;
while (r1 && unify_no_occur_check(r1->argval, c1, r2->argval, c2, trp)) {
r1 = r1->narg;
r2 = r2->narg;
}
if (r1 == NULL)
return 1;
else { /* restore trp and fail */
struct trail *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;
}
}
} /* unify_no_occur_check */
/*************
*
* int otter_match(t1, c1, t2, trail_address) -- one-way unification.
*
* Match returns 1 if t2 is an instance of {t1 in context c1}.
* This is not a very general version, but it is useful for
* demodulation and subsumption. It assumes that the variables
* of t1 and t2 are separate, that none of the variables in t2
* have been instantiated, and that none of those t2's variables
* will be instantiated. Hence, there is no context for t2,
* no need to dereference more than one level, and no need for
* an occur_check.
*
* The use of the trail is the same as in `unify'.
*
*************/
int otter_match(struct term *t1,
struct context *c1,
struct term *t2,
struct trail **trp)
{ if(Flags[LAMBDA_FLAG].val)
return match2(t1,c1,t2,trp); // Beeson's code
if (t1->type == VARIABLE) { /* t1 variable */
int 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
}
}
else if (t2->type == VARIABLE) /* t1 not variable, t2 variable, so fail */
return 0;
else if (t1->sym_num != t2->sym_num) /* neither term is a variable */
return 0; /* fail because of symbol clash */
else
{ /* following handles both names and complex terms */
struct trail *tpos = *trp; /* save trail position in case of failure */
struct rel *r1 = t1->farg;
struct rel *r2 = t2->farg;
/* arities are same because sym_nums are the same */
while (r1 != NULL && otter_match(r1->argval, c1, r2->argval, trp)) {
r1 = r1->narg;
r2 = r2->narg;
}
if (r1 == NULL)
return 1;
else { /* restore from trail and fail */
struct trail *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 */
/*************
*
* struct term *apply(term, context) -- Apply a substitution to a term.
*
* Apply always succeeds and returns a pointer to the
* instantiated term.
*
*************/
struct term *apply(struct term *t,
struct context *c)
{
/* 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->multiplier * MAX_VARS + t->varnum;
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)) // Beeson
{ vv = t->farg->argval->varnum; // Beeson
saveit = c->terms[vv]; // Beeson
c->terms[vv] = NULL; // Beeson
}
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 = apply(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;
}
} /* apply */
/*************
*
* int term_ident(term1, term2) -- Compare two terms.
*
* If identical return 1; else return 0. The bits
* field is not checked.
*
*************/
/* Beeson's comment: McCune's code is for true identity, i.e. returns false if
t1 and t2 differ only by renaming lambda-bound variables.
term_ident2 is used to allow terms to count as equivalent if the
differ only be renaming bound variables. Because these are recursive
functions, we don't want to check LAMBDA_FLAG at each level.
Therefore term_ident checks it and switches either to McCune's original
term_ident, now called McCune_term_ident, or to term_ident2 in unify2.c
*/
static int McCune_term_ident(struct term *t1, struct term *t2);
int term_ident(struct term *t1, struct term *t2)
{ if(Flags[LAMBDA_FLAG].val)
return term_ident2(t1,t2,0);
return McCune_term_ident(t1,t2);
}
static int McCune_term_ident(struct term *t1, struct term *t2)
{ if (t1->type != t2->type)
return 0;
else if (t1->type == COMPLEX) {
if (t1->sym_num != t2->sym_num)
return 0;
else {
struct rel *r1 = t1->farg;
struct rel *r2 = t2->farg;
while (r1 && r2 && McCune_term_ident(r1->argval,r2->argval)) { // Beeson added && r2
r1 = r1->narg;
r2 = r2->narg;
}
return (r1 == NULL && r2==NULL); // Beeson added second clause here
}
}
else if (t1->type == VARIABLE)
return (t1->varnum == t2->varnum);
else /* NAME */
return (t1->sym_num == t2->sym_num);
} /* McCune term_ident */
/*************
*
* clear_subst_2(trail_1, trail_2) -- Clear part of a substitution.
*
* It is assumed that trail_2 (including NULL) is a subtrail
* of trail_1. This routine clears entries starting at trail_1,
* up to (but not including) trail_2.
*
*************/
void clear_subst_2(struct trail *t1,
struct trail *t2)
{
if (t1 == NULL || t1 == t2)
return;
else {
clear_subst_2(t1->next, t2);
t1->context->terms[t1->varnum] = NULL;
free_trail(t1);
}
} /* clear_subst_2 */
/*************
*
* clear_subst_1(trail_1) -- Clear a substitution.
*
* Clear all members of the trail.
*
*************/
void clear_subst_1(struct trail *t1)
{
if (t1 == NULL)
return;
else {
clear_subst_1(t1->next);
t1->context->terms[t1->varnum] = NULL;
free_trail(t1);
}
} /* clear_subst_1 */
/*************
*
* print_subst(file_ptr, context)
*
*************/
void print_subst(FILE *fp,
struct context *c)
{
int i,j;
fprintf(fp, "Substitution in context %x, multiplier %d\n", (unsigned) c, c->multiplier);
for (i=0; i< MAX_VARS; i++)
if (c->terms[i] != NULL) {
fprintf(fp, "v%d -> ", i);
print_term(fp, c->terms[i]);
fprintf(fp, " context %x", (unsigned) c->contexts[i]);
for(j=0;j<MAX_VARS/(8*sizeof(int));j++) // Beeson 8.9.02
fprintf(fp, " forbidden %x\n", c->forbidden[i][j]); // Beeson 8.9.02
}
} /* print_subst */
/*************
*
* p_subst(context)
*
*************/
void p_subst(struct context *c)
{
print_subst(stdout, c);
} /* p_subst */
/*************
*
* print_trail(file_ptr, context)
*
*************/
void print_trail(FILE *fp,
struct trail *t)
{
struct trail *t2;
fprintf(fp, "Trail:");
t2 = t;
while (t2 != NULL) {
fprintf(fp, " <%d,%x>", t2->varnum, (unsigned) t2->context);
t2 = t2->next;
}
fprintf(fp, ".\n");
} /* print_trail */
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists