ATerm createMustSum(ATerm sum){
ATerm cond, newCond, condSort, act, newAct, newSum;
char newActName[250];
AFun memberTag;
ATbool toAbs = ATfalse;
memberTag = createNewFuncSym(memberSym,
ATmakeList2(MCRLterm_bool, liftSort(MCRLterm_bool)));
cond = (ATerm) ATgetArgument((ATermAppl) sum ,4);
condSort = getTermSort(cond);
if(isLifted(condSort)) toAbs = ATtrue;
if(isAbstracted(condSort))
cond = createGammaTerm(cond, condSort);
if(toAbs){
newCond = (ATerm) ATmakeAppl1(MCRLsym_not,
(ATerm) ATmakeAppl2(memberTag, MCRLterm_false, cond));
}
else{
newCond = cond;
newSum = sum;
}
newSum = (ATerm) ATsetArgument((ATermAppl) sum, (ATerm) newCond, 4);
act = (ATerm) ATgetArgument((ATermAppl) sum, 1);
appendString(MCRLgetName(act), mustSufix, newActName);
newAct = (ATerm) ATmakeAppl0(ATmakeAFun(newActName, 0, ATtrue));
return (ATerm) ATsetArgument((ATermAppl) newSum, newAct, 1);
}
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);
}
ATermList procAbstraction(ATermList procArgs){
ATerm procArg, newTerm, par, parSort, parName;
ATermList newProcArgs = ATmakeList0();
ATermList pars = MCRLgetListOfPars();
ATerm termSort;
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);
newTerm = termAbstraction(procArg, parSort);
termSort = getTermSort(newTerm);
if(isAbstracted(termSort) && !isAbstracted(parSort)){
if(!isLifted(termSort)){
newTerm = createSingTerm(newTerm, liftSort(termSort));
termSort = liftSort(termSort);
}
newTerm = createGammaTerm(newTerm, termSort);
if(-1 == ATindexOf(conflictingPars, parName , 0))
conflictingPars = ATappend(conflictingPars, parName);
}
newProcArgs = ATappend(newProcArgs, newTerm);
}
return newProcArgs;
}
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);
}
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;
} }
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 writeConstructor(A2PWriter writer, A2PType expected, ATermAppl constructor){
A2PConstructorType t = (A2PConstructorType) expected->theType;
A2PTupleType children = ((A2PTupleType) t->children->theType);
int nrOfChildren = typeArraySize(children->fieldTypes);
ISIndexedSet sharedTypes = writer->typeSharingMap;
int typeHash = hashType(expected);
int constructorTypeId = ISget(sharedTypes, (void*) expected, typeHash);
int arity = ATgetArity(ATgetAFun(constructor));
int i;
if(arity != nrOfChildren){ fprintf(stderr, "Arity (%d) is unequal to the number of children (%d); term was:\n%s\n", arity, nrOfChildren, ATwriteToString((ATerm) constructor)); exit(1);}
if(constructorTypeId == -1){
writeByteToBuffer(writer->buffer, PDB_CONSTRUCTOR_HEADER);
doWriteType(writer, expected);
ISstore(sharedTypes, (void*) expected, typeHash);
}else{
writeByteToBuffer(writer->buffer, PDB_CONSTRUCTOR_HEADER | PDB_TYPE_SHARED_FLAG);
printInteger(writer->buffer, constructorTypeId);
}
printInteger(writer->buffer, arity);
for(i = 0; i < arity; i++){
doSerialize(writer, children->fieldTypes[i], ATgetArgument(constructor, i));
}
}
static void writeNode(A2PWriter writer, A2PType expected, ATermAppl node){
AFun fun = ATgetAFun(node);
int arity = ATgetArity(fun);
char *name = ATgetName(fun);
int i;
unsigned int hash = hashString(name);
int nodeNameId = ISstore(writer->nameSharingMap, (void*) name, hash);
if(nodeNameId == -1){
int nameLength = dataArraySize(name);
writeByteToBuffer(writer->buffer, PDB_NODE_HEADER);
printInteger(writer->buffer, nameLength);
writeDataToBuffer(writer->buffer, name, nameLength);
}else{
writeByteToBuffer(writer->buffer, PDB_NODE_HEADER | PDB_NAME_SHARED_FLAG);
printInteger(writer->buffer, nodeNameId);
}
printInteger(writer->buffer, arity);
for(i = 0; i < arity; i++){
doSerialize(writer, A2PvalueType(), ATgetArgument(node, i));
}
}
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 void writeAnnotatedNode(A2PWriter writer, A2PType expected, ATermAppl node, ATermList annotations){
A2PNodeType t = (A2PNodeType) expected->theType;
AFun fun = ATgetAFun(node);
int arity = ATgetArity(fun);
char *name = ATgetName(fun);
int nrOfAnnotations = ATgetLength(annotations);
int i;
ATerm annotationLabel;
ATerm annotationValue;
unsigned int hash = hashString(name);
int nodeNameId = ISstore(writer->nameSharingMap, (void*) name, hash);
if(nodeNameId == -1){
int nameLength = dataArraySize(name);
writeByteToBuffer(writer->buffer, PDB_ANNOTATED_NODE_HEADER);
printInteger(writer->buffer, nameLength);
writeDataToBuffer(writer->buffer, name, nameLength);
}else{
writeByteToBuffer(writer->buffer, PDB_ANNOTATED_NODE_HEADER | PDB_NAME_SHARED_FLAG);
printInteger(writer->buffer, nodeNameId);
}
printInteger(writer->buffer, arity);
for(i = 0; i < arity; i++){
doSerialize(writer, A2PvalueType(), ATgetArgument(node, i));
}
/* Annotations. */
if((nrOfAnnotations % 2) == 1){ fprintf(stderr, "Detected corrupt annotations (Unbalanced).\n"); exit(1); }
printInteger(writer->buffer, nrOfAnnotations);
do{
char *label;
int labelLength;
A2PType annotationType;
annotationLabel = ATgetFirst(annotations);
annotations = ATgetNext(annotations);
annotationValue = ATgetFirst(annotations);
annotations = ATgetNext(annotations);
if(ATgetType(annotationLabel) != AT_APPL){ fprintf(stderr, "Detected corrupt annotation; label term is not a 'string'.\n"); exit(1); }
label = ATgetName(ATgetAFun((ATermAppl) annotationLabel));
labelLength = dataArraySize(label);
printInteger(writer->buffer, labelLength);
writeDataToBuffer(writer->buffer, label, labelLength);
annotationType = (A2PType) HTget(t->declaredAnnotations, (void*) label, hashString(label));
doSerialize(writer, annotationType, annotationValue);
}while(!ATisEmpty(annotations));
}
static void writeAnnotatedConstructor(A2PWriter writer, A2PType expected, ATermAppl constructor, ATermList annotations){
A2PConstructorType t = (A2PConstructorType) expected->theType;
ISIndexedSet sharedTypes = writer->typeSharingMap;
int typeHash = hashType(expected);
int constructorTypeId = ISget(sharedTypes, (void*) expected, typeHash);
int arity = ATgetArity(ATgetAFun(constructor));
int nrOfAnnotations = ATgetLength(annotations);
int i;
ATerm annotationLabel;
ATerm annotationValue;
if(constructorTypeId == -1){
writeByteToBuffer(writer->buffer, PDB_ANNOTATED_CONSTRUCTOR_HEADER);
doWriteType(writer, expected);
ISstore(sharedTypes, (void*) expected, typeHash);
}else{
writeByteToBuffer(writer->buffer, PDB_ANNOTATED_CONSTRUCTOR_HEADER | PDB_TYPE_SHARED_FLAG);
printInteger(writer->buffer, constructorTypeId);
}
printInteger(writer->buffer, arity);
for(i = 0; i < arity; i++){
doSerialize(writer, ((A2PTupleType) t->children->theType)->fieldTypes[i], ATgetArgument(constructor, i));
}
/* Annotations. */
if((nrOfAnnotations % 2) == 1){ fprintf(stderr, "Detected corrupt annotations (Unbalanced).\n"); exit(1); }
printInteger(writer->buffer, nrOfAnnotations);
do{
char *label;
int labelLength;
A2PType annotationType;
annotationLabel = ATgetFirst(annotations);
annotations = ATgetNext(annotations);
annotationValue = ATgetFirst(annotations);
annotations = ATgetNext(annotations);
if(ATgetType(annotationLabel) != AT_APPL){ fprintf(stderr, "Detected corrupt annotation; label term is not a 'string'.\n"); exit(1); }
label = ATgetName(ATgetAFun((ATermAppl) annotationLabel));
labelLength = dataArraySize(label);
printInteger(writer->buffer, labelLength);
writeDataToBuffer(writer->buffer, label, labelLength);
annotationType = (A2PType) HTget(t->declaredAnnotations, (void*) label, hashString(label));
doSerialize(writer, annotationType, annotationValue);
}while(!ATisEmpty(annotations));
}
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);
}
ATerm addVar(ATerm sum, ATerm varName, ATerm varSort){
ATermList vars = ATmakeList0();
ATerm var;
AFun vTag = ATmakeSymbol("v",2, ATfalse);
vars = (ATermList) ATgetArgument((ATermAppl) sum ,0);
vars = ATinsert(vars,(ATerm)ATmakeAppl2(vTag,varName,varSort));
return (ATerm) ATsetArgument((ATermAppl) sum, (ATerm) vars, 0);
}
ATerm funcAbstraction(ATerm func, ATerm dstSort){
ATermList argSorts;
ATerm newTerm, newTermSort;
ATerm arg, argSort, fSort, argSortAux;
ATbool modified;
int i, j;
char *fName;
AFun fun;
argSorts = getFuncSortList(func);
fSort = getTermSort(func);
fun = ATgetAFun(func);
fName = ATgetName(fun);
if(reservedFunc(fun))
return func;
do{
modified = ATfalse;
for(i=0; i< ATgetArity(ATgetAFun(func)); i++){
arg = ATgetArgument((ATermAppl) func, i);
argSort = ATelementAt(argSorts, i);
if(toAbstractArg(argSort, argSorts, fSort))
argSort = liftSort(abstractSort(getUnLifted(argSort)));
newTerm = termAbstraction(arg, argSort);
newTermSort = getTermSort(newTerm);
if(newTerm != arg)
modified = ATtrue;
func = (ATerm) ATsetArgument((ATermAppl) func, newTerm, i);
argSorts = ATreplace(argSorts, newTermSort, i);
if(toAbstractTarget(newTermSort, fSort))
fSort = liftSort(abstractSort(getUnLifted(fSort)));
if(toLiftTarget(newTermSort, fSort))
fSort = liftSort(fSort);
if(modified) break;
}
} while(modified);
if(toAbstractSort(fSort) && abstractedSorts(argSorts))
fSort = liftSort(abstractSort(getUnLifted(fSort)));
func = createNewFuncTerm(func, argSorts, fSort);
return func;
}
static ATerm _ProveCondition(ATerm c) {
/* Obliged that last branch must be "if (b, T, F)"
Invariant will be used at each first argument of "if" */
ATerm result = c;
ATermList ts = ATempty;
while (ATgetAFun(c)==MCRLsym_ite &&
ATgetArgument((ATermAppl) c, 2) == MCRLterm_false) {
ts = ATinsert(ts, ATgetArgument((ATermAppl) c, 0));
c = ATgetArgument((ATermAppl) c, 1);
}
if (ATisEmpty(ts)) return result;
else {
int n = ATgetLength (ts), i;
DECLA(ATerm, l, n);DECLA(ATerm, r, n); DECLA(ATerm, s, n);
ATerm I = MCRLgetInvariant(0);
for (i=n-1;i>=0;i--, ts = ATgetNext(ts))
l[i] = ATgetFirst(ts);
for (i=0;i<n;i++) {
int j, p;
for (p = 0, j=n-1;j>=0;j--)
if (i!=j) {
s[p] =
(ATerm) ATmakeAppl3(MCRLsym_ite, l[j],
p>0?s[p-1]:MCRLterm_true,MCRLterm_false);
p++;
}
r[i] = p>0?s[p-1]:MCRLterm_true;
}
for (i=0;i<n;i++) {
/* If proven (I and r) -> l then (c = l and r) will be replaced by r */
ATerm IandR = (ATerm) ATmakeAppl2(MCRLsym_and, I, r[i]),
arrow = Prove((ATerm) ATmakeAppl3(MCRLsym_ite, IandR, l[i],
MCRLterm_true));
/* ATwarning("QQQA %t", MCRLprint(arrow)); */
if (ATisEqual(arrow, MCRLterm_true)) {
return r[i];
}
}
return result;
}
}
static void DisabledEdges(ATermList gs) {
ATermList smds = MCRLgetListOfSummands(),
pars = MCRLgetListOfPars();
int false_cnt = 0, true_cnt = 0, n = ATgetLength(smds);
static int k = 1;
SubstituteInPars(pars, gs);
for (;!ATisEmpty(smds);smds=ATgetNext(smds)) {
ATerm smd = ATgetFirst(smds),
c = ATgetArgument((ATermAppl) smd,4),
cw = NULL;
if (!ATisEmpty((ATermList) ATgetArgument((ATermAppl) smd, 0)))
ATerror("Flag -extra is used while sum variables occur");
cw = RWrewrite(c);
if (
ATisEqual(cw, MCRLterm_false)) false_cnt++;
if (
ATisEqual(cw, MCRLterm_true)) true_cnt++;
}
fprintf(stdout, "Summand %d N = %d disabled %d enabled %d\n",
k++, n, false_cnt, true_cnt);
}
static ATbool Reduce(void) {
ATerm proc = MCRLgetProc();
ATermList sums = MCRLgetListOfSummands(),
pars = MCRLgetListOfPars();
ATermList newsums = ATmakeList0();
if (proverFlag) {
Declare_vars(pars);
if (invariant) MCRLparseInvariants(invariant);
}
else
RWdeclareVariables(pars);
for (cnt=0,newcnt = 0;!ATisEmpty(sums);sums=ATgetNext(sums),cnt++) {
ATerm sum = ATgetFirst(sums), newsum = NULL;
ATermList vars = (ATermList) ATgetArgument((ATermAppl) sum,0);
ATerm actname = ATgetArgument((ATermAppl) sum, 1);
ATermList actargs = (ATermList) ATgetArgument((ATermAppl) sum,2);
ATerm procarg = ATgetArgument((ATermAppl) sum, 3);
ATerm cond = ATgetArgument((ATermAppl) sum,4);
ATbool invariantUsed = ATfalse;
if (proverFlag) {
if (!ATisEmpty(vars)) Declare_vars(vars);
cond = Prove(cond);
if (invariant) {
ATerm cond1 = ProveCondition(cond);
if (!ATisEqual(cond1, cond)) {
invariantUsed = ATtrue;
cond = cond1;
}
/* ATwarning("QQQ cond = %t", cond); */
}
cond = RWrewrite(cond);
}
else {
if (!ATisEmpty(vars)) RWdeclareVariables(vars);
cond = RWrewrite(cond);
}
/* if (monitor) ATwarning("Condition of summand %d is rewritten", cnt+1); */
if (ATisEqual(cond, MCRLterm_false)) continue;
newcnt++;
actargs = RWrewriteList(actargs);
if (!ATisEqual(procarg, MCRLterm_terminated)) {
ATermList states = (ATermList) ATgetArgument((ATermAppl) procarg, 0);
states = proverFlag?ProveList(states):RWrewriteList(states);
procarg = (ATerm) ATmakeAppl1(MCRLsym_i, (ATerm) states);
}
newsum = ATmake("smd(<term>,<term>,<term>,<term>,<term>)",vars, actname,
actargs,procarg, cond);
newsums = ATinsert(newsums, newsum);
if (monitor && !ATisEqual(sum, newsum))
ATwarning("Summand %d is rewritten %s", cnt+1,
invariantUsed?"(invariant is used)":"");
}
MCRLsetProc(ATmake("initprocspec(<term>,<term>,<term>)",
(ATerm) RWrewriteList((ATermList) MCRLgetListOfInitValues()),
pars, (ATerm) ATreverse(newsums)));
return !ATisEqual(MCRLgetProc(), proc);
}
ATerm sumAbstraction(ATerm proc){
ATerm procSpec, cond, newTerm;
ATermList procArgs, actArgs;
ATermList inits;
procSpec = ATgetArgument(proc, 3);
procArgs = (ATermList)ATgetArgument((ATermAppl) procSpec,0);
newTerm = (ATerm) procAbstraction(procArgs);
procSpec = (ATerm)ATsetArgument((ATermAppl)procSpec, newTerm, 0);
proc = (ATerm)ATsetArgument((ATermAppl)proc, procSpec, 3);
actArgs = (ATermList)ATgetArgument(proc,2);
newTerm = (ATerm)actAbstraction(actArgs);
proc = (ATerm)ATsetArgument((ATermAppl)proc, newTerm, 2);
cond = ATgetArgument(proc, 4);
newTerm = condAbstraction(cond);
proc = (ATerm)ATsetArgument((ATermAppl)proc, newTerm, 4);
return proc;
}
ATerm get_new_module_name(int cid, ATerm searchPaths, const char *path, const char* id)
{
ATermList search = (ATermList) searchPaths;
char chosenPath[PATH_LEN] = "";
int chosenPathLen = 0;
char chosenId[PATH_LEN];
/* We will choose the longest search path that matches the path of
* the chosen module.
*/
for (; !ATisEmpty(search); search = ATgetNext(search)) {
char *current = ATgetName(ATgetAFun((ATermAppl) ATgetArgument(ATgetFirst(search), 1)));
int currentLen = strlen(current);
if (strncmp(current, path, currentLen) == 0) {
if (currentLen > chosenPathLen) {
strcpy(chosenPath, current);
chosenPathLen = currentLen;
}
}
}
/* Now construct a compound module id to complete
* the filename.
*/
if (chosenPathLen > 0) {
int i = chosenPathLen;
while (path[i] == SEP) {
i++;
}
if (strcmp(chosenPath, path) == 0) {
strcpy(chosenId, id);
}
else {
sprintf(chosenId, "%s%c%s", path+i, SEP, id);
}
return ATmake("snd-value(new-module-name(<str>,<str>))", chosenPath,
chosenId);
}
else {
return ATmake("snd-value(module-name-inconsistent)");
}
}
void CAESAR_DELTA_STATE(CAESAR_TYPE_FILE fp,CAESAR_TYPE_STATE s1,CAESAR_TYPE_STATE s2) {
ATermList pars = (ATermList)MCRLgetListOfPars();
ATermList l1 = (ATermList)LTSgetState(s1->state);
ATermList l2 = (ATermList)LTSgetState(s2->state);
while (!ATisEmpty(pars)) {
ATerm x1 = ATgetFirst(l1);
ATerm x2 = ATgetFirst(l2);
if (x1 != x2)
ATfprintf(fp,"%t := %t; ",
MCRLprint(ATgetArgument(ATgetFirst(pars),0)),
MCRLprint(x2));
l1 = ATgetNext(l1);
l2 = ATgetNext(l2);
pars = ATgetNext(pars);
}
// fprintf(fp,"Diff: %d - %d",s1->state,s2->state);
}
static void writeTuple(A2PWriter writer, A2PType expected, ATermAppl tuple){
A2PTupleType t = (A2PTupleType) expected->theType;
A2PType *fieldTypes = t->fieldTypes;
int numberOfFieldTypes = typeArraySize(fieldTypes);
int arity = ATgetArity(ATgetAFun(tuple));
int i;
if(numberOfFieldTypes != arity){ fprintf(stderr, "The number of children specified in the type is not equal to the arity of this tuple.\n"); exit(1); }
writeByteToBuffer(writer->buffer, PDB_TUPLE_HEADER);
printInteger(writer->buffer, arity);
for(i = 0; i < arity; i++){
doSerialize(writer, fieldTypes[i], ATgetArgument(tuple, i));
}
}
static ATbool occurs_rec(ATerm var, ATerm t, ATbool *nonempty) {
/* invariants:
- var doesn't occur in terms in No_occurs
- nonempty iff No_occurs is not empty
*/
ATbool b;
if (var==t) return ATtrue;
else if (ATisVariable(t)) return ATfalse;
else if (*nonempty && ATindexedSetGetIndex(No_occurs,t)>=0) return ATfalse;
else {
int i;
for (i=ATgetArity(ATgetSymbol(t))-1;i>=0;i--)
if (occurs_rec(var, ATgetArgument(t,i),nonempty)) return ATtrue;
}
*nonempty = ATtrue;
ATindexedSetPut(No_occurs,t,&b);
return ATfalse;
}
ATbool toLiftFunc(ATerm func){
ATerm arg;
int i;
ATermList argSorts, args;
ATerm fSort, argSort;
fSort = getTermSort(func);
argSorts = getFuncSortList(func);
if(toAbstractSort(fSort))
return ATtrue;
for(i=0; i< ATgetArity(ATgetAFun(func)); i++){
arg = ATgetArgument((ATermAppl) func, i);
if(toLiftTerm(arg))
return ATtrue;
}
return ATfalse;
}
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;
}
}
void CAESAR_PRINT_STATE(CAESAR_TYPE_FILE f,CAESAR_TYPE_STATE s) {
// fprintf(f,"PRINT_STATE %d",s->state);
ATermList values = (ATermList)LTSgetState(s->state);
ATermList names = MCRLgetListOfPars();
if (state_format>=1)
fprintf(f,"\n(");
else
fprintf(f,"(");
while (!ATisEmpty(values)) {
if (state_format>=1)
ATfprintf(f,"%t = ",MCRLprint(ATgetArgument(ATgetFirst(names),0)));
ATfprintf(f,"%t",MCRLprint(ATgetFirst(values)));
values=ATgetNext(values);
names=ATgetNext(names);
if (!ATisEmpty(values))
if (state_format>=1)
fprintf(f,",\n");
else
fprintf(f,",");
}
fprintf(f,")");
}
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;
} }
ATermList initAbstraction(ATermList inits){
ATermList pars = MCRLgetListOfPars();
ATermList newInits = ATmakeList0();
ATerm init, par, parSort, newTerm, initSort;
for (;!ATisEmpty(inits); inits= ATgetNext(inits), pars = ATgetNext(pars)){
init = ATgetFirst(inits);
par = ATgetFirst(pars);
parSort = (ATerm) ATgetArgument((ATermAppl) par, 1);
newTerm = init;
initSort = getConcrete(getUnLifted(parSort));
if(isLifted(parSort)){
initSort = liftSort(initSort);
newTerm = createSingTerm(newTerm, initSort);
}
if(isAbstracted(parSort)){
newTerm = createAlphaTerm(newTerm, initSort);
}
newInits = ATappend(newInits, newTerm);
}
return newInits;
}
unsigned int calc_hash(ATerm t)
{
unsigned int hnr = 0;
switch(ATgetType(t)) {
case AT_APPL:
{
ATermAppl appl = (ATermAppl)t;
AFun sym = ATgetAFun(appl);
int i, arity = ATgetArity(sym);
hnr = AT_hashSymbol(ATgetName(sym), arity);
for(i=0; i<arity; i++) {
hnr = hnr * MAGIC_HASH_CONST_APPL + calc_hash(ATgetArgument(appl, i));
}
}
break;
case AT_INT:
hnr = ATgetInt((ATermInt)t);
break;
case AT_LIST:
{
ATermList list = (ATermList)t;
hnr = 123;
while(!ATisEmpty(list)) {
hnr = hnr * MAGIC_HASH_CONST_LIST +
calc_hash(ATgetFirst(list));
list = ATgetNext(list);
}
}
break;
}
return hnr;
}
ATerm ATR_getSecond(ATTuple tuple) {
return ATgetArgument((ATermAppl)tuple, 1);
}
ATerm ATR_getFirst(ATTuple tuple) {
return ATgetArgument((ATermAppl)tuple, 0);
}
