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
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
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
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
00367 . snd-msg(save-module(Modulename, sdf))
00368 . rec-msg(saved-module(Modulename, Status?))
00369 endlet
00370
00371
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
