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