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
|
#' @export
cleanup <- function(...) UseMethod("cleanup")
#' Drop certain types of globals
#'
#' @param globals A Globals object.
#' @param drop A character vector specifying what type of globals to drop.
#' @param \dots Not used
#'
#' @aliases cleanup
#' @export
cleanup.Globals <- function(globals, drop = c("missing", "base-packages"),
...) {
where <- attr(globals, "where", exact = TRUE)
names <- names(globals)
keep <- rep(TRUE, times = length(globals))
names(keep) <- names
## Drop non-found objects
if ("missing" %in% drop) {
for (name in names) {
if (is.null(where[[name]])) keep[name] <- FALSE
}
}
## Drop objects that are part of one of the "base" packages
if ("base-packages" %in% drop) {
for (name in names) {
if (is_base_pkg(environmentName(where[[name]]))) keep[name] <- FALSE
}
}
## Drop objects that are primitive functions
if ("primitives" %in% drop) {
for (name in names) {
if (is.primitive(globals[[name]])) keep[name] <- FALSE
}
}
## Drop objects that calls .Internal()
if ("internals" %in% drop) {
for (name in names) {
if (is_internal(globals[[name]])) keep[name] <- FALSE
}
}
if (!all(keep)) {
globals <- globals[keep]
}
globals
}
|
