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;
}
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 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;
}
}
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 ATermInt SG_IndexTableGet(ATerm key, size_t pos)
{
ATermInt idx = NULL;
ATerm ambikey = SG_CreateAmbiKey(key, pos);
if (index_table) {
idx = (ATermInt)ATtableGet(index_table, ambikey);
}
return idx;
}
ATerm getTermSort(ATerm term){
ATerm sort;
if(isVariable(term)){
sort = ATtableGet(var_tab, term);
}
else if(isParameter(term)){
sort = ATtableGet(par_tab, term);
}
else {
sort = (ATerm) ATmake("<str>",ATgetName(MCRLgetSort(term)));
}
if(!strcmp("\"<int>\"", ATwriteToString(sort))){
PP("ERROR: ");
PP(ATgetName(MCRLgetSort(term)));
fprintf(stderr, " %d ", nSum);
pTerm(term);
exit(0);
}
return sort;
}
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;
}
void printResults(){
ATermList pars;
ATermList vars;
ATermList abstracted, lifted;
ATerm par, parSort;
ATerm var, varSort;
abstracted = ATmakeList0();
lifted = ATmakeList0();
pars = ATtableKeys(par_tab);
for(;!ATisEmpty(pars); pars = ATgetNext(pars)){
par = ATgetFirst(pars);
parSort = ATtableGet(par_tab, par);
if(isAbstracted(parSort)){
abstracted = ATinsert(abstracted, par);
}
else if (isLifted(parSort)){
lifted = ATinsert(lifted, par);
}
}
fprintf(stderr, "%d Parameters Abstracted:\n", ATgetLength(abstracted));
pTerm((ATerm) abstracted);
fprintf(stderr, "%d Parameters Lifted:\n", ATgetLength(lifted));
pTerm((ATerm) lifted);
fprintf(stderr, "%d Conflicting Parameters:\n",
ATgetLength(conflictingPars));
pTerm((ATerm) conflictingPars);
abstracted = ATmakeList0();
vars = ATtableKeys(var_tab);
for(;!ATisEmpty(vars); vars = ATgetNext(vars)){
var = ATgetFirst(vars);
varSort = ATtableGet(var_tab, var);
if(isAbstracted(varSort)){
abstracted = ATinsert(abstracted, var);
}
}
fprintf(stderr, "%d Variables Abstracted:\n", ATgetLength(abstracted));
pTerm((ATerm) abstracted);
}
static ATermList SG_ClusterTableGet(ATermInt idx)
{
ATermList cluster = NULL;
if (cluster_table && idx) {
cluster = (ATermList)ATtableGet(cluster_table, (ATerm)idx);
}
if (cluster) {
return cluster;
}
else {
return ATempty;
}
}
ATbool _table_get(void)
{
ATerm table, key, value;
int i;
if(MatchPair(Ttop, &table, &key))
{
/* ATfprintf(stderr, "<table-get>(%t,%t)\n", table, key); */
lookup_table(i, table);
value = ATtableGet(ST_tables[i], key);
if(value == NULL)
return ATfalse;
else
Tset(value);
return ATtrue;
}
return ATfalse;
}
void *_table_get(void)
{
ATerm table, key, value;
int i;
if(MatchPair(Ttop(), &table, &key))
{
/* ATfprintf(stderr, "<table-get>(%t,%t)\n", table, key); */
lookup_table(i, table);
value = ATtableGet(ST_tables[i], key);
if(value == NULL)
return fail_address;
else
Tset(value);
return NULL;
}
return fail_address;
}
static PT_Tree pAppl(PT_Tree tree, int *i)
{
int indent = *i;
PT_Args args = PT_getTreeArgs(tree);
PT_Production prod = PT_getTreeProd(tree);
SDF_Production sprod = (SDF_Production) ATtableGet(mapping, (ATerm) prod);
if (sprod != NULL) {
PT_Args newArgs = PT_makeArgsEmpty();
SDF_SymbolList slhs = SDF_getSymbolsList(SDF_getProductionSymbols(sprod));
PT_Symbols lhs = PT_getProductionLhs(prod);
PT_Tree nextLayout = NULL;
for (; !PT_isArgsEmpty(args); args = PT_getArgsTail(args), lhs = PT_getSymbolsTail(lhs)) {
PT_Tree head = PT_getArgsHead(args);
PT_Symbol sym = PT_getSymbolsHead(lhs);
// here we put in the layout that's in between the symbols on the lhs
if (PT_isOptLayoutSymbol(sym)) {
assert(nextLayout != NULL);
newArgs = PT_makeArgsList(createLayoutTree(indent, nextLayout), newArgs);
*i = calcIndentationLevel(indent, nextLayout);
nextLayout = NULL;
}
else {
SDF_Symbol ssym = SDF_getSymbolListHead(slhs);
PT_Symbol real = PT_getSymbolSymbol(sym);
newArgs = PT_makeArgsList(pTreeWithSymbol(head, i, real, ssym), newArgs);
if (SDF_hasSymbolListTail(slhs)) {
nextLayout = (PT_Tree) SDF_getSymbolListWsAfterFirst(slhs);
slhs = SDF_getSymbolListTail(slhs);
}
}
}
tree = PT_setTreeArgs(tree, PT_reverseArgs(newArgs));
}
else {
tree = PT_setTreeArgs(tree, pArgs(args, i));
}
return tree;
}
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 ATermList findSessions(ATerm moduleId) {
ATermList result;
ATermList bindingList;
EM_ModuleId needle;
assert(moduleId != NULL);
result = ATempty;
needle = EM_ModuleIdFromTerm(moduleId);
bindingList = ATtableKeys(bindings);
while (!ATisEmpty(bindingList)) {
EM_Sid cur = EM_SidFromTerm(ATgetFirst(bindingList));
EM_ModuleId peer = EM_ModuleIdFromTerm(ATtableGet(bindings,
EM_SidToTerm(cur)));
if (EM_isEqualModuleId(peer, needle)) {
result = ATinsert(result, EM_SidToTerm(cur));
}
bindingList = ATgetNext(bindingList);
}
return result;
}
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;
} }
ATSet ATR_get(ATRelationStore store, ATerm key) {
return ATtableGet(store, key);
}
ATerm T_getValue(Table table, ATerm key)
{
return ATtableGet((ATermTable)table, key);
}
static EM_Session getSession(ATerm sid) {
assert(sid != NULL);
return EM_SessionFromTerm(ATtableGet(sessions, sid));
}
ATbool isVariable(ATerm term){
if (NULL != ATtableGet(var_tab,term)){
return ATtrue;
}
return ATfalse;
}
ATbool isParameter(ATerm term){
if (NULL != ATtableGet(par_tab,term)){
return ATtrue;
}
return ATfalse;
}
static EM_ModuleId getModuleId(ATerm sid) {
assert(sid != NULL);
return EM_ModuleIdFromTerm(ATtableGet(bindings, sid));
}
