%//
%// MTOM written in MTOM using the ATerm Library from CWI
%//

%{
#include
#include 

#include 
#include 

char *getString(ATerm t);
char *decapString(ATerm t);
char *getSortTom(ATerm sort);
char *getSortGL(ATerm sort);
ATerm getSymbolRule(ATerm rule);
ATermList genOneToOneMatching(ATermList result, ATerm lhs, ATerm rhs, char *path, int nextlab, int deep);
ATerm getSymbolName(ATerm symbol);
ATerm getSymbolSort(ATerm symbol);
ATerm getSymbolCode(ATerm symbol);
  
static AFun f_Tom;
static AFun f_DeclGL;
static AFun f_MainGL;
static AFun f_DeclListTom;
static AFun f_RuleListTom;

static AFun f_Rule; 
static AFun f_RhsGL; 
static AFun f_SortDecl; 
static AFun f_SortsToSort; 
static AFun f_GetFunSymDecl;
static AFun f_GetSubtermDecl;
static AFun f_TermsEqualDecl;
static AFun f_VariableDecl;
static AFun f_Variable;
static AFun f_GL;
static AFun f_ApiGL;
static AFun f_CodeGL;
static AFun f_SymbolDecl;
static AFun f_SymbolTom;
static AFun f_Appl;
 
static AFun f_empty;
static AFun f_cons;
static AFun f_sort;

// Goal Language 
static AFun f_TomGL;
static AFun f_RuleSortedListTom;
static AFun f_RuleSetGL;
static AFun f_VariableList;
static AFun f_IfThenElseGL;
 
ATermList empty() {
  return ATmakeList0();
}

ATermList cons(ATerm t, ATermList l) {
  return ATinsert(l,t);
}
 
%}

%GET_FUN_SYM(xx) (ATgetAFun(xx))
%GET_SUBTERM(xx,n) (ATgetArgument(xx,n))

%GET_FUN_SYM(xx) ((ATisEmpty(xx))?f_empty:f_cons)
%GET_SUBTERM(xx,n) ((n==0)?ATgetFirst(xx):(ATerm)ATgetNext(xx))

%// ------------------------------------------------------------

%sym ATerm compile(ATerm)
%sym void prettyPrint(ATerm)
%sym void prettyPrintList(ATermList)

%sym ATerm Tom(ATerm, ATerm, ATerm, ATerm)      % f_Tom
%sym ATerm DeclGL(ATerm)			% f_DeclGL
%sym ATerm MainGL(ATerm)			% f_MainGL

%sym ATerm DeclListTom(ATermList)	        % f_DeclListTom
%sym ATerm RuleListTom(ATermList)	        % f_RuleListTom

%sym ATerm Rule(ATerm, ATerm)	                % f_Rule
%sym ATerm RhsGL(ATerm)	                        % f_RhsGL
%sym ATerm SortDecl(ATerm)	                % f_SortDecl
%sym ATerm SortsToSort(ATermList,ATerm)         % f_SortsToSort

%sym ATerm GetFunSymDecl(ATerm,ATerm)	        % f_GetFunSymDecl
%sym ATerm GetSubtermDecl(ATerm,ATerm,ATerm)	% f_GetSubtermDecl
%sym ATerm TermsEqualDecl(ATerm,ATerm,ATerm)	% f_TermsEqualDecl
%sym ATerm VariableDecl(ATerm)	                % f_VariableDecl
%sym ATerm Variable(ATerm,ATerm)	        % f_Variable
%sym ATerm GL(ATerm)	                        % f_GL
%sym ATerm ApiGL(ATerm)	                        % f_ApiGL
%sym ATerm CodeGL(ATerm)                        % f_CodeGL
%sym ATerm SymbolDecl(ATerm)	                % f_SymbolDecl
%sym ATerm SymbolTom(ATerm,ATerm,ATerm,ATerm)   % f_SymbolTom
%sym ATerm Appl(ATerm,ATermList)                % f_Appl

%sym ATermList empty()                          % f_empty
%sym ATermList cons(ATerm, ATermList)           % f_cons
%sym ATermList sort(ATermList)                  % f_sort

%// Goal Language
%sym ATerm TomGL(ATerm, ATermList, ATermList, ATerm)    % f_TomGL
%sym ATerm RuleSortedListTom(ATerm, ATermList)	        % f_RuleSortedListTom
%sym ATerm RuleSetGL(ATerm, ATerm, ATermList)           % f_RuleSetGL
%sym ATerm VariableList(ATermList)                      % f_VariableList
%sym ATerm IfThenElseGL(ATerm, ATerm, ATerm)            % f_IfThenElseGL
%sym void collectVariable(ATermTable, ATerm)

%// ------------------------------------------------------------

%var ATerm t, v1, v2, v3, v4;
%var ATermList l, l1, l2;

%var ATerm vDeclGL, vMainGL;
%var ATermList vDeclList, vRuleList;
%var ATerm name1, sort1, name2, sort2;
%var ATermTable vTable;

%// ------------------------------------------------------------

%rule compile(Tom(v1,v2,v3,v4)) %--> {
  ATerm declPart     = compile(v1);
  ATerm declListPart = compile(v2);
  ATerm ruleListPart = compile(v3);
  ATerm mainPart     = compile(v4);
  return (ATerm)ATmakeAppl4(f_TomGL,declPart,declListPart,ruleListPart,mainPart);
}

%rule compile(DeclGL(t)) %--> return t;

%rule compile(DeclListTom(l)) %--> {
  ATermList res = empty();
  ATerm c;
  while(!ATisEmpty(l)) {
    c = compile(ATgetFirst(l));
    if(c != NULL) {
      res = cons(c,res);
    }
    l = ATgetNext(l);
  }
  return (ATerm) res;
}


%rule compile(RuleListTom(l)) %--> {
  ATermTable table = ATtableCreate(20,100);
  ATerm c, rule, topSymbol;
  ATermList ruleList, keyList;
  ATermList res = empty();
  
  while(!ATisEmpty(l)) {
    rule = ATgetFirst(l);
    topSymbol = getSymbolRule(rule);
    ruleList = (ATermList)ATtableGet(table,topSymbol);
    if(ruleList == NULL) {
      ruleList = empty();
    }
    ruleList = ATappend(ruleList,rule);
    ATtablePut(table,topSymbol,(ATerm)ruleList);
    l = ATgetNext(l);
  }

  keyList = ATtableKeys(table);
  while(!ATisEmpty(keyList)) {
    topSymbol = ATgetFirst(keyList);
    ruleList = (ATermList)ATtableGet(table,topSymbol);
      /*
       * for each ruleList: build a matching automaton
       */
    c = compile((ATerm)ATmakeAppl2(f_RuleSortedListTom,topSymbol,(ATerm)ruleList));
    if(c != NULL) {
      res = cons(c,res);
    }
    keyList = ATgetNext(keyList);
  }
  return (ATerm)res;
}

%rule compile(RuleSortedListTom(t,l)) %--> {
    // t is the top-symbol
  ATerm lhs,rhs;
  ATermList result = empty();
  char path[256];
  char s[256];

  ATermTable table = ATtableCreate(20,100);
  ATerm variableList;
  int nextlab = 0;
  
  while(!ATisEmpty(l)) {
    ATmatch(ATgetFirst(l),"Rule(,RhsGL())",&lhs,&rhs);
    collectVariable(table,lhs);
    
    path[0]=0;
    result = genOneToOneMatching(result,lhs,rhs,path,nextlab+1,0);
    result = ATappend(result,ATmake("GL()",decapString(rhs)));
    sprintf(s,"lab%d:;",nextlab+1);
    result = ATappend(result,ATmake("GL()",s));
    nextlab++;
    l = ATgetNext(l);
  }
  variableList = (ATerm)ATmakeAppl1(f_VariableList,(ATerm)ATtableKeys(table));
  return (ATerm)ATmakeAppl3(f_RuleSetGL,t,variableList,(ATerm)result);
}

%rule collectVariable(vTable,Appl(v1,empty)) %--> {
  return;
}

%rule collectVariable(vTable,Appl(v1,l)) %--> {
  while(!ATisEmpty(l)) {
    collectVariable(vTable,ATgetFirst(l));
    l = ATgetNext(l) ;
  }
  return;
}

%rule collectVariable(vTable,Variable(name1,sort1)) %--> {
  ATerm variable = _2;
  ATtablePut(vTable,variable,variable);
  return;
}


%rule compile(MainGL(t)) %--> return t;

%rule compile(SortDecl(t)) %--> return NULL;
%rule compile(VariableDecl(t)) %--> return NULL;

%rule compile(GetFunSymDecl(Variable(name1,sort1),ApiGL(t))) %--> {
  char s[1024];
  sprintf(s,"#define GET_FUN_SYM_%s(%s) %s",decapString(ATgetArgument((ATermAppl) sort1,0)),
          decapString(name1),decapString(t));
  return ATmake("GL()",s);
}

%rule compile(GetSubtermDecl(Variable(name1,sort1),Variable(name2,sort2),ApiGL(t))) %--> {
  char s[1024];
  sprintf(s,"#define GET_SUBTERM_%s(%s,%s) %s",decapString(ATgetArgument((ATermAppl) sort1,0)),
          decapString(name1),decapString(name2),decapString(t));
  return ATmake("GL()",s);
}

%rule compile(TermsEqualDecl(Variable(name1,sort1),Variable(name2,sort2),ApiGL(t))) %--> {
  char s[1024];
  sprintf(s,"#define TERMS_EQUAL_%s(%s,%s) %s",decapString(ATgetArgument((ATermAppl) sort1,0)),
          decapString(name1),decapString(name2),decapString(t));
  return ATmake("GL()",s);
}

%rule compile(SymbolDecl(SymbolTom(name1,SortsToSort(l,sort1),v2,v3))) %--> {
  char s[1024];
  char arg[128];
  int argno=1;

  if(!ATisEmpty(l)) {
    sprintf(s,"%s %s",getSortGL(sort1),decapString(name1));
    
    if(!ATisEmpty(l)) {
      strcat(s,"(");
      while (!ATisEmpty(l)) {
        sprintf(arg,"%s _%d",getSortGL(ATgetFirst(l)),argno);
        argno++;
        strcat(s,arg);
        l = ATgetNext(l) ;
        if(!ATisEmpty(l)) {
          strcat(s,",");
        }
      }
      strcat(s,");");
    }
    return ATmake("GL()",s);
  }
  return NULL;
}


%rule compile(t) %--> {
  ATprintf("Cannot compile: %t\n",t);
  exit(1);
}

%// ------------------------------------------------------------

%rule prettyPrint(TomGL(vDeclGL,vDeclList,vRuleList,vMainGL)) %--> {
  ATprintf("%s\n", decapString(vDeclGL)); 
  prettyPrintList(vDeclList); 
  prettyPrintList(vRuleList); 
  ATprintf("%s\n", decapString(vMainGL));
  return;
}

%rule prettyPrint(SortDecl(v1)) %--> {
  printf("%ctype %s %s",'%',getSortTom(v1),getSortGL(v1));
  return;
}

%rule prettyPrint(GetFunSymDecl(Variable(name1,sort1),ApiGL(v3))) %--> {
  printf("%cGET_FUN_SYM %s %s %s\n",'%',getSortTom(sort1),decapString(name1),decapString(v3));
  return;
}

%rule prettyPrint(GetSubtermDecl(Variable(name1,sort1),Variable(name2,sort2),ApiGL(v3))) %--> {
  printf("%cGET_SUBTERM %s %s %s %s\n",'%',getSortTom(sort1),decapString(name1),
         decapString(name2),decapString(v3));
  return;
}

%rule prettyPrint(TermsEqualDecl(Variable(name1,sort1),Variable(name2,sort2),ApiGL(v3))) %--> {
  printf("%cTERMS_EQUAL %s %s %s %s\n",'%',getSortTom(sort1),decapString(name1),
         decapString(name2),decapString(v3));
  return;
}

%rule prettyPrint(VariableDecl(Variable(name1,sort1))) %--> {
  printf("%cvar %s %s\n",'%',getSortTom(sort1),decapString(name1));
  return;
}
 
%rule prettyPrint(SymbolDecl(SymbolTom(name1,SortsToSort(l,sort1),v2,CodeGL(v3)))) %--> {
  char *str;
  
  printf("%csym %s %s",'%',getSortTom(sort1),decapString(name1));
  if(!ATisEmpty(l)) {
    printf("(") ;
    while (!ATisEmpty(l)) {
      printf("%s",getSortTom(ATgetFirst(l)));
      l = ATgetNext(l) ;
      if(!ATisEmpty(l)) printf(",") ;
    }
    printf(")") ;
  }
  str = decapString(v3);
  if(*str==0) {
    printf("\n");
  } else {
    printf("   %c %s\n",'%',str);
  }
  return;
}

%rule prettyPrint(RuleSetGL(SymbolTom(name1,SortsToSort(l,sort1),v2,CodeGL(v3)),v1,l2)) %--> {
  char s[1024];
  char arg[128];
  int argno=1;

  if(!ATisEmpty(l)) {
    sprintf(s,"%s %s",getSortGL(sort1),decapString(name1));
    if(!ATisEmpty(l)) {
      strcat(s,"(");
      while (!ATisEmpty(l)) {
        sprintf(arg,"%s _%d",getSortGL(ATgetFirst(l)),argno);
        argno++;
        strcat(s,arg);
        l = ATgetNext(l) ;
        if(!ATisEmpty(l)) {
          strcat(s,",");
        }
      }
      strcat(s,") {\n");
    }
    printf("%s\n",s);
  }

  prettyPrint(v1);
  prettyPrintList(l2);
  printf("}\n");
  return;
}

%rule prettyPrint(VariableList(empty)) %--> return;
%rule prettyPrint(VariableList(cons(Variable(name1,sort1),l))) %--> {
  printf("%s %s;\n",getSortGL(sort1),decapString(name1));
  prettyPrint((ATerm)ATmakeAppl1(f_VariableList,(ATerm)l));
  return;
}


%rule prettyPrint(GL(t)) %--> {
  printf("%s\n",getString(t));
  return;
}

%rule prettyPrint(Rule(v1,RhsGL(v2))) %--> {
  printf("%crule ",'%'); prettyPrint(v1) ; printf(" %c--> %s\n",'%',decapString(v2)) ;
  return;
}

%rule prettyPrint(Appl(v1,empty)) %--> {
  printf("%s",decapString(ATgetArgument((ATermAppl)v1,0)));
  return;
}

%rule prettyPrint(Appl(v1,l)) %--> {
  printf("%s",decapString(ATgetArgument((ATermAppl)v1,0)));
  printf("(") ;
  while(!ATisEmpty(l)) {
    prettyPrint(ATgetFirst(l)) ;
    l = ATgetNext(l) ;
    if(!ATisEmpty(l)) printf(",") ; 
  }
  printf(")") ;
  return;
}

%rule prettyPrint(Variable(name1,sort1)) %--> {
  printf("%s",decapString(name1));
  return;
}

%rule prettyPrint(t) %--> {
  ATprintf("Cannot print: %t\n",t);
  exit(1);
}

%// ------------------------------------------------------------

%rule prettyPrintList(empty) %--> return;
%rule prettyPrintList(cons(t,l)) %--> {
  prettyPrint(t);
  prettyPrintList(l);
  return;
}
%rule prettyPrintList(l) %--> {
  ATprintf("Cannot print list: %l\n",l);
  exit(1);
}

%// ------------------------------------------------------------

%rule sort(empty) %--> {
  ATprintf("sort: %t\n", empty());
  return empty();
}

%rule sort(cons(v1,l)) %--> {
  ATprintf("sort: %t,%t\n", v1,l);
  return cons(v1,l);
}

%%

char *getString(ATerm t) {
  return ATgetName(ATgetAFun((ATermAppl) t));
}
 
char *decapString(ATerm t) {
  return getString(ATelementAt(ATgetArguments((ATermAppl) t),0)) ;
}

char *getSortTom(ATerm sort) {
  return decapString(ATgetArgument((ATermAppl) sort,0));
}

char *getSortGL(ATerm sort) {
  return decapString(ATgetArgument((ATermAppl) ATgetArgument((ATermAppl) sort,1),0));
}

ATerm getSymbolRule(ATerm rule) {
  return ATgetArgument((ATermAppl) ATgetArgument((ATermAppl) rule,0),0);
}

ATerm getSymbolName(ATerm symbol) {
  return ATgetArgument((ATermAppl)symbol,0);
}

ATerm getSymbolSort(ATerm symbol) {
  return ATgetArgument((ATermAppl)ATgetArgument((ATermAppl)symbol,1),1);
}

ATerm getSymbolCode(ATerm symbol) {
  return ATgetArgument((ATermAppl)symbol,3);
}


int main(int argc, char **argv) {
  ATerm     bottomOfStack;
  
  ATerm t, decGL, mainGL ;
  ATermList decList, ruleList ;
  ATerm v1,v2,v3,v4;
  ATerm compiledTerm;
  
    /*  Initialise the ATerm bits & pieces  */
  ATinit(argc, argv, &bottomOfStack);
  
    /*
     * Initialisation des AFun
     */
  f_Tom = ATmakeAFun("Tom", 4, ATfalse);
  f_DeclGL = ATmakeAFun("DeclGL", 1, ATfalse);
  f_MainGL = ATmakeAFun("MainGL", 1, ATfalse);
  
  f_DeclListTom = ATmakeAFun("DeclListTom", 1, ATfalse);
  f_RuleListTom = ATmakeAFun("RuleListTom", 1, ATfalse);
  
  f_Rule = ATmakeAFun("Rule", 2, ATfalse);
  f_RhsGL = ATmakeAFun("RhsGL", 1, ATfalse);
  f_SortDecl = ATmakeAFun("SortDecl", 1, ATfalse);
  f_SortsToSort = ATmakeAFun("SortsToSort", 2, ATfalse);
  
  f_GetFunSymDecl = ATmakeAFun("GetFunSymDecl", 2, ATfalse);
  f_GetSubtermDecl = ATmakeAFun("GetSubtermDecl", 3, ATfalse);
  f_TermsEqualDecl = ATmakeAFun("TermsEqualDecl", 3, ATfalse);
  f_VariableDecl = ATmakeAFun("VariableDecl", 1, ATfalse);
  f_Variable = ATmakeAFun("Variable", 2, ATfalse);
  f_GL = ATmakeAFun("GL", 1, ATfalse);
  f_ApiGL = ATmakeAFun("ApiGL", 1, ATfalse);
  f_CodeGL = ATmakeAFun("CodeGL", 1, ATfalse);
  f_SymbolDecl = ATmakeAFun("SymbolDecl", 1, ATfalse);
  f_SymbolTom = ATmakeAFun("SymbolTom", 4, ATfalse);
  f_Appl = ATmakeAFun("Appl", 2, ATfalse);
  
  f_empty = ATmakeAFun("empty", 0, ATfalse);
  f_cons = ATmakeAFun("cons", 2, ATfalse);
  f_sort = ATmakeAFun("sort", 1, ATfalse);

    /*
     * Goal Language
     */ 
  f_TomGL = ATmakeAFun("TomGL", 4, ATfalse);
  f_RuleSortedListTom = ATmakeAFun("RuleSortedListTom", 2, ATfalse);
  f_RuleSetGL = ATmakeAFun("RuleSetGL", 3, ATfalse);
  f_VariableList = ATmakeAFun("VariableList", 1, ATfalse);
  f_IfThenElseGL = ATmakeAFun("IfThenElseGL", 3, ATfalse);
    
  t = ATreadFromNamedFile(argv[1]);        
  if (t==NULL) ATerror("error opening file %s.\n",argv[1]);

  compiledTerm = compile(t);

  prettyPrint(compiledTerm);
  return(0);
}

ATermList genOneToOneMatching(ATermList result, ATerm lhs, ATerm rhs, char *path,
                              int nextlab, int deep) {
  int i,j;
  char *pbase;
  struct funSym *sfs;
  char s[1024];
  ATerm symbol, subterm;
  ATermList args;
  ATerm subtermSymbol, subtermName, subtermSort, subtermOption, subtermCode;
  ATermList subtermArgs, subtermSortList;
  static int semActionGenerated;
  int indexSubterm = 0;
  
  semActionGenerated = 0;
  pbase = strchr(path, 0);

  ATmatch(lhs,"Appl(,[])",&symbol,&args);

  while(!ATisEmpty(args)) {
    ATerm name,sort;

    subterm = ATgetFirst(args);
    indexSubterm++;

    sprintf(pbase,"_%d",indexSubterm);
    if(ATmatch(subterm,"Variable(,)",&name, &sort)) {
      sprintf(s,"%*s  %s = %s;", deep*2,"",decapString(name), path);
      result = ATappend(result,ATmake("GL()",s));
    } else if(ATmatch(subterm,
              "Appl(SymbolTom(,SortsToSort([],),,CodeGL()),[])",
                      &subtermName, &subtermSortList, &subtermSort,
                      &subtermOption, &subtermCode, &subtermArgs)) {
       
      int indexSubSubterm = 0;

      sprintf(s,"%*s  if(GET_FUN_SYM_%s(%s) != %s) goto lab%d;", deep*2,"",
              getSortTom(subtermSort),
              path,
              decapString(subtermCode),
              nextlab);
      result = ATappend(result,ATmake("GL()",s));
       
      sprintf(s,"%*s  {", deep*2,"");
      result = ATappend(result,ATmake("GL()",s));

      while(!ATisEmpty(subtermArgs)) {
        ATerm subSubterm = ATgetFirst(subtermArgs);
        ATerm subSubtermSymbol, subSubtermSort, subSubtermName;
        ATermList subSubtermArgs;

        if(ATmatch(subSubterm,"Appl(,[])",
                   &subSubtermSymbol, &subSubtermArgs)) {
          subSubtermSort = getSymbolSort(subSubtermSymbol);
        } else if(ATmatch(subSubterm,"Variable(,)",
                          &subSubtermName, &subSubtermSort)) { 
            // do nothing
        }
        
        indexSubSubterm++;
      
        sprintf(s,"%*s    %s %s_%d = (%s) GET_SUBTERM_%s(%s,%d);", deep*2,"",
                getSortGL(subSubtermSort),
                path,
                indexSubSubterm, 
                getSortGL(subSubtermSort),
                getSortTom(subtermSort),
                path,
                indexSubSubterm-1);
        result = ATappend(result,ATmake("GL()",s));
        subtermArgs = ATgetNext(subtermArgs);
      }
      result = genOneToOneMatching(result,subterm, rhs, path, nextlab, deep+1);
      sprintf(s,"%*s  }", deep*2,"");
      result = ATappend(result,ATmake("GL()",s));
    }
    args = ATgetNext(args);
  }
  return result;
}


Last modified: Mon Jan 08 2001