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"); }
ATerm pretty_print(int cid, ATerm input) { PT_ParseTree parsetree = NULL; BOX_Start box = NULL; PT_Tree result = NULL; ERR_resetErrorManager(); parsetree = PT_ParseTreeFromTerm(ATBunpack(input)); if (parsetree != NULL) { box = pandora(parsetree); } if (box != NULL) { result = toText(PT_ParseTreeFromTerm(BOX_StartToTerm(box))); } if (result != NULL) { PT_ParseTree presult = PT_makeValidParseTreeFromTree(result); ATerm value = ATBpack(PT_ParseTreeToTerm(presult)); return ATmake("snd-value(pretty-printed(<term>))", value); } else { ERR_Summary summary = ERR_getManagerSummary(); return ATmake("snd-value(pretty-print-error(<term>))", summary); } }
ATbool ofp_traverse_OpDeclInj(ATerm term, pOFP_Traverse OpDeclInj) { ATerm name, 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, &name)) { if (ATmatch(type, "[ConstType(Sort(<term>,<term>))]", &opt, &type)) { // MATCHED option object type if (ATmatch(type, "[SortNoArgs(<term>)]", &type) && ATisEqual(opt, ATmake("\"Option\""))) { isOptType = 1; } else return ATfalse; } else if (ATmatch(type, "[ConstType(SortNoArgs(<term>))]", &type)) { // MATCHED object type } if (ATmatch(name, "ConstType(SortNoArgs(<term>))", &name)) { // MATCHED object name } else return ATfalse; } else return ATfalse; if (isOptType) { OpDeclInj->term = ATmake("OptType(<term>,[<term>])", name, type); } else { OpDeclInj->term = ATmake("Type(<term>,[<term>])", name, type); } return ATtrue; } return ATfalse; }
int main (int argc, char* argv[]) { printf ("Building ATerm bottom; \n"); ATerm bottom; printf ("Building the ROSE AST \n"); SgProject* project = frontend(argc,argv); printf ("Calling ATinit \n"); ATinit(argc, argv, &bottom); printf ("Calling convertNodeToAterm \n"); ATerm term = convertNodeToAterm(project /*.get_file(0).get_root()*/); printf ("DONE: Calling convertNodeToAterm \n"); ROSE_ASSERT (term); #if 0 // DQ (3/23/2013): This was already commented out... AST_FILE_IO::startUp(sageProject); std::string astBlob = AST_FILE_IO::writeASTToString(); term = ATsetAnnotation(term, ATmake("ast"), ATmake("<blob>", astBlob.length(), astBlob.data())); #endif #if 0 // DQ (3/23/2013): commented out while debugging. ATwriteToBinaryFile(term, stdout); #endif return 0; }
int main (int argc, char* argv[]) { printf ("Building ATerm bottom; \n"); ATerm bottom; printf ("Building the ROSE AST \n"); SgProject* project = frontend(argc,argv); printf ("Calling ATinit \n"); ATinit(argc, argv, &bottom); printf ("Calling convertNodeToAterm \n"); ATerm term = convertNodeToAterm(project /*.get_file(0).get_root()*/); printf ("DONE: Calling convertNodeToAterm \n"); ROSE_ASSERT (term != NULL); #if 0 // DQ (3/23/2013): This was already commented out... AST_FILE_IO::startUp(sageProject); std::string astBlob = AST_FILE_IO::writeASTToString(); term = ATsetAnnotation(term, ATmake("ast"), ATmake("<blob>", astBlob.length(), astBlob.data())); #endif #if 0 // DQ (3/23/2013): commented out while debugging. // This can be usefull for piping output to other Stratego and Aterm tools/phases. ATwriteToBinaryFile(term, stdout); #endif // Open a file for writing... FILE* f = fopen("atermFile.aterm","w"); // Write the aterm to the file. ATbool status = ATwriteToTextFile(term,f); ROSE_ASSERT(status == ATtrue); // Close the file. fclose(f); #if 0 // Testing the ATerm file I/O. // Open a file for writing... FILE* file = fopen("atermFile.aterm","r"); printf ("Read aterm file \n"); // Write the aterm to the file. ATerm term2 = ATreadFromTextFile(file); ROSE_ASSERT(term2 != NULL); printf ("Closing file after reading aterm \n"); // Close the file. fclose(file); #endif return 0; }
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); }
ATerm get_path(int cid, ATerm sid) { EM_Session session; const char *path; session = getSession(sid); if (session == NULL) { return sndValue(ATmake("no-such-session")); } path = EM_getSessionPath(session); return sndValue(ATmake("path(<str>)", path)); }
ATerm get_session_by_path(int cid, const char *path) { EM_Session session; EM_Sid sid; assert(path != NULL); session = findSession(path); if (session == NULL) { return sndValue(ATmake("no-such-session")); } sid = EM_getSessionId(session); return sndValue(ATmake("session(<term>)", EM_SidToTerm(sid))); }
ATerm get_new_module_name(int cid, ATerm searchPaths, const char *path, const char* id) { ATermList search = (ATermList) searchPaths; char chosenPath[PATH_LEN] = ""; int chosenPathLen = 0; char chosenId[PATH_LEN]; /* We will choose the longest search path that matches the path of * the chosen module. */ for (; !ATisEmpty(search); search = ATgetNext(search)) { char *current = ATgetName(ATgetAFun((ATermAppl) ATgetArgument(ATgetFirst(search), 1))); int currentLen = strlen(current); if (strncmp(current, path, currentLen) == 0) { if (currentLen > chosenPathLen) { strcpy(chosenPath, current); chosenPathLen = currentLen; } } } /* Now construct a compound module id to complete * the filename. */ if (chosenPathLen > 0) { int i = chosenPathLen; while (path[i] == SEP) { i++; } if (strcmp(chosenPath, path) == 0) { strcpy(chosenId, id); } else { sprintf(chosenId, "%s%c%s", path+i, SEP, id); } return ATmake("snd-value(new-module-name(<str>,<str>))", chosenPath, chosenId); } else { return ATmake("snd-value(module-name-inconsistent)"); } }
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; }
ATerm toolbus_get_location(int conn, int cid) { assert(ATBisValidConnection(cid)); return ATmake("snd-value(toolbus-location(<str>,<int>))", ATBgetHost(cid), ATBgetPort(cid)); }
//======================================================================================== // 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; }
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); } }
int main(int argc, char *argv[]) { ATerm in_term, out_term; int i; /* ATfprintf(stderr, "This is %s\n", argv[0]); */ ATinit(argc, argv, &in_term); ATprotectArray(term_stack, TSIZE); ATprotectArray(environment, ESIZE); in_term = ATmake("Nil"); for(i = argc - 1; i >= 0; i--) { /* ATfprintf(stderr, " %s", argv[i]); */ in_term = App2("Cons", ATmakeString(argv[i]), in_term); } /* ATfprintf(stderr, "\n", argv[i]); */ out_term = doit(in_term); ATfprintf(stderr, "**** rewriting terminated abnormally\n"); exit(3); }
ATerm get_moduleid(int cid, ATerm sid) { EM_Session session; EM_ModuleId moduleId; session = getSession(sid); if (session == NULL) { return sndValue(ATmake("no-such-session")); } moduleId = getModuleId(sid); if (moduleId == NULL) { return sndValue(ATmake("session-not-bound")); } else { return sndValue(ATmake("moduleid(<term>)", moduleId)); } }
ATerm get_imported_module_names(int cid, ATerm atModule) { SDF_Start start = SDF_StartFromTerm(ATBunpack(atModule)); SDF_Module module = SDF_getStartTopModule(start); ATermList imports = SI_getImports(module); return ATmake("snd-value(imported-module-names(<term>))", imports); }
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; }
int HFinit(HFtree *tree, HTable *terms){ /* Protect and assign constants */ ESCAPE_SEQUENCE=ATmake("<str(<appl>)>","ESC","NEW"); NO_ATERM =ATmake("<str(<appl>)>","ESC","NIL"); ATprotect(&ESCAPE_SEQUENCE); ATprotect(&NO_ATERM); /* Init LZ buffer */ LZinit(&tree->buffer); /* Assign terms table */ tree->terms=terms; /* Create the root node */ tree->codes=(struct HFnode*)malloc(sizeof(struct HFnode)); tree->codes->high=NULL; tree->codes->parent=NULL; tree->codes->frequency=0L; tree->codes->term=NULL; /* Create the leaf for the escape code */ tree->codes->low=(struct HFnode*)malloc(sizeof(struct HFnode)); tree->codes->low->high=NULL; tree->codes->low->low=NULL; tree->codes->low->parent=tree->codes; tree->codes->low->frequency=0L; tree->codes->low->term=ESCAPE_SEQUENCE; /* Store the escape sequence term */ tree->top=tree->codes->low; /* Initialise the block list */ BLinit(&tree->blockList); BLinsert(&tree->blockList, tree->codes->low); BLinsert(&tree->blockList, tree->codes); return 1; }
ATerm get_module_id(int cid, ATerm atModule) { SDF_Start start = SDF_StartFromTerm(ATBunpack(atModule)); SDF_Module module = SDF_getStartTopModule(start); SDF_ModuleId id = SDF_getModuleName(module); return ATmake("snd-value(module-id(<str>))", PT_yieldTree((PT_Tree) id)); }
ATerm is_editor_registered(int cid, ATerm sid, ATerm editorType) { EM_Session session; session = getSession(sid); if (session != NULL) { EM_EditorType type = EM_EditorTypeFromTerm(editorType); EM_EditorTypeList types = EM_getSessionList(session); while (!EM_isEditorTypeListEmpty(types)) { EM_EditorType cur = EM_getEditorTypeListHead(types); if (EM_isEqualEditorType(cur, type)) { return sndValue(ATmake("editor-registered")); } types = EM_getEditorTypeListTail(types); } return sndValue(ATmake("editor-not-registered")); } return sndValue(ATmake("no-such-session")); }
ATerm toolbus_snd_msg(int conn, int id, ATerm msg) { if (id >= 0) { ATBpostEvent(id, ATmake("toolbus-rec-msg(<term>)", msg)); return ATparse("snd-value(msg-sent)"); } else { return ATparse("snd-value(toolbus-gone)"); } }
ATerm create_empty_session(int cid) { EM_Sid sid = makeUniqueSessionId(); EM_EditorTypeList list = EM_makeEditorTypeListEmpty(); EM_SessionStatus status = EM_makeSessionStatusRunning(); EM_Session session = EM_makeSessionDefault(sid, "", status, 0, list); putSession(session); return sndValue(ATmake("session(<term>)", EM_getSessionId(session))); }
ATerm is_valid_modulename(int cid, const char *moduleName) { int j; int namelen = strlen(moduleName); ATerm no = ATmake("snd-value(result(no))"); ATerm yes = ATmake("snd-value(result(yes))"); for(j=namelen - 1; j >= 0; j--) { if (!isalnum((int)moduleName[j]) && moduleName[j] != '-' && moduleName[j] != '_' && moduleName[j] != '/') { return no; } } return yes; }
ATerm bind_session(int cid, ATerm sid, ATerm moduleId) { assert(sid != NULL); assert(moduleId != NULL); if (getSession(sid) == NULL) { return sndValue(ATmake("no-such-session")); } else { EM_ModuleId id = getModuleId(sid); EM_ModuleId module = EM_ModuleIdFromTerm(moduleId); if (id != NULL && EM_isEqualModuleId(module, id) != 0) { ATabort("editor-manager:bind_session: attempt to rebind %t (%t)\n", sid, moduleId); } putModuleId(sid, module); return sndValue(ATmake("session-bound")); } }
void foo() { ATbool result; ATerm list; double rval; int ival; /* Sets result to ATtrue and ival to 16. */ result = ATmatch(ATmake("f(16)"), "f(<int>)", &ival); /* Sets result to ATtrue and rval to 3.14. */ result = ATmatch(ATmake("3.14"), "<real>", &rval); /* Sets result to ATfalse because f(g) != g(f) */ result = ATmatch(ATmake("f(g)"), "g(f)"); /* fills ival with 1 and list with [2,3] */ result = ATmatch(ATmake("[1,2,3]"), "[<int>,<list>]", &ival, &list); }
ATerm get_node_origin(int cid, ATerm t) { Node node = NodeFromTerm(t); AttributeList attrs = getNodeAttributes(node); while (!isAttributeListEmpty(attrs)) { Attribute attr = getAttributeListHead(attrs); if (isAttributeInfo(attr)) { const char *key = getAttributeKey(attr); ATerm value = getAttributeValue(attr); if (strcmp(key, "origin") == 0) { return ATmake("snd-value(origin(<term>))", value); } } attrs = getAttributeListTail(attrs); } return ATmake("snd-value(no-origin)"); }
ATerm rename_module(int cid, ATerm atImports, char *moduleName, ATerm term) { SDF_ImportList imports = SDF_ImportListFromTerm(atImports); SDF_ImportList relevant = getRelevantImports(moduleName, imports); ATermList newModules = applyImports(relevant, PT_ParseTreeFromTerm(ATBunpack(term))); return ATmake("snd-value(renamed-module(<term>))", newModules); }
ATerm get_all_needed_imports(int cid, ATerm atModules, const char* name) { ATermList list = (ATermList) ATBunpack(atModules); SDF_ModuleId id = SDF_makeModuleId(name); SDF_ImportList imports; imports = SI_getTransitiveImports(list, id); return ATmake("snd-value(all-needed-imports(<term>))", imports); }
ATerm rename_modulename_in_module(int cid, ATerm atModule, const char* name) { SDF_Start start = SDF_StartFromTerm(ATBunpack(atModule)); SDF_Module oldModule = SDF_getStartTopModule(start); SDF_Module newModule = SDF_setModuleName(oldModule, (char*) name); start = SDF_setStartTopModule(start, newModule); atModule = SDF_StartToTerm(start); return ATmake("snd-value(module(<term>))", ATBpack(atModule)); }
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; }