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;
} }
void abstractPars(){
ATermList pars = MCRLgetListOfPars();
ATermList newPars = ATmakeList0();
ATerm proc = MCRLgetProc();
ATerm par, parName, parSort;
for(;!ATisEmpty(pars); pars= ATgetNext(pars)){
par = (ATerm) ATgetFirst(pars);
parName = (ATerm) ATgetArgument((ATermAppl) par, 0);
parSort = (ATerm) ATgetArgument((ATermAppl) par, 1);
if(toAbstractPar(parName)){
parSort = liftSort(abstractSort(parSort));
}
if(toAbstractSort(parSort)){
parSort = liftSort(abstractSort(parSort));
}
if(!toAbstractSort(parSort) && BUT_SORT){
parSort = getConcrete(getUnLifted(parSort));
}
par = (ATerm) ATsetArgument((ATermAppl) par, parSort, 1);
newPars = ATappend(newPars, par);
ATtablePut(par_tab, parName, parSort);
}
proc = (ATerm) ATsetArgument((ATermAppl)proc,(ATerm) newPars, 1);
MCRLsetProc(proc);
}
PT_Tree PT_findTreeParentRecursive(PT_Tree needle, PT_Tree haystack)
{
assert(needle != NULL);
assert(haystack != NULL);
assert(needle != haystack);
if (ATtableGet(findParentCache, PT_TreeToTerm(haystack)) != NULL) {
return NULL;
}
if (PT_hasTreeArgs(haystack)) {
PT_Args children = PT_getTreeArgs(haystack);
while (!PT_isArgsEmpty(children)) {
PT_Tree child = PT_getArgsHead(children);
if (PT_isEqualTree(child, needle)) {
return haystack;
}
else {
PT_Tree suspect = PT_findTreeParentRecursive(needle, child);
if (suspect != NULL) {
return suspect;
}
}
children = PT_getArgsTail(children);
}
}
ATtablePut(findParentCache, PT_TreeToTerm(haystack), PT_TreeToTerm(NeedleNotHere));
return NULL;
}
void SG_AmbiTablesUpdateCluster(ATermInt idx, ATermList cluster)
{
if (!cluster_table || !index_table) {
SG_AmbiTablesCreate();
}
ATtablePut(cluster_table, (ATerm)idx, (ATerm)cluster);
}
static ATerm CaseRewrite(ATerm t) {
AFun f = ATgetAFun(t);
int n = ATgetArity(f);
ATerm u;
// ATwarning("%t", t);
if (n==0) return tasks->RWrewrite(t);
u = ATtableGet(norm, t);
if (u) return u;
{
int i;
ATerm *a = calloc(n, sizeof(ATerm));
ATbool changed = ATfalse;
ATprotectArray(a, n);
for (i=0; i<n; i++) {
ATerm arg = ATgetArgument((ATermAppl) t, i);
a[i] = CaseRewrite(arg);
if (!ATisEqual(a[i], arg)) changed = ATtrue;
}
u = CaseRewriteStep(changed?(ATerm) ATmakeApplArray(f, a):t);
ATtablePut(norm, t, u);
ATunprotect(a);
free(a);
return u;
}
}
static ATerm unfold_rec(ATerm t) {
/* Completely unfolds t according to equivalence.
invariants:
- loop_detection contains "ancestors" of t
- t is end point of find
- solution contains correct results [t -> s]
returns NULL: loop detected
returns s: s is unfolding of t.
*/
ATerm s;
ATbool no_loop;
char unifiable=1;
if (ATisVariable(t)) return t;
if ((s=ATtableGet(solution,t))) return s;
ATindexedSetPut(loop_detection,t,&no_loop);
if (no_loop) {
Symbol sym = ATgetSymbol(t);
int i,n=ATgetArity(sym);
ATerm *args = (ATerm*)alloca(n*sizeof(ATerm));
for (i=0;i<n;i++)
if (!(args[i] = unfold_rec(find(ATgetArgument(t,i))))) {
unifiable=0;
break;
}
ATindexedSetRemove(loop_detection,t);
if (unifiable) {
s=(ATerm)ATmakeApplArray(sym,args);
ATtablePut(solution,t,s);
return s;
} }
/* here either !no_loop, or !unifiable holds */
return NULL;
}
static void putSession(EM_Session session) {
EM_Sid sid;
assert(session != NULL);
sid = EM_getSessionId(session);
ATtablePut(sessions, EM_SidToTerm(sid), EM_SessionToTerm(session));
}
void abstractVars(){
ATermList newSums, sums = MCRLgetListOfSummands();
ATermList vars, newVars;
ATerm proc, sum;
ATerm var, varSort, varName, oldVarSort;
proc = MCRLgetProc();
newSums = ATmakeList0();
for(;!ATisEmpty(sums); sums= ATgetNext(sums)){
sum = ATgetFirst(sums);
vars = (ATermList) ATgetArgument((ATermAppl) sum ,0);
newVars = ATmakeList0();
for(;!ATisEmpty(vars); vars= ATgetNext(vars)){
var = (ATerm) ATgetFirst(vars);
varName = (ATerm) ATgetArgument((ATermAppl) var, 0);
varSort = (ATerm) ATgetArgument((ATermAppl) var, 1);
oldVarSort = ATtableGet(var_tab, varName);
if(oldVarSort != NULL)
if(varSort != getConcrete(oldVarSort)){
PP("Variable "); ppTerm(varName);
PP(" appears with two different types, ");
ppTerm(varSort); PP(" and "); pTerm(oldVarSort);
P("please modify the specification");
exit(-1);
}
if(toAbstractVar(varName)){
varSort = abstractSort(varSort);
}
if(toAbstractSort(varSort)){
varSort = abstractSort(varSort);
}
if(!toAbstractSort(varSort) && BUT_SORT){
varSort = getConcrete(varSort);
}
ATtablePut(var_tab, varName, varSort);
var = (ATerm) ATsetArgument((ATermAppl) var, varSort, 1);
newVars = ATinsert(newVars, var);
}
sum = (ATerm) ATsetArgument((ATermAppl) sum,
(ATerm) ATreverse(newVars), 0);
newSums = ATinsert(newSums, sum);
}
proc = (ATerm) ATsetArgument((ATermAppl) proc,
(ATerm)ATreverse(newSums), 2);
MCRLsetProc(proc);
}
static void SG_AmbiTablesAddIndex(ATerm key, size_t pos, ATermInt idx)
{
ATerm ambikey = SG_CreateAmbiKey(key, pos);
if (!cluster_table || !index_table) {
SG_AmbiTablesCreate();
}
ATtablePut(index_table, ambikey, (ATerm)idx);
}
static ATerm find(ATerm t) {
/* returns representative in 'equivalence',
shortening find-paths along the way (as in Union/Find) */
ATerm s = ATtableGet(equivalence,t);
if (s) {
ATerm r = find(s);
if (r != s) ATtablePut(equivalence,t,r);
return r;
}
return t;
}
ATbool _table_put(void)
{
ATerm table, key, value;
int i;
/* ATfprintf(stderr, "<table-put>%t\n", Ttop); */
if(MatchTriple(Ttop, &table, &key, &value))
{
/* ATfprintf(stderr, "<table-put>(%t,%t,%t)\n", table, key, value); */
lookup_table(i, table);
ATtablePut(ST_tables[i], key, value);
return ATtrue;
}
return ATfalse;
}
void *_table_put(void)
{
ATerm table, key, value;
int i;
/* ATfprintf(stderr, "<table-put>%t\n", Ttop()); */
if(MatchTriple(Ttop(), &table, &key, &value))
{
/* ATfprintf(stderr, "<table-put>(%t,%t,%t)\n", table, key, value); */
lookup_table(i, table);
ATtablePut(ST_tables[i], key, value);
return NULL;
}
return fail_address;
}
void *_create_table(void)
{
if(ST_table_table == NULL)
ST_table_table = ATtableCreate(100, 80);
if(ST_free_table >= NR_TABLES - 1)
{
ATfprintf(stderr, "create-table: too many tables\n");
exit(1);
}
/* ATfprintf(stderr, "<create-table>%t = %d\n", Ttop(), ST_free_table); */
ST_tables[ST_free_table] = ATtableCreate(117,75);
ATtablePut(ST_table_table, Ttop(), (ATerm)ATmakeInt(ST_free_table));
ST_free_table++;
return NULL;
}
void liftPars(){
ATermList sums, newSums;
ATerm sum;
ATerm procSpec, procArg;
ATermList procArgs;
ATermList pars, newPars;
ATerm proc = MCRLgetProc();
ATerm par, parName, parSort;
ATbool repeat;
do{
repeat = ATfalse;
sums = MCRLgetListOfSummands();
for(;!ATisEmpty(sums); sums= ATgetNext(sums)){
sum = ATgetFirst(sums);
procSpec = ATgetArgument(sum, 3);
procArgs = (ATermList)ATgetArgument((ATermAppl) procSpec,0);
pars = MCRLgetListOfPars();
newPars = ATmakeList0();
for(;!ATisEmpty(procArgs);
procArgs = ATgetNext(procArgs), pars = ATgetNext(pars)) {
procArg = ATgetFirst(procArgs);
par = ATgetFirst(pars);
parSort = (ATerm) ATgetArgument((ATermAppl) par, 1);
parName = (ATerm) ATgetArgument((ATermAppl) par, 0);
if(!isLifted(parSort)){
if(toLiftTerm(procArg)){
repeat = ATtrue;
parSort = liftSort(parSort);
}
}
par = (ATerm) ATsetArgument((ATermAppl) par, parSort, 1);
newPars = ATappend(newPars, par);
ATtablePut(par_tab, parName, parSort);
}
proc = (ATerm) ATsetArgument((ATermAppl)proc,(ATerm) newPars, 1);
MCRLsetProc(proc);
if(repeat) break;
fprintf(stderr,".");
}
}while(repeat);
}
static ATerm substVar_rec(ATerm t, ATerm var, ATerm s, ATbool *nonempty) {
/* invariants:
- Subst contains pairs (r , r[var := s])
- *nonempty iff Subst is not empty
*/
ATerm r;
if (var == t) return s;
else if (ATisVariable(t)) return t;
else if (*nonempty && (r=ATtableGet(Subst,t))) return r;
else {
Symbol sym = ATgetSymbol(t);
int i,n=ATgetArity(sym);
ATerm* args = (ATerm*)alloca(n*sizeof(ATerm));
for (i=0;i<n;i++)
args[i]=substVar_rec(ATgetArgument(t,i),var,s,nonempty);
r = (ATerm)ATmakeApplArray(sym,args);
*nonempty=ATtrue;
ATtablePut(Subst,t,r);
return r;
}
}
static void createMappingToPT(SDF_ProductionList productions)
{
mapping = ATtableCreate(1024, 75);
while (SDF_hasProductionListHead(productions)) {
SDF_Production prod = SDF_getProductionListHead(productions);
if (SDF_isProductionProd(prod)) {
PT_Production ptprod = SDFProductionToPtProduction(prod);
if (ptprod) {
ATtablePut(mapping, (ATerm) normalizeProduction(ptprod), (ATerm) prod);
}
}
if (!SDF_hasProductionListTail(productions)) {
break;
}
else {
productions = SDF_getProductionListTail(productions);
}
}
}
static ATerm substitute_rec(ATerm t, ATermSubst sigma, ATbool *nonempty) {
/* invariants:
- Subst contains pairs (r , r^sigma)
- *nonempty iff Subst is not empty
*/
ATerm s;
if (ATisVariable(t)) {
s=ATstackGet(sigma,ATgetInt((ATermInt)t));
return (s ? s : t);
}
else if (*nonempty && (s=ATtableGet(Subst,t)))
return s;
else {
Symbol sym = ATgetSymbol(t);
int i,n=ATgetArity(sym);
ATerm* args = (ATerm*)alloca(n*sizeof(ATerm));
for (i=0;i<n;i++)
args[i]=substitute_rec(ATgetArgument(t,i),sigma,nonempty);
s = (ATerm)ATmakeApplArray(sym,args);
*nonempty=ATtrue;
ATtablePut(Subst,t,s);
return s;
} }
void ATR_put(ATRelationStore store, ATerm key, ATSet set) {
ATtablePut(store, key, set);
}
void T_putValue(Table table, ATerm key, ATerm value)
{
ATtablePut((ATermTable)table, key, (ATerm)value);
}
static void putModuleId(ATerm sid, EM_ModuleId moduleId) {
assert(sid != NULL);
assert(moduleId != NULL);
ATtablePut(bindings, sid, EM_ModuleIdToTerm(moduleId));
}
