lobstr/0000755000176200001440000000000013506762114011564 5ustar liggesuserslobstr/tests/0000755000176200001440000000000013506706674012737 5ustar liggesuserslobstr/tests/testthat.R0000644000176200001440000000007013162455060014703 0ustar liggesuserslibrary(testthat) library(lobstr) test_check("lobstr") lobstr/tests/testthat/0000755000176200001440000000000013506762114014566 5ustar liggesuserslobstr/tests/testthat/test-sxp-atomic.txt0000644000176200001440000000022313506701651020364 0ustar liggesusers[1] () [2] () [3] () [4] () [5] () [6] () [7] () lobstr/tests/testthat/test-ref-character.txt0000644000176200001440000000016213506701651021010 0ustar liggesusers█ [1:0x001] ├─[2:0x002] ├─[2:0x002] └─[3:0x003] lobstr/tests/testthat/size-aligned.txt0000644000176200001440000000003013506701651017672 0ustar liggesusers* 400 B * 400,000 B lobstr/tests/testthat/test-ast-simple.txt0000644000176200001440000000022613506701651020361 0ustar liggesuserso-`function` +-o-x = `` +-o-`if` | +-o-`>` | | +-x | | \-1 | \-o-f | +-o-`$` | | +-y | | \-x | +-"x" | \-o-g \- lobstr/tests/testthat/test-ast.R0000644000176200001440000000170513477777720016500 0ustar liggesuserscontext("test-ast.R") test_that("quosures print same as expressions", { expect_equal(ast_tree(quo(x)), ast_tree(expr(x))) }) test_that("can print complex expression", { skip_on_os("windows") skip_on_cran() x <- expr(function(x) if (x > 1) f(y$x, "x", g())) expect_known_output( ast(!!x), "test-ast-fancy.txt", print = TRUE ) }) test_that("can print complex expression without unicode", { old <- options(lobstr.fancy.tree = FALSE) on.exit(options(old)) x <- expr(function(x) if (x > 1) f(y$x, "x", g())) expect_known_output( ast(!!x), "test-ast-simple.txt", print = TRUE ) }) test_that("can print scalar expressions nicely", { old <- options(lobstr.fancy.tree = FALSE) on.exit(options(old)) x <- expr(list( logical = c(FALSE, TRUE, NA), integer = 1L, double = 1, character = "a", complex = 1i )) expect_known_output( ast(!!x), "test-ast-scalar.txt", print = TRUE ) }) lobstr/tests/testthat/test-sxp-altrep.txt0000644000176200001440000000034013506701651020377 0ustar liggesusers[1] (altrep ) _class [2] () _attrib [3] () [4] () [5] () [6] () _data1 [7] () _data2 lobstr/tests/testthat/test-sxp.R0000644000176200001440000000462113502505272016477 0ustar liggesuserscontext("test-inspect") test_that("retrieves truelength", { skip_if_not(getRversion() >= "3.4") # true length is only updated after assignment x <- runif(100) x[101] <- 1 obj <- sxp(x) # weak test because R doesn't make any guarantees about what the object # will be expect_true(attr(obj, "truelength") > length(obj)) }) test_that("computes spanning tree", { x <- 1:10 y <- list(x, x, x) obj <- sxp(y) expect_false(attr(obj[[1]], "has_seen")) expect_true(attr(obj[[2]], "has_seen")) }) test_that("captures names of special environments", { x <- list( emptyenv(), baseenv(), globalenv() ) obj <- sxp(x) expect_equal(attr(obj[[1]], "value"), "empty") expect_equal(attr(obj[[2]], "value"), "base") expect_equal(attr(obj[[3]], "value"), "global") }) test_that("captures names of lists", { x <- list(a = 1, b = 2, c = 3) obj <- sxp(x) expect_named(obj, c(names(x), "_attrib")) }) test_that("can expand lists", { x <- c("xxx", "xxx", "y") obj <- sxp(x, expand = "character") expect_length(obj, 3) expect_equal(attr(obj[[1]], "ref"), attr(obj[[2]], "ref")) }) test_that("can inspect active bindings", { e <- new.env(hash = FALSE) env_bind_active(e, f = function() stop("!")) x <- sxp(e) expect_named(x, c("f", "_enclos")) }) # Regression tests -------------------------------------------------------- test_that("can inspect all atomic vectors", { x <- list( TRUE, 1L, 1, "3", 1i, raw(1) ) expect_known_output( print(sxp(x)), test_path("test-sxp-atomic.txt"), ) }) test_that("can inspect functions", { f <- function(x, y = 1, ...) x + 1 attr(f, "srcref") <- NULL environment(f) <- globalenv() expect_known_output( print(sxp(f)), test_path("test-sxp-function.txt"), ) }) test_that("can inspect environments", { e1 <- new.env(parent = emptyenv(), size = 5L) e1$x <- 10 e1$y <- e1 e2 <- new.env(parent = e1, size = 5L) expect_known_output( { print(sxp(e2)) cat("\n\n") print(sxp(e2, expand = "environment", max_depth = 5L)) }, test_path("test-sxp-environment.txt"), ) }) test_that("can expand altrep", { skip_if_not(getRversion() >= "3.5") skip_if_not(.Machine$sizeof.pointer == 8) # _class RAWSXP has different size x <- 1:10 expect_known_output( { print(sxp(x, expand = "altrep", max_depth = 4L)) }, test_path("test-sxp-altrep.txt") ) }) lobstr/tests/testthat/test-ref.R0000644000176200001440000000215513477777720016465 0ustar liggesuserscontext("test-ref.R") test_that("basic list display", { skip_on_os("windows") skip_on_cran() x <- 1:10 y <- list(x, x) test_addr_reset() expect_known_output( ref( x, list(), list(x, x, x), list(a = x, b = x), letters ), "test-ref-list.txt", print = TRUE ) }) test_that("basic environment display", { skip_on_os("windows") skip_on_cran() e <- env(a = 1:10) e$b <- e$a e$c <- e test_addr_reset() expect_known_output( ref(e), "test-ref-env.txt", print = TRUE ) }) test_that("can display ref to global string pool on request", { skip_on_os("windows") skip_on_cran() test_addr_reset() expect_known_output( ref(c("string", "string", "new string"), character = TRUE), "test-ref-character.txt", print = TRUE ) }) test_that("custom methods are never called (#30)", { # `[[.numeric_number` causes infinite recursion expect_error(ref(package_version("1.1.1")), NA) e <- env(a = 1:10) e$b <- e$a e$c <- e # `as.list.data.frame`(, ...) fails class(e) <- "data.frame" expect_error(ref(e), NA) }) lobstr/tests/testthat/test-ast-fancy.txt0000644000176200001440000000037413506701651020174 0ustar liggesusers█─`function` ├─█─x = `` ├─█─`if` │ ├─█─`>` │ │ ├─x │ │ └─1 │ └─█─f │ ├─█─`$` │ │ ├─y │ │ └─x │ ├─"x" │ └─█─g └─ lobstr/tests/testthat/test-ref-list.txt0000644000176200001440000000031113506701651020023 0ustar liggesusers[1:0x001] █ [2:0x002] █ [3:0x003] ├─[1:0x001] ├─[1:0x001] └─[1:0x001] █ [4:0x004] ├─a = [1:0x001] └─b = [1:0x001] [5:0x005] lobstr/tests/testthat/test-sxp-function.txt0000644000176200001440000000025213506701651020737 0ustar liggesusers[1] () _formals [2] () x [3] () y [4] () ... [3] _body [5] () ... _env [6] () lobstr/tests/testthat/test-ref-env.txt0000644000176200001440000000013213506701651017641 0ustar liggesusers█ [1:0x001] ├─a = [2:0x002] ├─b = [2:0x002] └─c = [1:0x001] lobstr/tests/testthat/test-address.R0000644000176200001440000000247313502502114017305 0ustar liggesuserscontext("test-address.R") test_that("address of expression varies", { a <- obj_addr(1:10) b <- obj_addr(1:10) expect_false(identical(a, b)) }) test_that("address of variable is constant", { x <- 1:10 expect_equal(obj_addr(x), obj_addr(x)) }) test_that("address flows through function wrappers", { x <- 1:10 f <- function(x) obj_addr(x) g <- function(y) f(y) h <- function(z) g(z) address <- obj_addr(x) expect_equal(f(x), address) expect_equal(g(x), address) expect_equal(h(x), address) }) # addresses --------------------------------------------------------------- test_that("can find addresses of list elements", { x <- 1:3 y <- 1:3 addr <- c(obj_addr(x), obj_addr(y)) l <- list(x, y) expect_equal(obj_addrs(l), addr) }) test_that("can find addresses of environment elements", { x <- 1:3 y <- 1:3 addr <- c(obj_addr(x), obj_addr(y)) e1 <- new.env(hash = TRUE) e1$x <- x e1$y <- y expect_setequal(obj_addrs(e1), addr) e2 <- new.env(hash = FALSE) e2$x <- x e2$y <- y expect_setequal(obj_addrs(e2), addr) }) test_that("address of character vectors points to global string pool", { addr <- obj_addrs(c("a", "a", "a")) expect_equal(addr[[1]], addr[[2]]) }) test_that("addresses of other elements throws errors", { expect_error(obj_addrs(1:10), "must be a list") }) lobstr/tests/testthat/test-sxp-environment.txt0000644000176200001440000000075613506701651021467 0ustar liggesusers[1] () _enclos [2] () x [3] () y [2] _enclos [4] () [1] () _frame _hashtab [3] () _enclos [4] () _frame _hashtab [5] () [6] () x [7] () [8] () y [4] _enclos [9] () lobstr/tests/testthat/test-size.R0000644000176200001440000001026513477777701016663 0ustar liggesuserscontext("test-size.R") expect_same <- function(x, ...) { lab <- as.character(expr_text(enexpr(x))) act <- as.vector(obj_size(x)) exp <- as.vector(object.size(x)) msg <- sprintf("`obj_size(%s)` is %s, not %s (\u0394%+i)", lab, act, exp, act - exp) expect(identical(act, exp), msg) invisible(act) } # S3 methods -------------------------------------------------------------- test_that("combined bytes are aligned", { x <- new_bytes(c(400, 400000)) expect_known_output(print(x), "size-aligned.txt") }) # Compatibility with base --------------------------------------------------- test_that("size correct for length one vectors", { expect_same(1) expect_same(1L) expect_same("abc") expect_same(paste(rep("banana", 100), collapse = "")) expect_same(charToRaw("a")) expect_same(5 + 1i) }) test_that("size scales correctly with length (accounting for vector pool)", { expect_same(numeric()) expect_same(1) expect_same(2) expect_same(c(1:10)) expect_same(c(1:1000)) }) test_that("size of list computed recursively", { expect_same(list()) expect_same(as.list(1)) expect_same(as.list(1:2)) expect_same(as.list(1:3)) expect_same(list(list(list(list(list()))))) }) test_that("size of symbols same as base", { expect_same(quote(x)) expect_same(quote(asfsadfasdfasdfds)) }) test_that("size of pairlists same as base", { expect_same(pairlist()) expect_same(pairlist(1)) expect_same(pairlist(1, 2)) expect_same(pairlist(1, 2, 3)) expect_same(pairlist(1, 2, 3, 4)) }) test_that("don't crash with large pairlists", { n <- 1e5 x <- pairlist(1) xn <- as.pairlist(rep(1, n)) expect_equal(obj_size(xn), n * obj_size(x)) }) test_that("size of S4 objects same as base", { Z <- methods::setClass("Z", slots = c(x = "integer")) z <- Z(x = 1L) expect_same(z) }) test_that("size of attributes included in object size", { expect_same(c(x = 1)) expect_same(list(x = 1)) expect_same(c(x = "y")) }) test_that("duplicated CHARSXPS only counted once", { expect_same("x") expect_same(c("x", "y", "x")) expect_same(c("banana", "banana", "banana")) }) # Improved behaviour for shared components ------------------------------------ test_that("shared components only counted once", { x <- 1:1e3 z <- list(x, x, x) expect_equal(obj_size(z), obj_size(x) + obj_size(vector("list", 3))) }) test_that("size of closures same as base", { f <- function() NULL attributes(f) <- NULL # zap srcrefs environment(f) <- emptyenv() expect_same(f) }) # Improved behaviour for ALTREP objects ----------------------------------- test_that("altrep size measured correctly", { skip_if_not(getRversion() > "3.5.0") # Currently reported size is 640 B # If regular vector would be 4,000,040 B # This test is conservative so shouldn't fail in case representation # changes in the future expect_true(obj_size(1:1e6) < 10000) }) test_that("can compute size of deferred string vectors", { x <- 1:10 names(x) <- 10:1 y <- names(x) obj_size(y) # Just assert that it doesn't crash succeed("Didn't crash") }) # Environment sizes ----------------------------------------------------------- test_that("terminal environments have size zero", { expect_equal(obj_size(globalenv()), new_bytes(0)) expect_equal(obj_size(baseenv()), new_bytes(0)) expect_equal(obj_size(emptyenv()), new_bytes(0)) expect_equal(obj_size(asNamespace("stats")), new_bytes(0)) }) test_that("environment size computed recursively", { e <- new.env(parent = emptyenv()) e_size <- obj_size(e) f <- new.env(parent = e) obj_size(f) expect_equal(obj_size(f), 2 * obj_size(e)) }) test_that("size of function includes environment", { f <- function() { y <- 1:1e3 a ~ b } g <- function() { y <- 1:1e3 function() 10 } expect_true(obj_size(f()) > obj_size(1:1e3)) expect_true(obj_size(g()) > obj_size(1:1e3)) }) test_that("size doesn't include parents of current environment", { x <- c(1:1e4) embedded <- (function() { g <- function() { x <- c(1:1e3) a ~ b } obj_size(g()) })() expect_true(embedded < obj_size(x)) }) test_that("support dots in closure environments", { fn <- (function(...) function() NULL)(foo) expect_error(obj_size(fn), NA) }) lobstr/tests/testthat/test-ast-scalar.txt0000644000176200001440000000022513506701651020334 0ustar liggesuserso-list +-logical = o-c | +-FALSE | +-TRUE | \-NA +-integer = 1L +-double = 1 +-character = "a" \-complex = 1i lobstr/src/0000755000176200001440000000000013506706674012364 5ustar liggesuserslobstr/src/size.cpp0000644000176200001440000001633613477777720014062 0ustar liggesusers#include using namespace Rcpp; #include // [[Rcpp::export]] double v_size(double n, int element_size) { if (n == 0) return 0; double vec_size = std::max(sizeof(SEXP), sizeof(double)); double elements_per_byte = vec_size / element_size; double n_bytes = ceil(n / elements_per_byte); // Rcout << n << " elements, each of " << elements_per_byte << " = " << // n_bytes << "\n"; double size = 0; // Big vectors always allocated in 8 byte chunks if (n_bytes > 16) size = n_bytes * 8; // For small vectors, round to sizes allocated in small vector pool else if (n_bytes > 8) size = 128; else if (n_bytes > 6) size = 64; else if (n_bytes > 4) size = 48; else if (n_bytes > 2) size = 32; else if (n_bytes > 1) size = 16; else if (n_bytes > 0) size = 8; // Size is pointer to struct + struct size return size; } bool is_namespace(Environment env) { return Rf_findVarInFrame3(env, Rf_install(".__NAMESPACE__."), FALSE) != R_UnboundValue; } // R equivalent // https://github.com/wch/r-source/blob/master/src/library/utils/src/size.c#L41 double obj_size_tree(SEXP x, Environment base_env, int sizeof_node, int sizeof_vector, std::set& seen, int depth) { // NILSXP is a singleton, so occupies no space. Similarly SPECIAL and // BUILTIN are fixed and unchanging if (TYPEOF(x) == NILSXP || TYPEOF(x) == SPECIALSXP || TYPEOF(x) == BUILTINSXP) return 0; // Don't count objects that we've seen before if (!seen.insert(x).second) return 0; // Rcout << "\n" << std::string(depth * 2, ' '); // Rprintf("type: %s", Rf_type2char(TYPEOF(x))); // Use sizeof(SEXPREC) and sizeof(VECTOR_SEXPREC) computed in R. // CHARSXP are treated as vectors for this purpose double size = (Rf_isVector(x) || TYPEOF(x) == CHARSXP) ? sizeof_vector : sizeof_node; #if defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0) // Handle ALTREP objects if (ALTREP(x)) { SEXP klass = ALTREP_CLASS(x); SEXP classname = CAR(ATTRIB(klass)); size += 3 * sizeof(SEXP); size += obj_size_tree(klass, base_env, sizeof_node, sizeof_vector, seen, depth + 1); if (classname == Rf_install("deferred_string")) { // Deferred string ALTREP uses an pairlist, but stores data in the CDR SEXP data1 = R_altrep_data1(x); size += obj_size_tree(CAR(data1), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(CDR(data1), base_env, sizeof_node, sizeof_vector, seen, depth + 1); } else { size += obj_size_tree(R_altrep_data1(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); } size += obj_size_tree(R_altrep_data2(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); return size; } #endif // CHARSXPs have fake attributes if (TYPEOF(x) != CHARSXP ) size += obj_size_tree(ATTRIB(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); switch (TYPEOF(x)) { // Vectors ------------------------------------------------------------------- // See details in v_size() // Simple vectors case LGLSXP: case INTSXP: size += v_size(XLENGTH(x), sizeof(int)); break; case REALSXP: size += v_size(XLENGTH(x), sizeof(double)); break; case CPLXSXP: size += v_size(XLENGTH(x), sizeof(Rcomplex)); break; case RAWSXP: size += v_size(XLENGTH(x), 1); break; // Strings case STRSXP: size += v_size(XLENGTH(x), sizeof(SEXP)); for (R_xlen_t i = 0; i < XLENGTH(x); i++) { size += obj_size_tree(STRING_ELT(x, i), base_env, sizeof_node, sizeof_vector, seen, depth + 1); } break; case CHARSXP: size += v_size(LENGTH(x) + 1, 1); break; // Generic vectors case VECSXP: case EXPRSXP: case WEAKREFSXP: size += v_size(XLENGTH(x), sizeof(SEXP)); for (R_xlen_t i = 0; i < XLENGTH(x); ++i) { size += obj_size_tree(VECTOR_ELT(x, i), base_env, sizeof_node, sizeof_vector, seen, depth + 1); } break; // Nodes --------------------------------------------------------------------- // https://github.com/wch/r-source/blob/master/src/include/Rinternals.h#L237-L249 // All have enough space for three SEXP pointers // Linked lists case DOTSXP: case LISTSXP: case LANGSXP: if (x == R_MissingArg) // Needed for DOTSXP break; for(SEXP cons = x; cons != R_NilValue; cons = CDR(cons)) { if (cons != x) size += sizeof_node; size += obj_size_tree(TAG(cons), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(CAR(cons), base_env, sizeof_node, sizeof_vector, seen, depth + 1); } break; case BCODESXP: size += obj_size_tree(TAG(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(CAR(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(CDR(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); break; // Environments case ENVSXP: if (x == R_BaseEnv || x == R_GlobalEnv || x == R_EmptyEnv || x == base_env || is_namespace(x)) return 0; size += obj_size_tree(FRAME(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(ENCLOS(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(HASHTAB(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); break; // Functions case CLOSXP: size += obj_size_tree(FORMALS(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); // BODY is either an expression or byte code size += obj_size_tree(BODY(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(CLOENV(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); break; case PROMSXP: size += obj_size_tree(PRVALUE(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(PRCODE(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(PRENV(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); break; case EXTPTRSXP: size += sizeof(void *); // the actual pointer size += obj_size_tree(EXTPTR_PROT(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(EXTPTR_TAG(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); break; case S4SXP: size += obj_size_tree(TAG(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); break; case SYMSXP: break; default: stop("Can't compute size of %s", Rf_type2char(TYPEOF(x))); } // Rprintf("type: %-10s size: %6.0f\n", Rf_type2char(TYPEOF(x)), size); return size; } // [[Rcpp::export]] double obj_size_(List objects, Environment base_env, int sizeof_node, int sizeof_vector) { std::set seen; double size = 0; int n = objects.size(); for (int i = 0; i < n; ++i) { size += obj_size_tree(objects[i], base_env, sizeof_node, sizeof_vector, seen, 0); } return size; } // [[Rcpp::export]] IntegerVector obj_csize_(List objects, Environment base_env, int sizeof_node, int sizeof_vector) { std::set seen; int n = objects.size(); IntegerVector out(n); for (int i = 0; i < n; ++i) { out[i] += obj_size_tree(objects[i], base_env, sizeof_node, sizeof_vector, seen, 0); } return out; } lobstr/src/address.cpp0000644000176200001440000000253513406772604014515 0ustar liggesusers#include using namespace Rcpp; std::string obj_addr_(SEXP x) { return tfm::format("%p", x); } // [[Rcpp::export]] std::string obj_addr_(SEXP name, Environment env) { return obj_addr_(Rf_eval(name, env)); } void frame_addresses(SEXP frame, std::vector* refs) { for(SEXP cur = frame; cur != R_NilValue; cur = CDR(cur)) { SEXP obj = CAR(cur); if (obj != R_UnboundValue) refs->push_back(obj_addr_(obj)); } } void hash_table_addresses(SEXP table, std::vector* refs) { int n = Rf_length(table); for (int i = 0; i < n; ++i) frame_addresses(VECTOR_ELT(table, i), refs); } // [[Rcpp::export]] std::vector obj_addrs_(SEXP x) { int n = Rf_length(x); std::vector out; switch(TYPEOF(x)) { case STRSXP: for (int i = 0; i < n; ++i) { out.push_back(obj_addr_(STRING_ELT(x, i))); } break; case VECSXP: for (int i = 0; i < n; ++i) { out.push_back(obj_addr_(VECTOR_ELT(x, i))); } break; case ENVSXP: { bool isHashed = HASHTAB(x) != R_NilValue; if (isHashed) { hash_table_addresses(HASHTAB(x), &out); } else { frame_addresses(FRAME(x), &out); } break; } default: Rcpp::stop( "`x` must be a list, environment, or character vector, not a %s.", Rf_type2char(TYPEOF(x)) ); } return out; } lobstr/src/inspect.cpp0000644000176200001440000002325113506701277014532 0ustar liggesusers#include using namespace Rcpp; #include struct Expand { bool alrep; bool charsxp; bool env; bool call; bool bytecode; }; class GrowableList { Rcpp::List data_; Rcpp::CharacterVector names_; R_xlen_t n_; public: GrowableList(R_xlen_t size = 10) : data_(size), names_(size), n_(0) { } void push_back(const char* string, SEXP x) { if (Rf_xlength(data_) == n_) { data_ = Rf_xlengthgets(data_, n_ * 2); names_ = Rf_xlengthgets(names_, n_ * 2); } SET_STRING_ELT(names_, n_, Rf_mkChar(string)); SET_VECTOR_ELT(data_, n_, x); n_++; } Rcpp::List vector() { if (Rf_xlength(data_) != n_) { data_ = Rf_xlengthgets(data_, n_); names_ = Rf_xlengthgets(names_, n_); } Rf_setAttrib(data_, R_NamesSymbol, names_); return data_; } }; SEXP obj_children_(SEXP x, std::map& seen, double max_depth, Expand expand); bool is_namespace(Environment env); bool is_altrep(SEXP x) { #if defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0) return ALTREP(x); #else return false; #endif } SEXP obj_inspect_(SEXP x, std::map& seen, double max_depth, Expand& expand) { int id; SEXP children; bool has_seen; if (seen.count(x)) { has_seen = true; id = seen[x]; children = PROTECT(Rf_allocVector(VECSXP, 0)); } else { has_seen = false; id = seen.size() + 1; seen[x] = id; children = PROTECT(obj_children_(x, seen, max_depth, expand)); } // don't store object directly to avoid increasing refcount Rf_setAttrib(children, Rf_install("addr"), PROTECT(Rf_mkString(tfm::format("%p", x).c_str()))); Rf_setAttrib(children, Rf_install("has_seen"), PROTECT(Rf_ScalarLogical(has_seen))); Rf_setAttrib(children, Rf_install("id"), PROTECT(Rf_ScalarInteger(id))); Rf_setAttrib(children, Rf_install("type"), PROTECT(Rf_ScalarInteger(TYPEOF(x)))); Rf_setAttrib(children, Rf_install("length"), PROTECT(Rf_ScalarReal(Rf_length(x)))); Rf_setAttrib(children, Rf_install("altrep"), PROTECT(Rf_ScalarLogical(is_altrep(x)))); Rf_setAttrib(children, Rf_install("named"), PROTECT(Rf_ScalarInteger(NAMED(x)))); Rf_setAttrib(children, Rf_install("object"), PROTECT(Rf_ScalarInteger(OBJECT(x)))); UNPROTECT(8); if (Rf_isVector(x)) { if (TRUELENGTH(x) > 0) { Rf_setAttrib(children, Rf_install("truelength"), PROTECT(Rf_ScalarReal(TRUELENGTH(x)))); UNPROTECT(1); } } const char* value = NULL; if (TYPEOF(x) == SYMSXP && PRINTNAME(x) != R_NilValue) { value = CHAR(PRINTNAME(x)); } else if (TYPEOF(x) == ENVSXP) { if (x == R_GlobalEnv) { value = "global"; } else if (x == R_EmptyEnv) { value = "empty"; } else if (x == R_BaseEnv) { value = "base"; } else { if (R_PackageEnvName(x) != R_NilValue) value = CHAR(STRING_ELT(R_PackageEnvName(x), 0)); } } if (value != NULL) { Rf_setAttrib(children, Rf_install("value"), PROTECT(Rf_mkString(value))); UNPROTECT(1); } Rf_setAttrib(children, Rf_install("class"), PROTECT(Rf_mkString("lobstr_inspector"))); UNPROTECT(1); UNPROTECT(1); return children; } inline void recurse( GrowableList* children, std::map& seen, const char* name, SEXP child, double max_depth, Expand& expand) { SEXP descendents = PROTECT(obj_inspect_(child, seen, max_depth - 1, expand)); children->push_back(name, descendents); UNPROTECT(1); } SEXP obj_children_( SEXP x, std::map& seen, double max_depth, Expand expand) { GrowableList children; bool skip = false; // Handle ALTREP objects if (expand.alrep && is_altrep(x)) { #if defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0) SEXP klass = ALTREP_CLASS(x); SEXP classname = CAR(ATTRIB(klass)); recurse(&children, seen, "_class", klass, max_depth, expand); if (classname == Rf_install("deferred_string")) { // Deferred string ALTREP uses an pairlist, but stores data in the CDR SEXP data1 = R_altrep_data1(x); recurse(&children, seen, "_data1_car", CAR(data1), max_depth, expand); recurse(&children, seen, "_data1_cdr", CDR(data1), max_depth, expand); } else { recurse(&children, seen, "_data1", R_altrep_data1(x), max_depth, expand); } recurse(&children, seen, "_data2", R_altrep_data2(x), max_depth, expand); #endif } else if (max_depth <= 0) { switch (TYPEOF(x)) { // Non-recursive types case NILSXP: case SPECIALSXP: case BUILTINSXP: case LGLSXP: case INTSXP: case REALSXP: case CPLXSXP: case RAWSXP: case CHARSXP: case SYMSXP: skip = false; break; default: skip = true; }; } else { switch (TYPEOF(x)) { // Non-recursive types case NILSXP: case SPECIALSXP: case BUILTINSXP: case LGLSXP: case INTSXP: case REALSXP: case CPLXSXP: case RAWSXP: case CHARSXP: case SYMSXP: break; // Strings case STRSXP: if (expand.charsxp) { for (R_xlen_t i = 0; i < XLENGTH(x); i++) { recurse(&children, seen, "", STRING_ELT(x, i), max_depth, expand); } } break; // Recursive vectors case VECSXP: case EXPRSXP: case WEAKREFSXP: { SEXP names = PROTECT(Rf_getAttrib(x, R_NamesSymbol)); if (TYPEOF(names) == STRSXP) { for (R_xlen_t i = 0; i < XLENGTH(x); ++i) { recurse(&children, seen, CHAR(STRING_ELT(names, i)), VECTOR_ELT(x, i), max_depth, expand); } } else { for (R_xlen_t i = 0; i < XLENGTH(x); ++i) { recurse(&children, seen, "", VECTOR_ELT(x, i), max_depth, expand); } } UNPROTECT(1); break; } // Linked lists case LANGSXP: if (!expand.call) { skip = true; break; } case DOTSXP: case LISTSXP: if (x == R_MissingArg) // Needed for DOTSXP break; for(SEXP cons = x; cons != R_NilValue; cons = CDR(cons)) { SEXP tag = TAG(cons); if (TYPEOF(tag) == NILSXP) { recurse(&children, seen, "", CAR(cons), max_depth, expand); } else if (TYPEOF(tag) == SYMSXP) { recurse(&children, seen, CHAR(PRINTNAME(tag)), CAR(cons), max_depth, expand); } else { // TODO: add index? needs to be a list? recurse(&children, seen, "_tag", tag, max_depth, expand); recurse(&children, seen, "_car", CAR(cons), max_depth, expand); } } break; case BCODESXP: if (!expand.bytecode) { skip = true; break; } recurse(&children, seen, "_tag", TAG(x), max_depth, expand); recurse(&children, seen, "_car", CAR(x), max_depth, expand); recurse(&children, seen, "_cdr", CDR(x), max_depth, expand); break; // Environments case ENVSXP: if (x == R_BaseEnv || x == R_GlobalEnv || x == R_EmptyEnv || is_namespace(x)) break; if (expand.env) { recurse(&children, seen, "_frame", FRAME(x), max_depth, expand); recurse(&children, seen, "_hashtab", HASHTAB(x), max_depth, expand); } else { SEXP names = PROTECT(R_lsInternal(x, TRUE)); for (R_xlen_t i = 0; i < XLENGTH(names); ++i) { const char* name = CHAR(STRING_ELT(names, i)); SEXP sym = PROTECT(Rf_install(name)); if (R_BindingIsActive(sym, x)) { SEXP sym = PROTECT(Rf_install("_active_binding")); SEXP active = PROTECT(obj_inspect_(sym, seen, max_depth, expand)); children.push_back(name, active); UNPROTECT(2); } else { SEXP obj = Rf_findVarInFrame(x, sym); recurse(&children, seen, name, obj, max_depth, expand); } UNPROTECT(1); } UNPROTECT(1); } recurse(&children, seen, "_enclos", ENCLOS(x), max_depth, expand); break; // Functions case CLOSXP: recurse(&children, seen, "_formals", FORMALS(x), max_depth, expand); recurse(&children, seen, "_body", BODY(x), max_depth, expand); recurse(&children, seen, "_env", CLOENV(x), max_depth, expand); break; case PROMSXP: recurse(&children, seen, "_value", PRVALUE(x), max_depth, expand); recurse(&children, seen, "_code", PRCODE(x), max_depth, expand); recurse(&children, seen, "_env", PRENV(x), max_depth, expand); break; case EXTPTRSXP: recurse(&children, seen, "_prot", EXTPTR_PROT(x), max_depth, expand); recurse(&children, seen, "_tag", EXTPTR_TAG(x), max_depth, expand); break; case S4SXP: recurse(&children, seen, "_tag", TAG(x), max_depth, expand); break; default: stop("Don't know how to handle type %s", Rf_type2char(TYPEOF(x))); } } // CHARSXPs have fake attriibutes if (max_depth > 0 && TYPEOF(x) != CHARSXP && !Rf_isNull(ATTRIB(x))) { recurse(&children, seen, "_attrib", ATTRIB(x), max_depth, expand); } SEXP out = PROTECT(children.vector()); if (skip) { Rf_setAttrib(out, Rf_install("skip"), PROTECT(Rf_ScalarLogical(skip))); UNPROTECT(1); } UNPROTECT(1); return out; } // [[Rcpp::export]] Rcpp::List obj_inspect_(SEXP x, double max_depth, bool expand_char = false, bool expand_altrep = false, bool expand_env = false, bool expand_call = false, bool expand_bytecode = false) { std::map seen; Expand expand = {expand_altrep, expand_char, expand_env, expand_call}; return obj_inspect_(x, seen, max_depth, expand); } lobstr/src/RcppExports.cpp0000644000176200001440000001100113506701633015340 0ustar liggesusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include using namespace Rcpp; // obj_addr_ std::string obj_addr_(SEXP name, Environment env); RcppExport SEXP _lobstr_obj_addr_(SEXP nameSEXP, SEXP envSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< SEXP >::type name(nameSEXP); Rcpp::traits::input_parameter< Environment >::type env(envSEXP); rcpp_result_gen = Rcpp::wrap(obj_addr_(name, env)); return rcpp_result_gen; END_RCPP } // obj_addrs_ std::vector obj_addrs_(SEXP x); RcppExport SEXP _lobstr_obj_addrs_(SEXP xSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< SEXP >::type x(xSEXP); rcpp_result_gen = Rcpp::wrap(obj_addrs_(x)); return rcpp_result_gen; END_RCPP } // obj_inspect_ Rcpp::List obj_inspect_(SEXP x, double max_depth, bool expand_char, bool expand_altrep, bool expand_env, bool expand_call, bool expand_bytecode); RcppExport SEXP _lobstr_obj_inspect_(SEXP xSEXP, SEXP max_depthSEXP, SEXP expand_charSEXP, SEXP expand_altrepSEXP, SEXP expand_envSEXP, SEXP expand_callSEXP, SEXP expand_bytecodeSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< SEXP >::type x(xSEXP); Rcpp::traits::input_parameter< double >::type max_depth(max_depthSEXP); Rcpp::traits::input_parameter< bool >::type expand_char(expand_charSEXP); Rcpp::traits::input_parameter< bool >::type expand_altrep(expand_altrepSEXP); Rcpp::traits::input_parameter< bool >::type expand_env(expand_envSEXP); Rcpp::traits::input_parameter< bool >::type expand_call(expand_callSEXP); Rcpp::traits::input_parameter< bool >::type expand_bytecode(expand_bytecodeSEXP); rcpp_result_gen = Rcpp::wrap(obj_inspect_(x, max_depth, expand_char, expand_altrep, expand_env, expand_call, expand_bytecode)); return rcpp_result_gen; END_RCPP } // v_size double v_size(double n, int element_size); RcppExport SEXP _lobstr_v_size(SEXP nSEXP, SEXP element_sizeSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< double >::type n(nSEXP); Rcpp::traits::input_parameter< int >::type element_size(element_sizeSEXP); rcpp_result_gen = Rcpp::wrap(v_size(n, element_size)); return rcpp_result_gen; END_RCPP } // obj_size_ double obj_size_(List objects, Environment base_env, int sizeof_node, int sizeof_vector); RcppExport SEXP _lobstr_obj_size_(SEXP objectsSEXP, SEXP base_envSEXP, SEXP sizeof_nodeSEXP, SEXP sizeof_vectorSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< List >::type objects(objectsSEXP); Rcpp::traits::input_parameter< Environment >::type base_env(base_envSEXP); Rcpp::traits::input_parameter< int >::type sizeof_node(sizeof_nodeSEXP); Rcpp::traits::input_parameter< int >::type sizeof_vector(sizeof_vectorSEXP); rcpp_result_gen = Rcpp::wrap(obj_size_(objects, base_env, sizeof_node, sizeof_vector)); return rcpp_result_gen; END_RCPP } // obj_csize_ IntegerVector obj_csize_(List objects, Environment base_env, int sizeof_node, int sizeof_vector); RcppExport SEXP _lobstr_obj_csize_(SEXP objectsSEXP, SEXP base_envSEXP, SEXP sizeof_nodeSEXP, SEXP sizeof_vectorSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< List >::type objects(objectsSEXP); Rcpp::traits::input_parameter< Environment >::type base_env(base_envSEXP); Rcpp::traits::input_parameter< int >::type sizeof_node(sizeof_nodeSEXP); Rcpp::traits::input_parameter< int >::type sizeof_vector(sizeof_vectorSEXP); rcpp_result_gen = Rcpp::wrap(obj_csize_(objects, base_env, sizeof_node, sizeof_vector)); return rcpp_result_gen; END_RCPP } static const R_CallMethodDef CallEntries[] = { {"_lobstr_obj_addr_", (DL_FUNC) &_lobstr_obj_addr_, 2}, {"_lobstr_obj_addrs_", (DL_FUNC) &_lobstr_obj_addrs_, 1}, {"_lobstr_obj_inspect_", (DL_FUNC) &_lobstr_obj_inspect_, 7}, {"_lobstr_v_size", (DL_FUNC) &_lobstr_v_size, 2}, {"_lobstr_obj_size_", (DL_FUNC) &_lobstr_obj_size_, 4}, {"_lobstr_obj_csize_", (DL_FUNC) &_lobstr_obj_csize_, 4}, {NULL, NULL, 0} }; RcppExport void R_init_lobstr(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } lobstr/NAMESPACE0000644000176200001440000000066513506701654013014 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("[",lobstr_bytes) S3method(c,lobstr_bytes) S3method(format,lobstr_inspector) S3method(print,lobstr_bytes) S3method(print,lobstr_inspector) S3method(print,lobstr_raw) export(ast) export(cst) export(mem_used) export(obj_addr) export(obj_addrs) export(obj_size) export(obj_sizes) export(ref) export(sxp) import(rlang) importFrom(Rcpp,sourceCpp) useDynLib(lobstr, .registration = TRUE) lobstr/NEWS.md0000644000176200001440000000122113506700225012651 0ustar liggesusers# lobstr 1.1.1 * Fix PROTECT error. * Remove UTF-8 charatecrs from comments # lobstr 1.1.0 * `ref()` now handles custom classes properly (@yutannihilation, #36) * `sxp()` is a new tool for displaying the underlying C representation of an object (#38). * `obj_size()` now special cases the ALTREP "deferred string vectors" which previously crashed due to the way in which they abuse the pairlist type (#35). # lobstr 1.0.1 * `ast()` prints scalar integer and complex more accurately (#24) * `obj_addr()` no longer increments the reference count of its input (#25) * `obj_size()` now correctly computes size of ALTREP objects on R 3.5.0 (#32) lobstr/R/0000755000176200001440000000000013506701653011766 5ustar liggesuserslobstr/R/lobstr.R0000644000176200001440000000013713247567071013425 0ustar liggesusers#' @import rlang #' @useDynLib lobstr, .registration = TRUE #' @importFrom Rcpp sourceCpp NULL lobstr/R/utils.R0000644000176200001440000000300613506666356013262 0ustar liggesusersis_testing <- function () { identical(Sys.getenv("TESTTHAT"), "true") } # CLI --------------------------------------------------------------------- box_chars <- function() { fancy <- getOption("lobstr.fancy.tree") %||% l10n_info()$`UTF-8` orange <- crayon::make_style("orange") if (fancy) { list( "h" = "\u2500", # - horizontal "v" = "\u2502", # | vertical "l" = "\u2514", # \ leaf "j" = "\u251C", # + junction "n" = orange("\u2588") # X node ) } else { list( "h" = "-", "v" = "|", "l" = "\\", "j" = "+", "n" = orange("o") ) } } grey <- function(...) { crayon::make_style(grDevices::grey(0.5), grey = TRUE)(...) } # string ----------------------------------------------------------------- str_dup <- function(x, n) { vapply(n, function(i) paste0(rep(x, i), collapse = ""), character(1)) } str_indent <- function(x, first, rest) { if (length(x) == 0) { character() } else if (length(x) == 1) { paste0(first, x) } else { c( paste0(first, x[[1]]), paste0(rest, x[-1L]) ) } } str_truncate <- function(x, n) { too_long <- nchar(x, type = "width") > n x[too_long] <- paste0(substr(x[too_long], 1, n - 3), "...") x } new_raw <- function(x) { structure(x, class = "lobstr_raw") } #' @export print.lobstr_raw <- function(x, ...) { cat(paste(x, "\n", collapse = ""), sep = "") invisible(x) } cat_line <- function(...) { cat(paste0(..., "\n", collapse = "")) } lobstr/R/size.R0000644000176200001440000000730713477777720013111 0ustar liggesusers#' Calculate the size of an object. #' #' `obj_size()` computes the size of an object or set of objects; #' `obj_sizes()` breaks down the individual contribution of multiple objects #' to the total size. #' #' @section Compared to `object.size()`: #' Compared to [object.size()], `obj_size()`: #' #' * Accounts for all types of shared values, not just strings in #' the global string pool. #' #' * Includes the size of environments (up to `env`) #' #' * Accurately measures the size of ALTREP objects. #' #' @section Environments: #' `obj_size()` attempts to take into account the size of the #' environments associated with an object. This is particularly important #' for closures and formulas, since otherwise you may not realise that you've #' accidentally captured a large object. However, it's easy to over count: #' you don't want to include the size of every object in every environment #' leading back to the [emptyenv()]. `obj_size()` takes #' a heuristic approach: it never counts the size of the global environment, #' the base environment, the empty environment, or any namespace. #' #' Additionally, the `env` argument allows you to specify another #' environment at which to stop. This defaults to the environment from which #' `obj_size()` is called to prevent double-counting of objects created #' elsewhere. #' #' @export #' @param ... Set of objects to compute size. #' @param env Environment in which to terminate search. This defaults to the #' current environment so that you don't include the size of objects that #' are already stored elsewhere. #' #' Regardless of the value here, `obj_size()` never looks past the #' global or base environments. #' #' @return An estimate of the size of the object, in bytes. #' @examples #' # obj_size correctly accounts for shared references #' x <- runif(1e4) #' obj_size(x) #' #' z <- list(a = x, b = x, c = x) #' obj_size(z) #' #' # this means that object size is not transitive #' obj_size(x) #' obj_size(z) #' obj_size(x, z) #' #' # use obj_size() to see the unique contribution of each component #' obj_sizes(x, z) #' obj_sizes(z, x) #' obj_sizes(!!!z) #' #' # obj_size() also includes the size of environments #' f <- function() { #' x <- 1:1e4 #' a ~ b #' } #' obj_size(f()) #' #' #' # In R 3.5 and greater, `:` creates a special "ALTREP" object that only #' # stores the first and last elements. This will make some vectors much #' # smaller than you'd otherwise expect #' obj_size(1:1e6) obj_size <- function(..., env = parent.frame()) { dots <- list2(...) size <- obj_size_(dots, env, size_node(), size_vector()) new_bytes(size) } #' @rdname obj_size #' @export obj_sizes <- function(..., env = parent.frame()) { dots <- list2(...) size <- obj_csize_(dots, env, size_node(), size_vector()) names(size) <- names(dots) new_bytes(size) } size_node <- function(x) as.vector(utils::object.size(quote(expr = ))) size_vector <- function(x) as.vector(utils::object.size(logical())) new_bytes <- function(x) { structure(x, class = "lobstr_bytes") } #' @export print.lobstr_bytes <- function(x, digits = 3, ...) { fx <- format(x, big.mark = ",", scientific = FALSE) if (length(x) == 1) { cat_line(fx, " B") } else { if (!is.null(names(x))) { cat_line(format(names(x)), ": ", fx, " B") } else { cat_line("* ", fx, " B") } } } #' @export c.lobstr_bytes <- function(...) { new_bytes(NextMethod()) } #' @export `[.lobstr_bytes` <- function(...) { new_bytes(NextMethod()) } # Helpers for interactive exploration ------------------------------------- comp <- function(x) { base <- utils::object.size(x) lobstr <- obj_size(x) c(base = base, lobstr = lobstr, diff = base - lobstr) } insp <- function(x) { eval(quote(.Internal(inspect(x)))) } lobstr/R/ast.R0000644000176200001440000000456713502504130012677 0ustar liggesusers#' Display the abstract syntax tree #' #' This is a useful alternative to `str()` for expression objects. #' #' @param x An expression to display. Input is automatically quoted, #' use `!!` to unquote if you have already captured an expression object. #' @family object inspectors #' @export #' @examples #' # Leaves #' ast(1) #' ast(x) #' #' # Simple calls #' ast(f()) #' ast(f(x, 1, g(), h(i()))) #' ast(f()()) #' ast(f(x)(y)) #' #' ast((x + 1)) #' #' # Displaying expression already stored in object #' x <- quote(a + b + c) #' ast(x) #' ast(!!x) #' #' # All operations have this same structure #' ast(if (TRUE) 3 else 4) #' ast(y <- x * 10) #' ast(function(x = 1, y = 2) { x + y } ) #' #' # Operator precedence #' ast(1 * 2 + 3) #' ast(!1 + !1) ast <- function(x) { expr <- enexpr(x) new_raw(ast_tree(expr)) } ast_tree <- function(x, layout = box_chars()) { if (is_quosure(x)) { x <- quo_squash(x) } # base cases if (rlang::is_syntactic_literal(x)) { return(ast_leaf_constant(x)) } else if (is_symbol(x)) { return(ast_leaf_symbol(x)) } else if (!is.pairlist(x) && !is.call(x)) { return(paste0("")) } # recursive case subtrees <- lapply(x, ast_tree, layout = layout) subtrees <- name_subtree(subtrees) n <- length(x) if (n == 0) { character() } else if (n == 1) { str_indent(subtrees[[1]], paste0(layout$n, layout$h), " " ) } else { c( str_indent(subtrees[[1]], paste0(layout$n, layout$h), paste0(layout$v, " ") ), unlist(lapply(subtrees[-c(1, n)], str_indent, paste0(layout$j, layout$h), paste0(layout$v, " ") )), str_indent(subtrees[[n]], paste0(layout$l, layout$h), " " ) ) } } name_subtree <- function(x) { nm <- names(x) if (is.null(nm)) return(x) has_name <- nm != "" label <- paste0(crayon::italic(grey(nm)), " = ") indent <- str_dup(" ", nchar(nm) + 3) x[has_name] <- Map(str_indent, x[has_name], label[has_name], indent[has_name]) x } ast_leaf_symbol <- function(x) { x <- as.character(x) if (!is.syntactic(x)) { x <- encodeString(x, quote = "`") } crayon::bold(crayon::magenta(x)) } ast_leaf_constant <- function(x) { if (is.complex(x)) { paste0(Im(x), "i") } else { deparse(x) } } is.syntactic <- function(x) make.names(x) == x lobstr/R/cst.R0000644000176200001440000000214413304255564012704 0ustar liggesusers#' Call stack tree #' #' Shows the relationship between calls on the stack. This function #' combines the results of [sys.calls()] and [sys.parents()] yielding a display #' that shows how frames on the call stack are related. #' #' @export #' @examples #' # If all evaluation is eager, you get a single tree #' f <- function() g() #' g <- function() h() #' h <- function() cst() #' f() #' #' # You get multiple trees with delayed evaluation #' try(f()) #' #' # Pay attention to the first element of each subtree: each #' # evaluates the outermost call #' f <- function(x) g(x) #' g <- function(x) h(x) #' h <- function(x) x #' try(f(cst())) #' #' # With a little ingenuity you can use it to see how NSE #' # functions work in base R #' with(mtcars, {cst(); invisible()}) #' invisible(subset(mtcars, {cst(); cyl == 0})) #' #' # You can also get unusual trees by evaluating in frames #' # higher up the call stack #' f <- function() g() #' g <- function() h() #' h <- function() eval(quote(cst()), parent.frame(2)) #' f() cst <- function() { x <- rlang::trace_back(globalenv()) print(x, simplify = "none") invisible() } lobstr/R/address.R0000644000176200001440000000264213406773157013551 0ustar liggesusers#' Find memory location of objects and their children. #' #' `obj_addr()` gives the address of the value that `x` points to; #' `obj_addrs()` gives the address of the components the list, #' environment, and character vector `x` point to. #' #' `obj_addr()` has been written in such away that it avoids taking #' references to an object. #' #' @param x An object #' @export #' @examples #' # R creates copies lazily #' x <- 1:10 #' y <- x #' obj_addr(x) == obj_addr(y) #' #' y[1] <- 2L #' obj_addr(x) == obj_addr(y) #' #' y <- runif(10) #' obj_addr(y) #' z <- list(y, y) #' obj_addrs(z) #' #' y[2] <- 1.0 #' obj_addrs(z) #' obj_addr(y) #' #' # The address of an object is different every time you create it: #' obj_addr(1:10) #' obj_addr(1:10) #' obj_addr(1:10) obj_addr <- function(x) { x <- enquo(x) addr <- obj_addr_(quo_get_expr(x), quo_get_env(x)) if (is_testing()) { test_addr_get(addr) } else { addr } } #' @export #' @rdname obj_addr obj_addrs <- function(x) { addrs <- obj_addrs_(x) if (is_testing()) { vapply(addrs, test_addr_get, character(1), USE.NAMES = FALSE) } else { addrs } } test_addr <- child_env(emptyenv(), "__next_id" = 1) test_addr_get <- function(addr) { if (env_has(test_addr, addr)) { addr <- env_get(test_addr, addr) } else { addr <- obj_id(test_addr, addr) } sprintf("0x%03i", addr) } test_addr_reset <- function() { env_poke(test_addr, "__next_id", 1) } lobstr/R/RcppExports.R0000644000176200001440000000165113506701653014405 0ustar liggesusers# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 obj_addr_ <- function(name, env) { .Call(`_lobstr_obj_addr_`, name, env) } obj_addrs_ <- function(x) { .Call(`_lobstr_obj_addrs_`, x) } obj_inspect_ <- function(x, max_depth, expand_char = FALSE, expand_altrep = FALSE, expand_env = FALSE, expand_call = FALSE, expand_bytecode = FALSE) { .Call(`_lobstr_obj_inspect_`, x, max_depth, expand_char, expand_altrep, expand_env, expand_call, expand_bytecode) } v_size <- function(n, element_size) { .Call(`_lobstr_v_size`, n, element_size) } obj_size_ <- function(objects, base_env, sizeof_node, sizeof_vector) { .Call(`_lobstr_obj_size_`, objects, base_env, sizeof_node, sizeof_vector) } obj_csize_ <- function(objects, base_env, sizeof_node, sizeof_vector) { .Call(`_lobstr_obj_csize_`, objects, base_env, sizeof_node, sizeof_vector) } lobstr/R/ref.R0000644000176200001440000000650113502504067012663 0ustar liggesusers#' Display tree of references #' #' This tree display focusses on the distinction between names and values. #' For each reference-type object (lists, environments, and optional character #' vectors), it displays the location of each component. The display #' shows the connection between shared references using a locally unique id. #' #' @param ... One or more objects #' @param character If `TRUE`, show references from character vector in to #' global string pool #' @export #' @family object inspectors #' @examples #' x <- 1:100 #' ref(x) #' #' y <- list(x, x, x) #' ref(y) #' ref(x, y) #' #' e <- new.env() #' e$e <- e #' e$x <- x #' e$y <- list(x, e) #' ref(e) #' #' # Can also show references to global string pool if requested #' ref(c("x", "x", "y")) #' ref(c("x", "x", "y"), character = TRUE) ref <- function(..., character = FALSE) { x <- list(...) seen <- child_env(emptyenv(), `__next_id` = 1) out <- lapply(x, ref_tree, character = character, seen = seen) n <- length(x) if (n > 1) { out[-n] <- lapply(out[-n], function(x) c(x, "")) } new_raw(unlist(out)) } ref_tree <- function(x, character = FALSE, seen = child_env(emptyenv()), layout = box_chars()) { addr <- obj_addr(x) has_seen <- env_has(seen, addr) id <- obj_id(seen, addr) desc <- obj_desc(addr, type_sum(x), has_seen, id) # Not recursive or already seen if (!has_references(x, character) || has_seen) { return(desc) } # Remove classes to avoid custom methods (note that environments cannot be unclasse()ed) attr(x, "class") <- NULL # recursive cases if (is.list(x)) { subtrees <- lapply(x, ref_tree, layout = layout, seen = seen, character = character) } else if (is.environment(x)) { subtrees <- lapply(as.list(x), ref_tree, layout = layout, seen = seen, character = character) } else if (is.character(x)) { subtrees <- ref_tree_chr(x, layout = layout, seen = seen) } subtrees <- name_subtree(subtrees) self <- str_indent(desc, paste0(layout$n, " "), paste0(layout$v, " ")) n <- length(subtrees) if (n == 0) { return(self) } c( self, unlist(lapply(subtrees[-n], str_indent, paste0(layout$j, layout$h), paste0(layout$v, " ") )), str_indent(subtrees[[n]], paste0(layout$l, layout$h), " " ) ) } type_sum <- function(x) { if (is_installed("pillar")) { pillar::type_sum(x) } else { typeof(x) } } obj_desc <- function(addr, type, has_seen, id) { if (has_seen) { paste0("[", grey(paste0(id, ":", addr)), "]") } else { paste0("[", crayon::bold(id), ":", addr, "] ", "<", type, ">") } } has_references <- function(x, character = FALSE) { is_list(x) || is.environment(x) || (character && is_character(x)) } ref_tree_chr <- function(x, layout = box_chars(), seen = child_env(emptyenv())) { addrs <- obj_addrs(x) has_seen <- logical(length(x)) ids <- integer(length(x)) for (i in seq_along(addrs)) { has_seen[[i]] <- env_has(seen, addrs[[i]]) ids[[i]] <- obj_id(seen, addrs[[i]]) } type <- paste0('string: "', str_truncate(x, 10), '"') out <- Map(obj_desc, addrs, type, has_seen, ids) names(out) <- names(x) out } obj_id <- function(env, ref) { if (env_has(env, ref)) { env_get(env, ref) } else { id <- env_get(env, "__next_id") env_poke(env, "__next_id", id + 1) env_poke(env, ref, id) id } } lobstr/R/sxp.R0000644000176200001440000001264713502504057012730 0ustar liggesusers#' Inspect an object #' #' `sxp(x)` is similar to `.Internal(inspect(x))`, recursing into the C data #' structures underlying any R object. The main difference is the output is a #' little more compact, it recurses fully, and avoids getting stuck in infinite #' loops by using a depth-first search. It also returns a list that you can #' compute with, and carefully uses colour to highlight the most important #' details. #' #' The name `sxp` comes from `SEXP`, the name of the C data structure that #' underlies all R objects. #' #' @param x Object to inspect #' @param max_depth Maximum depth to recurse. Use `max_depth = Inf` (with care!) #' to recurse as deeply as possible. Skipped elements will be shown as `...`.` #' @param expand Optionally, expand components of the true that are usually #' suppressed. Use: #' #' * "character" to show underlying entries in the global string pool. #' * "environment" to show the underlying hashtables. #' * "altrep" to show the underlying data. #' * "call" to show the full AST (but [ast()] is usually superior) #' * "bytecode" to show generated bytecode. #' @family object inspectors #' @export #' @examples #' x <- list( #' TRUE, #' 1L, #' runif(100), #' "3" #' ) #' sxp(x) #' #' # Expand "character" to see underlying CHARSXP entries in the global #' # string pool #' x <- c("banana", "banana", "apple", "banana") #' sxp(x) #' sxp(x, expand = "character") #' #' # Expand altrep to see underlying data #' x <- 1:10 #' sxp(x) #' sxp(x, expand = "altrep") #' #' # Expand environmnets to see the underlying implementation details #' e1 <- new.env(hash = FALSE, parent = emptyenv(), size = 3L) #' e2 <- new.env(hash = TRUE, parent = emptyenv(), size = 3L) #' e1$x <- e2$x <- 1:10 #' #' sxp(e1) #' sxp(e1, expand = "environment") #' sxp(e2, expand = "environment") sxp <- function(x, expand = character(), max_depth = 5L) { opts <- c("character", "altrep", "environment", "call", "bytecode") if (any(!expand %in% opts)) { abort("`expand` must contain only values from ", paste("'", opts, "'", collapse = ",")) } obj_inspect_(x, max_depth - 1L, opts[[1]] %in% expand, opts[[2]] %in% expand, opts[[3]] %in% expand, opts[[4]] %in% expand, opts[[5]] %in% expand ) } #' @export format.lobstr_inspector <- function(x, ..., depth = 0, name = NA) { indent <- paste0(rep(" ", depth), collapse = "") id <- crayon::bold(attr(x, "id")) if (!is_testing()) { addr <- paste0(":", crayon::silver(attr(x, "addr"))) } else { addr <- "" } if (attr(x, "type") == 0) { desc <- crayon::silver("") } else if (attr(x, "has_seen")) { desc <- paste0("[", attr(x, "id"), addr, "]") } else { type <- sexp_type(attr(x, "type")) if (sexp_is_vector(type)) { if (!is.null(attr(x, "truelength"))) { length <- paste0("[", attr(x, "length"), "/", attr(x, "truelength"), "]") } else { length <- paste0("[", attr(x, "length"), "]") } } else { length <- NULL } if (!is.null(attr(x, "value"))) { value <- paste0(": ", attr(x, "value")) } else { value <- NULL } # show altrep, object, named etc sxpinfo <- paste0( if (attr(x, "altrep")) "altrep ", if (attr(x, "object")) "object ", if (!is_testing()) paste0("named:", attr(x, "named")) ) desc <- paste0( "[", id, addr, "] ", "<", crayon::cyan(type), length, value, "> ", "(", sxpinfo, ")" ) } name <- if (!identical(name, "")) { paste0(crayon::italic(crayon::silver(name)), " ") } paste0(indent, name, desc) } #' @export print.lobstr_inspector <- function(x, ..., depth = 0, name = "") { cat_line(format(x, depth = depth, name = name)) if (isTRUE(attr(x, "skip"))) { indent <- paste0(rep(" ", depth + 1), collapse = "") cat_line(indent, crayon::silver("...")) } for (i in seq_along(x)) { print(x[[i]], depth = depth + 1, name = names(x)[[i]]) } } sxp_view <- function(x, expand = character()) { if (!"tools:rstudio" %in% search()) { abort("Can only be called from within RStudio") } env <- as.environment("tools:rstudio") old_opt <- options(crayon.enabled = FALSE) on.exit(options(old_opt), add = TRUE) old_fun <- env$.rs.explorer.objectDesc on.exit(env$.rs.addFunction("explorer.objectDesc", old_fun), add = TRUE) assign(".rs.explorer.objectDesc", envir = env, function(x) { if (inherits(x, "lobstr_inspector")) { format.lobstr_inspector(x) } else { old_fun(x) } }) obj <- sxp(x, expand = expand) env$.rs.viewHook(NULL, obj, "Object inspector") # explorer.objectDesc() is called lazily so this is a crude hack Sys.sleep(10) } # helpers ----------------------------------------------------------------- sexp_type <- function(x) { unname(SEXPTYPE[as.character(x)]) } sexp_is_vector <- function(x) { x %in% c("LGLSXP", "INTSXP", "REALSXP", "STRSXP", "RAWSXP", "CPLXSXP", "VECSXP", "EXPRSXP") } SEXPTYPE <- c( "0" = "NILSXP", "1" = "SYMSXP", "2" = "LISTSXP", "3" = "CLOSXP", "4" = "ENVSXP", "5" = "PROMSXP", "6" = "LANGSXP", "7" = "SPECIALSXP", "8" = "BUILTINSXP", "9" = "CHARSXP", "10" = "LGLSXP", "13" = "INTSXP", "14" = "REALSXP", "15" = "CPLXSXP", "16" = "STRSXP", "17" = "DOTSXP", "18" = "ANYSXP", "19" = "VECSXP", "20" = "EXPRSXP", "21" = "BCODESXP", "22" = "EXTPTRSXP", "23" = "WEAKREFSXP", "24" = "RAWSXP", "25" = "S4SXP", "30" = "NEWSXP", "31" = "FREESXP", "99" = "FUNSXP" ) lobstr/R/mem.R0000644000176200001440000000143113251235323012657 0ustar liggesusers#' How much memory is currently used by R? #' #' `mem_used()` wraps around `gc()` and returns the exact number of bytes #' currently used by R. Note that changes will not match up exactly to #' [obj_size()] as session specific state (e.g. [.Last.value]) adds minor #' variations. #' #' @export #' @examples #' prev_m <- 0; m <- mem_used(); m - prev_m #' #' x <- 1:1e6 #' prev_m <- m; m <- mem_used(); m - prev_m #' obj_size(x) #' #' rm(x) #' prev_m <- m; m <- mem_used(); m - prev_m #' #' prev_m <- m; m <- mem_used(); m - prev_m mem_used <- function() { new_bytes(sum(gc()[, 1] * c(node_size(), 8))) } node_size <- function() { bit <- 8L * .Machine$sizeof.pointer if (!(bit == 32L || bit == 64L)) { stop("Unknown architecture", call. = FALSE) } if (bit == 32L) 28L else 56L } lobstr/README.md0000644000176200001440000000424313407003613013036 0ustar liggesusers # lobstr [![CRAN status](https://www.r-pkg.org/badges/version/lobstr)](https://cran.r-project.org/package=lobstr) [![Travis-CI Build Status](https://travis-ci.org/r-lib/lobstr.svg?branch=master)](https://travis-ci.org/r-lib/lobstr) [![Coverage status](https://codecov.io/gh/r-lib/lobstr/branch/master/graph/badge.svg)](https://codecov.io/github/r-lib/lobstr?branch=master) lobstr provides tools in the same vein as `str()`, which allow you to dig into the detail of an object. ## Installation Install the released version of lobstr from CRAN: ``` r install.packages("lobstr") ``` You can install the development version with: ``` r # install.packages("devtools") devtools::install_github("r-lib/lobstr") ``` ## Example ### Abstract syntax trees `ast()` draws the abstract syntax tree of R expressions: ``` r ast(a + b + c) #> █─`+` #> ├─█─`+` #> │ ├─a #> │ └─b #> └─c ast(function(x = 1) { if (x > 0) print("Hi!") }) #> █─`function` #> ├─█─x = 1 #> ├─█─`{` #> │ └─█─`if` #> │ ├─█─`>` #> │ │ ├─x #> │ │ └─0 #> │ └─█─print #> │ └─"Hi!" #> └─ ``` ### References `ref()` shows hows objects can be shared across data structures by digging into the underlying \_\_ref\_\_erences: ``` r x <- 1:1e6 y <- list(x, x, x) ref(y) #> █ [1:0x7fa42b6a9598] #> ├─[2:0x7fa428ae7c88] #> ├─[2:0x7fa428ae7c88] #> └─[2:0x7fa428ae7c88] e <- rlang::env() e$self <- e ref(e) #> █ [1:0x7fa42d981790] #> └─self = [1:0x7fa42d981790] ``` A related tool is `obj_size()`, which computes the size of an object taking these shared references into account: ``` r obj_size(x) #> 680 B obj_size(y) #> 760 B ``` ### Call stack trees `cst()` shows how frames on the call stack are connected: ``` r f <- function(x) g(x) g <- function(x) h(x) h <- function(x) x f(cst()) #> █ #> 1. ├─global::f(cst()) #> 2. │ └─global::g(x) #> 3. │ └─global::h(x) #> 4. └─lobstr::cst() ``` lobstr/MD50000644000176200001440000000441413506762114012077 0ustar liggesuserse67abfee90a1f5d0fa2f791a9d21b589 *DESCRIPTION d7d59f243f9033b7970179fa6958c31e *NAMESPACE 1b5453d9fc400339e6a7b468a7868b3d *NEWS.md 6c3a7e10b62bf77f1104ed16ed167656 *R/RcppExports.R 93d58f53eeb7461eb9be11353d16243b *R/address.R 5cd39b056b3bdc4b0d0b945532dda9b4 *R/ast.R bb5066b00bc02e63f4225fb8817f8848 *R/cst.R f85f62d7965b6e0dbd848a4d29d8b6c3 *R/lobstr.R 77012918976575fd5b176b95a1d18fb3 *R/mem.R 4915760c3fe046368a117f475cc95705 *R/ref.R e85018495acccdadfc3d1345cbaa99bb *R/size.R f7d3d97198a963fb6c687ec382fc5e66 *R/sxp.R 1fdc903cf55779e17b413f0081a92eac *R/utils.R 2c4f20e492d9e2eee6d0fa66c15d51ab *README.md 32e9faa30332076a0e403009e89451cb *man/ast.Rd ec937196239fb6b6959b59e5f7764caa *man/cst.Rd 8f3defd041d3786de9355197c1b259a5 *man/figures/logo.png b6292677acd723224e8bb27b7938225e *man/mem_used.Rd de54fc026d86e22ce7e10db07ab32377 *man/obj_addr.Rd f8b5ee446ac342e149827cad29a7f658 *man/obj_size.Rd 25b24fa5fb6ed65e464ade94c996ea4c *man/ref.Rd 30b069aed55d7de71b4ec2b22d4d4a01 *man/sxp.Rd a43366150a25710c6b7bde35c63866b1 *src/RcppExports.cpp f63a19c6c734e9a4e08fd03fbb29b96b *src/address.cpp 7f0b3f02c6bfbc71845aa3180df15834 *src/inspect.cpp e0f255dbec9b124de7a0839b34858711 *src/size.cpp 35f98f5a6ad54e371e4e1f6638702a56 *tests/testthat.R 3786e6f6b356c7f36eff1d46cc40b649 *tests/testthat/size-aligned.txt 263d40dbd5737c596c2a84933180dc61 *tests/testthat/test-address.R 81733419cb75a9a55da5f47fdc7c283e *tests/testthat/test-ast-fancy.txt a1ff3dd26448e292b471c5eca2c9724c *tests/testthat/test-ast-scalar.txt d82d19cd84f2fe6406a1d3bb2bdc39eb *tests/testthat/test-ast-simple.txt d506ebdffb26f57e1f1c5c5f7c98d8f3 *tests/testthat/test-ast.R 43979f174cc721d777f38be9688814fc *tests/testthat/test-ref-character.txt 973089f8317d8c951abe2c3920c578be *tests/testthat/test-ref-env.txt 45391406745e334351aa6cbd635f0b31 *tests/testthat/test-ref-list.txt d31eaabdcdeac0b01bc8ef50bd01d0f7 *tests/testthat/test-ref.R 9fbcbd7952d457686bee58c3871f0139 *tests/testthat/test-size.R 9204cf352542f1e3e40a88bf5c6062fa *tests/testthat/test-sxp-altrep.txt c69c93ed1354a4ae210ddf7a29b32b1e *tests/testthat/test-sxp-atomic.txt f6face7c5132d4c959aebbed6f09b89b *tests/testthat/test-sxp-environment.txt 6c438df8bea2a5076071b5c397046054 *tests/testthat/test-sxp-function.txt a8f7d7ab8e3ba6803dc456d441613180 *tests/testthat/test-sxp.R lobstr/DESCRIPTION0000644000176200001440000000173313506762114013276 0ustar liggesusersPackage: lobstr Title: Visualize R Data Structures with Trees Version: 1.1.1 Authors@R: c( person("Hadley", "Wickham", , "hadley@rstudio.com", role = c("aut", "cre")), person("RStudio", role = "cph") ) Description: A set of tools for inspecting and understanding R data structures inspired by str(). Includes ast() for visualizing abstract syntax trees, ref() for showing shared references, cst() for showing call stack trees, and obj_size() for computing object sizes. License: GPL-3 URL: https://github.com/r-lib/lobstr BugReports: https://github.com/r-lib/lobstr/issues Depends: R (>= 3.2) Imports: crayon, Rcpp, rlang (>= 0.3.0) Suggests: covr, pillar, pkgdown, testthat LinkingTo: Rcpp Encoding: UTF-8 LazyData: true RoxygenNote: 6.1.1 NeedsCompilation: yes Packaged: 2019-07-02 17:00:44 UTC; hadley Author: Hadley Wickham [aut, cre], RStudio [cph] Maintainer: Hadley Wickham Repository: CRAN Date/Publication: 2019-07-02 23:10:04 UTC lobstr/man/0000755000176200001440000000000013506706674012350 5ustar liggesuserslobstr/man/obj_addr.Rd0000644000176200001440000000162113406773170014375 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/address.R \name{obj_addr} \alias{obj_addr} \alias{obj_addrs} \title{Find memory location of objects and their children.} \usage{ obj_addr(x) obj_addrs(x) } \arguments{ \item{x}{An object} } \description{ \code{obj_addr()} gives the address of the value that \code{x} points to; \code{obj_addrs()} gives the address of the components the list, environment, and character vector \code{x} point to. } \details{ \code{obj_addr()} has been written in such away that it avoids taking references to an object. } \examples{ # R creates copies lazily x <- 1:10 y <- x obj_addr(x) == obj_addr(y) y[1] <- 2L obj_addr(x) == obj_addr(y) y <- runif(10) obj_addr(y) z <- list(y, y) obj_addrs(z) y[2] <- 1.0 obj_addrs(z) obj_addr(y) # The address of an object is different every time you create it: obj_addr(1:10) obj_addr(1:10) obj_addr(1:10) } lobstr/man/figures/0000755000176200001440000000000013406770053014003 5ustar liggesuserslobstr/man/figures/logo.png0000644000176200001440000006747713406770053015476 0ustar liggesusersPNG  IHDRX?gAMA a cHRMz&u0`:pQ<bKGD pHYs!7!73XztIME Nn.IDATxw|y~:L `搜5f%˒`$ZٽpvϽ{w:QV%I0&p"s&A @:`?PC6Oe~Ѐ/5zb+'P`qUaW`/ P fA "ilSG/\>X Fӈ[ | VO1Q $:/bϋVD@⍈7&Wǰ%2M&"o$0]n~,PB/1R)p+`>2o^C+p)&ŎsU~i;H(80]>kJ'  WuK=!1 9p'`Ŗ XEL" 'R)uc8trHu ]^Kwߣ`ObǹK=$Cgۮ-8ք.έ;$I<w# ^Ls3˟zL)%P]WزM,4lɫtwarq?.e,yQ bq+~ضcf }pHKNyPXkm\:|"ر2P Z@5$zcwQSZŮ.E~@"Ϸ* qM/".׭YZ@BIUGSZhh&*kBB>wg vT"\"'ƿCAf(xp2ECJʚ2ofˋPT;p}]XֲaNlq P c29aVIϾv{v^ג;B"qn\͕͌ۏ/ȷ{ UD+i2_d~3 -`m?Ҡ""Kֱq.˭"*@*Ri*uj8t-(ĝ!e5ȅSWM:^. UBjqnYe 7m bb!A*3;e +[.@@%be~$_;s߽ĝ"(͗Zrc!@<s;U-.#ށ>2d~Ғ8\;4pJ+ŗVY;<83ʹ\k#M,׭.W/~(ːI)QUJKmC% q#wkt`rlq(xOPZ^āc{رXwwy O|3?qvK)4GGsLiI<~7M{x'iB#\µ 7 GV-l8H< d~O`ǹ+&;xʒ{jWdPO_ [\S< k)ĝ!DA(ĭ~e&oQiGhܻuVfPX[W۸tfEe=ڧ [~$򺱇.6zL hn[{{6d7*eA4&FCƞZnXlKx( q:VIvT@#dC6>kd+!tRq{4cqfסu%7$VY4Y/ ] >4U)K)y9D.&] ŕ}O9#TESVZAQfNJ"ضo :5elV(H%!q1ǀxS[Րm1.7@5g=WJ{y੽.Hb-3dIVDmOdpx<(bxlJ [\6 =Men\24M#RZ\\nhl߷g \UNGC$ ![`Wމmnl!3?`6vjYVWQ|^%x=Y sѰ*- Au]u[lb,dOY5. <bf"wWCvrLsRJJ*<B,Ӣ [\Z ,!0 wVJ8~4}8:kd+M%[ܐwjlPU?@iqɒdiQRs2K?v[Q7ն EIq=`eu!z.3m 'q8x..aTNٯ@F#pgoɂ,N'A]ي_eʪ7xL8񽷈I&SOVVxe^@uE1 S˖K01h!R$]_v4t:iǶ4ĞT+e%4GX1秤ˍC,ϴ 3?nx|s!t(REQ. UUX*;`żsWSv 8 Bs,ibQV[Ďˊ n=4-^[5; zUT|޶\6l1oH&wt'u;3Q%got: r_nEaw|eeabQۃG׳W&"N6 =XiS#\9;HKrxp8L(Ʋtm[\OŮ~.>?Ns=ڒ!%y`K!H뷹qPCsvr12@<g"4A4[75%j v{PU^,fxr7H&tu|Trxp.L$2 L)lqni2a/Mz<>TuC%CJp{"2%KbV.;=mgx"ϚWFgX!~ܮtt;Y¾- ǒǣ„ƢD&" qԹߙKZDQBTr%N++[s#JyE nx^4ug##;;: Vx LN)%I"$<ao"Q,k-4 EB#aL\Ym+Bw^?q48HtcOieQ /T2Ӿ^Y+--Isky/D^FyY%?G6wvy>H)) X#%884J+x{m{k'B @UTTƇtud ˴ R I$ 1.t]4f5`7hVIi-^22?Uq_ C; @@._jP6+X&C(vb@Q&@%N2;BOGC#)˙#eZD"Qtm{SfrP؍=dՔn_n.Cή![wPZUYu ˔8Nan(/d.!^BhJ)Hir,-Rn á(J.c=40ʹL O0LLT7'hp"%s7m O͚B9d~˻ӉkqF\su ҒUuO A }MԷuRZDwN&DU%~(.wjS폔qZN4x>tՑ,[2714 BQֲ]nlSL-fRߡβwE6qUUCaǾzH!}\8u s;&EזnQ#l]țKPecT2EoW?N_tJƬnuhیd*H)lASntkP0-s_-Ƕ@nw|ul/B`hٔ~eJ1OJIi:g ˲u6xh yaڛi:}B^AJ/ѻrV$#v(T]5155e4NQY gŧ>*Kpz ̨4Y#kTd:Z,s -iݿ^ݡ`CuζiDStt՘CՖR+4H$i GwAFI&R(Bh>i(`Kc{؎ZK)q]Upz/fDqx14d,mpհ]* Swah L~v$ҰM!D#1|P@<`w vsuFGFbXDUUtՁESuh iw.]iT*MDz$%4쪙$m)04ߓPi:mBBaN8KxsζnwԱi'Uue8"EvQVYo@yճ?Qfnw`YHa2yN^f,Sq(* .Hb! OL%0PQXIyE`Kn:h]s2f A ]wz5aY^좪lʍ"ot?AYU7d&?~xt.p$voAUfYbuRHAx"g}N ^*Ӵy6xsm!KbuQqG>BJIuC902~D5Oݙ/VÏٙaڮwxaBpj+7BUE-Y[ %!HSjFP]thNIEÏ!Xs8uT*EOG.ޤ3mbN7NZܼNķجPUŨ c D&b=ڈ/0w˿e1z***<NUUDU,Ӛ1C l{m| d?}Gb!q!w ~{wwKtyU)}nqК߼'0Y 5xʪf$vr  Eb>`o)%Ã4_Ivb8 ޝ!sp+{1@8A;tC_cC9JCQE~G4vZ.!LDy%Vmɳ~:FW+k8 Ӵ4rҲs<$˲n#E4޾QCꤛ0=]\U4C4pxn*JR6eÞ%6MDiVS'qm1|h}NE^%>E<>7NݡD^6-]A8kǴ,yWE٠ Tp wnw/b8jp70yu eu?EQ(nh&FC}qwܨz4]wzp:\SZQLIeEe~7swu-#'#Jsܸ| C3U-PVQnl|^\8u ';(P]W=qTfv=be=|irf FƆD546m^~d-nSW@S[_KqY-ZUYM$)&B 'iܻ=%is n\xEeg=_a>BqYm;&)%`0 ME,,K"XKk,a|$LJ#M:N3HJR'{) #Ã#?ݐCcn^l{?(* R&/!(-/Ld&WYnD (eqXӴ0Mt*(xh$F$% G⤒iLB P M~QQSO҆z3rx14,aR47\|Ɨ' |%)ϖMO,%1-{ !wzplt:E:mbMi˴,Q)䛊4eJVuC9ۃ7rciξy8tNC61{RRVȖǛp ܴY,$W,n écF,@%CZٵx,A$%N "4@d TaW5ٍkE[.hκ"jKGhb#nD>/)%t9Ŧ6恴d Zf4<8t7DW%Ъe7;mM3+so]Denl`tx:CyuofXYqY&8,y?k&;gEvJgLwVs=8ݶ<OpY[:p<?Wlv+`U( aXdK-,sBPU J8ypnӓV5q~[˲x m-8 'ct@n+w(x]bȼ`I*r>I\pU~wSveiz=v."T\˔4Md"Z @ɯ$  rUΒyXW#gգ:ۺ9%)pJR)7l`wn!|,dCh7/ݱ3*,z֗\k5]l`#EeY;?›/&rx6?]Ws8Kg 2ӆIn_뤿k`'au?#f#OJ6R}!#xmFqn ՙ=U4c;P̒paʧ_;oW*tkw fL$YZJwY`CX޷ oCQN`ldW&=}vF&Fvڊ#-3׹y62|> _Ѓ7s冽EB1(BH89~جch[h ^AL_*[/fh4>clm>:q99ûй8$K8y$PqpꨚiZDBQ2@_ tg(%_!l<{tE襄T2};W pг=UJjUPP>?8`0݅k:Su6jWNCrc8]zQ()QUѹ~63x_ֆ,xMR4-}l5De),D"uky8;vlȍۜgM5挻@p;sӮDϰLW[IĒx] 9Z(F).^ڵH&Ru? ^G!(. Jsue˲0&dD& xqn3-eI.YAgInlRrC&a~.p86mc BcaFƗt,btxYTUés+#7zȟKgq͋ LArOMb8WO"X-{+yA2O#Kdn@ȽwB 5sld<_ًX pCJ[[Y_:%]}N8 Nذg{ vk,^3$aFE ƴ Qҩ=|'"+8J'RJJ}<0vݧt:q3eqslWe|6Ks!i116A4gb$ /L, 4!I5B024F"M_* S(C x'B'^|o_FZ*2QuhJ a]^é/YA"$4dH).=UF !:U/ ît~'opva\x"h Gl"N[6D!TE]a!TUeǾ-vdfٵ7?LwG/݅@]l>BFljhȜ*%x}NiR.:%`|48J@K22f$}] tW  K@.،YiO65}7aolywΙkMotCcW7Gjn;_!KSUu7Ғ{lt$f7L;sf|huUU{| Nʊ ,tA"QTe-RJJ+J6Οh&_AiqL+Aʪv8Wrc\ob^):&OqSHRp\lib|8̹7/ai<%6#D&b1\fDkt7g(]Q`0XsV3"歏J)iܷ꼲PKo6hBnJbZ멨+Wfڢv? > A"F/q;^یM5HCJa8獃%`8 \M:e %ck+w s̭):\)%?wmMu}.tCuuO-"/. L3e/c!coi[d"E<$sy~2<8 eZ̙V55o)I.cΞf!#tƚ\|dl<|]  ;xnvl=a|E| (xLwj+kZn^jÒPQى4fK%AǸx ](Bc,fW&ԡ( n51>wfJͫEbxrWTMEʆJ)x",p/H-.ud2ŶZ<^7Bd' E)!R[Ҋb!L`I@Ǿc;WiF<ǡ9qhEve]CJ3.r;M`UUsdhh, 'Hpyxf Doݠz TU, r9QCK~H& tqM;6Tc8tT%DZ|IN9s Av )Aw9+x~M #,&Ix,]KY &O`ߚؙ $hj[.;\8]N id"I,'<\8}UpjnrNK QRF뺖g%o)sβt=c}o^mEUGG–S;>z; OD8q TMlK EXzg( $fd<egSZHi9Knc[]b:rnrh4C[#:/%XJ*\욙Y.@ØRrbKԳ@<qot@L yۉv*HJL"I0?FWk}Cģů>]whde6f[t|?%Ōts?E$civʹW&vhpMx W]AQyzy5~h2 3$Rf݇$~{L/0cߑ*xnA7u+ZwZzl"kzhP3Xs]gNAzvB`)CJ*yr/jVd]OeZqj'`o `H I签)I4Ui$wwUc^@y!lK:D[s-X!CΖהsN 7 !sbHuD1ǨQGqQޙ: ݝeYgDK(.p9rx4΅SWH&Ruf CH)q8 a)5ص&HiIEsr,`d`h(PVQBIe`J^t͑jƎ}[0CYb.ûY(8/`7U%UBÎ:m]ba { [d!vkáSs ɬyWRyS k2^P p@ӵLgbÞᣢ\ԂEhvpSEi5ٖ 8ڒYi*^䅯[3Ӱ_(8O*JUsRUl^h`HĒ2{\n'{̜xV>*a,Z.v$Ïٔ{AQy)%eU8<% L_5{ɤ̸D 9@Ie`yn߻<͹.<e-2\=Jʊ+vSPuq{9U(kY633=USmg'bJ= _;6(̴\c%)zP Uh @UTبW2:8HK,PUּGւY\h;;s_JDZ {GIwsN+4 4U#2\83WZsc7sde@Q잃`~M.+BaAw[?#amqmz&BBcƇC l!PZ6еBEfmjI,U4&BikhfTWkߢi4R@, ݪ89')GrS$AZ'˒XS2p{8"Lk٭`Op{];KRJB@3.G\W74K.zH΅!׮oRaC! = %QT?)b:T1Zur :Z{ʽL˲8p|5RY[j+S 1>&\Z/h$f˞=D E) yK dj9"H%$\vy!cCƣp{ܨ%-T: ˲(.=Gu{]G^_~KɡG}7g%{-/^R,,$O,BϚL SR71DJ '6I&e-ǒ R\r%l>\I, o}9ɛEQ| ~2懔q_?C]][ùwҒSERK^˲HēpuHl?xhY9rB,;"p3m:C_׫,Oe{Uh8Ƶs\Cd"F˞Cup+zq_=wzx ɶu@Ҋ"߳E$-˶諩UBs"\;ʩW.s|+#cCf"U'p8:Qk ƾ}O!one0nGuO|=hY'~wĢYɣ  /k=ei*5%<f*,[4R姻ΊgEB\.'N.!9 iq&ɧ4`Gy>@o jfdxHҘ}4cK} spc=+\@UT;?I"c@vcM{rp1LQU"|7p.wdi? EP閅(ң#)%NҊ"Jʂ=NI:i n;^do˲7,IEM ? z^/Mv[%*IҌW32P3m5L*tCsk3'``O_[NGYgmvS;ΩW/feI6)݇N|K/co=[k2Pآ9+A]}%;(~ܿ}I95N|4:풛2l*}aI GlS79F?#cBNǢ\ @7 ;ص+ڤZx"Փq9<i: qyp*CZc!>wEQt&CH)y}w-̇.XiBteilX VAӑeEtCUv/vp&<>{i6+?iaol/Eܸpv26Nh$;d/T*@Hf $]FiPYv]E܉X^ڲvDJhэxNjS\aﱧS,!thL2WdI(UU֕;n݇Kl];& =.IEm IJ+x['ysģ QJ a{+ʹ }M` =)xt֡s} 7 /$6j˨.Y|~X)%2l߽8FμVvxޣAN4X4Nؗ̇D wgZ!{ {`MYq|k=ϓ3ͩTn ,B. jJcS=NcߒR<Dgph8>}~\h`_(Clos8] winDNkNhwCW9+@YKGA)WӴ5r2 ]A~IyʢElFiE($x,AGkϼ^74>qHɍKm4_9{ydfO|=W/xa\o|-;(KZ])!H&npy8E'-%/M#(9WSAO  P) JRM-R?#'s񑐭/nmz;dOp O0o_qg w~ObM*Z*20;V\\nb#=TU:MrL.[zx3=!nԐqeXiI/zqyDN@W[_Bu}9&-cM<',%Ist 8ujVp&n\j'Ik~?&0B&nq_AnY!N]rRғ[2"+[R z$bCt~ hx%bn`(=4ca-Sin^n.)é324΍8sHGir/_$2i=-4 ˒הϽ_üʷOگ-l춏جՠ%>wb۔{< f|-bKc5;3EubG5:>%ٹcw!-ɵ3Jg>WZTlN}?ػs|}`/7Nk=ݔUv/)áN7* pJ;? LO 5Jp󕄖Bma4-j(I.6܄|6=9 2j?4 hgϭH-9`/vͲÿC?jV =hI.=E9/]=lo2k6G>c<ù$/}dFnczF4Ͻmk3Ƕ,*<'8݄8obNh |_RJ/ 2MCc$02BXm֭<􎃹bS߇Ŷݵϼ9 L|o_yc[:p|_9hn+3#oUE?+vˤeYsu,@0e}}A;=PT:;>{ݹyS|OL@:~e6#Ȳ"vo`l8$BU|J)WOƋfcCwQ Em7:ؽMGvH8Ɲ֞n #i.߸`])wM /ɗ.?.Tz/{kE˧orKt_g3iz`;nn XXH OI Esg |"o]˯g9u/&SRC3MqL J~7Sz^>ghYïpJ-$)@)1ŷo𝯝RNDo6 )9NZR*J8x|)ωS?T}[|fYnhx|)>8GiZw?Hl^Mq} ~X4py=Gv07ʵ{*5P p"8e.O(. xx<љ¶6޼_dwtFsrp<_zR| N}wqz`l84던f~k<ø}$u]||ܱ_xs<ܹ7&/⟾}fֲU*"4}XšGޟxjQ,k:o-z -;?7'?ʣ:BOo֕5Vo 6%,IM}~/ 0 qGB sx,A<ɛ RYW:;osge >_2R7˗O~}ph6Bu}9j}ڹ5.v\p%jӢ]=w4ΡwSX/EQq0Ϸrv "MR|so\ȵM {r? ;kl⌏iWrt\ (n\^'Y5:~㽟xR~ =:oQvQ'I;),o( >Kʙ1MsDR})?&)'PU]³$c"QR|_\|Gf\("qΜׯt8\BCфi=ܲ$gN\ˮiS&jҩ8]OĒcp{'%ܸІe֩Ȗ~OOg}*4I&Si1iC6Q^S2wĚeY䂿cY ^Us]|h7u+XR27ʩ/O1>ڰ$o(=̈́tYRMboY< @m B] e-l042gCz M;vucO<ET&L {8~|0.x3M ?}]$TԔ~ׂ*T2?y۰O~+y |gc~`V׿,@zvƟĆ$}CeAR<JF3Ұ&&-I͖*jucUՈz;s&>RP5 iY"qGܺk;å7H%ӹ2w.SL79/e$aǧ}Tח/xq[%Xcg!*jJg„}bW_z@B$N\C-s$V5dktL}4\9BG{/5[9YTD1 LOit o_unk_>xrJ\/$X&HT>S{X J*̭$}CH @Qg*Lz~"Fa οy} y-w_~?{>Dyz>qLē|˯?Ͽ0M 5sRZ 1NzZ(/Z)g4hFqݠb:n~d+='2#ahcC˲gwzxό./7'1u*}'s7x/3+l?ag͂1?6W?$H !NK7>ljeYv-yh+ey?dd<ŅכI&R9 MӨd\yb3L)qh.E|"޿Gr]lY ҘPR973uYϾ#|x4ۼ7l!<7ybnc-S;qV—_#?5>f,fX2B*iO<[Cs]~@0o~K㾅[1o^nw_33FRJ8T|Q#!2eD$N݉mΙ ~τ ڷ`)nTĴ@S7=[G0YE 2-YH)q >EޡQweQ]_HT(wyVhW38uZ(+,ɼq` dZ#KaIss*V/VT>&| 7,yVx2F*\ߺNN@wS/_o[A~ޒ6rDn3_VgfXx'-B+B)d X$}}*O63>s xP]o1e&&"SNu{@ &&T8*s/2B aЖϦe!@;oҩ&ۮ^~x%0N=G%RE(8t'ݹiLR"-k3{zn*ծ 8 - wŬ$~ع3R *) $i&'ca^?>8@4"&Id誁p/X@isS%Wd !p-lbQfpUlw׀%A)]2 ؘ0-x*qnx;=A;q'?v= _Nx-.l4X"JOǗ s`q➉7ͭ> u9DS[mI*̴?.;p/eXiD 2qh9ȵe\Zn#8uF{%n6uOa_E?nu!>.`=DlH/cǹ?"AX*qX1_u^) X?,S7=0'n+lNs뀟]q5U/ X#/^/?ڳyaFM#a_L=QQ-XA_.3dD+I,V՜M";>~ẹV; X1rMu8{ U!nkN"rv3K8tW&>.;2x*q &ya YOsv-yUBז.>D*ӷZ~;-vrK&nkn k%[+9./P-JXkZa]inu) V%[+=ld. W,N]OZ!/EAXt( -wVXwGZ!,/ǖsxcAJ<>'olDZ!/MRe22S챷vvHf7|*<GL< 06ee~d$#:X'nXj!/ 6'9}1|;vaId:%n24S}.n7wѸ/]$Hr&ߞB6xrq&_nN ` vaZ&)3%[] Rk`e,{."εETxn?l;nF1$keZҲj,y+[=^v7(QZUDyu ]~2=ùX2\q} {ͯa\G,6Fnl{[Wpg2ؾڭ5w{rǟO"k9qx=1,w\V.1J,6-D4p~܇.Y1m)3P?*(?[=:+x|."qku7.aYTh"b&ob8'Ν]W-,V q{Wxl/?{|U=*-3e~kMo'c[=-{ bKcɩe !PUt$PCQN})oth##8:[wpm.݌Rqn{c'aƹᾲ1MA\G}[W;( z^=Kgk/Gmbx`W}ѡՐ>op_Y&[=lee-SJfhx>gL7~pGuqzyr{g9%n\l#[]ako´xꏱmC7EӴ)w8]֝<[׹uD<"&BY< mSa8tv4m`K'o03"PW E,@0\m~`Ym~ ρY-krQ-f]]á0[wϳ6o_bGJXR.b`+`ͷm6,=`eb e+n(Z%A*kK iΎܸƭkQf?bv7oPKĴ6@E^BQGvk`th m7BQx׏=ʕ-CֵG()pR;dp(JLd~ I{)Ǖi e(#@,/|"/7{vOL)Z!JRRvYh]T#_b{! DPZ \UĴmb9W}ۢb}aNtg?0锉?xK >~PIYw@h%}Vzޱ>B$E~