static ATbool ofp_isOptionOrKind(ATerm kind)
{
   if (ATmatch(kind, "\"Option\"") || ATmatch(kind, "\"Or\"")) {
      return ATtrue;
   }
   return ATfalse;
}
static ATerm ofp_getArgType(ATerm term, ATbool * isOptType)
{
   int i;
   ATerm kind, name;

   if (ATmatch(term, "[<term>,<term>]", &kind, &name)) {
      // MATCHED (kind, name)
   }
   else {
      *isOptType = ATfalse;
      return ATmake("None");
   }

   for (i = 0; i <  ATgetLength(gTypeTable); i++) {
      ATerm typeName, typeList;
      ATbool matched = ATfalse;
      ATerm name_type = ATelementAt(gTypeTable, i);
      if (ATmatch(name_type, "Type(<term>,<term>)", &typeName, &typeList)) {
         matched = ATtrue;
         *isOptType = ATfalse;
      }
      else if (ATmatch(name_type, "OptType(<term>,<term>)", &typeName, &typeList)) {
         matched = ATtrue;
         *isOptType = ATtrue;
      }
      if (matched && ATisEqual(name, typeName)) {
         return typeList;
      }
   }

   *isOptType = ATfalse;
   return ATmake("None");
}
ATbool ofp_traverse_OpDeclInj(ATerm term, pOFP_Traverse OpDeclInj)
{
   ATerm alias, type, opt;
   int isOptType = 0;

   if (ATmatch(term, "OpDeclInj(<term>)", &OpDeclInj->term)) {
#ifdef DEBUG_PRINT
      printf("\nofp_traverse_OpDeclInj: %s\n", ATwriteToString(OpDeclInj->term));
#endif
      if (ATmatch(OpDeclInj->term, "FunType(<term>,<term>)", &type, &alias)) {
         ATermList list;
         if (ATmatch(type, "<term>", &list)) {
            // not a simple alias
            if (ATgetLength(list) > 1) return ATfalse;
         } else return ATfalse;
         if (ATmatch(type, "[ConstType(SortNoArgs(<term>))]", &type)) {
            // MATCHED object type
         } else return ATfalse;
         if (ATmatch(alias, "ConstType(SortNoArgs(<term>))", &alias)) {
            // MATCHED object alias
         } else return ATfalse;
      } else return ATfalse;

      OpDeclInj->term = ATmake("Alias(<term>,<term>)", type, alias);

      return ATtrue;
   }
   return ATfalse;
}
Exemple #4
0
/* Event handler for tool 'restorebrackets' */
ATerm restorebrackets_handler(int conn, ATerm term)
{
  ATerm in, out;
  /* We need some temporary variables during matching */
  ATerm t0, t1;

  if(ATmatch(term, "rec-eval(restore-brackets(<term>,<term>))", &t0, &t1)) {
    return restore_brackets(conn, t0, t1);
  }
  if(ATmatch(term, "rec-terminate(<term>)", &t0)) {
    rec_terminate(conn, t0);
    return NULL;
  }
  if(ATmatch(term, "rec-eval(add-brackets(<term>,<term>))", &t0, &t1)) {
    return add_brackets(conn, t0, t1);
  }
  if(ATmatch(term, "rec-do(signature(<term>,<term>))", &in, &out)) {
    ATerm result = restorebrackets_checker(conn, in);
    if(!ATmatch(result, "[]"))
      ATfprintf(stderr, "warning: not in input signature:\n\t%\n\tl\n", result);
    return NULL;
  }

  ATerror("tool restorebrackets cannot handle term %t", term);
  return NULL; /* Silence the compiler */
}
Exemple #5
0
/* Event handler for tool 'toolSdf2Sig' */
ATerm toolSdf2Sig_handler(int conn, ATerm term)
{
  ATerm in, out;
  /* We need some temporary variables during matching */
  char *s0, *s1;
  ATerm t0;

  if(ATmatch(term, "rec-eval(rewrite(<term>))", &t0)) {
    return rewrite(conn, t0);
  }
  if(ATmatch(term, "rec-eval(apply-rewrite(<str>,<str>,<term>))", &s0, &s1, &t0)) {
    return apply_rewrite(conn, s0, s1, t0);
  }
  if(ATmatch(term, "rec-terminate(<term>)", &t0)) {
    rec_terminate(conn, t0);
    return NULL;
  }
  if(ATmatch(term, "rec-do(signature(<term>,<term>))", &in, &out)) {
    ATerm result = toolSdf2Sig_checker(conn, in);
    if(!ATmatch(result, "[]"))
      ATfprintf(stderr, "warning: not in input signature:\n\t%\n\tl\n", result);
    return NULL;
  }

  ATerror("tool toolSdf2Sig cannot handle term %t", term);
  return NULL; /* Silence the compiler */
}
Exemple #6
0
/* Event handler for tool 'batch' */
ATerm batch_handler(int conn, ATerm term)
{
  ATerm in, out;
  /* We need some temporary variables during matching */
  int i0;
  char *s0;
  ATerm t0;

  if(ATmatch(term, "rec-eval(fromFile)")) {
    return fromFile(conn);
  }
  if(ATmatch(term, "rec-do(toFile(<str>,<int>))", &s0, &i0)) {
    toFile(conn, s0, i0);
    return NULL;
  }
  if(ATmatch(term, "rec-terminate(<term>)", &t0)) {
    rec_terminate(conn, t0);
    return NULL;
  }
  if(ATmatch(term, "rec-do(signature(<term>,<term>))", &in, &out)) {
    ATerm result = batch_checker(conn, in);
    if(!ATmatch(result, "[]"))
      ATfprintf(stderr, "warning: not in input signature:\n\t%\n\tl\n", result);
    return NULL;
  }

  ATerror("tool batch cannot handle term %t", term);
  return NULL; /* Silence the compiler */
}
Exemple #7
0
/*
 *  This handler is invoked by the toolbus module whenever an event is received
 *  from the toolbus.
 */
ATerm toolbus_handler( int tb_conn, ATerm input )
{
  ATerm rv = NULL;  /* return value, gets sent back to the toolbus */
  ATerm myterm;    /* general purpose */
  ATerm myterm2;    /* general purpose */
  char html_buf[HTML_BUF_SIZE];
  char *html_text;
    
  ATfprintf( stderr, "mod_toolbus: toolbus_handler(): received: %t\n", 
    input );
  fflush( stderr );
  
  /*
   *  match input from toolbus
   */
   
  /* toolbus asked for a signature check */ 
  if(ATmatch(input, "rec-do(signature(<term>,<term>))", &myterm, &myterm2))
  {
    ATfprintf( stderr, "mod_toolbus: toolbus_handler(): signature check\n" );
    fflush( stderr );
    rv =  NULL;                         /* we don't do a signature check */
  }
  /* receive ack of an event we sent (that's how we initiated our session) */
  else if( ATmatch( input, "rec-ack-event(<term>)", &myterm ) )
  {
    ATfprintf( stderr, "mod_toolbus: toolbus_handler(): rec-ack-event: %t\n",
      myterm );
    fflush( stderr );
    rv = NULL;
  }
  /* toolbus asked us to display an HTML page encoded as an ATerm  */
  else if( ATmatch( input, "rec-do(reply-html(<term>))", &myterm ) )
  {
    ATfprintf(stderr, "mod_toolbus: toolbus_handler(): rec-do(reply-html())\n" );
    ATparseHTML( myterm, html_buf, HTML_BUF_SIZE );
    ap_rprintf( global_http_req, html_buf );  
    global_is_tb_session_done ++;  /* after this we're done */
    rv = NULL;
  }
  else if( ATmatch( input, "rec-do(reply-text(<str>))", &html_text ) )
  {
    ATfprintf(stderr, "mod_toolbus: toolbus_handler(): rec-do(reply-text())\n" );
    ap_rprintf( global_http_req, html_text );  
    global_is_tb_session_done ++;  /* after this we're done */
    rv = NULL;
  }
  else   /* default response */
  {
    global_is_tb_session_done ++;
    ATfprintf( stderr, "mod_toolbus: toolbus_handler(): event: default\n" );
    fflush( stderr );
    rv = NULL;
  }
  ATfprintf( stderr, "mod_toolbus: toolbus_handler(): leaving...\n" );
  fflush( stderr );
  return rv;
}
static ATbool ofp_isArgOptionOptionKind(ATerm list)
{
   ATerm kind, name;
   assert(ATmatch(list, "[<term>,<term>]", &kind, &name));
   if (ATmatch(kind, "\"OptionOption\"")) {
      return ATtrue;
   }
   return ATfalse;
}
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;
}
Exemple #10
0
ATerm tree2graph(int cid, ATerm tree, ATerm layout_on, ATerm leaves_on,
		 ATerm sharing_on)
{
  ATbool layoutFlag = ATmatch(layout_on, "true");
  ATbool leavesFlag = ATmatch(leaves_on, "true");
  ATbool sharingFlag = ATmatch(sharing_on, "true");

  Graph graph = PT_printAnyToGraph(ATBunpack(tree), leavesFlag, ATtrue, layoutFlag, 
				   leavesFlag, sharingFlag);

  return ATmake("snd-value(graph(<term>))", GraphToTerm(graph));
}
Exemple #11
0
ATerm hello_handler(int conn, ATerm inp)  /* Handle input from ToolBus */
{ ATerm arg, isig, osig;

  if(ATmatch(inp, "rec-eval(get-text)"))
    return ATmake("snd-value(text(\"Hello World, my first ToolBus tool in C!\n\"))");
  if(ATmatch(inp, "rec-terminate(<term>)", &arg))
    exit(0);
  if(ATmatch(inp, "rec-do(signature(<term>,<term>))", &isig, &osig)){
    return NULL;                         /* we don't do a signature check */
  }  
  ATerror("hello: wrong input %t received\n", inp);
  return NULL;
}
Exemple #12
0
ATerm SSL_int_to_string(ATerm x)
{ int k;
  double r;
  char buf[32];
  if(ATmatch(x, "<int>", &k)) 
    ;
  else if(ATmatch(x, "<real>", &r))
    k = r;
  else
    _fail(x);

  sprintf(buf, "%d", k);
  return((ATerm) ATmakeString(buf));
}
Exemple #13
0
void *_int(void)
{ int k;
  double r; 
  if(ATmatch(Ttop(), "<int>", &k))
    {
      return NULL; 
    } 
  else if(ATmatch(Ttop(), "<real>", &r))
    {
      Tset((ATerm) ATmakeInt((int)r));
      return NULL; 
    } 
  else return fail_address; 
}
Exemple #14
0
ATerm printer_handler(int conn, ATerm e)
{
  char *text;
  ATerm arg;
  if(ATmatch(e, "rec-do(print-text(<str>))", &text)){
    ATprintf("%s", text);
    return NULL;
  } else
    if(ATmatch(e, "rec-terminate(<term>)", &arg)){
      exit(0);
  } else {
    ATerror("printer: wrong event received: %t\n", e);
    return NULL;
  }
}
Exemple #15
0
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);
}
//========================================================================================
// 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;
}
//========================================================================================
// SgUntypedExpression
//----------------------------------------------------------------------------------------
ATbool traverse_SgUntypedExpression(ATerm term, SgUntypedExpression** var_SgUntypedExpression)
{
#ifdef PRINT_ATERM_TRAVERSAL
  printf("... traverse_SgUntypedExpression: %s\n", ATwriteToString(term));
#endif

  ATerm term1;
  //CER-FIXME  SgToken::ROSE_Fortran_Keywords* arg1;
  SgToken::ROSE_Fortran_Keywords arg1;

  *var_SgUntypedExpression = NULL;
  if (traverse_SgUntypedReferenceExpression(term, (SgUntypedReferenceExpression**) var_SgUntypedExpression)) {
    // SgUntypedReferenceExpression
  }
  else if (traverse_SgUntypedValueExpression(term, (SgUntypedValueExpression**) var_SgUntypedExpression)) {
    // SgUntypedValueExpression
  }
  else if (traverse_SgUntypedBinaryOperator(term, (SgUntypedBinaryOperator**) var_SgUntypedExpression)) {
    // SgUntypedBinaryOperator
  }
  else if (ATmatch(term, "SgUntypedExpression(<term>)", &term1)) {
    if (traverse_SgToken_ROSE_Fortran_Keywords(term1, &arg1)) {
      // SgToken_ROSE_Fortran_Keywords
    } else return ATfalse;
    *var_SgUntypedExpression = new SgUntypedExpression(arg1);
  }
  else return ATfalse;

  return ATtrue;
}
//========================================================================================
// SgUntypedVariableDeclaration
//----------------------------------------------------------------------------------------
ATbool traverse_SgUntypedVariableDeclaration(ATerm term, SgUntypedVariableDeclaration** var_SgUntypedVariableDeclaration)
{
#ifdef PRINT_ATERM_TRAVERSAL
  printf("... traverse_SgUntypedVariableDeclaration: %s\n", ATwriteToString(term));
#endif

  //CER-FIXME (arguments)
  ATerm term2, term3, term4;
  char* arg1;
  SgToken::ROSE_Fortran_Keywords arg2;
  SgUntypedType* arg3;
  SgUntypedInitializedNameList* arg4;

  *var_SgUntypedVariableDeclaration = NULL;
  if (ATmatch(term, "SgUntypedVariableDeclaration(<str>,<term>,<term>,<term>)", &arg1,&term2,&term3,&term4)) {
    if (traverse_SgToken_ROSE_Fortran_Keywords(term2, &arg2)) {
      // SgToken_ROSE_Fortran_Keywords
    } else return ATfalse;
    if (traverse_SgUntypedType(term3, &arg3)) {
      // SgUntypedType
    } else return ATfalse;
    if (traverse_SgUntypedInitializedNameList(term4, &arg4)) {
       // SgUntypedInitializedNameList
    } else return ATfalse;
  } else return ATfalse;

  *var_SgUntypedVariableDeclaration = new SgUntypedVariableDeclaration(arg1,arg2,arg3,arg4);

  return ATtrue;
}
//========================================================================================
// SgUntypedValueExpression
//----------------------------------------------------------------------------------------
ATbool traverse_SgUntypedValueExpression(ATerm term, SgUntypedValueExpression** var_SgUntypedValueExpression)
{
#ifdef PRINT_ATERM_TRAVERSAL
  printf("... traverse_SgUntypedValueExpression: %s\n", ATwriteToString(term));
#endif

  ATerm term1, term3;
  //CER-FIXME  SgToken::ROSE_Fortran_Keywords* arg1;
  SgToken::ROSE_Fortran_Keywords arg1;
  char* arg2;
  SgUntypedType* arg3;

  *var_SgUntypedValueExpression = NULL;
  if (ATmatch(term, "SgUntypedValueExpression(<term>,<str>,<term>)", &term1,&arg2,&term3)) {
    if (traverse_SgToken_ROSE_Fortran_Keywords(term1, &arg1)) {
      // SgToken_ROSE_Fortran_Keywords
    } else return ATfalse;
    if (traverse_SgUntypedType(term3, &arg3)) {
      // SgUntypedType
    } else return ATfalse;
  } else return ATfalse;

  *var_SgUntypedValueExpression = new SgUntypedValueExpression(arg1,arg2,arg3);

  return ATtrue;
}
//========================================================================================
// SgUntypedBinaryOperator
//----------------------------------------------------------------------------------------
ATbool traverse_SgUntypedBinaryOperator(ATerm term, SgUntypedBinaryOperator** var_SgUntypedBinaryOperator)
{
#ifdef PRINT_ATERM_TRAVERSAL
  printf("... traverse_SgUntypedBinaryOperator: %s\n", ATwriteToString(term));
#endif

  ATerm term1, term2, term4, term5;
//CER-FIXME   SgToken::ROSE_Fortran_Keywords* arg1;
//CER-FIXME   SgToken::ROSE_Fortran_Operators* arg2;
  SgToken::ROSE_Fortran_Keywords arg1;
  SgToken::ROSE_Fortran_Operators arg2;
  char* arg3;
  SgUntypedExpression* arg4;
  SgUntypedExpression* arg5;

  *var_SgUntypedBinaryOperator = NULL;
  if (ATmatch(term, "SgUntypedBinaryOperator(<term>,<term>,<str>,<term>,<term>)", &term1,&term2,&arg3,&term4,&term5)) {
    if (traverse_SgToken_ROSE_Fortran_Keywords(term1, &arg1)) {
      // SgToken_ROSE_Fortran_Keywords
    } else return ATfalse;
    if (traverse_SgToken_ROSE_Fortran_Operators(term2, &arg2)) {
      // SgToken_ROSE_Fortran_Operators
    } else return ATfalse;
    if (traverse_SgUntypedExpression(term4, &arg4)) {
      // SgUntypedExpression
    } else return ATfalse;
    if (traverse_SgUntypedExpression(term5, &arg5)) {
      // SgUntypedExpression
    } else return ATfalse;
  } else return ATfalse;

  *var_SgUntypedBinaryOperator = new SgUntypedBinaryOperator(arg1,arg2,arg3,arg4,arg5);

  return ATtrue;
}
//========================================================================================
// SgUntypedGlobalScope
//----------------------------------------------------------------------------------------
ATbool traverse_SgUntypedGlobalScope(ATerm term, SgUntypedGlobalScope** var_SgUntypedGlobalScope)
{
#ifdef PRINT_ATERM_TRAVERSAL
  printf("... traverse_SgUntypedGlobalScope: %s\n", ATwriteToString(term));
#endif

  ATerm term2, term3, term4, term5;
  char* arg1;
  SgToken::ROSE_Fortran_Keywords arg2;
  SgUntypedDeclarationStatementList* arg3;
  SgUntypedStatementList* arg4;
  SgUntypedFunctionDeclarationList* arg5;
  
  *var_SgUntypedGlobalScope = NULL;
  if (ATmatch(term, "SgUntypedGlobalScope(<str>,<term>,<term>,<term>,<term>)", &arg1,&term2,&term3,&term4,&term5)) {
    if (traverse_SgToken_ROSE_Fortran_Keywords(term2, &arg2)) {
      // SgToken_ROSE_Fortran_Keywords
    } else return ATfalse;
    if (traverse_SgUntypedDeclarationStatementList(term3, &arg3)) {
      // SgUntypedDeclarationStatementList
    } else return ATfalse;
    if (traverse_SgUntypedStatementList(term4, &arg4)) {
      // SgUntypedStatementList
    } else return ATfalse;
    if (traverse_SgUntypedFunctionDeclarationList(term5, &arg5)) {
      // SgUntypedFunctionDeclarationList
    } else return ATfalse;
  } else return ATfalse;

  *var_SgUntypedGlobalScope = new SgUntypedGlobalScope(arg1,arg2,arg3,arg4,arg5);

  return ATtrue;
}
static ATerm ofp_getArgName(ATerm term)
{
   ATerm kind, name;

   assert(ATmatch(term, "[<term>,<term>]", &kind, &name));
   return name;
}
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;
}
ATerm parse_file(char *name)
{
  ATermList decls;
  int res;

  if(name == NULL) {
    yyin = stdin;
    fprintf(stderr, "parsing stdin ...");
  } else {
    yyin = find_file(name);  
    /* add file to list of dependencies */
    ATfprintf(dep_file, "%s ", file_name);
    yylineno = 0;
    if(!yyin) {
      fprintf(stderr, "no such file: %s\n", name);
      exit(1);
    }
    if(!silent)
      fprintf(stderr, "parsing %s ...", file_name);
  }
  if((res = parse()) == 0) {    
    if(!silent)
      ATfprintf(stderr, " succeeded\n", parse_tree);
    if(ATmatch(parse_tree, "Specification([<list>])", &decls))
      {
	return ATmake("Specification([<list>])", 
		      get_imports(decls));
      }
    else
      return parse_tree;    
  } else {    
    ATfprintf(stderr, " parsing %s failed\n\n", name);
    exit(1);
  }
}
Exemple #25
0
static char* deslash(ATerm atstr)
{
  char *tmp, *str = NULL;
  int i, length, found;

  if(ATmatch(atstr,"<str>", &tmp)) {
    str = strdup(tmp);
    length = strlen(str);

    /* copy string without slashes and quotes, 
     * including the EOS character
     */
    for(found = 0, i = 0; i <= length; i++) {
      switch(str[i]) {
	case '\\':
	  found++;
	  break;
	default:
	    str[i - found] = str[i];
	 break; 
      }	  
    }  
  }

  return str;
}
//========================================================================================
// SgUntypedAssignmentStatement
//----------------------------------------------------------------------------------------
ATbool traverse_SgUntypedAssignmentStatement(ATerm term, SgUntypedAssignmentStatement** var_SgUntypedAssignmentStatement)
{
#ifdef PRINT_ATERM_TRAVERSAL
  printf("... traverse_SgUntypedAssignmentStatement: %s\n", ATwriteToString(term));
#endif

  ATerm term2, term3, term4;
  char* arg1;
  //CER-FIXME  SgToken::ROSE_Fortran_Keywords* arg2;
  SgToken::ROSE_Fortran_Keywords arg2;
  SgUntypedExpression* arg3;
  SgUntypedExpression* arg4;
  
  *var_SgUntypedAssignmentStatement = NULL;
  if (ATmatch(term, "SgUntypedAssignmentStatement(<str>,<term>,<term>,<term>)", &arg1,&term2,&term3,&term4)) {
    if (traverse_SgToken_ROSE_Fortran_Keywords(term2, &arg2)) {
      // SgToken_ROSE_Fortran_Keywords
    } else return ATfalse;
    if (traverse_SgUntypedExpression(term3, &arg3)) {
      // SgUntypedExpression
    } else return ATfalse;
    if (traverse_SgUntypedExpression(term4, &arg4)) {
      // SgUntypedExpression
    } else return ATfalse;
  } else return ATfalse;

  *var_SgUntypedAssignmentStatement = new SgUntypedAssignmentStatement(arg1,arg2,arg3,arg4);

  return ATtrue;
}
Exemple #27
0
void CAESAR_PRINT_STATE_HEADER(CAESAR_TYPE_FILE fp) {
    ATerm l = (ATerm)MCRLgetListOfPars();
    ATerm v,s;
    while (ATmatch(l,"[v(<term>,<term>),<list>]",
                   &v,&s,&l))
        ATfprintf(fp,"%t:%s \n",MCRLprint(v),ATgetName(ATgetSymbol(s)));
}
Exemple #28
0
void *_is_string()
{ char *k;
  if(ATmatch(Ttop(), "<str>", &k))
    {
      return NULL; 
    } 
  else return fail_address; 
}
Exemple #29
0
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;
  }
}
Exemple #30
0
ATbool _is_string(void)
{ char *k;
  if(ATmatch(Ttop, "<str>", &k))
    {
      return ATtrue; 
    } 
  else return ATfalse; 
}