1#' Display a call (or expression) as a tree. 2#' 3#' \code{ast_} takes a quoted expression; \code{ast} does the quoting 4#' for you. 5#' 6#' @param x Quoted call, list of calls, or expression to display. 7#' @param width Display width, defaults to current width as reported by 8#' \code{getOption("width")}. 9#' @export 10#' @examples 11#' ast(f(x, 1, g(), h(i()))) 12#' ast(if (TRUE) 3 else 4) 13#' ast(function(a = 1, b = 2) {a + b + 10}) 14#' ast(f(x)(y)(z)) 15#' 16#' ast_(quote(f(x, 1, g(), h(i())))) 17#' ast_(quote(if (TRUE) 3 else 4)) 18#' ast_(expression(1, 2, 3)) 19ast_ <- function(x, width = getOption("width")) { 20 if (is.expression(x) || is.list(x)) { 21 trees <- vapply(x, tree, character(1), width = width) 22 out <- paste0(trees, collapse = "\n\n") 23 } else { 24 out <- tree(x, width = width) 25 } 26 27 cat(out, "\n") 28} 29 30#' @rdname ast_ 31#' @export 32ast <- function(x) ast_(expr_find(x)) 33 34tree <- function(x, level = 1, width = getOption("width"), branch = "\u2517 ") { 35 if (is_atomic(x) && length(x) == 1) { 36 label <- paste0(" ", deparse(x)[1]) 37 children <- NULL 38 } else if (is_name(x)) { 39 x <- as.character(x) 40 if (x == "") { 41 # Special case the missing argument 42 label <- "`MISSING" 43 } else { 44 label <- paste0("`", as.character(x)) 45 } 46 47 children <- NULL 48 } else if (is_call(x)) { 49 label <- "()" 50 children <- vapply(as.list(x), tree, character(1), 51 level = level + 1, width = width - 3) 52 } else if (is_pairlist(x)) { 53 label <- "[]" 54 55 branches <- paste("\u2517", format(names(x)), "=") 56 children <- character(length(x)) 57 for (i in seq_along(x)) { 58 children[i] <- tree(x[[i]], level = level + 1, width = width - 3, 59 branch = branches[i]) 60 } 61 } else { 62 # Special case for srcrefs, since they're commonly seen 63 if (inherits(x, "srcref")) { 64 label <- "<srcref>" 65 } else { 66 label <- paste0("<", typeof(x), ">") 67 } 68 children <- NULL 69 } 70 71 indent <- paste0(str_dup(" ", level - 1), branch) 72 label <- str_trunc(label, width - 3) 73 74 if (is.null(children)) { 75 paste0(indent, label) 76 } else { 77 paste0(indent, label, "\n", paste0(children, collapse = "\n")) 78 } 79} 80 81str_trunc <- function(x, width = getOption("width")) { 82 ifelse(nchar(x) <= width, x, paste0(substr(x, 1, width - 3), "...")) 83} 84 85str_dup <- function(x, n) { 86 paste0(rep(x, n), collapse = "") 87} 88