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






______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel

Reply via email to