Handle primitive functions in pluck()

Closes #404

NEWS.md

@@ -64,6 +64,8 @@ reduce2_right(.x = letters[1:4], .y = paste2, .f = c("-", ".", "-")) # working
 
 ## Minor improvements and fixes
 
+* `pluck()` now supports primitive functions (#404).
+
 * New `.rev` argument in `compose()`. If set to `FALSE`, the functions
   are composed from left to right rather than right to left.
 

src/pluck.c

@@ -150,13 +150,23 @@ SEXP extract_s4(SEXP x, SEXP index_i, int i, bool strict) {
   return Rf_getAttrib(x, sym);
 }
 
-SEXP extract_clo(SEXP x, SEXP clo) {
+SEXP extract_fn(SEXP x, SEXP clo) {
   SEXP expr = PROTECT(Rf_lang2(clo, x));
   SEXP out = Rf_eval(expr, R_GlobalEnv);
 
   UNPROTECT(1);
   return out;
 }
+static bool is_function(SEXP x) {
+  switch (TYPEOF(x)) {
+  case CLOSXP:
+  case BUILTINSXP:
+  case SPECIALSXP:
+    return true;
+  default:
+    return false;
+  }
+}
 
 SEXP pluck_impl(SEXP x, SEXP index, SEXP missing, SEXP strict_arg) {
   if (TYPEOF(index) != VECSXP) {
@@ -169,8 +179,8 @@ SEXP pluck_impl(SEXP x, SEXP index, SEXP missing, SEXP strict_arg) {
   for (int i = 0; i < n; ++i) {
     SEXP index_i = VECTOR_ELT(index, i);
 
-    if (TYPEOF(index_i) == CLOSXP) {
-      x = extract_clo(x, index_i);
+    if (is_function(index_i)) {
+      x = extract_fn(x, index_i);
       continue;
     }
 

tests/testthat/test-pluck.R

@@ -90,7 +90,7 @@ test_that("supports splicing", {
 })
 
 
-# closures ----------------------------------------------------------------
+# functions ---------------------------------------------------------------
 
 test_that("can pluck attributes", {
   x <- structure(
@@ -132,6 +132,11 @@ test_that("pluck() dispatches on global methods", {
   expect_identical(pluck(iris, "Species", levels), levels(iris$Species))
 })
 
+test_that("pluck() supports primitive functions (#404)", {
+  x <- list(a = "apple", n = 3, v = 1:5)
+  expect_identical(pluck(x, "n", as.character), "3")
+})
+
 
 # attribute extraction ----------------------------------------------------