static ATermList applyImports(SDF_ImportList imports, PT_ParseTree pt)
{
ATermList result = ATempty;
while (!SDF_isImportListEmpty(imports)) {
SDF_Import import = SDF_getImportListHead(imports);
if (SDF_hasImportRenamings(import)) {
SDF_Renamings renamings = SDF_getImportRenamings(import);
result = ATinsert(result,
ATBpack(
PT_ParseTreeToTerm(applyRenamings(renamings, pt))));
}
else {
result = ATinsert(result, ATBpack(PT_ParseTreeToTerm(pt)));
}
if (SDF_hasImportListTail(imports)) {
imports = SDF_getImportListTail(imports);
}
else {
break;
}
}
return result;
}
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 ATerm matching_subterms_as_list(ATerm term, ATerm pattern) {
/* Should assert number of placeholders in pattern <= 10. */
ATermList list = ATempty;
ATerm t1 = NULL,
t2 = NULL,
t3 = NULL,
t4 = NULL,
t5 = NULL,
t6 = NULL,
t7 = NULL,
t8 = NULL,
t9 = NULL,
t10 = NULL;
if (ATmatchTerm(term, pattern, &t1, &t2, &t3, &t4, &t5, &t6, &t7, &t8, &t9, &t10)) {
if ((t1)) list = ATinsert(list, t1);
if ((t2)) list = ATinsert(list, t2);
if ((t3)) list = ATinsert(list, t3);
if ((t4)) list = ATinsert(list, t4);
if ((t5)) list = ATinsert(list, t5);
if ((t6)) list = ATinsert(list, t6);
if ((t7)) list = ATinsert(list, t7);
if ((t8)) list = ATinsert(list, t8);
if ((t9)) list = ATinsert(list, t9);
if ((t10)) list = ATinsert(list, t10);
}
return (ATerm)list;
}
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;
}
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);
}
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");
}
int main (int argc, char * argv [])
{
ATerm out_term;
ATermList in_term;
int i;
ATinit(argc, argv, &(out_term));
init_constructors();
in_term = ATempty;
for ( i = (argc - 1) ; (i >= 0) ; i-- )
{
in_term = ATinsert(in_term, (ATerm) ATmakeAppl0(ATmakeSymbol(argv[i], 0, ATtrue)));
}
SRTS_stratego_initialize();
memset(__tracing_table, 0, (sizeof(unsigned short) * TRACING_TABLE_SIZE));
__tracing_table_counter = 0;
register_strategies();
out_term = main_0_0(NULL, (ATerm) in_term);
if((out_term != NULL))
{
ATfprintf(stdout, "%t\n", out_term);
exit(0);
}
else
{
ATfprintf(stderr, "%s: rewriting failed, trace:\n", argv[0]);
for ( i = 0 ; (__tracing_table[i] && (i < TRACING_TABLE_SIZE)) ; i++ )
ATfprintf(stderr, "\t%s\n", __tracing_table[i]);
exit(1);
}
}
/* 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;
}
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;
}
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);
}
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);
}
ATermList generate_numbers(int max)
{
int i;
ATermList numbers = ATmakeList0();
for(i=max; i>0; i--)
numbers = ATinsert(numbers, (ATerm) ATmakeInt(i));
return numbers;
}
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);
}
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));
}
}
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);
}
ATerm toolbus_get_instances(int conn)
{
ATermList result = ATempty;
int cid;
for (cid=max_cid; cid>=0; cid--) {
if (ATBisValidConnection(cid)) {
result = ATinsert(result, (ATerm)ATmakeInt(cid));
}
}
return ATmake("snd-value(toolbus-instances(<term>))", result);
}
ATermList TS_getTableNames(void)
{
ATermList tableNames = ATempty;
int i;
for(i = 0; i < MAX_NR_OF_TABLES; i++) {
if (tableStore[i].name != NULL) {
AFun fun = ATmakeAFun(tableStore[i].name, 0, ATtrue);
ATermAppl appl = ATmakeAppl0(fun);
tableNames = ATinsert(tableNames, (ATerm)appl);
}
}
return tableNames;
}
ATermList T_getAllKeyValuePairs(Table table)
{
ATermList keys = T_getAllKeys(table);
ATermList pairs;
for (pairs = ATempty; !ATisEmpty(keys); keys = ATgetNext(keys)) {
ATerm key = ATgetFirst(keys);
ATerm value = T_getValue(table, key);
ATermList pair = ATmakeList2(key, value);
pairs = ATinsert(pairs, (ATerm) pair);
}
return pairs;
}
ATermList TS_filterKeys(const char *table, ATermList keysList)
{
ATerm key;
ATermList unknownKeys = ATempty;
while (!ATisEmpty(keysList)) {
key = ATgetFirst(keysList);
if (!TS_containsKey(table,key)) {
unknownKeys = ATinsert(unknownKeys, key);
}
keysList = ATgetNext(keysList);
}
return unknownKeys;
}
ATerm SSL_write_term_to_shared_string(ATerm term) {
int i;
int length;
char* result = ATwriteToSharedString(term, &length);
ATermList result_term = ATmakeList0();;
if(result == NULL) {
perror("SRTS/write_term_to_shared_string");
_fail(term);
}
for(i = length - 1; i >= 0; i--) {
ATerm next = (ATerm) ATmakeInt(result[i]);
result_term = ATinsert(result_term, next);
}
return (ATerm) result_term;
}
ATermList T_getValues(Table table, ATermList keys)
{
ATermList values = ATempty;
for ( ;!ATisEmpty(keys); keys = ATgetNext(keys)) {
ATerm key = ATgetFirst(keys);
ATerm value = T_getValue(table, key);
if (value != NULL) {
values = ATinsert(values, value);
}
else {
return NULL;
}
}
return values;
}
ATermList TS_removeValueFromAllTables(ATerm key)
{
int i;
ATermList changedTables = ATempty;
for(i = 0; i < MAX_NR_OF_TABLES; i++) {
if (tableStore[i].name != NULL) {
Table table = tableStore[i].table;
if (T_containsKey(table, key)) {
AFun fun = ATmakeAFun(tableStore[i].name, 0, ATtrue);
ATermAppl appl = ATmakeAppl0(fun);
changedTables = ATinsert(changedTables, (ATerm)appl);
T_removeValue(table, key);
}
}
}
return changedTables;
}
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 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;
}
ATerm SSL_readdir(ATerm t)
{
DIR *dir = NULL;
ATermList entries = ATempty;
struct dirent *entry = NULL;
if(!t_is_string(t))
_fail(t);
dir = opendir(ATgetName(ATgetSymbol(t)));
if(dir == NULL)
_fail(t);
while((entry = readdir(dir)) != NULL)
{
entries = ATinsert(entries, ATmakeString(entry->d_name));
}
closedir(dir);
return (ATerm) entries;
}
/* Given an itemset find the productions or symbols that will label the edges
* leaving the state containing the given itemset. Specifically:
* - For items of the form (\cdot \alpha -> X) add that item's production
* number to predprods.
* - For items of the form (\alpha \cdot A \beta -> X) add A to predchars,
* where can be a terminal or a non-terminal encoded as a char-class. */
void outgoing(ItemSet itemset, ATermList *predprods, CC_Set *predchars) {
Item item;
PT_Symbol symbol;
ItemSetIterator iter;
*predprods = ATempty;
ITS_iterator(itemset, &iter);
while (ITS_hasNext(&iter)) {
item = ITS_next(&iter);
if (IT_getDotPosition(item) == 0) {
ATerm prod = (ATerm)ATmakeInt(IT_getProdNr(item));
/*assert(ATindexOf(*predprods, prod, 0) == -1);*/
*predprods = ATinsert(*predprods, prod);
}
symbol = (PT_Symbol)IT_getDotSymbol(item);
if (PT_isSymbolCharClass(symbol)) {
CC_addPTSymbolToClass(CC_addToSet(predchars), symbol);
}
}
}
void ACC_push_unfold_data(AN2Data data, AN2Data bindings) {
unfold_stack = ATinsert(unfold_stack, (ATerm)ATmakeList2(data,bindings));
}
void ACC_set_raised_data(AN2Data data) {
data_stack = ATinsert(data_stack, data);
}
int
main (int argc, char **argv)
{
int c; /* option character */
ATerm bottomOfStack;
char *inputs[MAX_MODULES] = { "-" };
int nInputs = 0;
char *output = "-";
ATbool module = ATfalse;
ATermList list;
ASF_ASFConditionalEquationList alleqs;
int i;
if(argc == 1) { /* no arguments */
usage();
exit(1);
}
while ((c = getopt(argc, argv, myarguments)) != EOF) {
switch (c) {
case 'h':
usage();
exit(0);
case 'm':
module = ATtrue;
break;
case 'o':
output = strdup(optarg);
break;
case 'V': fprintf(stderr, "%s %s\n", myname, myversion);
exit(0);
default:
usage();
exit(1);
}
}
/* The optind variable indicates where getopt has stopped */
for(i = optind; i < argc; i++) {
if (nInputs < MAX_MODULES) {
inputs[nInputs++] = strdup(argv[i]);
} else {
ATerror("Maximum number of %d modules exceeded.\n", MAX_MODULES);
exit(1);
}
}
if (nInputs == 0) {
nInputs = 1;
inputs[0] = strdup("-");
}
ATinit(argc, argv, &bottomOfStack);
PT_initMEPTApi();
ASF_initASFMEApi();
list = ATempty;
for (--nInputs; nInputs >= 0; nInputs--) {
ATerm p = ATreadFromNamedFile(inputs[nInputs]);
if (p == NULL) {
ATwarning("concat-asf: Unable to read anything from %s\n",
inputs[nInputs]);
}
else {
list = ATinsert(list, p);
}
free(inputs[nInputs]);
}
alleqs = ASF_makeASFConditionalEquationListEmpty();
for(;!ATisEmpty(list); list = ATgetNext(list)) {
ATerm head = ATgetFirst(list);
ASF_ASFConditionalEquationList list;
if (ATgetType(head) == AT_LIST) {
list = ASF_ASFConditionalEquationListFromTerm(head);
}
else {
ASF_ASFModule module = ASF_getStartTopASFModule(ASF_StartFromTerm(head));
list = ASF_getASFModuleEquationList(module);
}
ATwarning("Adding %d equations\n", ASF_getASFConditionalEquationListLength(list));
alleqs = ASF_unionASFConditionalEquationList(alleqs, ASF_makeLayoutNewline(), list);
}
if (module) {
ASF_OptLayout l = ASF_makeLayoutNewline();
ASF_ASFSection sec = ASF_makeASFSectionEquations(l, alleqs);
ASF_ASFModule mod = ASF_makeASFModuleDefault(ASF_makeASFSectionListSingle(sec));
/*PT_ParseTree pt = PT_makeValidParseTreeFromTree((PT_Tree) mod);*/
ATwriteToNamedBinaryFile((ATerm) mod, output);
}
else {
ATwriteToNamedBinaryFile(ASF_ASFConditionalEquationListToTerm(alleqs),
output);
}
return 0;
}
static void generateSource(FILE *file, ATermList terms, ATermList afuns)
{
int len, row, col, index;
unsigned char *data;
ATerm all;
ATermList list, term_aliases, afun_aliases;
ATermList term_values, afun_values;
if (opt_gen_date) {
time_t now = time(NULL);
fprintf(file, "/*\n * Generated at %s", ctime(&now));
fprintf(file, " */\n\n");
}
fprintf(file, "#include \"%s.h\"\n\n", file_prefix);
/*{{{ unzip term and afun lists */
term_aliases = ATempty;
afun_aliases = ATempty;
term_values = ATempty;
afun_values = ATempty;
list = afuns;
while (!ATisEmpty(list)) {
ATerm alias, value;
ATerm pair = ATgetFirst(list);
list = ATgetNext(list);
if (!ATmatch(pair, "[<term>,<term>]", &alias, &value)) {
ATfprintf(stderr, "malformed [alias,afun] pair: %t\n", pair);
exit(1);
}
afun_aliases = ATinsert(afun_aliases, alias);
afun_values = ATinsert(afun_values, value);
}
afun_aliases = ATreverse(afun_aliases);
afun_values = ATreverse(afun_values);
list = terms;
while (!ATisEmpty(list)) {
ATerm alias, value;
ATerm pair = ATgetFirst(list);
list = ATgetNext(list);
if (!ATmatch(pair, "[<term>,<term>]", &alias, &value)) {
ATfprintf(stderr, "malformed [alias,term] pair: %t\n", pair);
exit(1);
}
term_aliases = ATinsert(term_aliases, alias);
term_values = ATinsert(term_values, value);
}
term_aliases = ATreverse(term_aliases);
term_values = ATreverse(term_values);
/*}}} */
/*{{{ generate symbol declarations */
list = afun_aliases;
while (!ATisEmpty(list)) {
ATerm alias = ATgetFirst(list);
list = ATgetNext(list);
checkAlias(alias);
ATfprintf(file, "AFun %t;\n", alias);
}
fprintf(file, "\n");
/*}}} */
/*{{{ generate term declarations */
list = term_aliases;
while (!ATisEmpty(list)) {
ATerm alias = ATgetFirst(list);
list = ATgetNext(list);
checkAlias(alias);
ATfprintf(file, "ATerm %t = NULL;\n", alias);
}
/*}}} */
/*{{{ generate BAF data */
ATfprintf(file, "\n/*\n");
list = afuns;
while (!ATisEmpty(list)) {
ATermList pair = (ATermList)ATgetFirst(list);
list = ATgetNext(list);
ATfprintf(file, " * %t = %t\n", ATelementAt(pair, 0), ATelementAt(pair, 1));
}
ATfprintf(file, " *\n");
list = terms;
while (!ATisEmpty(list)) {
ATermList pair = (ATermList)ATgetFirst(list);
list = ATgetNext(list);
ATfprintf(file, " * %t = %t\n", ATelementAt(pair, 0), ATelementAt(pair, 1));
}
ATfprintf(file, " *\n");
ATfprintf(file, " */\n");
ATfprintf(file, "\nstatic ATerm _%s = NULL;\n\n", code_prefix);
all = ATmake("[<term>,<term>]", afun_values, term_values);
data = (unsigned char *)ATwriteToBinaryString(all, &len);
ATfprintf(file, "#define _%s_LEN %d\n\n", code_prefix, len);
ATfprintf(file, "static char _%s_baf[_%s_LEN] = {\n", code_prefix, code_prefix, len);
index = 0;
for (row=0; index<len; row++) {
for (col=0; col<ROW_LENGTH && index<len; col++) {
fprintf(file, "0x%02X", data[index++]);
if (index < len) {
fprintf(file, ",");
}
}
fprintf(file, "\n");
}
ATfprintf(file, "};\n\n");
/*}}} */
/*{{{ generate init function */
ATfprintf(file, "void init_%s()\n", code_prefix);
ATfprintf(file, "{\n");
ATfprintf(file, " ATermList afuns, terms;\n\n");
ATfprintf(file, " _%s = ATreadFromBinaryString(_%s_baf, _%s_LEN);\n",
code_prefix, code_prefix, code_prefix);
ATfprintf(file, " assert(_%s);\n\n", code_prefix);
ATfprintf(file, " ATprotect(&_%s);\n\n", code_prefix);
ATfprintf(file, " afuns = (ATermList)ATelementAt((ATermList)_%s, 0);\n\n", code_prefix);
list = afuns;
while (!ATisEmpty(list)) {
ATerm alias;
ATermList pair = (ATermList)ATgetFirst(list);
list = ATgetNext(list);
alias = ATelementAt(pair, 0);
ATfprintf(file, " %t = ATgetAFun((ATermAppl)ATgetFirst(afuns));\n", alias);
ATfprintf(file, " afuns = ATgetNext(afuns);\n");
}
ATfprintf(file, "\n terms = (ATermList)ATelementAt((ATermList)_%s, 1);\n\n", code_prefix);
list = terms;
index = 0;
while (!ATisEmpty(list)) {
ATerm alias;
ATermList pair = (ATermList)ATgetFirst(list);
list = ATgetNext(list);
alias = ATelementAt(pair, 0);
ATfprintf(file, " %t = ATgetFirst(terms);\n", alias);
ATfprintf(file, " terms = ATgetNext(terms);\n");
}
ATfprintf(file, "}\n");
/*}}} */
}