[Swift-commit] r4080 - SwiftApps/SwiftR/Swift/exec
noreply at svn.ci.uchicago.edu
noreply at svn.ci.uchicago.edu
Thu Feb 10 08:46:29 CST 2011
Author: tga
Date: 2011-02-10 08:46:29 -0600 (Thu, 10 Feb 2011)
New Revision: 4080
Modified:
SwiftApps/SwiftR/Swift/exec/SwiftRServer.R
Log:
Changed how environments are managed within the R server: the previous scheme where we created an independent environment to run functions in was problematic as the approach wiped out closures attached to functions which prevented applied functions correctly resolving non-global variables or library functions in its closure. Now exported data goes into the global environment of the R server, and all of the functions and data required for the R server to run are stored within variables beginning with "." in the R global environment. This allows imported data to be cleaned out of the global environment when needed.
Modified: SwiftApps/SwiftR/Swift/exec/SwiftRServer.R
===================================================================
--- SwiftApps/SwiftR/Swift/exec/SwiftRServer.R 2011-02-10 14:42:13 UTC (rev 4079)
+++ SwiftApps/SwiftR/Swift/exec/SwiftRServer.R 2011-02-10 14:46:29 UTC (rev 4080)
@@ -1,189 +1,188 @@
#! /usr/bin/env Rscript
-require(methods)
-argv = commandArgs(TRUE)
-print("SwiftRServer arguments:")
-print(argv)
+library(methods)
-fifoDir = argv[1]; # FIXME: test for valid arguments
-cat(Sys.getpid(),file=paste(fifoDir,"/R.pid",sep=""))
-.current.initializer <<- ""
+# Enclose everything within .main environment so that we can use global environmen tfor process data
+# Note; Everything in the global environment that belong to this script should be prefixed
+# with a .: other thrings are assumed to belong to script.
+.main <- function (argv) {
-SwiftRFifoServer <- function( fifoBasename )
-{
- inFifoName = file.path(fifoDir,"toR.fifo")
- outFifoName = file.path(fifoDir,"fromR.fifo")
- dir = getwd()
- cat("SwiftRServer starting in dir:",dir,"\n");
- repeat {
- cat("SwiftRServer at top of loop is in dir:",getwd(),"\n");
- setwd(dir) # FIXME: not yet sure what is changing the CWD
- infifo <- fifo(inFifoName,open="rb",blocking=TRUE)
- cmd <- scan(infifo,what=list("","",""),nlines=1,flush=FALSE,quiet=FALSE,fill=TRUE)
- op = cmd[[1]]
- callBatchFileName = cmd[[2]]
- resultBatchFileName = cmd[[3]]
- cat("cmd: op=",op," call batch=",callBatchFileName," result batch=",resultBatchFileName,"\n");
- #cat(file=outfifo, "Read from sock: cmd=",cmd[[1]], cmd[[2]],"\n");
- if(is.null(op)) {
- cat("op is NULL\n")
- }
- else {
- if( identical(op,"quit")) {
- outfifo <- fifo(outFifoName,open="wb",blocking=TRUE)
- cat(file=outfifo,"Server closing down.\n")
- break
- }
- if( identical(op,"run")) {
- #cat(file=outfifo, "About to run batch file: ", callBatchFileName,"\n");
- runBatch(callBatchFileName,resultBatchFileName)
- outfifo <- fifo(outFifoName,open="wb",blocking=TRUE)
- cat(file=outfifo, "Batch completed: result batch file: ", resultBatchFileName,"\n");
- }
- }
- close(infifo)
- close(outfifo)
- }
-}
+ print("SwiftRServer arguments:")
+ print(argv)
-doFail <- function( error )
-{
- outFifoName = file.path(fifoDir,"fromR.fifo")
- outfifo <- fifo(outFifoName,open="wb",blocking=TRUE)
- cat(file=outfifo, paste("ERROR: R server failed with error", gsub("\n", " ", error)))
- close(outfifo)
-}
+ fifoDir = argv[1]; # FIXME: test for valid arguments
-doInit <- function(initializer, env) {
- #print(sprintf("received initializer=%s latestInitializer=%s\n",
- # initializer, latestInitializer));
- if( initializer != .current.initializer) {
- eval(parse(text=initializer), envir=env)
- .current.initializer <<- initializer
- }
-}
+ cat(Sys.getpid(),file=paste(fifoDir,"/R.pid",sep=""))
-failBatch <- function(rcall, try.error, resultBatchFileName) {
- # This function is called when an error occurs and
- # no valid argument values can be produced
- # It fills a result array with the try.error object
- # and writes it to resultBatchFileName
- result <- list()
- for (c in 1:length(rcall$arglistbatch)) {
- result[[c]] <- try.error
+ .current.initializer <<- ""
+
+ SwiftRFifoServer <- function( fifoBasename )
+ {
+ inFifoName = file.path(fifoDir,"toR.fifo")
+ outFifoName = file.path(fifoDir,"fromR.fifo")
+ dir = getwd()
+ cat("SwiftRServer starting in dir:",dir,"\n");
+ repeat {
+ cat("SwiftRServer at top of loop is in dir:",getwd(),"\n");
+ setwd(dir) # FIXME: not yet sure what is changing the CWD
+ infifo <- fifo(inFifoName,open="rb",blocking=TRUE)
+ cmd <- scan(infifo,what=list("","",""),nlines=1,flush=FALSE,quiet=FALSE,fill=TRUE)
+ op = cmd[[1]]
+ callBatchFileName = cmd[[2]]
+ resultBatchFileName = cmd[[3]]
+ cat("DB: cmd: op=",op," call batch=",callBatchFileName," result batch=",resultBatchFileName,"\n");
+ if(is.null(op)) {
+ cat("op is NULL\n")
+ outfifo <- fifo(outFifoName,open="wb",blocking=TRUE)
+ cat(file=outfifo,"op is NULL.\n")
+ }
+ else {
+ if( identical(op,"quit")) {
+ outfifo <- fifo(outFifoName,open="wb",blocking=TRUE)
+ cat(file=outfifo,"Server closing down.\n")
+ break
+ }
+ if( identical(op,"run")) {
+ cat("DB: About to run batch file: ", callBatchFileName,"\n");
+ runBatch(callBatchFileName,resultBatchFileName)
+ outfifo <- fifo(outFifoName,open="wb",blocking=TRUE)
+ cat(file=outfifo, "Batch completed: result batch file: ", resultBatchFileName,"\n");
+ }
+ }
+ close(infifo)
+ close(outfifo)
+ }
}
- save(result,file=resultBatchFileName)
-}
-runBatch <- function( callBatchFileName, resultBatchFileName )
-{
- success <- try(load(callBatchFileName));
- if (inherits(success, "try-error")) {
- failBatch(rcall, paste(callBatchFileName, "could not be opened"),
- resultBatchFileName)
- return()
- }
- success <- try(loadImports(rcall$imports))
- if (inherits(success, "try-error")) {
- failBatch(rcall, success, resultBatchFileName)
- return()
- }
+ doFail <- function( error )
+ {
+ outFifoName = file.path(fifoDir,"fromR.fifo")
+ outfifo <- fifo(outFifoName,open="wb",blocking=TRUE)
+ cat(paste("ERROR: R server failed with error", gsub("\n", " ", error)), "\n")
+ cat(file=outfifo, paste("ERROR: R server failed with error", gsub("\n", " ", error)), "\n")
+ close(outfifo)
+ }
- if (exists(".current.envir", envir=globalenv())) {
- env = get(".current.envir", envir=globalenv())
- }
- else {
- # Create a new environment to work in
- if (is.null(importlist) || is.null(importlist$session)) {
- # If the client provides no info about the environment,
- # we should create a new environment to work in
- env = new.env(parent=parent.env(globalenv()))
+ doInit <- function(initializer) {
+ #print(sprintf("received initializer=%s latestInitializer=%s\n",
+ # initializer, latestInitializer));
+ if( initializer != .current.initializer) {
+ cat("DB: Running initializer:", initializer, "\n", file=stderr())
+ eval(parse(text=initializer), envir=globalenv())
+ .current.initializer <<- initializer
+ }
}
- else {
- newSession(importlist$session)
- env = get(".current.envir", envir=globalenv())
+
+ failBatch <- function(rcall, try.error, resultBatchFileName) {
+ # This function is called when an error occurs and
+ # no valid argument values can be produced
+ # It fills a result array with the try.error object
+ # and writes it to resultBatchFileName
+ result <- list()
+ cat("DB: Failing with error:", try.error, "\n", file=stderr())
+ for (c in 1:length(rcall$arglistbatch)) {
+ result[[c]] <- try.error
+ }
+ save(result,file=resultBatchFileName)
}
- }
- environment(rcall$func) <- env
- success <- try(doInit(rcall$initializer, env))
- if (inherits(success, "try-error")) {
- failBatch(rcall, success, resultBatchFileName)
- return()
- }
+ runBatch <- function( callBatchFileName, resultBatchFileName )
+ {
+ # Load contents into local environment
+ success <- try(load(callBatchFileName, envir=environment()));
+ if (inherits(success, "try-error")) {
+ failBatch(rcall, paste(callBatchFileName, "could not be opened"),
+ resultBatchFileName)
+ return()
+ }
+ success <- try(loadImports(rcall$imports))
+ if (inherits(success, "try-error")) {
+ failBatch(rcall, success, resultBatchFileName)
+ return()
+ }
- result <- list()
- for(c in 1:length(rcall$arglistbatch)) {
- # FIXME: run this under try/catch and save error status
- # in results object (need to make it a list: rval + error status)
- result[[c]] = try(do.call( rcall$func,
- as.list(rcall$arglistbatch[[c]] )))
- }
- save(result,file=resultBatchFileName)
-}
-newSession <- function (session) {
- cat("Setting up new session\n", file=stderr())
- #Setup new session
- .current.session <<- session
- # Use an environment as a hash table to track imports
- .current.imported <<- new.env(hash=T, parent=emptyenv())
- # Create an environment to store imported items in
- # and to evaluate apply calls in. Note that the environment
- # does not point to the global environment as its parent, which means
- # means that assignments and variable lookusp will not touch the global
- # environment by default, and will be contained in this session.
- # However, the <<- assignment operator and the get, assign, etc function
- # can still access the global enviroment if used in the applied function.
+ success <- try(doInit(rcall$initializer))
+ if (inherits(success, "try-error")) {
+ failBatch(rcall, success, resultBatchFileName)
+ return()
+ }
- .current.envir <<- new.env(parent=parent.env(globalenv()))
+ cat("DB: Doing apply\n", file=stderr())
+ result <- list()
+ for(c in 1:length(rcall$arglistbatch)) {
+ # FIXME: run this under try/catch and save error status
+ # in results object (need to make it a list: rval + error status)
+ result[[c]] = try(do.call( rcall$func,
+ as.list(rcall$arglistbatch[[c]] )))
+ }
+ cat("DB: Saving Results\n", file=stderr())
+ save(result,file=resultBatchFileName)
+ cat("DB: Results saved\n", file=stderr())
+ }
- .current.initializer <<- ""
-}
+ newSession <- function (session) {
+ cat("DB: Setting up new session\n", file=stderr())
+ cat("DB: Deleting:", ls(envir=globalenv()), "\n", file=stderr())
+ #Setup new session
+ .current.session <<- session
+ # Use an environment as a hash table to track imports
+ .current.imported <<- new.env(hash=T, parent=emptyenv())
+
+ # Clear out global environment of anything not starting
+ # with a . - ie. things put there by previous imports
+ rm(list=ls(envir=globalenv()), envir=globalenv())
-loadImports <- function (importlist) {
- # First check whether the session id has changed
- #cat(paste("Import list:", importlist$exports, "\n"), file=stderr())
- #cat(paste("New Session:", importlist$session, "\n"), file=stderr())
- #cat(paste("Old Session:", try(get(".current.session", envir=globalenv())),
- # "\n"), file=stderr())
- doSetup <- FALSE
- if (!is.null(importlist)) {
- if (exists(".current.session", envir=globalenv())) {
- if (importlist$session != .current.session)
+ .current.initializer <<- ""
+ cat("DB: reset env\n")
+ }
+
+ loadImports <- function (importlist) {
+ # First check whether the session id has changed
+ #cat(paste("Import list:", importlist$exports, "\n"), file=stderr())
+ #cat(paste("New Session:", importlist$session, "\n"), file=stderr())
+ #cat(paste("Old Session:", try(get(".current.session", envir=globalenv())),
+ # "\n"), file=stderr())
+ doSetup <- FALSE
+ if (!is.null(importlist)) {
+ if (exists(".current.session", envir=globalenv())) {
+ if (importlist$session != .current.session)
+ doSetup <- TRUE
+ }
+ else {
doSetup <- TRUE
+ }
}
- else {
- doSetup <- TRUE
+ if (doSetup) {
+ newSession(importlist$session)
}
- }
- if (doSetup) {
- newSession(importlist$session)
- }
- for (file in importlist$exports) {
- # Load the contents of the specified file
- # into the global environment
+ for (file in importlist$exports) {
+ # Load the contents of the specified file
+ # into the global environment
- #cat("File: ", file, "\n")
- # check to see if already imported
- if (!exists(file, envir=.current.imported)) {
- #TODO: load can fail with warning
- load(file, envir=.current.envir)
- # if an error occurs here, assume calling function
- # will catch it
- assign(file, TRUE, envir=.current.imported)
- cat("Loaded file ", file, "\n")
+ #cat("File: ", file, "\n")
+ # check to see if already imported
+ if (!exists(file, envir=.current.imported)) {
+ #TODO: load can fail with warning
+ load(file, envir=globalenv())
+ # if an error occurs here, assume calling function
+ # will catch it
+ assign(file, TRUE, envir=.current.imported)
+ cat("Loaded file ", file, "\n")
+ }
+ else {
+ #cat("Ignored file ", file, "\n")
+ }
}
- else {
- #cat("Ignored file ", file, "\n")
- }
}
+
+ cat("calling server: dir=",fifoDir,"\n")
+ setwd(fifoDir)
+ tryCatch(SwiftRFifoServer(fifoDir), error=doFail)
+ cat("returned from server: dir=",fifoDir,"\n")
}
-cat("calling server: dir=",fifoDir,"\n")
-setwd(fifoDir)
-tryCatch(SwiftRFifoServer(fifoDir), error=doFail)
-cat("returned from server: dir=",fifoDir,"\n"))
+.main(commandArgs(TRUE))
More information about the Swift-commit
mailing list