Eliminate ATTRIB() use

compile_commands.json

@@ -0,0 +1,22 @@
+[
+    {
+        "command": "clang++ -arch arm64 -std=gnu++17 -I\"/Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/include\" -DNDEBUG  -I\"/Users/hadleywickham/Library/R/arm64/4.5/library/cpp11/include\" -I/opt/R/arm64/include    -fPIC  -falign-functions=64 -Wall -g -O2   -c address.cpp -o address.o",
+        "file": "address.cpp",
+        "directory": "/Users/hadleywickham/Documents/r-lib/lobstr/src"
+    },
+    {
+        "command": "clang++ -arch arm64 -std=gnu++17 -I\"/Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/include\" -DNDEBUG  -I\"/Users/hadleywickham/Library/R/arm64/4.5/library/cpp11/include\" -I/opt/R/arm64/include    -fPIC  -falign-functions=64 -Wall -g -O2   -c cpp11.cpp -o cpp11.o",
+        "file": "cpp11.cpp",
+        "directory": "/Users/hadleywickham/Documents/r-lib/lobstr/src"
+    },
+    {
+        "command": "clang++ -arch arm64 -std=gnu++17 -I\"/Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/include\" -DNDEBUG  -I\"/Users/hadleywickham/Library/R/arm64/4.5/library/cpp11/include\" -I/opt/R/arm64/include    -fPIC  -falign-functions=64 -Wall -g -O2   -c inspect.cpp -o inspect.o",
+        "file": "inspect.cpp",
+        "directory": "/Users/hadleywickham/Documents/r-lib/lobstr/src"
+    },
+    {
+        "command": "clang++ -arch arm64 -std=gnu++17 -I\"/Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/include\" -DNDEBUG  -I\"/Users/hadleywickham/Library/R/arm64/4.5/library/cpp11/include\" -I/opt/R/arm64/include    -fPIC  -falign-functions=64 -Wall -g -O2   -c size.cpp -o size.o",
+        "file": "size.cpp",
+        "directory": "/Users/hadleywickham/Documents/r-lib/lobstr/src"
+    }
+]

src/inspect.cpp

@@ -320,9 +320,39 @@ SEXP obj_children_(
     }
   }
 
-  // CHARSXPs have fake attriibutes
-  if (max_depth > 0 && TYPEOF(x) != CHARSXP && !Rf_isNull(ATTRIB(x))) {
-    recurse(&children, seen, "_attrib", ATTRIB(x), max_depth, expand);
+  // CHARSXPs have fake attributes
+  if (max_depth > 0 && TYPEOF(x) != CHARSXP && ANY_ATTRIB(x)) {
+    // Count attributes
+    R_xlen_t n_attribs = 0;
+    R_mapAttrib(x, [](SEXP tag, SEXP val, void* data) -> SEXP {
+      (*(R_xlen_t*)data)++;
+      return NULL;
+    }, &n_attribs);
+
+    // Build a list of attribute values
+    struct CollectData { SEXP vals; SEXP names; R_xlen_t i; bool any_named; };
+    SEXP attrib_vals = PROTECT(Rf_allocVector(VECSXP, n_attribs));
+    SEXP attrib_names = PROTECT(Rf_allocVector(STRSXP, n_attribs));
+    CollectData cd = {attrib_vals, attrib_names, 0, false};
+
+    R_mapAttrib(x, [](SEXP tag, SEXP val, void* data) -> SEXP {
+      CollectData* d = (CollectData*)data;
+      SET_VECTOR_ELT(d->vals, d->i, val);
+      if (TYPEOF(tag) == SYMSXP) {
+        SET_STRING_ELT(d->names, d->i, PRINTNAME(tag));
+        d->any_named = true;
+      }
+      d->i++;
+      return NULL;
+    }, &cd);
+
+    // Only set names when attributes have tags, to avoid adding a
+    // spurious names attribute to the container
+    if (cd.any_named) {
+      Rf_setAttrib(attrib_vals, R_NamesSymbol, attrib_names);
+    }
+    recurse(&children, seen, "_attrib", attrib_vals, max_depth, expand);
+    UNPROTECT(2);
   }
 
   SEXP out = PROTECT(children.vector());

src/size.cpp

@@ -83,8 +83,25 @@ double obj_size_tree(SEXP x,
 #endif
 
   // CHARSXPs have fake attributes
-  if (TYPEOF(x) != CHARSXP )
-    size += obj_size_tree(ATTRIB(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1);
+  if (TYPEOF(x) != CHARSXP && ANY_ATTRIB(x)) {
+    struct attrib_size_data {
+      double* size;
+      SEXP base_env;
+      int sizeof_node;
+      int sizeof_vector;
+      std::set<SEXP>* seen;
+      int depth;
+    };
+    attrib_size_data cb_data = {&size, base_env, sizeof_node, sizeof_vector, &seen, depth};
+    R_mapAttrib(x, [](SEXP tag, SEXP val, void* data) -> SEXP {
+      attrib_size_data* d = (attrib_size_data*)data;
+      // Account for the pairlist cons cell
+      *(d->size) += d->sizeof_node;
+      *(d->size) += obj_size_tree(tag, d->base_env, d->sizeof_node, d->sizeof_vector, *(d->seen), d->depth + 1);
+      *(d->size) += obj_size_tree(val, d->base_env, d->sizeof_node, d->sizeof_vector, *(d->seen), d->depth + 1);
+      return NULL;
+    }, &cb_data);
+  }
 
   switch (TYPEOF(x)) {
   // Vectors -------------------------------------------------------------------

src/utils.h

@@ -39,4 +39,35 @@ static inline
 SEXP R_ParentEnv(SEXP x) {
   return ENCLOS(x);
 }
+
+static inline
+int ANY_ATTRIB(SEXP x) {
+  return ATTRIB(x) != R_NilValue;
+}
+#endif
+
+#if R_VERSION < R_Version(4, 6, 0)
+// Polyfill for R_mapAttrib(), available in R >= 4.6.0.
+// Pulled exactly as-is from R:
+// https://github.com/r-devel/r-svn/blob/a39f4a28848fd02a1310b455353a871f2bb1965b/src/main/attrib.c#L2014
+// https://github.com/r-devel/r-svn/blob/a39f4a28848fd02a1310b455353a871f2bb1965b/doc/manual/R-exts.texi#L17920
+static inline
+SEXP R_mapAttrib(SEXP x, SEXP (*FUN)(SEXP, SEXP, void *), void *data) {
+  PROTECT_INDEX api;
+  SEXP a = ATTRIB(x);
+  SEXP val = NULL;
+
+  PROTECT_WITH_INDEX(a, &api);
+  while (a != R_NilValue) {
+    SEXP tag = PROTECT(TAG(a));
+    SEXP attr = PROTECT(CAR(a));
+    val = FUN(tag, attr, data);
+    UNPROTECT(2);
+    if (val != NULL)
+      break;
+    REPROTECT(a = CDR(a), api);
+  }
+  UNPROTECT(1);
+  return val;
+}
 #endif

tests/testthat/_snaps/sxp.md

@@ -66,7 +66,7 @@
     Output
       [1] <INTSXP[10]> (altrep )
         _class [2] <RAWSXP[144]> ()
-          _attrib [3] <LISTSXP> ()
+          _attrib [3] <VECSXP[3]> ()
             [4] <SYMSXP: compact_intseq> ()
             [5] <SYMSXP: base> ()
             [6] <INTSXP[1]> ()