The Meta-Environment API
00001 #ifndef __SDF_UTILS__ 00002 #define __SDF_UTILS__ 00003 00004 #include <sdf-modules.idef> 00005 #include <parse-utils.tb> 00006 #include <error-utils.tb> 00007 #include <io-utils.tb> 00008 #include <config-utils.tb> 00009 00010 #define SDF_TREE_CACHE "sdf-annotated-tree" 00011 00012 process NewModuleContentHandler is 00013 let 00014 ModuleId: str, 00015 Pid: int 00016 in 00017 Pid := process-id 00018 . 00019 ( 00020 rec-msg(get-module-contents(Pid, ModuleId?)) 00021 . snd-msg(module-contents(Pid, ["module ", ModuleId, "\n\n"])) 00022 + 00023 rec-msg(cancel-content-handler(Pid)) 00024 ) 00025 endlet 00026 00027 /* 00028 process DumpParseTable(ModuleId : module-id, Namespace: term, Filename : str, Type : term) is 00029 let 00030 Directory: str, 00031 Error: term, 00032 Extension: str, 00033 Id: term, 00034 NewFilename: str, 00035 NewPath: str, 00036 Path: str, 00037 Table: term 00038 in 00039 AddJob(Filename) 00040 . Id := process-id 00041 . snd-msg(get-parsetable(ModuleId, Type)) 00042 . 00043 ( 00044 rec-msg(parsetable(ModuleId, Type, Table?)) 00045 . GetModulePath(ModuleId, Namespace, Path?) 00046 . 00047 if equal(Filename, "") then 00048 TODO("DumpParseTable got empty filename") 00049 else 00050 NewFilename := Filename 00051 fi 00052 . snd-msg(io-unpack-and-write-term-in-baf(NewFilename, Table)) 00053 . 00054 ( 00055 rec-msg(io-file-written) 00056 + 00057 rec-msg(io-file-not-written(Error?)) 00058 ) 00059 + 00060 rec-msg(no-parsetable(ModuleId)) 00061 ) 00062 . JobDone(Filename) 00063 endlet 00064 */ 00065 00066 process DumpSdfDefinition(ModuleId: module-id, Filename: str) is 00067 let 00068 Syntax: term, 00069 Path: str, 00070 Text: str, 00071 Error: term, 00072 ErrorMessage: str 00073 in 00074 AddJob(Filename) 00075 . GetSyntaxDefinition(ModuleId, Syntax?) 00076 . 00077 if not-equal(Syntax, UNDEFINED) then 00078 GetModulePath(ModuleId, SDF_NAMESPACE, Path?) 00079 . snd-msg(unparse(Syntax)) 00080 . rec-msg(unparsed-text(Text?)) 00081 . snd-msg(io-write-text-list(Filename, [Text])) 00082 . 00083 ( 00084 rec-msg(io-file-written) 00085 + 00086 rec-msg(io-file-not-written(Error?)) 00087 ) 00088 else 00089 tau 00090 fi 00091 . JobDone(Filename) 00092 endlet 00093 00094 process GetModules(ModuleIds: list, Modules: list?) is 00095 let 00096 Runner: list, 00097 Result: list, 00098 ModuleTree: term, 00099 ModuleId: module-id, 00100 Incomplete: bool 00101 in 00102 Runner := ModuleIds 00103 . Result := [] 00104 . 00105 if and(not-equal(Runner, []),not-equal(Incomplete,true)) then 00106 ModuleId := first(Runner) 00107 . GetSDFParsetree(ModuleId, ModuleTree?) 00108 . 00109 if equal(ModuleTree, UNDEFINED) then 00110 Incomplete := true 00111 else 00112 tau 00113 fi 00114 . Result := join(ModuleTree, Result) 00115 . Runner := next(Runner) 00116 fi 00117 * 00118 if or(equal(Runner, []),equal(Incomplete,true)) then 00119 tau 00120 fi 00121 . 00122 if equal(Incomplete, true) then 00123 Modules := [] 00124 else 00125 Modules := Result 00126 fi 00127 endlet 00128 00129 process GetSyntaxDefinition(ModuleId: module-id, Syntax: term?) is 00130 let 00131 ModuleIds: list, 00132 Modules: list, 00133 Status: term 00134 in 00135 MM-GetAttribute(ModuleId, SDF_NAMESPACE, "status", Status?) 00136 . 00137 if equal(Status, complete) then 00138 MM-GetAllModuleDependencies(ModuleId, ModuleIds?) 00139 . ModuleIds := join([ModuleId], ModuleIds) 00140 . GetModules(ModuleIds, Modules?) 00141 . 00142 if equal(Modules, []) then 00143 Syntax := UNDEFINED 00144 else 00145 snd-msg(sm-make-sdf-definition(Modules)) 00146 . 00147 ( 00148 rec-msg(sm-sdf-definition(Syntax?)) 00149 + 00150 rec-msg(sm-no-sdf-definition) 00151 . Syntax := UNDEFINED 00152 ) 00153 fi 00154 else 00155 Syntax := UNDEFINED 00156 fi 00157 endlet 00158 00159 process GetImportedModulenames(Tree: term, Imports: list?) is 00160 snd-msg(sm-get-imported-module-names(Tree)) 00161 . rec-msg(sm-imported-module-names(Imports?)) 00162 00163 process CloseOtherModules(ModuleId: module-id) is 00164 let 00165 Dependencies: list, 00166 CloseModules: list, 00167 NewTerm: term 00168 in 00169 MM-GetAllModuleDependencies(ModuleId, Dependencies?) 00170 . Dependencies := join(Dependencies, [ModuleId]) 00171 . MM-GetAllModules(CloseModules?) 00172 . CloseModules := diff(CloseModules, Dependencies) 00173 . CloseModules(CloseModules) 00174 endlet 00175 00176 process CloseModule(ModuleId: module-id, Recursive: bool) is 00177 let 00178 Dependencies: list, 00179 Modulename: str, 00180 CloseModules: list, 00181 NewTerm: term 00182 in 00183 MM-GetAttribute(ModuleId, SDF_NAMESPACE, "name", Modulename?) 00184 . 00185 if equal(Recursive, true) then 00186 MM-GetClosableModules(ModuleId, CloseModules?) 00187 . 00188 if equal(CloseModules, []) then 00189 printf("warning: Unable to close %s, it would break some import(s).\n", Modulename) 00190 else 00191 CloseModules(CloseModules) 00192 fi 00193 else 00194 MM-GetModuleParents(ModuleId, Dependencies?) 00195 . 00196 if equal(Dependencies, []) then 00197 CloseModules([ModuleId]) 00198 else 00199 printf("warning: Unable to close %s, it would break the import of: %t\n", 00200 Modulename, Dependencies) 00201 fi 00202 fi 00203 endlet 00204 00205 process CloseModules(CloseModules: list) is 00206 let 00207 ModuleId: module-id, 00208 Modules: list 00209 in 00210 Modules := quote(CloseModules) 00211 . 00212 if not-equal(Modules, []) then 00213 ModuleId := first(Modules) 00214 . MM-DeleteModule(ModuleId) 00215 . Modules := next(Modules) 00216 fi 00217 * 00218 if equal(Modules, []) then 00219 tau 00220 fi 00221 endlet 00222 00223 process CancelCreateNewModule(Pid: int, Error: str, Args: list) is 00224 snd-note(ui-status(errorf(Error, Args))) 00225 . snd-msg(cancel-content-handler(Pid)) 00226 00227 process CreateNewModule(Pid: int, Directory: str, Filename: str) is 00228 let 00229 BaseDir: str, 00230 Contents: list, 00231 Error: term, 00232 Extension: str, 00233 ModuleId: module-id, 00234 Modulename: str, 00235 Path: str, 00236 SearchPaths: list 00237 in 00238 snd-msg(cm-get-module-paths) 00239 . rec-msg(cm-module-paths(SearchPaths?)) 00240 . snd-msg(sm-get-new-module-name(SearchPaths, Directory, Filename)) 00241 . 00242 ( 00243 rec-msg(sm-new-module-name(BaseDir?, Modulename?)) 00244 . MM-GetModuleIdByAttribute(SDF_NAMESPACE, "name", Modulename, ModuleId?) 00245 . 00246 if equal(ModuleId, UNDEFINED) then 00247 BuildPath(BaseDir, Modulename, SDF_EXTENSION, Path?) 00248 . snd-msg(io-exists-file(Path)) 00249 . 00250 ( 00251 rec-msg(io-file-exists) 00252 . CancelCreateNewModule(Pid, "File %s already exists", [Path]) 00253 + 00254 rec-msg(io-file-not-exists) 00255 . snd-msg(get-module-contents(Pid, Modulename)) 00256 . rec-msg(module-contents(Pid, Contents?)) 00257 . snd-msg(io-write-text-list(Path, Contents)) 00258 . 00259 ( 00260 rec-msg(io-file-written) 00261 . OpenModule(Modulename, ModuleId?) 00262 + 00263 rec-msg(io-file-not-written(Error?)) 00264 . snd-note(ui-status(errorf("%s: %s", [Path, Error]))) 00265 ) 00266 ) 00267 else 00268 CancelCreateNewModule(Pid, "Module %s already exists", [Modulename]) 00269 fi 00270 + 00271 rec-msg(sm-new-module-name-inconsistent) 00272 . CancelCreateNewModule(Pid, 00273 "Module %s in %s is inconsistent with module paths", 00274 [Filename, Path]) 00275 ) 00276 endlet 00277 00278 process CopySdfModule(SrcModulename: str, Directory: str, Filename: str) is 00279 let 00280 Id: int, 00281 Pid: int 00282 in 00283 Id := process-id 00284 . snd-note(ui-status(statf(Id, "Copying %s to %s", [SrcModulename, Filename]))) 00285 . create(CopySdfContentHandler(SrcModulename), Pid?) 00286 . CreateNewModule(Pid, Directory, Filename) 00287 . snd-note(ui-status(endstat(Id))) 00288 endlet 00289 00290 process CopySdfContentHandler(SrcModulename: str) is 00291 let 00292 Contents: str, 00293 DestModulename: str, 00294 Pid: int, 00295 Syntax: term 00296 in 00297 Pid := process-id 00298 . 00299 ( 00300 rec-msg(get-module-contents(Pid, DestModulename?)) 00301 . snd-msg(ts-get-term-value("sdf-tree", SrcModulename)) 00302 . rec-msg(ts-value("sdf-tree", SrcModulename, Syntax?)) 00303 . snd-msg(sm-rename-modulename-in-module(Syntax, DestModulename)) 00304 . rec-msg(sm-modulename-renamed-in-module(Syntax?)) 00305 . snd-msg(unparse(Syntax)) 00306 . rec-msg(unparsed-text(Contents?)) 00307 . snd-msg(module-contents(Pid, [Contents])) 00308 + 00309 rec-msg(cancel-content-handler(Pid)) 00310 ) 00311 endlet 00312 00313 process SaveSdfModules(Modules: list, Status: term?) is 00314 let 00315 Runner: list, 00316 Module: str 00317 in 00318 Runner := Modules 00319 . 00320 if not-equal(Runner, []) then 00321 Module := first(Runner) 00322 . snd-msg(save-module(Module, sdf)) 00323 . rec-msg(saved-module(Module, Status?)) 00324 . Runner := next(Runner) 00325 fi 00326 * 00327 if equal(Runner, []) then 00328 tau 00329 fi 00330 endlet 00331 00332 /* TODO: The following should be DEAD */ 00333 process RenameImports(OldImport: str, NewImport: str) is 00334 let 00335 ImportRelations: list, 00336 ModuleId: str, 00337 Depending: list 00338 in 00339 snd-msg(ts-get-key-value-pairs("import-relations")) 00340 . rec-msg(ts-pairs("import-relations", ImportRelations?)) 00341 . snd-msg(sm-get-depending-module-names(ImportRelations, OldImport)) 00342 . rec-msg(sm-depending-module-names(Depending?)) 00343 . 00344 if not-equal(Depending, []) then 00345 ModuleId := first(Depending) 00346 . RenameImport(ModuleId, OldImport, NewImport) 00347 . Depending := next(Depending) 00348 fi 00349 * 00350 if equal(Depending, []) then 00351 tau 00352 fi 00353 endlet 00354 00355 process RenameImport(Modulename: str, OldImport: str, NewImport: str) is 00356 let 00357 Status: term, 00358 Tree: term 00359 in 00360 snd-msg(ts-get-term-value("sdf-tree", Modulename)) 00361 . rec-msg(ts-value("sdf-tree", Modulename, Tree?)) 00362 . snd-msg(sm-remove-import-from-module(Tree, OldImport)) 00363 . rec-msg(sm-import-removed-from-module(Tree?)) 00364 . snd-msg(sm-add-import-to-module(Tree, NewImport)) 00365 . rec-msg(sm-import-added-to-module(Tree?)) 00366 /* . MDB-StoreModuleTree(Modulename, Tree) dead */ 00367 . snd-msg(save-module(Modulename, sdf)) 00368 . rec-msg(saved-module(Modulename, Status?)) 00369 endlet 00370 00371 /* end of dead code */ 00372 00373 process IsLibraryModule(ModuleId: module-id, LibraryModule: bool?) is 00374 let 00375 Directories: list, 00376 Extension: str, 00377 Filename: str, 00378 Modulename: str, 00379 Path: str, 00380 Prefix: str 00381 in 00382 snd-msg(cm-get-library-paths) 00383 . rec-msg(cm-library-paths(Directories?)) 00384 . GetModulePath(ModuleId, SDF_NAMESPACE, Path?) 00385 . snd-msg(io-get-relative-filename(Directories, Path, ".sdf")) 00386 . rec-msg(io-filename(Directories, Path, ".sdf", Prefix?, Filename?)) 00387 . 00388 if equal(Filename, "") then 00389 LibraryModule := false 00390 else 00391 LibraryModule := true 00392 fi 00393 endlet 00394 00395 process CreateModule(Modulename: str, ModuleId: module-id?) is 00396 MM-GetModuleIdByAttribute(SDF_NAMESPACE, "name", Modulename, ModuleId?) 00397 . 00398 if equal(ModuleId, UNDEFINED) then 00399 MM-CreateModule(ModuleId?) 00400 . MM-SetAttribute(ModuleId, SDF_NAMESPACE, "name", Modulename) 00401 . MM-SetAttribute(ModuleId, SDF_NAMESPACE, "status", unknown) 00402 else 00403 tau 00404 fi 00405 00406 process OpenModule(Modulename: str, ModuleId: module-id?) is 00407 let 00408 Editable: bool, 00409 LibraryModule: bool, 00410 Path: str 00411 in 00412 CreateModule(Modulename, ModuleId?) 00413 . GetModulePath(ModuleId, SDF_NAMESPACE, Path?) 00414 . 00415 if equal(Path, EMPTY_PATH) then 00416 LocateFile(Modulename, SDF_EXTENSION, Path?) 00417 . 00418 if equal(Path, EMPTY_PATH) then 00419 printf("warning: Unable to locate %s\n", Modulename) 00420 . BuildPath(".", Modulename, SDF_EXTENSION, Path?) 00421 . SetModulePath(ModuleId, SDF_NAMESPACE, Path) 00422 . MM-SetAttribute(ModuleId, SDF_NAMESPACE, "editable", true) 00423 . MM-SetAttribute(ModuleId, SDF_NAMESPACE, "status", unavailable) 00424 else 00425 SetModulePath(ModuleId, SDF_NAMESPACE, Path) 00426 . IsLibraryModule(ModuleId, LibraryModule?) 00427 . Editable := not(LibraryModule) 00428 . MM-SetAttribute(ModuleId, SDF_NAMESPACE, "editable", Editable) 00429 . MM-SetAttribute(ModuleId, SDF_NAMESPACE, "status", available) 00430 fi 00431 else 00432 tau 00433 fi 00434 endlet 00435 00436 toolbus(InitCache(SDF_TREE_CACHE)) 00437 toolbus(ClearCacheHandler(SDF_TREE_CACHE, SDF_NAMESPACE, "status", <term>, edited)) 00438 00439 process GetSDFParsetree(ModuleId: module-id, Result: term?) is 00440 let 00441 ParseTable: term, 00442 Path: str, 00443 Pid: int, 00444 Text: str, 00445 Type: term, 00446 Tree: term 00447 in 00448 snd-msg(tm-request-transaction(sdf-parsing)) 00449 . GetCachedValue(SDF_TREE_CACHE, ModuleId, Tree?) 00450 . 00451 if equal(Tree, UNDEFINED) then 00452 Type := sdf 00453 . GetModulePath(ModuleId, SDF_NAMESPACE, Path?) 00454 . ReadText(Path, Text?) 00455 . 00456 if not-equal(Text, "") then 00457 GetParseTable(ModuleId, Type, ParseTable?) 00458 . 00459 if not-equal(ParseTable, UNDEFINED) then 00460 create(ParseTreeHandler(ModuleId, Path), Pid?) 00461 . ParseText(Pid, Text, ParseTable, SDF_TOPSORT, off) 00462 . 00463 ( 00464 rec-msg(parse-handler-done(Pid, ModuleId, Tree?)) 00465 . AnnotateTree(Tree, Path, Result?) 00466 . PutCachedValue(SDF_TREE_CACHE, ModuleId, Result) 00467 + 00468 rec-msg(parse-handler-done(Pid)) 00469 . Result := UNDEFINED 00470 ) 00471 else 00472 Result := UNDEFINED 00473 fi 00474 else 00475 Result := UNDEFINED 00476 fi 00477 else 00478 Result := Tree 00479 fi 00480 . snd-msg(tm-end-transaction(sdf-parsing)) 00481 endlet 00482 00483 process SDFIdentifyModule(ModuleId: module-id, ResultStatus: term?) is 00484 let 00485 Tree: term, 00486 Path: str, 00487 Directory: str, 00488 Modulename: str, 00489 File: str 00490 in 00491 GetSDFParsetree(ModuleId, Tree?) 00492 . 00493 if not-equal(Tree, UNDEFINED) then 00494 GetModulePath(ModuleId, SDF_NAMESPACE, Path?) 00495 . snd-msg(sm-get-module-id(Tree)) 00496 . rec-msg(sm-module-id(Modulename?)) 00497 . snd-msg(io-get-path-directory(Path)) 00498 . rec-msg(io-directory(Path, Directory?)) 00499 . snd-msg(sm-get-module-path(Directory, Modulename)) 00500 . rec-msg(sm-module-path(Directory?)) 00501 . BuildPath(Directory, Modulename, SDF_EXTENSION, File?) 00502 . 00503 if equal(File, Path) then 00504 MM-SetAttribute(ModuleId, SDF_NAMESPACE, "name", Modulename) 00505 . ResultStatus := identified 00506 else 00507 printf("error: Module %s should be in a file named %s\n", Modulename, File) 00508 . ResultStatus := error 00509 fi 00510 else 00511 tau 00512 fi 00513 endlet 00514 00515 process GetImportsForRenaming(ModuleId: module-id, ModuleIds: list, Imports: term?) is 00516 let 00517 Modulename: str, 00518 Modules: list 00519 in 00520 GetModules(ModuleIds, Modules?) 00521 . 00522 if equal(Modules, []) then 00523 Imports := [] 00524 else 00525 MM-GetAttribute(ModuleId, SDF_NAMESPACE, "name", Modulename?) 00526 . snd-msg(sm-get-all-needed-imports(Modules, Modulename)) 00527 . rec-msg(sm-all-needed-imports(Imports?)) 00528 fi 00529 endlet 00530 00531 process SDFExtraction(ModuleId: module-id) is 00532 let 00533 Modulename: str, 00534 RStore: rstore, 00535 Store: term, 00536 Syntax: term 00537 in 00538 GetSyntaxDefinition(ModuleId, Syntax?) 00539 . MM-GetAttribute(ModuleId, SDF_NAMESPACE, "name", Modulename?) 00540 . snd-msg(es-extract-sdf(Syntax)) 00541 . rec-msg(es-sdf-store(Store?)) 00542 . snd-msg(rs-lower-rstore(Store)) 00543 . rec-msg(rs-lowered-rstore(RStore?)) 00544 . snd-msg(rc-load-rstore(Modulename, RStore)) 00545 endlet 00546 00547 #endif /* __SDF_UTILS__ */