Sindbad~EG File Manager
/* beta reduction */
/* Author: M. Beeson */
#include <assert.h>
#include "header.h"
#include "beta.h"
#include "bterms.h"
#include "bsym.h"
#include "unify2.h" // forbid
#include "unify.h" // BIND
static int rename_variables(term b, term a, int varnums[MAX_VARS], int *nextvar);
static struct term * fsubst(struct term *a, struct term *x, struct term *b, struct context *c);
// substitute a for x in b, using context c, renaming bound variables in c if necessary
/*__________________________________________________________________________*/
struct term * beta_reduce(struct term *t, struct context *c)
/* if t = ap(lambda(x,q), r) then return q[x:==r], renaming bound variables
of q if required to avoid conflict with the free variables of r. The returned
term is entirely new, but the original term is not destroyed. If t does
not have this form, then NULL is returned.
*/
{ struct term *x,*r,*s,*q, *ans;
if(FUNCTOR(t) != AP)
return NULL;
s = ARG0(t);
if(FUNCTOR(s) != LAMBDA)
return NULL;
x = ARG0(s);
q = ARG1(s);
r = ARG1(t);
#if 0 // DEBUG
fprintf(stdout,"\n fsubst ");
print_term_nl(stdout, r);
fprintf(stdout," for ");
print_term_nl(stdout,x);
fprintf(stdout," in ");
print_term_nl(stdout, q);
fprintf(stdout," yields\n");
#endif
ans = fsubst(r,x,q,c);
#if 0 // DEBUG
print_term_nl(stdout,ans);
#endif
return ans;
}
/*____________________________________________________________________________*/
static void vars_in(term t, int *varnums)
/* traverse t and mark in varnums the variables that occur in t, by putting a
1 at the index given by var_num. varnums is presumed to have dimension MAX_VARS. */
{ struct rel *r;
if (t->type == NAME)
return;
if (t->type == COMPLEX)
{ for(r = t->farg; r; r= r->narg)
{ vars_in(r->argval, varnums);
}
return;
}
// now t->type == VAR
varnums[t->varnum] = 1;
}
/*____________________________________________________________________________*/
int otter_contains(term t, term x)
/* x is presumed to be a variable or constant. Return 1 if t contains x, 0 if not */
{ struct rel *r;
int rval = 0;
if(t->type == NAME && x->type== NAME)
return t->sym_num == x->sym_num;
if(t->type == VARIABLE && x->type == VARIABLE)
return t->varnum == x->varnum;
if(t->type == NAME || t->type == VARIABLE)
return 0;
// Now t->type == COMPLEX
for(r = t->farg; r; r= r->narg)
{ rval = otter_contains(r->argval, x);
if(rval)
break;
}
return rval;
}
/*____________________________________________________________________________*/
static int rename_vars(term t, int varnums[MAX_VARS], int *nextvar)
/* Rename the bound variables in t by giving them var_nums whose entry in varnums is 0.
If varnums fills up return 1, otherwise return 0 for success. Increase *nextvar
if necessary to be larger than any of the renamed variables.
*/
{ struct rel *r;
term v;
int i;
if(t->type == VARIABLE && varnums[t->varnum] > 1)
{ t->varnum = varnums[t->varnum]-2;
return 0;
}
if(t->type != COMPLEX)
return 0;
r = t->farg;
if(BINDER(t->sym_num))
{ v = r->argval;
if(varnums[v->varnum] > 1)
v->varnum = varnums[v->varnum]-2; // already renamed
else
{ for(i=0;i<MAX_VARS;i++)
{ if(varnums[i] == 0)
{ varnums[v->varnum] = i+2; // store for further occurrences of this variable
v->varnum = i;
varnums[i] = 1; // don't use this variable again.
if(*nextvar <= i)
*nextvar = i+1;
break;
}
}
if(i==MAX_VARS)
return 1; // too many variables
}
r = r->narg;
}
// go on to the rest of the args (or do all the args if no bound variable was encountered)
for(;r; r=r->narg)
{ rename_vars(r->argval, varnums,nextvar);
}
return 0;
}
/*____________________________________________________________________________*/
static int rename_variables(term b, term a, int varnums[MAX_VARS], int *nextvar)
/* rename bound variables in b that occur in a (free or bound) so that
afterwards, no variable in a occurs bound in b. [Thus when a is substituted
for some free variable in b, there will be no accidental capture of the free
variables of a.] Do not use any varnum less than the initial value
of *nextvar.
Return 0 for success, 1 if renaming would create more than
MAX_VARS variables. Increase *nextvar from its initial value, if necessary,
to be larger than any renamed variable in b.
*/
{ int err,i;
// first traverse a and mark in varnums the variables that occur in a;
vars_in(a,varnums);
for(i=0;i<*nextvar;i++)
varnums[i]= 1;
// Now rename the bound variables of b to avoid the marked variables.
err = rename_vars(b,varnums, nextvar);
return err;
}
/*_________________________________________________________________________________________*/
static struct term * fsubst2(struct term *a, struct term *x, struct term *b, struct context *c)
/* substitute a for unbound occurrences of x in b, using context c. It is assumed
that the bound variables in b do not occur free in a.
It is not assumed that x is a variable, but if it is, b could contain subterms that
bind the same variable x again, so such subterms are skipped, i.e. copied.
This function is used in beta-reduction but a more general fsubst is used in unify2,
see fsubst3 in fsubst.c. An example of the difference is
substituting z for g(X) in g(Y). This function will return the unmodified g(Y).
fubst3 and fsubst4 will return z after unifying g(X) and g(Y) using the contexts and
trail that are required as extra parameters to those functions.
*/
{ term t, ans;
struct rel *r,*s;
struct context *d;
if(x->type == COMPLEX)
{ if(term_ident2(x,b,0))
return copy_term(a);
}
if(b->type == COMPLEX)
{ if(BINDER(b->sym_num) && VARNUM(ARG0(b))== VARNUM(x))
return copy_term(b);
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 = fsubst2(a,x,r->argval,c);
++s->argval->fpa_id; // FIX THIS -- McCune says not necessary
if(r->narg)
{ s->narg = get_rel();
s = s->narg;
}
// zap_term_special(r->argval); removed 2.7.03
}
return ans;
}
if(b->type == NAME)
return copy_term(b);
// now b->type == VARIABLE
if(b->varnum < MAX_VARS)
t = c->terms[b->varnum];
else
t = NULL;
if(!t)
{ if(x->varnum == b->varnum)
return copy_term(a);
return copy_term(b);
}
d = c->contexts[b->varnum];
// t->fpa_id++; /* count of extra references to a term */ // gets incremented AFTER the call.
return fsubst2(a,x,t,d);
}
/*____________________________________________________________________________*/
static struct term * fsubst(struct term *a, struct term *x, struct term *b, struct context *c)
/* Rename bound variables in b to avoid conflict with free variables of a. Then
substitute a for unbound occurrences of x in b, using context c.
It is NOT assumed that x is a variable. But if it is a bound variable,
b could contain subterms that bind the same variable x again, so such subterms are
skipped, i.e. copied.
*/
{ int varnums[MAX_VARS];
int err;
memset(varnums, 0, MAX_VARS * sizeof(int));
if(x->type == VARIABLE)
{ if(x->varnum < MAX_VARS)
varnums[x->varnum] = 1;
}
err = rename_variables(b,a,varnums,&c->next_var);
if(err)
abend("Too many variables required to rename bound variables to avoid accidental capture.");
return fsubst2(a,x,b,c);
}
/*__________________________________________________________________________*/
void rename2(int i, int j, term c)
/* rename variable i as variable j in term c */
{ struct rel *r;
if(c->type == NAME)
return;
if(c->type == VARIABLE)
{ if(c->varnum == i)
{ c->varnum = j;
if(c->sym_num) // variable left over from user input
c->sym_num = 0;
}
return;
}
for(r = c->farg;r;r = r->narg)
rename2(i,j,r->argval);
}
/*__________________________________________________________________________*/
void forbid_all(struct term *a, struct context *c1, struct term *x, struct context *c2)
/* forbid all uninstantiated free variables in a, other than x itself, to take the value x */
{ struct rel *r;
if(a->type == VARIABLE && (TYPE(x) != VARIABLE || a->varnum != x->varnum || c1 != c2))
{ if(c1->terms[a->varnum])
{ // a is already instantiated
forbid_all(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))
return;
// now a->type == COMPLEX
r = a->farg;
while(r != NULL)
{ forbid_all(r->argval,c1,x,c2);
r = r->narg;
}
}
/*__________________________________________________________________________*/
static void forbid_all2(struct term *a, struct context *c1, struct term *x, struct context *c2)
/* forbid all uninstantiated variables in a, other than x itself or
a variable in another context with the same varnum, to take the value x */
{ struct rel *r;
if(a->type == VARIABLE && (TYPE(x) != VARIABLE || a->varnum != x->varnum))
{ if(c1->terms[a->varnum])
{ // a is already instantiated
forbid_all2(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))
return;
// now a->type == COMPLEX
r = a->farg;
while(r != NULL)
{ forbid_all2(r->argval,c1,x,c2);
r = r->narg;
}
}
/*__________________________________________________________________________*/
void rename_bound(struct term *a, struct context *c1, struct term *b, struct context *c2, struct trail **trp)
/* It is assumed that a and b are terms with the same functor f, and
that this functor satisfies BINDING(f). For example, a = lambda(x,t)
and b = lambda(y,s). BIND one of the variables to the other (unless
they're already identical. Also, make both bound variables
forbidden to all variables in the scope of the binding, i.e. in
ARG1(a) and ARG1(b) except x.
*/
{ int varnums[MAX_VARS];
term x = ARG0(a);
term y = ARG0(b);
if(c1 == c2 && x->varnum == y->varnum)
return; // not necessary to do anything--don't BIND a variable to itself
validate_context(c1); // DEBUG 6.17.03
validate_context(c2); // DEBUG 6.17.03
fprintf(stdout,"Renaming bound variables in:\n"); // DEBUG 6.30.03
print_term_nl(stdout,a);
print_term_nl(stdout,b); // DEBUG 6.30.03
memset(varnums,0,MAX_VARS *sizeof(int));
vars_in(b,varnums);
BIND(x->varnum,c1,y,c2,trp);
forbid_all(ARG1(a),c1,x,c1);
forbid_all2(ARG1(b),c2,x,c1); // 6.29.03
forbid_all(ARG1(b),c2,y,c2); // 6.26,29.03
forbid_all2(ARG1(b),c2,x,c1); // 6.26,29.03
}
/*____________________________________________________________*/
int forbid_bound(struct context *p, struct term *t)
/* make all bound variables in t forbidden to all variables
occurring in the scope of the binding operator. This is called
by get_context2. Also, make p->bound[i] = 1 when variable i occurs
bound in t. Return value is always 1--this function needs to be
called in an if-test so it needs a return value.
*/
{ struct term *x;
struct rel *r;
if(t->type == COMPLEX && BINDER(t->sym_num))
{ x = ARG0(t);
if(x->type != VARIABLE)
{ fprintf(stdout, "Oops, non-variable appears where variable expected in\n");
print_term_nl(stdout,t);
assert(0);
}
p->bound[x->varnum] = 1;
for(r = t->farg->narg;r;r=r->narg)
forbid_all(r->argval,p,x,p);
}
if(t->type == COMPLEX)
{ for(r=t->farg;r;r=r->narg)
forbid_bound(p,r->argval);
}
return 1;
}
void clear_forbidden(struct context *c)
// free all memory in the forbidden[i] lists and set them to 0
{ int i;
for(i=0;i<MAX_VARS;i++)
{ if(c->forbidden[i])
{ free_int_ptr(c->forbidden[i]);
c->forbidden[i] = 0;
}
}
}
/*________________________________________________________________________*/
struct context *get_context2(struct clause *c, int multiplier)
/* Beeson 8.16.02
It is used to replace get_context, when there is a parent clause at hand,
so that the next_var field can be set sensibly. The next_var field
should point to a var_num greater than all the var_nums of variables in the
clause c. Each bound variable should be forbidden to all variables
occurring in the scope of the binding operator. The bound[] array
of the context should be set to contain a 1 for each variable occurring
bound in clause c. In Otter2, each variable in a clause must occur
bound or free--it cannot have some free and some bound occurrences. It
can have several bound occurrences, with scopes either disjoint or nested.
*/
{
struct context *p = get_context();
static int count=0;
struct literal *lit;
if(c==NULL)
abend("get_context2 called with a NULL parameter"); // c must point to a context
memset(p->terms,0,MAX_VARS * sizeof(int*));
memset(p->forbidden,0,MAX_VARS * sizeof(restrictdata));
memset(p->contexts,0,MAX_VARS * sizeof(struct context *));
memset(p->bound,0,MAX_VARS * sizeof(char));
p->multiplier = multiplier;
p->next_var = c->next_var;
if(c->next_var < 0)
assert(0);
for(lit = c->first_lit; lit; lit = lit->next_lit)
forbid_bound(p,lit->atom);
p->next = NULL; // added 12.3.05
return(p);
} /* get_context2 */
/*_________________________________________________________*/
struct context * copy_context(struct context *c)
/* return a copy of c, but in all new space, with a NULL next pointer */
{ struct context *p = get_context();
memcpy(p->terms,c->terms,MAX_VARS * sizeof(int*));
memcpy(p->forbidden,c->forbidden,MAX_VARS*sizeof(restrictdata));
memcpy(p->contexts,c->contexts,MAX_VARS *sizeof(struct context *));
memcpy(p->bound,c->bound,MAX_VARS *sizeof(char));
p->multiplier = c->multiplier;
p->next_var = c->next_var;
p->next = NULL;
return p;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists