A doubt about substitute() after delayedAssign()

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