fixed do_call

R/do_call.R

@@ -1,19 +1,30 @@
 # Updates the formals of a function with specified arguments before calling it.
 # Enables non-standard evaluation by allowing expressions in certain arguments.
-# Example: `do_call(func, list(args = bquote(.(constant_here) + symbol_here)))`
 do_call <- function(func, default = list(), fixed = list(), ...) {
-    # use `as.list()` because `formals()` returns a pairlist
-    formals <- as.environment(as.list(formals(func)))
+    # `formals()` returns a pairlist, not compatible with `list2env()`.
+    args <- list2env(as.list.default(formals(func)), parent = emptyenv())
 
-    formal_names <- names(formals)
+    params <- names(args)
 
-    # use `base::list2env()` over `utils::modifyList()` for minimal dependency
-    formals <- list2env(envir = formals, default)
-    formals <- list2env(envir = formals, list(...))
-    formals <- list2env(envir = formals, fixed)
+    args <- list2env(envir = args, default)
+    args <- list2env(envir = args, list(...))
+    args <- list2env(envir = args, fixed)
 
-    formals <- as.list.environment(formals, all.names = TRUE)[formal_names]
+    ...args <- setdiff(names(args), params)
 
-    # `func` should be non-primitive
-    `formals<-`(func, value = formals)()
+    # `func` should be non-primitive.
+    formals(func) <- lapply(
+        `names<-`(params, params), function(param) {
+            # `args[[param]]` might be a "missing symbol object".
+            # Always use the full form `args[[param]]` here.
+            # https://stackoverflow.com/questions/3892580
+            if (!is.language(args[[param]])) {
+                bquote(parent.frame()[[.(param)]])
+            } else args[[param]]
+        }
+    )
+
+    # All arguments will be evaluated within the existing `args` environment.
+    # https://stackoverflow.com/a/25371509/23137996
+    eval(as.call(c(func, lapply(`names<-`(...args, ...args), as.name))), args)
 }