Constructing functions from symbols using 'bquote' (or alternatives to doing so) - r

Question

Let's say I have an object of type "symbol" representing the name of a function. For example:
nm <- quote(mean)
I want to construct a function f whose body uses the function named by the symbol nm. For example:
f <- function(x, do = c("something", "nothing")) {
switch(match.arg(do), something = mean(x), nothing = x)
}
I want to construct this function identically, which implies that I would not be satisfied with the following approach:
factory <- function(name) {
func <- match.fun(name)
function(x, do = c("something", "nothing")) {
switch(match.arg(do), something = func(x), nothing = x)
}
}
g <- factory(nm)
since the body of g is not body(f) and the environment of g is not environment(f).
One approach that I've considered is bquote:
h <- eval(bquote({
function(x, do = c("something", "nothing")) {
switch(match.arg(do), something = .(nm)(x), nothing = x)
}
}))
bquote gets me most of the way there, but one issue is that the print output of h doesn't contain the substituted value of nm by default:
h
## function(x, do = c("something", "nothing")) {
## switch(match.arg(do), something = .(nm)(x), nothing = x)
## }
print(h, useSource = FALSE)
## function (x, do = c("something", "nothing"))
## {
## switch(match.arg(do), something = mean(x), nothing = x)
## }
The cause seems to be the srcref attribute of h:
identical(f, h)
## [1] TRUE
identical(f, h, ignore.srcref = FALSE)
## [1] FALSE
My question is: How might one approach the general problem of constructing f from nm?
My conditions on the constructed function h are that identical(f, h) should be TRUE and that the output of print(h) should contain the substituted value of nm, similar to print(f).
I would welcome answers improving on my existing bquote approach, or answers suggesting a new approach, or answers explaining why what I want to do is not actually possible...

Answer 1

Not especially elegant, but a parse(deparse( seems to work:
nm <- quote(mean)
f <- function(x, do = c("something", "nothing")) {
switch(match.arg(do), something = mean(x), nothing = x)
}
eval(parse(text=deparse(bquote(h <- function(x, do = c("something", "nothing")) {
switch(match.arg(do), something = .(nm)(x), nothing = x)
}))))
identical(f, h)
#> [1] TRUE
print(f)
#> function(x, do = c("something", "nothing")) {
#> switch(match.arg(do), something = mean(x), nothing = x)
#> }
print(h)
#> function(x, do = c("something", "nothing")) {
#> switch(match.arg(do), something = mean(x), nothing = x)
#> }
srcref is not identical, as expected:
identical(f, h, ignore.srcref = FALSE)
#> [1] FALSE
attributes(attributes(f)$srcref)$srcfile$lines
#> [1] "f <- function(x, do = c(\"something\", \"nothing\")) {"
#> [2] " switch(match.arg(do), something = mean(x), nothing = x)"
#> [3] "}"
attributes(attributes(h)$srcref)$srcfile$lines
#> [1] "h <- function(x, do = c(\"something\", \"nothing\")) {"
#> [2] " switch(match.arg(do), something = mean(x), nothing = x)"
#> [3] "}"

Answer 2

Reading through ?srcref, it seems that there are two idiomatic ways to improve the bquote approach. The first uses removeSource to recursively clean a function that preserves its source code:
h <- removeSource(eval(bquote({
function(x, do = c("something", "nothing")) {
switch(match.arg(do), something = .(nm)(x), nothing = x)
}
})))
h
function (x, do = c("something", "nothing"))
{
switch(match.arg(do), something = mean(x), nothing = x)
}
The second avoids preserving the source code altogether:
op <- options(keep.source = FALSE)
h <- eval(bquote({
function(x, do = c("something", "nothing")) {
switch(match.arg(do), something = .(nm)(x), nothing = x)
}
}))
options(op)
h
function (x, do = c("something", "nothing"))
{
switch(match.arg(do), something = mean(x), nothing = x)
}
Actually, ?options states that the default value of keep.source is interactive(), so both approaches are somewhat redundant in non-interactive contexts.