ATbool ATunifySystem(ATermStack system,ATermSubst sigma) {
/* Solves {system[0]=system[1], ...,system[2n-2]=system[2n-1]}
- returns 0: t1=t2 is not unifiable; sigma is reset.
- returns 1: ATermSubst represents the mgu {X1->t1,..,Xn->tn}
This implements the Pascal version of Baader/Nipkow.
(Linear space, nearly linear time)
- ATermTable equivalence contains the Union/Find structure
- ATermStack assigned contains the domain of the solution
First, the system is solved without occur-check
Subsequently, a substitution is computed, with loop detection.
*/
static char first_call = 1;
char unifiable = 1;
if (first_call) {
first_call=0;
assigned = ATstackCreate(40);
equivalence = ATtableCreate(40,40);
}
assert((!sigma) || (ATstackDepth(sigma)==0));
assert(ATstackDepth(assigned)==0);
assert(ATisEmpty(ATtableKeys(equivalence)));
while (ATstackDepth(system)>0) {
ATerm t1=find(ATstackPop(system));
ATerm t2=find(ATstackPop(system));
int i,n;
if (t1==t2) continue;
if (ATisVariable(t2))
{ ATerm t3=t1; t1=t2; t2=t3; }
if (ATisVariable(t1)) {
ATstackPush(assigned,t1);
ATtablePut(equivalence,t1,t2);
/* ATprintf("%t->%t\n",t1,t2); */
}
else { /* both t1 and t2 start with function symbol. */
Symbol s1 = ATgetSymbol(t1);
Symbol s2 = ATgetSymbol(t2);
if (s1!=s2) {
unifiable=0;
break;
}
else {
n = ATgetArity(s1);
ATtablePut(equivalence,t1,t2); /* note: forget about cardinality */
for (i=0;i<n;i++) {
ATstackPush(system,ATgetArgument(t1,i));
ATstackPush(system,ATgetArgument(t2,i));
} } } }
if (unifiable) return unfold_solution(sigma);
else {
ATstackReset(system);
ATstackReset(assigned);
ATtableReset(equivalence);
return ATfalse;
} }
ATerm ATsubstVar(ATerm t, ATerm var, ATerm s) {
ATerm result;
ATbool table_nonempty=ATfalse;
if (first_subst_call) {
first_subst_call=0;
Subst=ATtableCreate(16,40);
}
result = substVar_rec(t,var,s,&table_nonempty);
if (table_nonempty) ATtableReset(Subst);
return result;
}
ATerm ATsubstitute(ATerm t, ATermSubst sigma) {
ATerm result;
ATbool table_nonempty=ATfalse;
if (first_subst_call) {
first_subst_call=0;
Subst=ATtableCreate(16,40);
}
result = substitute_rec(t,sigma,&table_nonempty);
if (table_nonempty) ATtableReset(Subst);
return result;
}
PT_Tree PT_findTreeParent(PT_Tree needle, PT_Tree haystack)
{
PT_Tree result;
if (findParentCache == NULL) {
findParentCache = ATtableCreate(1024, 75);
NeedleNotHere = ATparse("needle-not-here");
ATprotect(&NeedleNotHere);
}
result = PT_findTreeParentRecursive(needle, haystack);
ATtableReset(findParentCache);
return result;
}
static char unfold_solution(ATermSubst sigma) {
/* - makes assigned, solution and equivalence empty
- doesn't alter equivalence, except shortening find paths
- returns 1: unifiable; sigma contains solution (except when NULL)
- returns 0: not unifiable; sigma is empty
Note: unfolding is also needed if sigma=NULL to detect loops.
*/
int i;
ATerm t;
char unifiable=1;
static char first_call=1;
if (first_call) {
first_call = 0;
loop_detection=ATindexedSetCreate(64,50);
solution = ATtableCreate(64,50);
}
assert(ATisEmpty(ATtableKeys(solution)));
for (i=ATstackDepth(assigned)-1;i>=0;i--) {
ATerm x = ATstackPop(assigned);
assert(ATisEmpty(ATindexedSetElements(loop_detection)));
t = unfold_rec(find(x));
if (t && sigma)
ATstackSet(sigma,ATgetInt((ATermInt)x),t);
else {
unifiable=0;
break;
} }
ATtableReset(solution);
ATtableReset(equivalence);
if (unifiable)
return ATtrue;
else {
ATstackReset(assigned);
if (sigma) ATstackReset(sigma);
return ATfalse;
} }
void RWflush(void) {
if (norm) ATtableReset(norm);
if (tasks->RWflush) tasks->RWflush();
}
void RWassignVariable(AFun var, ATerm t, ATerm tsort, int level) {
if (norm) ATtableReset(norm);
tasks->RWassignVariable(var, t, tsort, level);
}
