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;
}
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;
}
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_Symbols PT_appendSymbols(PT_Symbols symbols, PT_Symbol symbol)
{
return PT_SymbolsFromTerm(
(ATerm)ATappend((ATermList)PT_SymbolsToTerm(symbols),
PT_SymbolToTerm(symbol)));
}
ATermList actAbstraction (ATermList actArgs){
ATerm actArg, actArgSort, newTerm;
ATermList newActArgs = ATmakeList0();
for(;!ATisEmpty(actArgs); actArgs = ATgetNext(actArgs)) {
actArg = ATgetFirst(actArgs);
actArgSort = getTermSort(actArg);
if(toAbstractSort(actArgSort)){
actArgSort = liftSort(abstractSort(getUnLifted(actArgSort)));
}
newTerm = termAbstraction(actArg, actArgSort);
newActArgs = ATappend(newActArgs, newTerm);
}
return newActArgs;
}
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 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);
}
ATermList filter_non_primes(ATermList numbers)
{
ATermList primes = ATmakeList0();
/* Skip 1, we dont want to filter that! */
numbers = ATgetNext(numbers);
while(!ATisEmpty(numbers)) {
/* The first number must be prime. remove it from numbers. */
ATerm prime = ATgetFirst(numbers);
/* Remove all multiples of n, because they cannot be prime! */
numbers = filter_multiples(ATgetInt((ATermInt)prime), numbers);
/*ATprintf("%d numbers.\n", ATgetLength(numbers));*/
/* Now add n to the list of primes */
primes = ATappend(primes, prime);
}
return (ATermList)ATmake("[1,<list>]", primes);
}
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;
}
ATermList generateNewSums(ATerm sum){
ATerm maySum, mustSum;
ATermList procArgs, newProcArgs;
ATerm proc, procArg, procArgSort;
ATermList actArgs;
ATermList newActArgs;
ATerm actArg, actArgSort;
ATermList vars;
ATerm var, varName, varSort;
ATerm cond, auxMayCondition, auxMustCondition;
int i;
char auxVarName[NAME_LENGTH];
proc = (ATerm) ATgetArgument(sum, 3);
procArgs = (ATermList)ATgetArgument(proc, 0);
newProcArgs = ATmakeList0();
auxMayCondition = NULL;
auxMustCondition = NULL;
maySum = sum;
mustSum = sum;
if(HOMOMORPHISM){
for(i=0;!ATisEmpty(procArgs); procArgs= ATgetNext(procArgs)) {
procArg = ATgetFirst(procArgs);
procArgSort = getTermSort(procArg);
if(isLifted(procArgSort)){
sprintf(auxVarName, "%s%d", auxVarPrefix, i);
i++;
varName = (ATerm)ATmakeAppl0(ATmakeAFun(auxVarName, 0, ATtrue));
varSort = getUnLifted(procArgSort);
maySum = addVar(maySum, varName, varSort);
newProcArgs = ATappend(newProcArgs,
createSingleton(varName, varSort));
auxMayCondition = createMemberAuxCondition(auxMayCondition,
varName, procArg, varSort);
auxMustCondition = createSingletonAuxCondition(auxMustCondition,
procArg, procArgSort);
}
else{
newProcArgs = ATappend(newProcArgs, procArg);
}
}
proc = (ATerm)ATsetArgument((ATermAppl)
proc, (ATerm) newProcArgs, 0);
maySum = (ATerm)ATsetArgument((ATermAppl)maySum, proc, 3);
mustSum = sum;
actArgs = (ATermList)ATgetArgument(sum,2);
newActArgs = ATmakeList0();
for(;!ATisEmpty(actArgs); actArgs= ATgetNext(actArgs),i++) {
actArg = ATgetFirst(actArgs);
actArgSort = getTermSort(actArg);
if(isLifted(actArgSort)){
sprintf(auxVarName, "%s%d", auxVarPrefix, i);
i++;
varName = (ATerm)ATmakeAppl0(ATmakeAFun(auxVarName, 0, ATtrue));
varSort = getUnLifted(actArgSort);
maySum = addVar(maySum, varName, varSort);
mustSum = addVar(mustSum, varName, varSort);
newActArgs = ATappend(newActArgs, varName);
auxMayCondition = createMemberAuxCondition(auxMayCondition,
varName, actArg, varSort);
auxMustCondition = createMemberAuxCondition(auxMustCondition,
varName, actArg, varSort);
auxMustCondition = createSingletonAuxCondition(auxMustCondition,
actArg, actArgSort);
}
else{
newActArgs = ATappend(newActArgs, actArg);
}
maySum = (ATerm)ATsetArgument((ATermAppl)maySum,
(ATerm)newActArgs, 2);
}
}
maySum = (ATerm)createMaySum(maySum);
mustSum = (ATerm)createMustSum(mustSum);
if(HOMOMORPHISM){
cond = ATgetArgument(maySum, 4);
cond = createAuxCondition2(auxMayCondition, cond);
maySum = (ATerm)ATsetArgument((ATermAppl)maySum, cond, 4);
cond = ATgetArgument(mustSum, 4);
cond = createAuxCondition2(auxMustCondition, cond);
mustSum = (ATerm)ATsetArgument((ATermAppl)mustSum, cond, 4);
}
if(MAY && MUST)
return ATmakeList2(maySum, mustSum);
else if(MAY)
return ATmakeList1(maySum);
else if(MUST)
return ATmakeList1(mustSum);
}
ATbool ofp_traverse_FunType(ATerm term, pOFP_Traverse FunType)
{
int i;
char * percent_s = "%s";
char * comma = "";
char * name = "None";
ATermList args = (ATermList) ATmake("[]");
//#ifdef DEBUG_PRINT
printf("\nFunType: %s\n", ATwriteToString(term));
//#endif
OFP_Traverse FunType_args, FunType_result;
if (ATmatch(term, "FunType(<term>,<term>)", &FunType_args.term, &FunType_result.term) ) {
printf("---------args------- %s\n", ATwriteToString(FunType_args.term));
if (ofp_traverse_FunType_result(FunType_result.term, &FunType_result)) {
// MATCHED FunType_result
name = (char*) FunType_result.post;
} else return ATfalse;
printf("---------name------- %s\n", name);
ATermList FunType_args_tail = (ATermList) ATmake("<term>", FunType_args.term);
while (! ATisEmpty(FunType_args_tail)) {
OFP_Traverse FunType_arg;
FunType_arg.term = ATgetFirst(FunType_args_tail);
FunType_args_tail = ATgetNext(FunType_args_tail);
if (ofp_traverse_FunType_arg(FunType_arg.term, &FunType_arg)) {
// MATCHED FunType_arg
args = ATappend(args, FunType_arg.term);
} else return ATfalse;
}
}
/** Output traversal function header information
*/
printf("\n");
printf("//========================================================================================\n");
printf("// %s\n", name);
printf("//----------------------------------------------------------------------------------------\n");
printf("ATbool ofp_traverse_%s(ATerm term, pOFP_Traverse %s)\n", name, name);
printf("{\n");
printf("#ifdef DEBUG_PRINT\n");
printf(" printf(\"%s: %s\\n\", ATwriteToString(term));\n", name, percent_s);
printf("#endif\n\n");
for (i = 0; i < ATgetLength(args); i++) {
ATerm arg = ATelementAt(args, i);
ATbool list_type = ofp_isArgListKind(arg);
if (list_type) ofp_build_node_traversal(arg, "_list", 1);
else ofp_build_node_traversal(arg, "_term", 1);
}
/** Declare input (args) to production
*/
comma = "";
printf(" OFP_Traverse");
for (i = 0; i < ATgetLength(args); i++) {
char * arg_name = "None";
ATerm arg = ATelementAt(args, i);
ATbool list_type = ofp_isArgListKind(arg);
printf("%s %s", comma, ofp_getArgNameStr(arg, &arg_name));
if (list_type) printf("_list");
else printf("_term");
comma = ",";
}
printf(";\n");
/** Traverse input (args) to production
*/
comma = "";
// replace production name with the name given to the ATerm
printf(" if (ATmatch(term, \"%s(", (char*) FunType->pre);
for (i = 0; i < ATgetLength(args); i++) {
printf("%s<term>", comma);
comma = ",";
}
printf(")\"");
for (i = 0; i < ATgetLength(args); i++) {
char * arg_name = "None";
ATerm arg = ATelementAt(args, i);
ATbool list_type = ofp_isArgListKind(arg);
printf(", &%s", ofp_getArgNameStr(arg, &arg_name));
if (list_type) printf("_list");
else printf("_term");
printf(".term");
}
printf(")) {\n\n");
/** Call traversal for input (arg) to production
*/
for (i = 0; i < ATgetLength(args); i++) {
ATbool isOptType;
ATerm arg = ATelementAt(args, i);
ATerm type = ofp_getArgType(arg, &isOptType);
ATerm kind = ofp_getArgKind(arg);
ATerm name = ofp_getArgName(arg);
if (ofp_isTypeNameList(type)) {
int j;
ATermList nameList = (ATermList) type;
for (j = 0; j < ATgetLength(nameList); j++) {
arg = ATmake("[<term>,<term>]", kind, ATelementAt(nameList, j));
ofp_build_old_node_traversal(name, arg, kind);
}
// This is a production with or rules so one of the traversals must have
// matched and returned ATtrue. So return ATfalse in case none matched.
printf(" return ATfalse; /* for set of OR productions */\n");
}
else {
ofp_build_old_node_traversal(ofp_getArgName(arg), arg, kind);
}
}
printf("\n return ATtrue;\n");
printf(" }\n");
printf("\n return ATfalse;\n");
printf("}\n");
return ATtrue;
}
void process_options(int argc, char *argv[])
{
int i;
program_name = argv[0];
input_file = NULL;
output_file = NULL;
silent = ATfalse;
show_stats = 1;
binary_output = ATfalse;
includes = (ATermList) ATmake("[\".\"]");
for(i = 1; i < argc; i++)
{
if(streq(argv[i], "-silent"))
silent = ATtrue;
else if(streq(argv[i], "-i"))
{
if(i == argc - 1)
{
ATfprintf(stderr, "error: no input file specified after -i\n");
exit(1);
}
i++;
input_file = argv[i];
}
else if(streq(argv[i], "-o"))
{
if(i == argc - 1)
{
ATfprintf(stderr, "error: no output file specified after -o\n");
exit(1);
}
i++;
output_file = argv[i];
}
else if(streq(argv[i], "-b"))
binary_output = ATtrue;
else if(streq(argv[i], "-include") || streq(argv[i], "-I"))
{
if(i == argc - 1)
{
ATfprintf(stderr, "error: no include path specified after -I\n");
exit(1);
}
i++;
includes = ATappend(includes, ATmake("<str>", argv[i]));
}
else if(streq(argv[i], "-stats"))
{
show_stats = 2;
}
else if(streq(argv[i], "-help") || streq(argv[i], "-h"))
{
usage();
}
else
{
ATfprintf(stderr, "unknown option: %s\n", argv[i]);
exit(1);
}
}
return;
}
