On 29/04/12 13:50, Duncan Murdoch wrote:
On 12-04-29 3:30 AM, Philippe Grosjean wrote:
> Hello,
>
> ?delayedAssign presents substitute() as a way to look at the expression
> in the promise. However,
>
> msg<- "old"
> delayedAssign("x", msg)
> msg<- "new!"
> x #- new!
> substitute(x) #- x (was 'msg' ?)
>
> Here, we just got 'x'... shouldn't we got 'msg'?
>
> Same result when the promise is not evaluated yet:
>
> delayedAssign("x", msg)
> substitute(x)
>
> In a function, that works:
>
> foo<- function (x = msg) substitute(x)
> foo()
>
> Did I misunderstood something? It seems to me that substitute() does not
> behaves as documented for promises created using delayedAssign().
I don't think this is well documented, but substitute() doesn't act the
same when its "env" argument is the global environment. So this works
the way you'd expect:
e <- new.env()
msg <- "old"
delayedAssign("x", msg, assign=e)
msg <- "new"
e$x
substitute(x, e)
I forget what the motivation was for special-casing globalenv().
Duncan Murdoch
In the corresponding C code, there is a comment telling that it is for
"historical reasons". Are these historical reasons that important that
there is no way using R code (not C code) to know if a symbol is bind to
a promise in .GlobalEnv? Anyway, I have filled a bug report because, at
least the documentation of ?delayedAssign and ?substitute should be
clarified, as well as, the example for delayedAssign... But, unless for
a good reason, it would be better to perform substitution, even in
.GlobalEnv, or alternatively, to provide a function like promiseExpr()
to get it.
Here are a couple of potentially useful functions (using the inline
package for convenience, and also note that I had to use a trick of
passing the substituted name of the variable to get the promise at the C
level... which would be unnecessary if these would be special base
functions that pass unevaluated arguments):
## is.promise(): check if a name is bind to a promise
require(inline)
code <- '
SEXP obj;
if (!isString(name) || length(name) != 1)
error("name is not a single string");
if (!isEnvironment(envir))
error("envir should be an environment");
obj = findVar(install(CHAR(STRING_ELT(name, 0))), envir);
return ScalarLogical(TYPEOF(obj) == PROMSXP);
'
is.promise <- cfunction(signature(name = "character", envir =
"environment"),
code)
formals(is.promise) <- alist(x =, name = deparse(substitute(x)),
envir = parent.frame(1))
## isEvaluated(), determine if a promise has already been evaluated
## return always TRUE is the name is bind to something else
## than a promise
code <- '
SEXP obj;
if (!isString(name) || length(name) != 1)
error("name is not a single string");
if (!isEnvironment(envir))
error("envir should be an environment");
obj = findVar(install(CHAR(STRING_ELT(name, 0))), envir);
if (TYPEOF(obj) == PROMSXP && PRVALUE(obj) == R_UnboundValue) {
return ScalarLogical(FALSE);
} else {
/* if it is not a promise, it is always evaluated! */
return ScalarLogical(TRUE);
}
'
isEvaluated <- cfunction(signature(name = "character", envir =
"environment"),
code)
formals(isEvaluated) <- alist(x =, name = deparse(substitute(x)),
envir = parent.frame(1))
## promiseExpr() retrieve the expression associated with a promise...
## even if it is in .GlobalEnv, what subsitute() does not!
code <- '
SEXP obj;
if (!isString(name) || length(name) != 1)
error("name is not a single string");
if (!isEnvironment(envir))
error("envir should be an environment");
obj = findVar(install(CHAR(STRING_ELT(name, 0))), envir);
if (TYPEOF(obj) == PROMSXP) {
return PREXPR(obj);
} else {
return R_NilValue;
}
'
promiseExpr <- cfunction(signature(name = "character", envir =
"environment"),
code)
formals(promiseExpr) <- alist(x =, name = deparse(substitute(x)),
envir = parent.frame(1))
## promiseEnv() get the evaluation environment associated with a promise
code <- '
SEXP obj;
if (!isString(name) || length(name) != 1)
error("name is not a single string");
if (!isEnvironment(envir))
error("envir should be an environment");
obj = findVar(install(CHAR(STRING_ELT(name, 0))), envir);
if (TYPEOF(obj) == PROMSXP) {
return PRENV(obj);
} else {
return R_NilValue;
}
'
promiseEnv <- cfunction(signature(name = "character", envir =
"environment"),
code)
formals(promiseEnv) <- alist(x =, name = deparse(substitute(x)),
envir = parent.frame(1))
## reeval() reavaluate a promise that has been already evaluated,
## An environment for the evaluation is required since PRENV is set
## to NULL on promise evaluation
code <- '
SEXP obj;
if (!isString(name) || length(name) != 1)
error("name is not a single string");
if (!isEnvironment(envir))
error("envir should be an environment");
if (!isEnvironment(evalenv))
error("evalenv should be an environment");
obj = findVar(install(CHAR(STRING_ELT(name, 0))), envir);
if (TYPEOF(obj) == PROMSXP) {
/* TODO: should we use the same precautions as in forcePromise(), line
297 of eval.c? */
/* TODO: what to do here, if not evaluated yet?*/
SEXP val;
val = eval(PRCODE(obj), evalenv);
SET_PRVALUE(obj, val);
return PRVALUE(obj);
} else {
return R_NilValue;
}
'
reeval <- cfunction(signature(name = "character", envir = "environment",
evalenv = "environment"), code)
formals(reeval) <- alist(x =, name = deparse(substitute(x)),
envir = parent.frame(1), evalenv = parent.frame(1))
rm(code)
msg <- "old"
delayedAssign("x", msg)
y <- msg
is.promise(x) # TRUE
isEvaluated(x) # FALSE, promise not evaluated yet!
is.promise(y) # FALSE
isEvaluated(y) # TRUE (always when not a promise)
msg <- "new"
x
y
is.promise(x) # Still TRUE
isEvaluated(x) # Now TRUE, the promise is evaluated
promiseExpr(x) # Also work in .GlobalEnv, on the contrary to
substitute()! For "historical" reasons!
promiseExpr(y) # NULL because it is not a promise
promiseEnv(x) # It becomes NULL once the promise is evaluated!
msg <- "brand new message..."
x
reeval(x)
x
Best,
Philippe Grosjean
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
