ATermList get_imports(ATermList decls)
{
ATerm decl, mod, spec;
ATermList mods, new_decls;
new_decls = ATmakeList0();
while(!ATisEmpty(decls)) {
decl = ATgetFirst(decls);
decls = ATgetNext(decls);
if(ATmatch(decl, "Imports([<list>])", &mods)) {
while(!ATisEmpty(mods)) {
mod = ATgetFirst(mods);
mods = ATgetNext(mods);
if(ATindexOf(imported, mod, 0) == -1)
{
if(!silent)
ATfprintf(stderr, " importing: %t\n", mod);
imported = ATinsert(imported, mod);
sprintf(file_name, "%s.r", t_string(mod));
spec = parse_file(file_name);
new_decls = ATconcat(spec_decls(spec), new_decls);
}
else
{
if(!silent)
ATfprintf(stderr, " importing: %t (done)\n", mod);
}
}
} else {
new_decls = ATinsert(new_decls, decl);
}
}
return new_decls;
}
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);
}
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);
}
ATermList ofp_coalesceTypeTable(ATermList oldTable)
{
// Assumes:
// 1. Contains list of terms Type(<str>,<list>) or OptType(<str>,<list>)
// a. <str> is type name
// b. <list> is [type] of length 1
// 2. Portions of table to be coalesced are in order
// 3. If OptType must match "(Some(<term>))"
//
ATerm head;
int isOptType;
ATermList table = (ATermList) ATmake("[]");
ATermList types = (ATermList) ATmake("[]");
ATermList tail = (ATermList) ATmake("<term>", oldTable);
if (ATisEmpty(tail)) {
return oldTable;
}
head = ATgetFirst(tail);
tail = ATgetNext(tail);
while (1) {
ATerm headName, headType, next, nextName, nextType;
if (ATisEmpty(tail)) next = ATmake("Type(None,[None])");
else next = ATgetFirst(tail);
if ( ATmatch(head, "Type(<term>,[<term>])", &headName, &headType) ) isOptType = 0;
else if ( ATmatch(head, "OptType(<term>,[<term>])", &headName, &headType) ) isOptType = 1;
else assert(0);
assert( ATmatch(next, "Type(<term>,[<term>])", &nextName, &nextType)
|| ATmatch(next, "OptType(<term>,[<term>])", &nextName, &nextType)
);
types = ATappend(types, headType);
// check for need to coalesce
if (! ATisEqual(headName, nextName)) {
if (isOptType) {
table = ATappend((ATermList)table, ATmake("OptType(<term>,<term>)", headName, types));
} else {
table = ATappend((ATermList)table, ATmake( "Type(<term>,<term>)", headName, types));
}
types = (ATermList) ATmake("[]");
if (ATisEmpty(tail)) break;
}
head = ATgetFirst(tail);
tail = ATgetNext(tail);
}
return table;
}
static void generateHeader(FILE *file, ATermList terms, ATermList afuns)
{
if (opt_gen_date) {
time_t now = time(NULL);
fprintf(file, "/*\n * Generated at %s", ctime(&now));
fprintf(file, " */\n\n");
}
fprintf(file, "#ifndef __%s_H\n", code_prefix);
fprintf(file, "#define __%s_H\n\n", code_prefix);
fprintf(file, "#include <aterm2.h>\n\n");
fprintf(file, "#include <assert.h>\n\n");
while (!ATisEmpty(afuns)) {
ATerm afun, alias, pair = ATgetFirst(afuns);
afuns = ATgetNext(afuns);
if (!ATmatch(pair, "[<term>,<term>]", &alias, &afun)) {
ATfprintf(stderr, "malformed [alias,afun] pair: %t\n", pair);
exit(1);
}
checkAlias(alias);
checkAFun(afun);
ATfprintf(file, "extern AFun %t;\n", alias);
}
fprintf(file, "\n");
while (!ATisEmpty(terms)) {
ATerm term, alias, pair = ATgetFirst(terms);
terms = ATgetNext(terms);
if (!ATmatch(pair, "[<term>,<term>]", &alias, &term)) {
ATfprintf(stderr, "malformed [alias,term] pair: %t\n", pair);
exit(1);
}
checkAlias(alias);
ATfprintf(file, "extern ATerm %t;\n", alias);
}
fprintf(file, "\nextern void init_%s();\n", code_prefix);
fprintf(file, "\n#endif /* __%s_H */\n", code_prefix);
}
/* For all non-terminals which are to the right of the dot in |item|, add
* that non-terminal's items to the set of |items| if they do not already
* exist. Note that only items that do not cause a priority conflict are
* added to the predicted items. */
static ATermList predict(Item item, ATermList items) {
int prodnr;
PT_Symbol dotsymbol;
ATermList prods;
if (IT_isValidItem(item)) {
dotsymbol = (PT_Symbol)IT_getDotSymbol(item);
if (!PT_isSymbolEmpty(dotsymbol)) {
prods = PGEN_getProductionNumbersOfRhsNonTerminal(dotsymbol);
if (prods) {
while (!ATisEmpty(prods)) {
/*ATwarning("prods = %t\n", prods);*/
prodnr = ATgetInt((ATermInt)ATgetFirst(prods));
prods = ATgetNext(prods);
if (!PGEN_isPriorityConflict(item, prodnr)) {
Item newitem = IT_createItem(prodnr);
items = ATinsert(items, IT_ItemToTerm(newitem));
}
}
}
}
}
return items;
}
static void writeSet(A2PWriter writer, A2PType expected, ATermList set){
A2PSetType setType = (A2PSetType) expected->theType;
A2PType elementType = setType->elementType;
ISIndexedSet sharedTypes = writer->typeSharingMap;
int elementHash = hashType(elementType);
int elementTypeId = ISget(sharedTypes, (void*) elementType, elementHash);
int size = ATgetLength(set);
ATermList next;
if(elementTypeId == -1){
writeByteToBuffer(writer->buffer, PDB_SET_HEADER);
doWriteType(writer, elementType);
ISstore(sharedTypes, (void*) elementType, elementHash);
}else{
writeByteToBuffer(writer->buffer, PDB_SET_HEADER | PDB_TYPE_SHARED_FLAG);
printInteger(writer->buffer, elementTypeId);
}
printInteger(writer->buffer, size);
next = set;
while(!ATisEmpty(next)){
ATerm current = ATgetFirst(next);
next = ATgetNext(next);
doSerialize(writer, elementType, current);
}
}
static void writeRelation(A2PWriter writer, A2PType expected, ATermList relation){
A2PRelationType relationType = (A2PRelationType) expected->theType;
A2PType tupleType = relationType->tupleType;
ISIndexedSet sharedTypes = writer->typeSharingMap;
int tupleHash = hashType(tupleType);
int tupleTypeId = ISget(sharedTypes, (void*) tupleType, tupleHash);
int size = ATgetLength(relation);
ATermList next;
if(tupleTypeId == -1){
writeByteToBuffer(writer->buffer, PDB_RELATION_HEADER);
doWriteType(writer, tupleType);
ISstore(sharedTypes, (void*) tupleType, tupleHash);
}else{
writeByteToBuffer(writer->buffer, PDB_RELATION_HEADER | PDB_TYPE_SHARED_FLAG);
printInteger(writer->buffer, tupleTypeId);
}
printInteger(writer->buffer, size);
next = relation;
while(!ATisEmpty(next)){
ATerm current = ATgetFirst(next);
next = ATgetNext(next);
doSerialize(writer, tupleType, current);
}
}
void specAbstraction(){
ATermList inits;
ATermList newSums, sums;
int i;
ATerm proc, sum, var, varName, parName, par;
ATermList vars, pars, newVars, newPars;
proc = MCRLgetProc();
P("Specification Abstraction");
inits = MCRLgetListOfInitValues();
inits = initAbstraction(inits);
proc = (ATerm) ATsetArgument((ATermAppl)proc, (ATerm) inits, 0);
MCRLsetProc(proc);
newSums = ATmakeList0();
sums = MCRLgetListOfSummands();
for(nSum = 1; !ATisEmpty(sums); sums= ATgetNext(sums), nSum++){
sum = ATgetFirst(sums);
sum = sumAbstraction(sum);
newSums = ATinsert(newSums, sum);
fprintf(stderr,".");
}
proc = (ATerm) ATsetArgument((ATermAppl) proc,
(ATerm) newSums, 2);
MCRLsetProc(proc);
fprintf(stderr,"\n");
}
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;
}
PT_Symbols PT_foreachSymbolInSymbols(PT_Symbols symbols, PT_SymbolVisitor visitor,
PT_SymbolVisitorData data)
{
ATermList store;
PT_Symbols newSymbols = PT_makeSymbolsEmpty();
/* apply func to each element */
store = ATempty;
while (PT_hasSymbolsHead(symbols)) {
store = ATinsert(store,
PT_SymbolToTerm(
visitor(PT_getSymbolsHead(symbols), data)));
if (PT_hasSymbolsTail(symbols)) {
symbols = PT_getSymbolsTail(symbols);
}
else {
break;
}
}
/* create new list */
for (; !ATisEmpty(store); store = ATgetNext(store)) {
PT_Symbol newSymbol = PT_SymbolFromTerm(ATgetFirst(store));
newSymbols = PT_makeSymbolsList(newSymbol,newSymbols);
}
return newSymbols;
}
//========================================================================================
// SgUntypedInitializedNameList
//----------------------------------------------------------------------------------------
ATbool traverse_SgUntypedInitializedNameList(ATerm term, SgUntypedInitializedNameList** var_SgUntypedInitializedNameList)
{
#ifdef PRINT_ATERM_TRAVERSAL
printf("... traverse_SgUntypedInitializedNameList: %s\n", ATwriteToString(term));
#endif
ATerm term1;
*var_SgUntypedInitializedNameList = NULL;
if (ATmatch(term, "SgUntypedInitializedNameList(<term>)", &term1)) {
SgUntypedInitializedNameList* plist = new SgUntypedInitializedNameList();
ATermList tail = (ATermList) ATmake("<term>", term1);
while (! ATisEmpty(tail)) {
SgUntypedInitializedName* arg;
ATerm head = ATgetFirst(tail);
tail = ATgetNext(tail);
if (traverse_SgUntypedInitializedName(head, (SgUntypedInitializedName**) &arg)) {
// SgUntypedInitializedName
plist->get_name_list().push_back(arg);
continue;
}
delete plist;
return ATfalse;
}
*var_SgUntypedInitializedNameList = plist;
}
else return ATfalse;
// turn on build functions (using BuildStmt) in sage-to-traverse.str
return ATtrue;
}
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);
}
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 ATermList mapInsertX(ATerm x, ATermList xs) {
ATermList result = ATempty;
while (!ATisEmpty(xs)) {
result = ATinsert(result, (ATerm)ATinsert((ATermList)ATgetFirst(xs), x));
xs = ATgetNext(xs);
}
return result;
}
static void prettyPrint(ATerm t, FILE *fp)
{
ATermList ambs;
int count;
int i;
if (ATmatch(t, "ambiguities(<int>,[<list>])",&count,&ambs)) {
if (count == 0) {
ATfprintf(fp,"No ambiguities\n");
}
else {
ATfprintf(fp, "%d ambiguity cluster%s:\n\n",count,count > 1 ? "s" : "");
for(i = 1;!ATisEmpty(ambs); ambs = ATgetNext(ambs), i++) {
ATerm amb = ATgetFirst(ambs);
ATermList productions;
ATerm line, col, offset;
if(ATmatch(amb,"ambiguity("
" position(character(0),"
" line(<term>),"
" col(<term>),"
" char(<term>)),"
" productions([<list>]))",
&line,
&col,
&offset,
&productions)) {
ATfprintf(fp,"[%d/%d] at (%t:%t):\n", i, count, line, col);
for(;!ATisEmpty(productions); productions = ATgetNext(productions)) {
char *str = deslash(ATgetFirst(productions));
ATfprintf(fp," %s\n", str);
free(str);
}
ATfprintf(fp,"\n");
} else {
ATerror("%s: Unexpected term: %t\n",myname,t);
}
}
}
} else {
ATerror("%s: Unexpected term: %t\n", myname,t);
return;
}
}
static ATermList CaseRewriteList(ATermList ts) {
ATermList r = ATempty;
for (; !ATisEmpty(ts); ts=ATgetNext(ts)) {
ATerm t = ATgetFirst(ts);
r = ATinsert(r, CaseRewrite(t));
}
return ATreverse(r);
}
ATbool ofp_traverse_Constructors(ATerm term, pOFP_Traverse Constructors)
{
#ifdef DEBUG_PRINT
printf("\nConstructors: %s\n", ATwriteToString(term));
#endif
OFP_Traverse OpDecl_list;
if (ATmatch(term, "Constructors(<term>)", &OpDecl_list.term) ) {
gTypeProductions = (ATermList) ATmake("[]");
/* First build the type aliase table. It is needed when matching productions.
*/
ATermList OpDeclInj_tail = (ATermList) ATmake("<term>", OpDecl_list.term);
while (! ATisEmpty(OpDeclInj_tail)) {
OFP_Traverse OpDeclInj;
OpDeclInj.term = ATgetFirst(OpDeclInj_tail);
OpDeclInj_tail = ATgetNext(OpDeclInj_tail);
if (ofp_traverse_OpDeclInj(OpDeclInj.term, &OpDeclInj)) {
// MATCHED OpDeclInj
gTypeProductions = ATappend(gTypeProductions, OpDeclInj.term);
}
}
/* Coalesce the type table so there is one name per list of types
*/
gTypeProductions = ofp_coalesceAliasTable(gTypeProductions);
ATermList OpDecl_tail = (ATermList) ATmake("<term>", OpDecl_list.term);
while (! ATisEmpty(OpDecl_tail)) {
OFP_Traverse OpDecl;
OpDecl.term = ATgetFirst(OpDecl_tail);
OpDecl_tail = ATgetNext(OpDecl_tail);
if (ofp_traverse_OpDecl(OpDecl.term, &OpDecl)) {
// MATCHED OpDecl
}
}
printf("\nPRODUCTIONS: %s\n", ATwriteToString((ATerm) gTypeProductions));
return ATtrue;
}
return ATfalse;
}
void RWdeclareVariables(ATermList variable_names) {
if (ATisEmpty(variable_names)) return;
tasks->RWdeclareVariables(variable_names);
if (!currentAdt) return;
if (ATgetArity(ATgetAFun(ATgetFirst(variable_names)))==0)
MCRLdeclareVarNames(variable_names);
else
MCRLdeclareVars(variable_names);
}
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);
}
static ATermList ProveList(ATermList args) {
ATermList r = ATempty;
AFun bool = ATgetAFun(MCRLterm_bool);
for (;!ATisEmpty(args);args=ATgetNext(args)) {
ATerm arg = ATgetFirst(args);
r = ATinsert(r, MCRLgetSort(arg)==bool?
RWrewrite(Prove(arg)):RWrewrite(arg));
}
return ATreverse(r);
}
static ATermList powerList0(ATermList list) {
if (ATisEmpty(list)) {
return ATinsert(ATempty, (ATerm)ATempty);
}
else {
ATerm x = ATgetFirst(list);
ATermList xs = ATgetNext(list);
ATermList xss = powerList0(xs);
return ATconcat(xss, mapInsertX(x, xss));
}
}
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 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 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);
}
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 void args2buf(ATermList args)
{
while(!ATisEmpty(args)) {
ATerm arg = ATgetFirst(args);
args = ATgetNext(args);
if(ATgetType(arg) != AT_LIST)
char2buf('{');
term2buf(arg);
if(ATgetType(arg) != AT_LIST)
char2buf('}');
char2buf(' ');
}
}
void DumpOneAction(FILE *out, parse_table *pt, int s)
{
actions val;
int c, nxt = 0;
for(c = 0; c <= SG_CHAR_CLASS_EOF; c++) {
if((val = SG_LookupAction(pt, SG_SETSTATE(s), c)) && !ATisEmpty(val)) {
if(!nxt++)
ATfprintf(out,"%d", s);
ATfprintf(out,"\t%d\t%t\n", c, val);
}
}
}
ATSet ATR_fromList(ATermList list) {
ATSet set = ATR_empty();
while (!ATisEmpty(list)) {
ATerm first = ATgetFirst(list);
if (ATgetType(first) == AT_LIST) {
set = ATR_insert(set, ATR_fromList((ATermList)first));
}
else {
set = ATR_insert(set, first);
}
list = ATgetNext(list);
}
return set;
}
