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

From: Philippe Grosjean <phgrosjean_at_sciviews.org>
Date: Tue, 01 May 2012 22:21:43 +0200

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_at_r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel Received on Tue 01 May 2012 - 20:23:54 GMT

This quarter's messages: by month, or sorted: [ by date ] [ by thread ] [ by subject ] [ by author ]

All messages

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.2.0, at Tue 01 May 2012 - 21:10:52 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-devel. Please read the posting guide before posting to the list.

list of date sections of archive