Skip to content

Commit c3dc5fc

Browse files
lionel-lionel-
committed
Use conformant API to iterate over environments
1 parent bd32f7a commit c3dc5fc

File tree

6 files changed

+218
-74
lines changed

6 files changed

+218
-74
lines changed

‎NEWS.md‎

Lines changed: 8 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,13 @@
11
# lobstr (development version)
22

3-
* `obj_size()` no longer errors with "bad binding access" when inspecting
4-
environments with non-standard bindings such as those created by `for` loops
5-
or immediate bindings (#48).
3+
* `obj_size()`, `obj_addrs()`, and `sxp()` no longer error with "bad binding
4+
access" when inspecting environments with non-standard bindings such as
5+
those created by `for` loops or immediate bindings (#48).
6+
7+
* `sxp(expand = "environment")` no longer shows the internal `_frame` and
8+
`_hashtab` structures. Instead, it now shows promise expressions without
9+
forcing them. This change was necessary to make lobstr compliant with R's
10+
public C API.
611

712
# lobstr 1.1.3
813

‎R/sxp.R‎

Lines changed: 15 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@
1717
#' suppressed. Use:
1818
#'
1919
#' * "character" to show underlying entries in the global string pool.
20-
#' * "environment" to show the underlying hashtables.
20+
#' * "environment" to show binding components without any side effect (e.g. promise).
2121
#' * "altrep" to show the underlying data.
2222
#' * "call" to show the full AST (but [ast()] is usually superior)
2323
#' * "bytecode" to show generated bytecode.
@@ -43,14 +43,13 @@
4343
#' sxp(x)
4444
#' sxp(x, expand = "altrep")
4545
#'
46-
#' # Expand environmnets to see the underlying implementation details
47-
#' e1 <- new.env(hash = FALSE, parent = emptyenv(), size = 3L)
48-
#' e2 <- new.env(hash = TRUE, parent = emptyenv(), size = 3L)
49-
#' e1$x <- e2$x <- 1:10
46+
#' # Expand environments to see promise expressions without forcing
47+
#' e <- new.env(parent = emptyenv())
48+
#' delayedAssign("x", 1 + 1, assign.env = e)
5049
#'
51-
#' sxp(e1)
52-
#' sxp(e1, expand = "environment")
53-
#' sxp(e2, expand = "environment")
50+
#' sxp(e)
51+
#' sxp(e, expand = "environment")
52+
5453
sxp <- function(x, expand = character(), max_depth = 5L) {
5554
opts <- c("character", "altrep", "environment", "call", "bytecode")
5655
if (any(!expand %in% opts)) {
@@ -78,7 +77,7 @@ format.lobstr_inspector <- function(x, ..., depth = 0, name = NA) {
7877
indent <- paste0(rep(" ", depth), collapse = "")
7978

8079
id <- crayon::bold(attr(x, "id"))
81-
if (!is_testing()) {
80+
if (!is_testing() && !is_placeholder(x)) {
8281
addr <- paste0(":", crayon::silver(attr(x, "addr")))
8382
} else {
8483
addr <- ""
@@ -102,7 +101,7 @@ format.lobstr_inspector <- function(x, ..., depth = 0, name = NA) {
102101
value <- NULL
103102
}
104103

105-
if (!is_testing()) {
104+
if (!is_testing() && !is_placeholder(x)) {
106105
no_references <- attr(x, "no_references")
107106
maybe_shared <- attr(x, "maybe_shared")
108107
if (no_references == 1) {
@@ -237,3 +236,9 @@ SEXPTYPE <- c(
237236
"31" = "FREESXP",
238237
"99" = "FUNSXP"
239238
)
239+
240+
# Placeholder nodes do not have any inspectable properties such as refcount or
241+
# address
242+
is_placeholder <- function(x) {
243+
!nzchar(attr(x, "addr"))
244+
}

‎src/address.cpp‎

Lines changed: 34 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -1,24 +1,18 @@
11
#include "utils.h"
22
#include <cpp11/environment.hpp>
3+
#include <cpp11/sexp.hpp>
34
#include <vector>
45

6+
extern "C" {
7+
#include <rlang.h>
8+
}
9+
510
[[cpp11::register]]
611
std::string obj_addr_(SEXP name, cpp11::environment env) {
712
return obj_addr_(Rf_eval(name, env));
813
}
914

10-
void frame_addresses(SEXP frame, std::vector<std::string>* refs) {
11-
for(SEXP cur = frame; cur != R_NilValue; cur = CDR(cur)) {
12-
SEXP obj = CAR(cur);
13-
if (obj != R_UnboundValue)
14-
refs->push_back(obj_addr_(obj));
15-
}
16-
}
17-
void hash_table_addresses(SEXP table, std::vector<std::string>* refs) {
18-
int n = Rf_length(table);
19-
for (int i = 0; i < n; ++i)
20-
frame_addresses(VECTOR_ELT(table, i), refs);
21-
}
15+
2216

2317
[[cpp11::register]]
2418
std::vector<std::string> obj_addrs_(SEXP x) {
@@ -39,14 +33,34 @@ std::vector<std::string> obj_addrs_(SEXP x) {
3933
break;
4034

4135
case ENVSXP: {
42-
// Using node-based object accessors: CAR for FRAME, and TAG for HASHTAB.
43-
// TODO: Iterate over environments using environment accessors.
44-
// We won't be able to provide an address for things like promises though.
45-
bool isHashed = TAG(x) != R_NilValue;
46-
if (isHashed) {
47-
hash_table_addresses(TAG(x), &out);
48-
} else {
49-
frame_addresses(CAR(x), &out);
36+
cpp11::sexp syms(r_env_syms(x));
37+
R_xlen_t n_bindings = Rf_xlength(syms);
38+
39+
for (R_xlen_t i = 0; i < n_bindings; ++i) {
40+
SEXP sym = VECTOR_ELT(syms, i);
41+
enum r_env_binding_type type = r_env_binding_type(x, sym);
42+
43+
switch (type) {
44+
case R_ENV_BINDING_TYPE_value:
45+
case R_ENV_BINDING_TYPE_missing:
46+
out.push_back(obj_addr_(r_env_find(x, sym)));
47+
break;
48+
49+
case R_ENV_BINDING_TYPE_delayed:
50+
out.push_back(obj_addr_(r_env_binding_delayed_expr(x, sym)));
51+
break;
52+
53+
case R_ENV_BINDING_TYPE_forced:
54+
out.push_back(obj_addr_(r_env_binding_forced_value(x, sym)));
55+
break;
56+
57+
case R_ENV_BINDING_TYPE_active:
58+
out.push_back(obj_addr_(r_env_binding_active_fn(x, sym)));
59+
break;
60+
61+
case R_ENV_BINDING_TYPE_unbound:
62+
break;
63+
}
5064
}
5165
break;
5266
}

‎src/inspect.cpp‎

Lines changed: 89 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,15 @@
11
#include <cpp11/environment.hpp>
22
#include <cpp11/list.hpp>
3+
#include <cpp11/sexp.hpp>
34
#include <cpp11/strings.hpp>
45
#include <Rversion.h>
56
#include <map>
67
#include "utils.h"
78

9+
extern "C" {
10+
#include <rlang.h>
11+
}
12+
813
struct Expand {
914
bool alrep;
1015
bool charsxp;
@@ -50,6 +55,30 @@ class GrowableList {
5055
SEXP obj_children_(SEXP x, std::map<SEXP, int>& seen, double max_depth, Expand expand);
5156
bool is_namespace(cpp11::environment env);
5257

58+
// Create a placeholder inspector node for synthetic entries (e.g. promise bindings)
59+
SEXP new_placeholder_inspector(int type, std::map<SEXP, int>& seen) {
60+
SEXP out = PROTECT(Rf_allocVector(VECSXP, 0));
61+
62+
int id = seen.size() + 1;
63+
64+
// Placeholder address. Causes a more bare bones display in the tree.
65+
Rf_setAttrib(out, Rf_install("addr"), PROTECT(Rf_mkString("")));
66+
67+
// Placeholder properties
68+
Rf_setAttrib(out, Rf_install("has_seen"), PROTECT(Rf_ScalarLogical(false)));
69+
Rf_setAttrib(out, Rf_install("id"), PROTECT(Rf_ScalarInteger(id)));
70+
Rf_setAttrib(out, Rf_install("type"), PROTECT(Rf_ScalarInteger(type)));
71+
Rf_setAttrib(out, Rf_install("length"), PROTECT(Rf_ScalarReal(0)));
72+
Rf_setAttrib(out, Rf_install("altrep"), PROTECT(Rf_ScalarLogical(false)));
73+
Rf_setAttrib(out, Rf_install("maybe_shared"), PROTECT(Rf_ScalarInteger(0)));
74+
Rf_setAttrib(out, Rf_install("no_references"), PROTECT(Rf_ScalarInteger(0)));
75+
Rf_setAttrib(out, Rf_install("object"), PROTECT(Rf_ScalarInteger(0)));
76+
Rf_setAttrib(out, Rf_install("class"), PROTECT(Rf_mkString("lobstr_inspector")));
77+
78+
UNPROTECT(11);
79+
return out;
80+
}
81+
5382
bool is_altrep(SEXP x) {
5483
#if defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0)
5584
return ALTREP(x);
@@ -251,38 +280,75 @@ SEXP obj_children_(
251280
break;
252281

253282
// Environments
254-
case ENVSXP:
283+
case ENVSXP: {
255284
if (x == R_BaseEnv || x == R_GlobalEnv || x == R_EmptyEnv || is_namespace(x))
256285
break;
257286

258-
if (expand.env) {
259-
// Using node-based object accessors: CAR for FRAME, and TAG for HASHTAB.
260-
// TODO: Iterate manually over the environment using environment accessors.
261-
recurse(&children, seen, "_frame", CAR(x), max_depth, expand);
262-
recurse(&children, seen, "_hashtab", TAG(x), max_depth, expand);
263-
} else {
264-
SEXP names = PROTECT(R_lsInternal3(x, /* all= */ TRUE, /* sorted= */ FALSE));
265-
for (R_xlen_t i = 0; i < XLENGTH(names); ++i) {
266-
const char* name = CHAR(STRING_ELT(names, i));
267-
SEXP sym = PROTECT(Rf_install(name));
268-
269-
if (R_BindingIsActive(sym, x)) {
270-
SEXP sym = PROTECT(Rf_install("_active_binding"));
271-
SEXP active = PROTECT(obj_inspect_(sym, seen, max_depth, expand));
272-
children.push_back(name, active);
273-
UNPROTECT(2);
274-
} else {
275-
SEXP obj = PROTECT(Rf_findVarInFrame(x, sym));
276-
recurse(&children, seen, name, obj, max_depth, expand);
277-
UNPROTECT(1);
287+
cpp11::sexp syms(r_env_syms(x));
288+
R_xlen_t n_bindings = Rf_xlength(syms);
289+
290+
for (R_xlen_t i = 0; i < n_bindings; ++i) {
291+
SEXP sym = VECTOR_ELT(syms, i);
292+
const char* name = CHAR(PRINTNAME(sym));
293+
enum r_env_binding_type type = r_env_binding_type(x, sym);
294+
295+
switch (type) {
296+
case R_ENV_BINDING_TYPE_value:
297+
recurse(&children, seen, name, r_env_find(x, sym), max_depth, expand);
298+
break;
299+
300+
case R_ENV_BINDING_TYPE_missing: {
301+
SEXP missing = PROTECT(new_placeholder_inspector(SYMSXP, seen));
302+
Rf_setAttrib(missing, Rf_install("value"), PROTECT(Rf_mkString("<missing>")));
303+
children.push_back(name, missing);
304+
UNPROTECT(2);
305+
break;
306+
}
307+
308+
case R_ENV_BINDING_TYPE_delayed: {
309+
SEXP promise = PROTECT(new_placeholder_inspector(PROMSXP, seen));
310+
children.push_back(name, promise);
311+
UNPROTECT(1);
312+
313+
if (expand.env) {
314+
recurse(&children, seen, "_code", r_env_binding_delayed_expr(x, sym), max_depth, expand);
315+
recurse(&children, seen, "_env", r_env_binding_delayed_env(x, sym), max_depth, expand);
278316
}
317+
break;
318+
}
319+
320+
case R_ENV_BINDING_TYPE_forced: {
321+
SEXP promise = PROTECT(new_placeholder_inspector(PROMSXP, seen));
322+
children.push_back(name, promise);
279323
UNPROTECT(1);
324+
325+
if (expand.env) {
326+
recurse(&children, seen, "_value", r_env_binding_forced_value(x, sym), max_depth, expand);
327+
recurse(&children, seen, "_code", r_env_binding_forced_expr(x, sym), max_depth, expand);
328+
}
329+
break;
330+
}
331+
332+
case R_ENV_BINDING_TYPE_active: {
333+
SEXP active = PROTECT(new_placeholder_inspector(CLOSXP, seen));
334+
Rf_setAttrib(active, Rf_install("value"), PROTECT(Rf_mkString("active")));
335+
children.push_back(name, active);
336+
UNPROTECT(2);
337+
338+
if (expand.env) {
339+
recurse(&children, seen, "_fn", r_env_binding_active_fn(x, sym), max_depth, expand);
340+
}
341+
break;
342+
}
343+
344+
case R_ENV_BINDING_TYPE_unbound:
345+
break;
280346
}
281-
UNPROTECT(1);
282347
}
283348

284-
recurse(&children, seen, "_enclos", R_ParentEnv(x), max_depth, expand);
349+
recurse(&children, seen, "_enclos", r_env_parent(x), max_depth, expand);
285350
break;
351+
}
286352

287353
// Functions
288354
case CLOSXP:

‎tests/testthat/_snaps/sxp.md‎

Lines changed: 49 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,48 @@
1+
# snapshots environment binding types
2+
3+
Code
4+
print(sxp(e))
5+
Output
6+
[1] <ENVSXP> ()
7+
active [2] <CLOSXP: active> ()
8+
forced [2] <PROMSXP> ()
9+
delayed [2] <PROMSXP> ()
10+
missing [2] <SYMSXP: <missing>> ()
11+
value [2] <REALSXP[1]> ()
12+
_enclos [3] <ENVSXP: empty> ()
13+
Code
14+
print(sxp(e, expand = "environment", max_depth = 6L))
15+
Output
16+
[1] <ENVSXP> ()
17+
active [2] <CLOSXP: active> ()
18+
_fn [2] <CLOSXP> ()
19+
_formals <NILSXP>
20+
_body [4] <REALSXP[1]> ()
21+
_env [5] <ENVSXP> ()
22+
e [1]
23+
_enclos [6] <ENVSXP> ()
24+
_enclos [7] <ENVSXP> ()
25+
_enclos [8] <ENVSXP> ()
26+
...
27+
_attrib [9] <LISTSXP> ()
28+
srcref [10] <INTSXP[8]> (object )
29+
_attrib [11] <LISTSXP> ()
30+
srcfile [12] <ENVSXP> (object )
31+
...
32+
class [13] <STRSXP[1]> ()
33+
...
34+
forced [14] <PROMSXP> ()
35+
_value [14] <REALSXP[1]> ()
36+
_code [15] <LANGSXP> ()
37+
...
38+
delayed [16] <PROMSXP> ()
39+
_code [16] <LANGSXP> ()
40+
...
41+
_env [5]
42+
missing [17] <SYMSXP: <missing>> ()
43+
value [17] <REALSXP[1]> ()
44+
_enclos [18] <ENVSXP: empty> ()
45+
146
# can inspect all atomic vectors
247

348
Code
@@ -39,24 +84,10 @@
3984
print(sxp(e2, expand = "environment", max_depth = 5L))
4085
Output
4186
[1] <ENVSXP> ()
42-
_frame <NILSXP>
43-
_hashtab [3] <VECSXP[5]> ()
44-
<NILSXP>
45-
<NILSXP>
46-
<NILSXP>
47-
<NILSXP>
48-
<NILSXP>
49-
_enclos [4] <ENVSXP> ()
50-
_frame <NILSXP>
51-
_hashtab [5] <VECSXP[5]> ()
52-
[6] <LISTSXP> ()
53-
x [7] <REALSXP[1]> ()
54-
[8] <LISTSXP> ()
55-
y [4]
56-
<NILSXP>
57-
<NILSXP>
58-
<NILSXP>
59-
_enclos [9] <ENVSXP: empty> ()
87+
_enclos [2] <ENVSXP> ()
88+
x [3] <REALSXP[1]> ()
89+
y [2]
90+
_enclos [4] <ENVSXP: empty> ()
6091

6192
# can expand altrep
6293

0 commit comments

Comments
 (0)