[Rd] A doubt about substitute() after delayedAssign()

[Duncan Murdoch]

On 12-05-01 4:21 PM, Philippe Grosjean wrote:
> 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?

I don't know.  I believe I lost an argument similar to yours a few years 
ago, so I won't spend time on this again.

Duncan Murdoch

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
>
>
>
>
>