11 Expressions

This chapter was written and contributed by Peter Hurford.

11.1 Structure of expressions

  1. Q: There’s no existing base function that checks if an element is a valid component of an expression (i.e., it’s a constant, name, call, or pairlist). Implement one by guessing the names of the “is” functions for calls, names, and pairlists.

    A:

    is.expression_component <- function(x) {
  x <- substitute(x)
  (is.atomic(x) & length(x) == 1) | is.call(x) | is.name(x) | is.pairlist(x)
}

  2. Q: pryr::ast() uses non-standard evaluation. What’s its escape hatch to standard evaluation?

    A: You can call pryr::call_tree directly.

  3. Q: What does the call tree of an if statement with multiple else conditions look like?

    A: It depends a little bit how it is written. Here the infix version:

    pryr::ast(`if`(FALSE, "first",
               `if`(TRUE, "second",
                    `if`(TRUE, "third", "fourth"))))
#> \- ()
#>   \- `if
#>   \-  FALSE
#>   \-  "first"
#>   \- ()
#>     \- `if
#>     \-  TRUE
#>     \-  "second"
#>     \- ()
#>       \- `if
#>       \-  TRUE
#>       \-  "third"
#>       \-  "fourth"

    And here the “normal” version:

    pryr::ast(if (FALSE) {
  "first"
  } else (
    if (TRUE) {
      "second"
      } else (
        if (TRUE) {
          "third"
          } else (
            "fourth"
            )
        )
    ))
#> \- ()
#>   \- `if
#>   \-  FALSE
#>   \- ()
#>     \- `{
#>     \-  "first"
#>   \- ()
#>     \- `(
#>     \- ()
#>       \- `if
#>       \-  TRUE
#>       \- ()
#>         \- `{
#>         \-  "second"
#>       \- ()
#>         \- `(
#>         \- ()
#>           \- `if
#>           \-  TRUE
#>           \- ()
#>             \- `{
#>             \-  "third"
#>           \- ()
#>             \- `(
#>             \-  "fourth"

    However, under the hood the language will call another base if statement. So else if seems to be for human readibility.

  4. Q: Compare ast(x + y %+% z) to ast(x ^ y %+% z). What do they tell you about the precedence of custom infix functions?

    A: Comparison of the syntax trees:

    # for ast(x + y %+% z)
# y %+% z will be calculated first and the result will be added to x
pryr::ast(x + y %+% z)
#> \- ()
#>   \- `+
#>   \- `x
#>   \- ()
#>     \- `%+%
#>     \- `y
#>     \- `z

# for ast(x ^ y %+% z)
# x^y will be calculated first, and the result will be used as first argument of `%+%()`
pryr::ast(x ^ y %+% z)
#> \- ()
#>   \- `%+%
#>   \- ()
#>     \- `^
#>     \- `x
#>     \- `y
#>   \- `z

    So we can conclude that custom infix functions must have a precedence between addition and exponentiation. The general precedence rules can be found for example here.

  5. Q: Why can’t an expression contain an atomic vector of length greater than one? Which one of the six types of atomic vector can’t appear in an expression? Why?

    A: Because you can’t type an expression that evaluates to an atomic of greater length than one without using a function (in particular, the function c), which means that these expressions would be calls.

    We can illustrate that via an example:

    is.atomic(quote(1)) # is an atomic
#> [1] TRUE
is.atomic(quote(c(1,1))) # is not an atomic (it just would evaluate to an atomic).
#> [1] FALSE
is.call(quote(c(1,1))) # however it is still a call (so at least a valid expression).
#> [1] TRUE

    Also raws can’t appear in expressions, because of a similar reason. We think they are impossible to construct without using as.raw, which would mean that we will also end up with a call.

    For similar reasons also complex numbers won’t work

    (function(x){is.atomic(x) & length(x) == 1})(quote(1 + 1.5i))
#> [1] FALSE

# however, imaginary parts of complex numbers work:
pryr::ast(1i)
#> \-  0+1i

11.2 Names

  1. Q: You can use formals() to both get and set the arguments of a function. Use formals() to modify the following function so that the default value of x is missing and y is 10.

    g <- function(x = 20, y) {
  x + y
}

    A:

    formals(g) <- alist(x = , y = 10)

    Similarly one can change the body of the function through body<-() and also the environment via environment<-().

  2. Q: Write an equivalent to get() using as.name() and eval(). Write an equivalent to assign() using as.name(), substitute(), and eval(). (Don’t worry about the multiple ways of choosing an environment; assume that the user supplies it explicitly.)

    A:

    get3 <- function(x, env = parent.frame()) {
  eval(as.name(x), env)
}

assign3 <- function(x, value, env = parent.frame()) {
  eval(substitute(x <- value,list(x = as.name(x), value = value)), env)
  if (length(x) > 1) {
    warning("Only the first element is used as variable name.")
  }
}

11.3 Calls

  1. Q: The following two calls look the same, but are actually different:

    (a <- call("mean", 1:10))
#> mean(1:10)
(b <- call("mean", quote(1:10)))
#> mean(1:10)
identical(a, b)
#> [1] FALSE

    What’s the difference? Which one should you prefer?

    A: call evalulates its ... arguments. So in the first call 1:10 will be evaluated to an integer (1, 2, 3, …, 10) and in the second call quote() compensates the effect of the evaluation, so that b’s second element will be the expression 1:10 (which is again a call):

    as.list(a)
#> [[1]]
#> mean
#> 
#> [[2]]
#>  [1]  1  2  3  4  5  6  7  8  9 10
as.list(b)
#> [[1]]
#> mean
#> 
#> [[2]]
#> 1:10

    We can create an example, where we can see the consequences directly:

    arg <- seq(10)
call1 <- call("mean", arg)
print(call1)
#> mean(1:10)
call2 <- call("mean", quote(arg))
print(call2)
#> mean(arg)
eval(call1)
#> [1] 5.5
eval(call2)
#> [1] 5.5

    I would prefer the second version, since it behaves more like lazy evaluation. It’s better to have call args depends on the calling environment rather than the enclosing environment,that’s more similar to normal function behavior.

  2. Q: Implement a pure R version of do.call().

    A:

    do.call2 <- function(what, args, quote = FALSE, env = parent.frame()) {
  if (!is.list(args)) {
    stop("second argument must be a list")
  }
  if (isTRUE(quote)) {
    args <- lapply(args, enquote)
  }
  eval(as.call(c(what, args)), env)
}

  3. Q: Concatenating a call and an expression with c() creates a list. Implement concat() so that the following code works to combine a call and an additional argument.

    concat(quote(f), a = 1, b = quote(mean(a)))
#> f(a = 1, b = mean(a))

    A:

    concat <- function(f, ...) {
  as.call(c(f, list(...)))
}
concat(quote(f), a = 1, b = quote(mean(a)))
#> f(a = 1, b = mean(a))

  4. Q: Since list()s don’t belong in expressions, we could create a more convenient call constructor that automatically combines lists into the arguments. Implement make_call() so that the following code works.

    make_call(quote(mean), list(quote(x), na.rm = TRUE))
#> mean(x, na.rm = TRUE)
make_call(quote(mean), quote(x), na.rm = TRUE)
#> mean(x, na.rm = TRUE)

    A:

    make_call <- function(x, ...) {
  as.call(c(x, ...))
}

make_call(quote(mean), list(quote(x), na.rm = TRUE))
#> mean(x, na.rm = TRUE)
make_call(quote(mean), quote(x), na.rm = TRUE)
#> mean(x, na.rm = TRUE)

  5. Q: How does mode<- work? How does it use call()?

    A: We can explain it best, when we comment the source code:

    function (x) {
  # when x is an expression, mode(x) will return "expression"
  if (is.expression(x)) 
    return("expression")
  # when x is a call (or language, which is exactly the same), the first element 
  # of the call will be coerced to character. 
  # If the call is an autoprinting (like in quote((1))), mode will return "(".
  # For any other call, mode will return "call" 
  if (is.call(x)) 
    return(switch(deparse(x[[1L]])[1L], `(` = "(", "call"))
  # if x is a name (or a symbol, which is exactly the same), then mode will return "name"
  if (is.name(x)) 
    "name"
  # otherwise, mode will return dependent on typeof(x). If typeof(x) is double or integer, 
  # mode will return "numeric". If typeof(x) is closure, builtin or special, mode(x) will
  # return "function". And in all other cases, mode will just return typeof(x)
  else switch(tx <- typeof(x), double = , integer = "numeric", 
              closure = , builtin = , special = "function", tx)
  }
<bytecode: 0x000000000c4e66e0>
  <environment: namespace:base>

    As commented above, mode() uses is.call() to distinguish autoprint- and “normal” calls with the help of a separate switch().

  6. Q: Read the source for pryr::standardise_call(). How does it work? Why is is.primitive() needed?

    A: It evaluates the first element of the call, which is usually the name of a function, but can also be another call. Then is uses match.call() to get the standard names for all the arguments.

    is.primitive() is used as an escape to just return the call instead of using match.call() if the function passed is a primitive. This is done because match.call() does not work for primitives.

  7. Q: standardise_call() doesn’t work so well for the following calls. Why?

    library(pryr)
#> 
#> Attaching package: 'pryr'
#> The following object is masked _by_ '.GlobalEnv':
#> 
#>     make_call
standardise_call(quote(mean(1:10, na.rm = TRUE)))
#> mean(x = 1:10, na.rm = TRUE)
standardise_call(quote(mean(n = T, 1:10)))
#> mean(x = 1:10, n = T)
standardise_call(quote(mean(x = 1:10, , TRUE)))
#> mean(x = 1:10, , TRUE)

    A: The reason these don’t work is not that mean is a primitive (as seen in exercise 6) – it’s not – but because mean uses S3 dispatch (i.e., UseMethod) and therefore does not store its formals on mean, but rather mean.default. For example, pryr::standardize_call can do much better when the S3 dispatch is explicit.

    For example, this works:

    pryr::standardise_call(quote(mean.default(n = T, 1:10)))
#> mean.default(x = 1:10, na.rm = T)

  8. Q: Read the documentation for pryr::modify_call(). How do you think it works? Read the source code.

    A: Again, we explain by commenting the source.

    function (call, new_args) {
  # check if call is a call and new_args is a list
  stopifnot(is.call(call), is.list(new_args))
  # standardise the call
  call <- standardise_call(call)
  # check if the supplied new_args list has any unnamed elements.
  # if so, an error occurs.
  nms <- names(new_args) %||% rep("", length(new_args))
  if (any(nms == "")) {
    stop("All new arguments must be named", call. = FALSE)
    }
  # every name element of the call, for which a new argument was supplied by the user,
  # becomes overwritten
  for (nm in nms) {
    call[[nm]] <- new_args[[nm]]
    }
  # finally the modified call is returned
  call
}
<environment: namespace:pryr>

  9. Q: Use ast() and experimentation to figure out the three arguments in an if() call. Which components are required? What are the arguments to the for() and while() calls?

    A:

    if:

    ## All these return an error
# pryr::ast(if)
# pryr::ast(if())
# pryr::ast(if{})
# pryr::ast(if(){})
# pryr::ast(if(TRUE))

## This is the minimum required
pryr::ast(if(TRUE){1})
#> \- ()
#>   \- `if
#>   \-  TRUE
#>   \- ()
#>     \- `{
#>     \-  1

## One can also supply an alternative expression
pryr::ast(if(TRUE){}
          else {3})
#> \- ()
#>   \- `if
#>   \-  TRUE
#>   \- ()
#>     \- `{
#>   \- ()
#>     \- `{
#>     \-  3

## However, one has to supply the compound expression (the first one),
## otherwise we get an error
# pryr::ast(if(TRUE)
#           else {3})

# So this is how if basically works
pryr::ast(if(cond)expr)
#> \- ()
#>   \- `if
#>   \- `cond
#>   \- `expr

# and here within a call
eval(call("if", TRUE, 1))
#> [1] 1
eval(call("if", TRUE, 1, 2))
#> [1] 1
eval(call("if", FALSE, 1, 2))
#> [1] 2

    for:

    ## All these return an error
# pryr::ast(for)
# pryr::ast(for{})
# pryr::ast(for())
# pryr::ast(for(){})
# pryr::ast(for(in){})
# pryr::ast(for(var in){})
# pryr::ast(for(var in 10))
# pryr::ast(for(in 10){})

## This is the minimum required
pryr::ast(for(var in 10){})
#> \- ()
#>   \- `for
#>   \- `var
#>   \-  10
#>   \- ()
#>     \- `{

## So this is how for basically works
pryr::ast(for(var in seq)expr)
#> \- ()
#>   \- `for
#>   \- `var
#>   \- `seq
#>   \- `expr

## And here within a call (note that we need quote, since var has to be a nanme
## and expr has to be an expression)
eval(call("for", var = quote(i), seq = 1:3, expr = quote(print(i))))
#> [1] 1
#> [1] 2
#> [1] 3

## as infix function it looks a little bit easier
`for`(i, 1:3, print(i))
#> [1] 1
#> [1] 2
#> [1] 3

    while:

    ## All these return an error
# pryr::ast(while)
# pryr::ast(while())
# pryr::ast(while(TRUE))
# pryr::ast(while(){})
# pryr::ast(while()1)
# pryr::ast(while(TRUE){})

## This is the minimum required
pryr::ast(while(TRUE)1)
#> \- ()
#>   \- `while
#>   \-  TRUE
#>   \-  1

## So this is how while basically works
pryr::ast(while(cond)expr)
#> \- ()
#>   \- `while
#>   \- `cond
#>   \- `expr

## And here within a call (infinite loop in this case)
# eval(call("while", TRUE , 1))

11.4 Capturing the current call

  1. Q: Compare and contrast update_model() with update.default().

    A:

    update_call <- function (object, formula_, ...) {
  call <- object$call
  if (!missing(formula_)) {
    call$formula <- update.formula(formula(object), formula_)
    }
  pryr::modify_call(call, pryr::dots(...))
}

update_model <- function(object, formula_, ...) {
  call <- update_call(object, formula_, ...)
  eval(call, environment(formula(object)))
}

    update_model always evaluates the resulting call, whereas update.default can return the call without evaluation if evaluate = FALSE.

    update.default evaluates the call in the environment where update.default was called, whereas update_model evaluates the call within the environment of the object passed.

    update.default handles some extras whereas update_model does not.

    update_model’s syntax is less verbose and easier to read.

  2. Q: Why doesn’t write.csv(mtcars, "mtcars.csv", row = FALSE) work? What property of argument matching has the original author forgotten?

    A: write.csv rewrites the call. While doing this, the author explicitly matches the argument names, forgetting that this is too strict, since R does also partial matching.

  3. Q: Rewrite update.formula() to use R code instead of C code.

    A:

    modify_formula <- function(old, new) {
  old_lhs <- old[[2]]
  old_rhs <- old[[3]]
  if (length(new) == 2) {
    new_lhs <- old_lhs
    new_rhs <- new[[2]]
    } else {
      new_lhs <- new[[2]]
      new_rhs <- new[[3]]
    }

  new_lhs_ <- gsub(".", deparse(old_lhs), deparse(new_lhs), fixed = TRUE)
  new_rhs_ <- gsub(".", deparse(old_rhs), deparse(new_rhs), fixed = TRUE)
  as.formula(paste(new_lhs_, "~", new_rhs_))
}

modify_formula(y ~ x, ~ . + x2)
#> y ~ x + x2
#> <environment: 0x55876b15d168>
update.formula(y ~ x, ~ . + x2)
#> y ~ x + x2
update.formula(y ~ x, log(.) ~ .)
#> log(y) ~ x
modify_formula(y ~ x, log(.) ~ .)
#> log(y) ~ x
#> <environment: 0x55876b2f6b88>
update.formula(. ~ u+v, res ~ .)
#> res ~ u + v
modify_formula(. ~ u+v, res ~ .)
#> res ~ u + v
#> <environment: 0x55876b889638>

  4. Q: Sometimes it’s necessary to uncover the function that called the function that called the current function (i.e., the grandparent, not the parent). How can you use sys.call() or match.call() to find this function?

    A: You can use sys.call(-2).

    child_fn <- function() {
  message("I am the child_fn")
  message("My parent is ", sys.call(-1))
  message("My grandparent is ", sys.call(-2))
}

daddy_fn <- function() { child_fn() }
grandpa_fn <- function() { daddy_fn() }
grandpa_fn()
#> I am the child_fn
#> My parent is daddy_fn
#> My grandparent is grandpa_fn

11.5 Pairlists

  1. Q: How are alist(a) and alist(a = ) different? Think about both the input and the output.

    A: alist(a) returns an unnamed list of length 1 with the first element being the name a (note that this refers to the name class, which is distinct from being named a), so it is unsuitable for use in a function. alist(a = ) returns a named list with the first element having name a and the first element being empty.

  2. Q: Read the documentation and source code for pryr::partial(). What does it do? How does it work? Read the documentation and source code for pryr::unenclose(). What does it do and how does it work?

    A: pryr::partial takes a function and arguments and then constructs a call of that function with those args. pryr::unenclose takes a closure and substitutes the variables in that closure for its values found in its environment, which results in the explicit function.

  3. Q: The actual implementation of curve() looks more like

    curve3 <- function(expr, xlim = c(0, 1), n = 100, env = parent.frame()) {
  env2 <- new.env(parent = env)
  env2$x <- seq(xlim[1], xlim[2], length = n)
  y <- eval(substitute(expr), env2)
  plot(env2$x, y, type = "l", ylab = deparse(substitute(expr)))
}
    curve2 <- function(expr, xlim = c(0, 1), n = 100, env = parent.frame()) {
  f <- pryr::make_function(alist(x = ), substitute(expr), env)
  x <- seq(xlim[1], xlim[2], length = n)
  y <- f(x)
  plot(x, y, type = "l", ylab = deparse(substitute(expr)))
}

    How does this approach differ from curve2() defined above?

    A: curve2 uses pryr::make_function instead of creating an env and evaluating within it.

11.6 Parsing and deparsing

  1. Q: What are the differences between quote() and expression()?

    A: The main difference is that an expression object returned by expression is a list of expressions, whereas a quote is a single expression. See:

    as.list(expression( 2*3))
#> [[1]]
#> 2 * 3
as.list(quote(2*3))
#> [[1]]
#> `*`
#> 
#> [[2]]
#> [1] 2
#> 
#> [[3]]
#> [1] 3

  2. Q: Read the help for deparse() and construct a call that deparse() and parse() do not operate symmetrically on.

    A: parse and deparse handle length > 1 vectors differently.

    parse(text = c(1, 2, 3))
#> expression(1, 2, 3)
deparse(c(1, 2, 3))
#> [1] "c(1, 2, 3)"

  3. Q: Compare and contrast source() and sys.source().

    A: source is a standardGeneric created from the base package, whereas sys.source is a function exported from base. source has many more options than sys.source. source can accept data from connections other than files, whereas sys.source cannot. sys.source which is a streamlined version to source a file into an environment.

  4. Q: Modify simple_source() so it returns the result of every expression, not just the last one.

    A:

            simple_source <- function(file, envir = new.env()) {
            stopifnot(file.exists(file))
            stopifnot(is.environment(envir))
            lines <- readLines(file, warn = FALSE)
            exprs <- parse(text = lines)
            if (length(exprs) == 0L) return(invisible())
            invisible(lapply(exprs, function(expr) { eval(expr, envir) }))
        }

  5. Q: The code generated by simple_source() lacks source references. Read the source code for sys.source() and the help for srcfilecopy(), then modify simple_source() to preserve source references. You can test your code by sourcing a function that contains a comment. If successful, when you look at the function, you’ll see the comment and not just the source code.

    A:

            simple_source <- function(file, envir = new.env()) {
            stopifnot(file.exists(file))
            stopifnot(is.environment(envir))
            lines <- readLines(file, warn = FALSE)
            srcfile <- srcfilecopy(file, lines, file.mtime(file), isFile = TRUE)
            exprs <- parse(text = lines, srcfile = srcfile, keep.source = TRUE)
            if (length(exprs) == 0L) return(invisible())
            invisible(lapply(exprs, function(expr) { eval(expr, envir) }))
        }

11.7 Walking the AST with recursive functions

  1. Q: Why does logical_abbr() use a for loop instead of a functional like lapply()?

    A: The loop performs better because it allows for early returns. The return(TRUE) in the loop within logical_abbr() allows the loop to return at the first sign of TRUE, rather than executing the entire loop, and this saves a lot of time. Also, the loop seems a lot more readible.

  2. Q: logical_abbr() works when given quoted objects, but doesn’t work when given an existing function, as in the example below. Why not? How could you modify logical_abbr() to work with functions? Think about what components make up a function.

    A:

    logical_abbr <- function(x) {
  if (is.atomic(x)) {
    FALSE
    } else if (is.name(x)) {
      identical(x, quote(T)) || identical(x, quote(F))
    } else if (is.call(x) || is.pairlist(x)) {
      for (i in seq_along(x)) {
        if (logical_abbr(x[[i]])) return(TRUE)
    }
      FALSE
    } else if (is.function(x)) {  # Add this to handle functions.
      logical_abbr(body(x)) || logical_abbr(formals(x))
    }  else {
      stop("Don't know how to handle type ", typeof(x), 
           call. = FALSE)
    }
}
        f <- function(x = TRUE) {
          g(x + T)
        }

logical_abbr(f)
#> [1] TRUE

  3. Q: Write a function called ast_type() that returns either “constant”, “name”, “call”, or “pairlist”. Rewrite logical_abbr(), find_assign(), and bquote2() to use this function with switch() instead of nested if statements.

    A:

            ast_type <- function(x) {
            if (is.atomic(x)) return("constant")
            if (is.name(x)) return("name")
            if (is.call(x)) return("call")
            if (is.pairlist(x)) return("pairlist")
            "Other"
        }

        logical_abbr <- function(x) {
            switch(ast_type(x),
                "constant" = FALSE,
                "name" = logical_abbr.name(x),
                "call" = logical_abbr.call(x),
                "pairlist" = logical_abbr.call(x)
            )
        }

        logical_abbr.name <- function(x) {
            identical(x, quote(T)) || identical(x, quote(F))
        }

        logical_abbr.call <- function(x) {
            for (i in seq_along(x)) {
                if (logical_abbr(x[[i]])) return(TRUE)
            }
            FALSE
        }

        find_assign <- function(x) {
            switch(ast_type(x),
                "constant" = character(),
                "name" = character(),
                "call" = find_assign.call(x),
                "pairlist" = find_assign.pairlist(x)
            )
        }

        find_assign.call <- function(x) {
            lhs <- if (identical(x[[1]], quote(`<-`)) && is.name(x[[2]])) {
                as.character(x[[2]])
            } else { character() }
            unique(c(lhs, unlist(lapply(x, find_assign))))
        }

        find_assign.pairlist <- function(x) {
            unique(unlist(lapply(x, find_assign)))
        }

        bquote2 <- function(x, where = parent.frame()) {
            switch(ast_type(x),
                "constant" = x,
                "name" = x,
                "call" = bquote2.call(x, where),
                "pairlist" = bquote2.pairlist(x, where)
            )
        }

        bquote2.call <- function(x, where) {
            if (identical(x[[1]], quote(.))) {
                # Call to .(), so evaluate
                eval(x[[2]], where)
            } else {
                # Otherwise apply recursively, turning result back into call
                as.call(lapply(x, bquote2, where = where))
            }
        }

bquote2.pairlist <- function(x, where) {
            as.pairlist(lapply(x, bquote2, where = where))
        }

  4. Q: Write a function that extracts all calls to a function. Compare your function to pryr::fun_calls().

    A:

            get_calls <- function(expr) {
            to_call <- function(expr) { Filter(is.call, as.list(expr)) }
            unique(as.character(unlist(lapply(expr, function(x) {
                if (length(to_call(x)) > 0) { get_calls(x) }
                else if (is.call(x) || is.name(x)) { x }
            }))))
        }
    While both `pryr::fun_calls` and `get_calls` are recursive, `get_calls` is loop-based. This is potentially less efficient. Notably, `pryr::fun_calls` executes about 6x faster than `get_calls`.

`get_calls` has the ability to extract calls from the formals of a function, whereas `pryr::fun_calls` cannot do that.

`get_calls` can return an entire call (i.e., "get_calls(x)") whereas `pryr::fun_calls` can only return the call name.

However, `get_calls` sometimes accidentally returns variable names, whereas `pryr::fun_calls` does not make this mistake.

`pryr::fun_calls` is also more readable.

  5. Q: Write a wrapper around bquote2() that does non-standard evaluation so that you don’t need to explicitly quote() the input.

    A:

    bquote2 <- function (x, where = parent.frame()) {
  bquote_fn <- function(x, where) {
    if (is.atomic(x) || is.name(x)) {x}
    else if (is.call(x)) {
      if (identical(x[[1]], quote(.))) {
        eval(x[[2]], where)
      } else {
        as.call(lapply(x, bquote_fn, where = where))
      }
    } else if (is.pairlist(x)) {
        as.pairlist(lapply(x, bquote_fn, where = where))
    } else {
        stop("Don't know how to handle type ", typeof(x), call. = FALSE)
    }
  }
  bquote_fn(substitute(x), where)
}

bquote2(x == .(x))

  6. Q: Compare bquote2() to bquote(). There is a subtle bug in bquote(): it won’t replace calls to functions with no arguments. Why?

    bquote(.(x)(), list(x = quote(f)))
#> .(x)()
bquote(.(x)(1), list(x = quote(f)))
#> f(1)

    A:

    Here's the source for `bquote` (from `base`):
    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[[2]], where)
                } else { as.call(lapply(e, unquote)) }
            }
            unquote(substitute(expr))
        }
    The subtle bug is on the line `else if (length(e) <= 1L) { e }`, where it returns `e` if `length(e)` is <= 1. `length(substitute(.(x)()))` is 1, so it will just be returned instead of parsed.

  7. Q: Improve the base recurse_call() template to also work with lists of functions and expressions (e.g., as from parse(path_to_file)).

    A:

    recurse_call <- function(x) {
  if (is.atomic(x)) {
    # Return a value
  } else if (is.name(x)) {
    # Return a value
  } else if (is.expression(x)) {  # Expansion goes here to handle expressions!
                # Return a value
  } else if (is.call(x)) {
    # Call recurse_call recursively
  } else if (is.pairlist(x)) {
    # Call recurse_call recursively
  } else if (is.list(x)) {  # Expansion goes here to handle lists!
    # Call recurse_call recursively
  } else {
    stop("Don't know how to handle type ", typeof(x), call. = FALSE)
  }
}

    For example, we can extend logical_abbr as follows:

            logical_abbr <- function(x) {
            if (is.atomic(x)) {
                FALSE
            } else if (is.name(x)) {
                identical(x, quote(T)) || identical(x, quote(F))
            } else if (is.expression(x)) { # Added this part to `logical_abbr` to handle expressions.
                identical(x[[1]], quote(T)) || identical(x[[1]], quote(F))
            } else if (is.call(x) || is.pairlist(x)) {
                for (i in seq_along(x)) {
                    if (logical_abbr(x[[i]])) return(TRUE)
                }
                FALSE
            } else if (is.list(x)) { # Added this part to `logical_abbr` handle lists.
                lapply(x, logical_abbr)
            } else {
                stop("Don't know how to handle type ", typeof(x), call. = FALSE)
            }
        }
        logical_abbr(quote(TRUE))
#> [1] FALSE
        logical_abbr(quote(T))
#> [1] TRUE
        logical_abbr(expression(TRUE))
#> [1] FALSE
        logical_abbr(expression(T))
#> [1] TRUE
        logical_abbr(list(quote(T), quote(F), quote(TRUE)))
#> [[1]]
#> [1] TRUE
#> 
#> [[2]]
#> [1] TRUE
#> 
#> [[3]]
#> [1] FALSE