Move getFutureBackendConfigs() methods to the corresponding FutureBackend files

Author: HenrikBengtsson

R/backend_api-ClusterFutureBackend-class.R

@@ -1040,3 +1040,44 @@ assertValidConnection <- function(future) {
     stop(FutureError(msg, future = future))
   }
 }
+
+
+
+#' @export
+getFutureBackendConfigs.ClusterFuture <- function(future, ..., debug = isTRUE(getOption("future.debug"))) {
+  resignalImmediateConditions <- getOption("future.psock.relay.immediate", TRUE)
+  if (!resignalImmediateConditions) return(list())
+
+  conditionClasses <- future[["conditions"]]
+  if (is.null(conditionClasses)) return(list())
+  
+  immediateConditionClasses <- attr(conditionClasses, "immediateConditionClasses", exact = TRUE)
+  if (is.null(immediateConditionClasses)) {
+    immediateConditionClasses <- "immediateCondition"
+  } else if (length(immediateConditionClasses) == 0L) {
+    return(list())
+  }
+  
+  ## Does the cluster node communicate with a connection?
+  ## (if not, it's via MPI)
+  workers <- future[["workers"]]
+  stop_if_not(inherits(workers, "cluster"))
+  ## AD HOC/FIXME: Here 'future[["node"]]' is yet not assigned, so we look at
+  ## the first worker and assume the others are the same. /HB 2019-10-23
+  cl <- workers[1L]
+  stop_if_not(inherits(cl, "cluster"))
+  node <- cl[[1L]]
+  stop_if_not(inherits(node, c("SOCK0node", "SOCKnode")))
+  con <- node[["con"]]
+  if (is.null(con)) return(list())
+
+  capture <- list(
+    immediateConditionHandlers = list(
+      immediateCondition = psockImmediateConditionHandler
+    )
+  )
+
+  list(
+    capture = capture
+  )
+}

R/backend_api-Future-class.R

@@ -847,109 +847,6 @@ getFutureBackendConfigs <- function(future, ...) {
   UseMethod("getFutureBackendConfigs")
 }
 
-#' @export
-getFutureBackendConfigs.Future <- function(future, ...) {
-  list()
-}
-
-#' @export
-getFutureBackendConfigs.UniprocessFuture <- function(future, ...) {
-  conditionClasses <- future[["conditions"]]
-  if (is.null(conditionClasses)) return(list())
-  
-  capture <- list(
-    immediateConditionHandlers = list(
-      immediateCondition = function(cond) {
-        signalCondition(cond)
-      }
-    )
-  )
-
-  list(
-    capture = capture
-  )
-}
-
-
-#' @export
-getFutureBackendConfigs.MulticoreFuture <- function(future, ..., debug = isTRUE(getOption("future.debug"))) {
-  conditionClasses <- future[["conditions"]]
-  if (is.null(conditionClasses)) {
-    capture <- list()
-  } else {
-    path <- immediateConditionsPath(rootPath = tempdir())
-    capture <- list(
-      immediateConditionHandlers = list(
-        immediateCondition = function(cond) {
-          fileImmediateConditionHandler(cond, path = path)
-        }
-      )
-    )
-  }
-
-  ## Disable multi-threading in futures?
-  threads <- NA_integer_
-  multithreading <- getOption("future.fork.multithreading.enable", TRUE)  
-  if (isFALSE(multithreading)) {
-    if (supports_omp_threads(assert = TRUE, debug = debug)) {
-      threads <- 1L
-      if (debug) mdebugf("- Force single-threaded (OpenMP and RcppParallel) processing in %s", class(future)[1])
-    } else {
-      warning(FutureWarning("It is not possible to disable OpenMP multi-threading on this systems", future = future))
-    }
-  }
-
-  context <- list(
-    threads = threads
-  )
-
-  list(
-    capture = capture,
-    context = context
-  )
-}
-
-
-
-#' @export
-getFutureBackendConfigs.ClusterFuture <- function(future, ..., debug = isTRUE(getOption("future.debug"))) {
-  resignalImmediateConditions <- getOption("future.psock.relay.immediate", TRUE)
-  if (!resignalImmediateConditions) return(list())
-
-  conditionClasses <- future[["conditions"]]
-  if (is.null(conditionClasses)) return(list())
-  
-  immediateConditionClasses <- attr(conditionClasses, "immediateConditionClasses", exact = TRUE)
-  if (is.null(immediateConditionClasses)) {
-    immediateConditionClasses <- "immediateCondition"
-  } else if (length(immediateConditionClasses) == 0L) {
-    return(list())
-  }
-  
-  ## Does the cluster node communicate with a connection?
-  ## (if not, it's via MPI)
-  workers <- future[["workers"]]
-  stop_if_not(inherits(workers, "cluster"))
-  ## AD HOC/FIXME: Here 'future[["node"]]' is yet not assigned, so we look at
-  ## the first worker and assume the others are the same. /HB 2019-10-23
-  cl <- workers[1L]
-  stop_if_not(inherits(cl, "cluster"))
-  node <- cl[[1L]]
-  stop_if_not(inherits(node, c("SOCK0node", "SOCKnode")))
-  con <- node[["con"]]
-  if (is.null(con)) return(list())
-
-  capture <- list(
-    immediateConditionHandlers = list(
-      immediateCondition = psockImmediateConditionHandler
-    )
-  )
-
-  list(
-    capture = capture
-  )
-}
-
 
 getFutureData <- function(future, ..., debug = isTRUE(getOption("future.debug"))) {
   if (debug) {

R/backend_api-FutureBackend-class.R

@@ -70,3 +70,9 @@ makeFutureBackend <- function(evaluator, ...) {
 
   backend
 }
+
+
+#' @export
+getFutureBackendConfigs.Future <- function(future, ...) {
+  list()
+}

R/backend_api-MulticoreFutureBackend-class.R

@@ -540,3 +540,42 @@ result.MulticoreFuture <- local({
     result
   }
 })
+
+
+#' @export
+getFutureBackendConfigs.MulticoreFuture <- function(future, ..., debug = isTRUE(getOption("future.debug"))) {
+  conditionClasses <- future[["conditions"]]
+  if (is.null(conditionClasses)) {
+    capture <- list()
+  } else {
+    path <- immediateConditionsPath(rootPath = tempdir())
+    capture <- list(
+      immediateConditionHandlers = list(
+        immediateCondition = function(cond) {
+          fileImmediateConditionHandler(cond, path = path)
+        }
+      )
+    )
+  }
+
+  ## Disable multi-threading in futures?
+  threads <- NA_integer_
+  multithreading <- getOption("future.fork.multithreading.enable", TRUE)  
+  if (isFALSE(multithreading)) {
+    if (supports_omp_threads(assert = TRUE, debug = debug)) {
+      threads <- 1L
+      if (debug) mdebugf("- Force single-threaded (OpenMP and RcppParallel) processing in %s", class(future)[1])
+    } else {
+      warning(FutureWarning("It is not possible to disable OpenMP multi-threading on this systems", future = future))
+    }
+  }
+
+  context <- list(
+    threads = threads
+  )
+
+  list(
+    capture = capture,
+    context = context
+  )
+}

R/backend_api-SequentialFutureBackend-class.R

@@ -100,3 +100,22 @@ nbrOfFreeWorkers.SequentialFutureBackend <- function(evaluator, background = FAL
   assert_no_positional_args_but_first()
   if (isTRUE(background)) 0L else 1L
 }
+
+
+#' @export
+getFutureBackendConfigs.UniprocessFuture <- function(future, ...) {
+  conditionClasses <- future[["conditions"]]
+  if (is.null(conditionClasses)) return(list())
+  
+  capture <- list(
+    immediateConditionHandlers = list(
+      immediateCondition = function(cond) {
+        signalCondition(cond)
+      }
+    )
+  )
+
+  list(
+    capture = capture
+  )
+}