File: walkAST.R

package info (click to toggle)
r-cran-globals 0.14.0-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, sid
  • size: 300 kB
  • sloc: sh: 14; makefile: 2
file content (116 lines) | stat: -rw-r--r-- 3,021 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
source("incl/start.R")

message("*** walkAST() ...")

exprs <- list(
  null        = quote(NULL),
  atomic      = quote(1),
  atomic      = quote("a"),
  atomic      = quote(TRUE),
  assign      = quote(a <- 1),
  assign      = quote(1 -> a),
  assign      = quote(a <- b + 1),
  assign      = quote(x <- rnorm(20, mu = 0)),
  index       = quote(x[1, 1]),
  index       = quote(x[1:2, 1:2]),
  index       = quote(x[, 1:2]),
  index       = quote(x[, 1]),
  fcn         = quote(function(a = 1, b = 2) sum(c(a, b))),
  fcn         = quote(function(a = 1, b) sum(c(a, b))),
  fcn         = quote(function(a = 1, b = 2, ...) sum(c(a, b, ...))),
  fcn         = quote(function(a = NULL) a),
  ok          = quote(function(...) sum(x, ...)),
  warn        = quote(sum(x, ...)),
  null        = quote(NULL),
  builtin     = base::length,
  closure     = function() NULL,
  closure     = function() a,
  closure     = function(x = 0) a * x,
  special     = base::log,
  list        = substitute(FUN(a = A), list(A = list())),
  pairlist    = substitute(FUN(a = A), list(A = pairlist(a = 1))),
  expression  = substitute(FUN(a = A), list(A = expression()))
# environment = new.env()
)
if (requireNamespace("methods")) {
  exprs$s4 <- methods::getClass("MethodDefinition")
}

nullify <- function(e) NULL

disp <- function(expr) {
  cat("Expression:\n")
  print(expr)
  cat("str():\n")
  str(expr)
  cat(sprintf("typeof: %s\n", typeof(expr)))
  if (is.recursive(expr)) {
    cat("as.list():\n")
    str(as.list(expr))
  }  
  expr
} ## disp()

for (kk in seq_along(exprs)) {
  name <- names(exprs)[kk]
  message(sprintf("- walkAST(<expression #%d (%s)>) ...", kk, sQuote(name)))
  expr <- exprs[[kk]]
  disp(expr)

  ## Assert identity (default behavior)
  expr_i <- walkAST(expr)
  disp(expr_i)
  stopifnot(length(expr_i) == length(expr), identical(expr_i, expr))

  ## Display the AST tree
  walkAST(expr, atomic = disp, name = disp, call = disp, pairlist = disp)

  ## Nullify
  expr_n <- walkAST(expr, atomic = nullify, name = nullify,
                    call = nullify, pairlist = nullify)
  disp(expr_n)

  message("*** walkAST() - nullify ... DONE")

  message(sprintf("- walkAST(<expression #%d (%s)>) ... DONE",
                  kk, sQuote(name)))
} ## for (name ...)



message("*** walkAST() - substitute = TRUE ...")

expr <- walkAST(a <- 1, substitute = TRUE)
print(expr)

message("*** walkAST() - substitute = TRUE ... DONE")


message("*** walkAST() - exceptions ...")

f <- function(...) get("...")
expr <- f(NULL)
  
options(globals.walkAST.onUnknownType = "error")
res <- tryCatch({
  walkAST(expr)
}, error = identity)
print(res)
stopifnot(inherits(res, "simpleError"))

options(globals.walkAST.onUnknownType = "warning")
foo <- walkAST(expr)

res <- tryCatch({
  walkAST(expr)
}, warning = identity)
print(res)
stopifnot(inherits(res, "simpleWarning"))

options(globals.walkAST.onUnknownType = "error")

message("*** walkAST() - exceptions ... DONE")

message("*** walkAST() ... DONE")

source("incl/end.R")