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); }