R devel - May 2010 - A fix that for 'bquote' that may work (PR#14031)

--- On Fri, 6/11/09, tlumley at u.washington.edu <tlumley at
u.washington.edu> wrote:
> From: tlumley at u.washington.edu <tlumley at u.washington.edu>
> Subject: Re: [Rd] A fix that for 'bquote' that may work? (PR#14031)
> To: suharto_anggono at yahoo.com
> Cc: r-devel at stat.math.ethz.ch, R-bugs at r-project.org
> Date: Friday, 6 November, 2009, 11:42 PM
> On Thu, 5 Nov 2009, suharto_anggono at yahoo.com
> wrote:
> 
> > This is a fix for 'bquote' that may work.
> > 
> > function (expr, where =3D parent.frame())=20
> > {
> >? ? unquote <- function(e) {
> >? ? ? ? if (length(e) <=3D 1 ||
> !is.language(e))=20
> >? ? ? ? ? ? e
> >? ? ? ? else if (e[[1]] =3D=3D
> as.name("."))=20
> >? ? ? ? ? ? eval(e[[2]],
> where)
> >? ? ? ? else as.call(lapply(e,
> unquote))
> >? ? }
> >? ? unquote(substitute(expr))
> > }
> 
> If you want to use bquote() on function definitions a
> better fix is
> 
> bquote <- function (expr, where = parent.frame())
> {
> ? ? unquote <- function(e) {
> ? ? ? ? if (length(e) <= 1)
> ? ? ? ? ? ? e
> ? ? ? ? else if (e[[1]] => as.name("."))
> ? ? ? ? ? ? eval(e[[2]],
> where)
> ? ? ? ? else if (is.pairlist(e)){
> ? ? ? ? ? ?
> as.pairlist(lapply(e,unquote))
> ? ? ? ? }
> ? ? ? ? else as.call(lapply(e,
> unquote))
> ? ? }
> ? ? unquote(substitute(expr))
> }
> 
> since that now allows substitution into default arguments,
> eg
> ? default<-1
> ? g<-b2quote(function(x,y=.(default)) x+y )
> 
> 
> 
> ? ? ? ? -thomas
> 
> Thomas Lumley??? ???
> ??? Assoc. Professor, Biostatistics
> tlumley at u.washington.edu???
> University of Washington, Seattle
> 
> 
Thank you.

I have tried R 2.11.0. I see that the above is the definition of
'bquote' in R 2.11.0.

With the definition, 'bquote' does not substitute into default argument
for function with one argument.

> default <- 1
> bquote( function(y = .(default)) y )
function(y = .(default)) y
> sessionInfo()
R version 2.11.0 (2010-04-22)
i386-pc-mingw32

locale:
[1] LC_COLLATE=English_United States.1252
[2] LC_CTYPE=English_United States.1252
[3] LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C
[5] LC_TIME=English_United States.1252

attached base packages:
[1] stats? ???graphics? grDevices utils? ???datasets? methods???base


To make it also work for function with one argument, in the function
'unquote' in 'bquote', apparently is.pairlist(e) should be the
first to be checked, before checking (length(e) <= 1), for example with this
definition for 'bquote'.

function (expr, where = parent.frame())
{
    unquote <- function(e) if (is.pairlist(e))
        as.pairlist(lapply(e, unquote))
    else if (length(e) <= 1L)
        e
    else if (e[[1L]] == as.name("."))
        eval(e[[2L]], where)
    else as.call(lapply(e, unquote))
    unquote(substitute(expr))
}


There is a cosmetic problem if 'bquote' is applied to function
definition with more than one line.
> fq <- bquote(
+ function() {
+ }
+ )
> f <- eval(fq)
> str(f)
function ()
 - attr(*, "source")= language? ...

The "source" attribute of the 'eval'-ed function is a language
object. Normally, "source" attribute of a function is character.

One way to avoid that is by not changing non-call object (except pairlist) in
'unquote', for example by using this definition for 'bquote'.

function (expr, where = parent.frame())
{
? ? unquote <- function(e) if (is.pairlist(e))
? ? ? ? as.pairlist(lapply(e, unquote))
? ? else if (!is.call(e))
? ? ? ? e
? ? else if (e[[1L]] == as.name(".") && length(e) > 1L)
? ? ? ? eval(e[[2L]], where)
? ? else as.call(lapply(e, unquote))
? ? unquote(substitute(expr))
}

The logic of 'unquote' above can be written like this.
- Check if 'e' is a call object.
- If 'e' is not a call object, leave it as is, except if it is a
pairlist.
- If 'e' is a call object, check if it is a call to '.' with
argument.
If yes, 'eval' its (first) argument. If not, 'unquote' its
parts.

I assume that length of a call object is at least 1.
In my last definition above for 'unquote' in 'bquote', call
object of length 1 is not special-cased. That will allow 'bquote' to
substitute to function name for a call to function without argument. Currently,
substitution to function name only works for a call to function with argument.
> bquote
function (expr, where = parent.frame())
{
    unquote <- function(e) if (length(e) <= 1L)
        e
    else if (e[[1L]] == as.name("."))
        eval(e[[2L]], where)
    else if (is.pairlist(e))
        as.pairlist(lapply(e, unquote))
    else as.call(lapply(e, unquote))
    unquote(substitute(expr))
}
<environment: namespace:base>
> fnam <- as.name("f")
> bquote( .(fnam)() )
.(fnam)()
> bquote( .(fnam)(x) )
f(x)