Skip to content

Commit 240e51d

Browse files
HenrikBengtssonHenrikBengtsson
committed
evalFuture(): add 'globals' argument
1 parent becfd04 commit 240e51d

File tree

3 files changed

+71
-10
lines changed

3 files changed

+71
-10
lines changed

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
Package: future
2-
Version: 1.34.0-9094
2+
Version: 1.34.0-9095
33
Title: Unified Parallel and Distributed Processing in R for Everyone
44
Imports:
55
digest,

‎R/Future-class.R‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -668,7 +668,10 @@ getExpression.Future <- function(future, expr = future$expr, local = future$loca
668668
warning(FutureWarning("Future version was not set. Using default %s",
669669
sQuote(version)))
670670
}
671-
671+
672+
## Globals needed by the future
673+
globals <- globals(future)
674+
672675
## Packages needed by the future
673676
pkgs <- packages(future)
674677
if (length(pkgs) > 0) {
@@ -700,7 +703,7 @@ getExpression.Future <- function(future, expr = future$expr, local = future$loca
700703
pkgs <- unique(c(pkgs, pkgsS))
701704
}
702705

703-
expr <- makeExpression(expr = expr, local = local, stdout = stdout, conditionClasses = conditionClasses, split = split, enter = NULL, exit = exit, ..., seed = seed, packages = pkgs, mc.cores = mc.cores, version = version)
706+
expr <- makeExpression(expr = expr, local = local, stdout = stdout, conditionClasses = conditionClasses, split = split, globals = globals, enter = NULL, exit = exit, ..., seed = seed, packages = pkgs, mc.cores = mc.cores, version = version)
704707
if (getOption("future.debug", FALSE)) mprint(expr)
705708

706709
## mdebug("getExpression() ... DONE")

‎R/expressions.R‎

Lines changed: 65 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -4,12 +4,12 @@ makeExpression <- local({
44
tmpl_expr_local <- future:::bquote_compile(base::local(.(expr)))
55

66
tmpl_expr_evaluate2 <- future:::bquote_compile({
7-
## Evaluate future
8-
future:::evalFuture(expr = quote(.(expr)), stdout = .(stdout), conditionClasses = .(conditionClasses), split = .(split), immediateConditions = .(immediateConditions), immediateConditionClasses = .(immediateConditionClasses), globals.onMissing = .(globals.onMissing), globalenv = .(globalenv), skip = .(skip), packages = .(packages), seed = .(seed), strategiesR = .(strategiesR), forwardOptions = .(forwardOptions), mc.cores = .(mc.cores))
7+
## Evaluate future
8+
future:::evalFuture(expr = quote(.(expr)), stdout = .(stdout), conditionClasses = .(conditionClasses), split = .(split), immediateConditions = .(immediateConditions), immediateConditionClasses = .(immediateConditionClasses), globals = .(globals), globals.onMissing = .(globals.onMissing), globalenv = .(globalenv), skip = .(skip), packages = .(packages), seed = .(seed), strategiesR = .(strategiesR), forwardOptions = .(forwardOptions), mc.cores = .(mc.cores))
99
})
1010

1111

12-
function(expr, local = TRUE, immediateConditions = FALSE, stdout = TRUE, conditionClasses = NULL, split = FALSE, globals.onMissing = getOption("future.globals.onMissing", NULL), globalenv = (getOption("future.globalenv.onMisuse", "ignore") != "ignore"), enter = NULL, exit = NULL, version = "1.8", packages = NULL, seed = NULL, mc.cores = NULL) {
12+
function(expr, local = TRUE, immediateConditions = FALSE, stdout = TRUE, conditionClasses = NULL, split = FALSE, globals = NULL, globals.onMissing = getOption("future.globals.onMissing", NULL), globalenv = (getOption("future.globalenv.onMisuse", "ignore") != "ignore"), enter = NULL, exit = NULL, version = "1.8", packages = NULL, seed = NULL, mc.cores = NULL) {
1313
if (version != "1.8") {
1414
stop(FutureError("Internal error: Non-supported future expression version: ", version))
1515
}
@@ -55,6 +55,22 @@ makeExpression <- local({
5555
packages <- unique(c(packages, pkgsS))
5656
}
5757

58+
if (is.function(strategiesR)) {
59+
if (!inherits(strategiesR, "future")) {
60+
stop(FutureError(sprintf("Argument 'strategiesR' is a function, but does not inherit 'future': %s", paste(sQuote(class(strategiesR)), collapse = ", "))))
61+
}
62+
} else if (is.list(strategiesR)) {
63+
for (kk in seq_along(strategiesR)) {
64+
strategy <- strategiesR[[kk]]
65+
if (!inherits(strategy, "future")) {
66+
stop(FutureError(sprintf("Element #%d of list 'strategiesR' is a function, but does not inherit 'future': %s", kk, paste(sQuote(class(strategy)), collapse = ", "))))
67+
}
68+
}
69+
} else if (is.character(strategiesR)) {
70+
} else {
71+
stop(FutureError(sprintf("Unknown value of argument 'strategiesR': %s", paste(sQuote(class(strategiesR)), collapse = ", "))))
72+
}
73+
5874
forwardOptions <- list(
5975
## Assert globals when future is created (or at run time)?
6076
future.globals.onMissing = globals.onMissing,
@@ -82,7 +98,21 @@ makeExpression <- local({
8298

8399

84100

85-
evalFuture <- function(expr, stdout = TRUE, conditionClasses = character(0L), split = FALSE, immediateConditions = NULL, immediateConditionClasses = character(0L), globals.onMissing = getOption("future.globals.onMissing", NULL), globalenv = (getOption("future.globalenv.onMisuse", "ignore") != "ignore"), skip = NULL, packages = NULL, seed = NULL, mc.cores = NULL, forwardOptions = NULL, strategiesR = future::sequential, envir = parent.frame()) {
101+
logme <- function(expr, envir = parent.frame()) {
102+
expr <- substitute(expr)
103+
stdout <- utils::capture.output(eval(expr, envir = envir))
104+
stdout <- sprintf("[evalFuture()] %s\n", stdout)
105+
stdout <- paste(stdout, collapse = "")
106+
cat(stdout, file = "callr.log", append = TRUE)
107+
}
108+
109+
FutureEvalError <- function(...) {
110+
ex <- FutureError(...)
111+
class(ex) <- c("FutureEvalError", class(ex))
112+
ex
113+
}
114+
115+
evalFuture <- function(expr, stdout = TRUE, conditionClasses = character(0L), split = FALSE, immediateConditions = NULL, immediateConditionClasses = character(0L), globals = NULL, globals.onMissing = getOption("future.globals.onMissing", NULL), globalenv = (getOption("future.globalenv.onMisuse", "ignore") != "ignore"), skip = NULL, packages = NULL, seed = NULL, mc.cores = NULL, forwardOptions = NULL, strategiesR = NULL, envir = parent.frame()) {
86116
stop_if_not(
87117
length(stdout) == 1L && is.logical(stdout),
88118
length(split) == 1L && is.logical(split) && !is.na(split),
@@ -91,11 +121,25 @@ evalFuture <- function(expr, stdout = TRUE, conditionClasses = character(0L), sp
91121
is.character(immediateConditionClasses) && !anyNA(immediateConditionClasses) && all(nzchar(immediateConditionClasses)),
92122
length(globalenv) == 1L && is.logical(globalenv) && !is.na(globalenv),
93123
length(skip) == 2L && is.integer(skip) && !anyNA(skip) && all(skip >= 0L),
94-
!is.null(strategiesR),
95124
is.null(seed) || is_lecyer_cmrg_seed(seed) || (is.logical(seed) && !is.na(seed) || !seed),
96125
is.null(mc.cores) || (is.numeric(mc.cores) && length(mc.cores) == 1L && !is.na(mc.cores) && mc.cores >= 1)
97126
)
98127

128+
if (is.function(strategiesR)) {
129+
if (!inherits(strategiesR, "future")) {
130+
stop(FutureEvalError(sprintf("Argument 'strategiesR' is a function, but does not inherit 'future': %s", paste(sQuote(class(strategiesR)), collapse = ", "))))
131+
}
132+
} else if (is.list(strategiesR)) {
133+
for (kk in seq_along(strategiesR)) {
134+
strategy <- strategiesR[[kk]]
135+
if (!inherits(strategy, "future")) {
136+
stop(FutureEvalError(sprintf("Element #%d of list 'strategiesR' is a function, but does not inherit 'future': %s", kk, paste(sQuote(class(strategy)), collapse = ", "))))
137+
}
138+
}
139+
} else if (is.character(strategiesR)) {
140+
} else {
141+
stop(FutureEvalError(sprintf("Unknown value of argument 'strategiesR': %s", paste(sQuote(class(strategiesR)), collapse = ", "))))
142+
}
99143

100144
## Start time for future evaluation
101145
...future.startTime <- Sys.time()
@@ -106,7 +150,7 @@ evalFuture <- function(expr, stdout = TRUE, conditionClasses = character(0L), sp
106150
## -----------------------------------------------------------------
107151
## Current working directory
108152
...future.workdir <- getwd()
109-
153+
110154
## mc.cores
111155
...future.mc.cores.old <- getOption("mc.cores")
112156

@@ -326,6 +370,14 @@ evalFuture <- function(expr, stdout = TRUE, conditionClasses = character(0L), sp
326370
...future.globalenv.names <- c(names(.GlobalEnv), "...future.value", "...future.globalenv.names", ".Random.seed")
327371
}
328372

373+
if (length(globals) > 0) {
374+
base_attach <- base::attach ## To please R CMD check
375+
base_attach(globals, pos = 2L, name = "future:globals")
376+
on.exit({
377+
detach(name = "future:globals")
378+
}, add = TRUE)
379+
}
380+
329381
## Ignore, capture or discard standard output?
330382
if (is.na(stdout)) { ## stdout = NA
331383
## Don't capture, but also don't block any output
@@ -354,9 +406,15 @@ evalFuture <- function(expr, stdout = TRUE, conditionClasses = character(0L), sp
354406
options(future.plan = NULL)
355407
Sys.unsetenv("R_FUTURE_PLAN")
356408

409+
# logme("future:plan() ...")
410+
# logme(utils::str(strategiesR))
411+
# logme(print(strategiesR))
412+
357413
## Use the next-level-down ("popped") future strategy
358414
future::plan(strategiesR, .cleanup = FALSE, .init = FALSE)
359-
415+
416+
# logme("future:plan() ... done")
417+
360418
## Temporarily set R option 'mc.cores'?
361419
if (!is.null(mc.cores)) {
362420
options(mc.cores = mc.cores)

0 commit comments

Comments
 (0)