R/sxp.R

In lobstr: Visualize R Data Structures with Trees

#' 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 binding components without any side effects (e.g. promises or active bindings).
#'   * "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 environments to see promise expressions without forcing
#' e <- new.env(parent = emptyenv())
#' delayedAssign("x", 1 + 1, assign.env = e)
#'
#' sxp(e)
#' sxp(e, expand = "environment")

sxp <- function(x, expand = character(), max_depth = 5L) {
  opts <- c("character", "altrep", "environment", "call", "bytecode")
  if (any(!expand %in% opts)) {
    abort(
      sprintf(
        "`expand` must contain only values from: '%s'.",
        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() && !is_placeholder(x)) {
    addr <- paste0(":", crayon::silver(attr(x, "addr")))
  } else {
    addr <- ""
  }

  type <- attr(x, "type")

  if (attr(x, "has_seen")) {
    desc <- paste0("[", attr(x, "id"), addr, "]")
  } else {
    if (sexp_is_vector(type)) {
      length <- paste0("[", attr(x, "length"), "]")
    } else {
      length <- NULL
    }

    if (!is.null(attr(x, "value"))) {
      value <- paste0(": ", attr(x, "value"))
    } else {
      value <- NULL
    }

    if (!is_testing() && !is_placeholder(x)) {
      no_references <- attr(x, "no_references")
      maybe_shared <- attr(x, "maybe_shared")
      if (no_references == 1) {
        references <- "refs:0"
      } else if (maybe_shared == 0) {
        references <- "refs:1"
      } else {
        references <- "refs:2+"
      }
    } else {
      references <- NULL
    }

    # show altrep, object, named etc
    sxpinfo <- paste0(
      if (attr(x, "altrep")) "altrep ",
      if (attr(x, "object")) "object ",
      references
    )

    # Placeholders don't show sxpinfo or id (they can't be referenced)
    if (is_placeholder(x)) {
      desc <- paste0(
        "<",
        crayon::cyan(type),
        value,
        ">"
      )
    } else {
      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_is_vector <- function(x) {
  x %in%
    c(
      "LGLSXP",
      "INTSXP",
      "REALSXP",
      "STRSXP",
      "RAWSXP",
      "CPLXSXP",
      "VECSXP",
      "EXPRSXP"
    )
}

# Placeholder nodes do not have any inspectable properties such as refcount or
# address
is_placeholder <- function(x) {
  !nzchar(attr(x, "addr")) || identical(attr(x, "type"), "NILSXP")
}