/
import.r
282 lines (253 loc) · 11.4 KB
/
import.r
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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
#' Import a module into the current scope
#'
#' \code{module = import('module')} imports a specified module and makes its
#' code available via the environment-like object it returns.
#'
#' @param module a character string specifying the full module path
#' @param attach either a boolean or a character vector. If \code{TRUE}, attach
#' the newly loaded module to the object search path (see \code{Details}).
#' Alternatively, if a character vector is given, attach only the listed names.
#' @param attach_operators if \code{TRUE}, attach operators of module to the
#' object search path, even if \code{attach} is \code{FALSE}
#' @param doc boolean specifying whether to load the module’s documentation (see
#' \code{Details})
#' @return the loaded module environment (invisible)
#'
#' @details Modules are loaded in an isolated environment which is returned, and
#' optionally attached to the object search path of the current scope (if
#' argument \code{attach} is \code{TRUE}).
#' \code{attach} defaults to \code{FALSE}. However, in interactive code it is
#' often helpful to attach packages by default. Therefore, in interactive code
#' invoked directly from the terminal only (i.e. not within modules),
#' \code{attach} defaults to the value of \code{options('import.attach')}, which
#' can be set to \code{TRUE} or \code{FALSE} depending on the user’s preference.
#'
#' \code{attach_operators} causes \emph{operators} to be attached by default,
#' because operators can only be invoked in R if they re found in the search
#' path. Not attaching them therefore drastically limits a module’s usefulness.
#'
#' \code{doc} loads the module’s documentation, specified as roxygen comments.
#' It defaults to \code{TRUE} in interactive mode and to \code{FALSE} otherwise.
#'
#' Modules are searched in the module search path \code{options('import.path')}.
#' This is a vector of paths to consider, from the highest to the lowest
#' priority. The current directory is \emph{always} considered last. That is,
#' if a file \code{a.r} exists both in the current directory and in a module
#' search path, the local file \code{./a.r} will not be loaded, unless the
#' import is explicitly specified as \code{import('./a')}.
#'
#' Module names can be fully qualified to refer to nested paths. See
#' \code{Examples}.
#'
#' Module source code files are assumed to be encoded in UTF-8 without BOM.
#' Ensure that this is the case when using an extended character set.
#'
#' @note Unlike for packages, attaching happens \emph{locally}: if
#' \code{import} is executed in the global environment, the effect is the same.
#' Otherwise, the imported module is inserted as the parent of the current
#' \code{environment()}. When used (globally) \emph{inside} a module, the newly
#' imported module is only available inside the module’s search path, not
#' outside it (nor in other modules which might be loaded).
#'
#' @examples
#' \dontrun{
#' # `a.r` is a file in the local directory containing a function `f`.
#' a = import('a')
#' a$f()
#'
#' # b/c.r is a file in path `b`, containing functions `f` and `g`.
#' import('b/c', attach = 'f')
#' # No module name qualification necessary
#' f()
#' g() # Error: could not find function "g"
#'
#' import('b/c', attach = TRUE)
#' f()
#' g()
#' }
#' @seealso \code{unload}
#' @seealso \code{reload}
#' @seealso \code{module_name}
#' @seealso \code{module_help}
#' @export
import = function (module, attach, attach_operators = TRUE, doc) {
stopifnot(inherits(module, 'character'))
if (missing(attach)) {
attach = if (interactive() && is.null(module_name()))
getOption('import.attach', FALSE)
else
FALSE
}
stopifnot(class(attach) == 'logical' && length(attach) == 1 ||
class(attach) == 'character')
if (is.character(attach)) {
export_list = attach
attach = TRUE
}
else
export_list = NULL
if (missing(doc))
doc = interactive()
module_path = try(find_module(module), silent = TRUE)
if (inherits(module_path, 'try-error'))
stop(attr(module_path, 'condition')$message)
containing_modules = module_init_files(module, module_path)
mapply(do_import, names(containing_modules), containing_modules,
rep(doc, length(containing_modules)))
mod_ns = do_import(as.character(module), module_path, doc)
module_parent = parent.frame()
mod_env = exhibit_namespace(mod_ns, as.character(module), module_parent,
export_list)
attached_module = if (attach)
mod_env
else if (attach_operators)
export_operators(mod_ns, module_parent)
else
NULL
if (! is.null(attached_module)) {
# The following distinction is necesary because R segfaults if we try to
# change `parent.env(.GlobalEnv)`. More info:
# http://stackoverflow.com/q/22790484/1968
if (identical(module_parent, .GlobalEnv)) {
attach(attached_module, name = environmentName(attached_module))
attr(mod_env, 'attached') = environmentName(attached_module)
}
else
parent.env(module_parent) = attached_module
}
attr(mod_env, 'call') = match.call()
lockEnvironment(mod_env, bindings = TRUE)
invisible(mod_env)
}
do_import = function (module_name, module_path, doc) {
if (is_module_loaded(module_path))
return(get_loaded_module(module_path))
# Environment with helper functions which are only available when loading a
# module via `import`, and are not otherwise exported by the package.
helper_env = list2env(list(export_submodule = export_submodule),
parent = .BaseNamespaceEnv)
# The namespace contains a module’s content. This schema is very much like
# R package organisation.
# A good resource for this is:
# <http://obeautifulcode.com/R/How-R-Searches-And-Finds-Stuff/>
namespace = structure(new.env(parent = helper_env),
name = paste('namespace', module_name, sep = ':'),
path = module_path,
class = c('namespace', 'environment'))
# First cache the (still empty) namespace, then source code into it. This is
# necessary to allow circular imports.
cache_module(namespace)
# R, Windows and Unicode don’t play together. `source` does not work here.
# See http://developer.r-project.org/Encodings_and_R.html and
# http://stackoverflow.com/q/5031630/1968 for a discussion of this.
eval(parse(module_path, encoding = 'UTF-8'), envir = namespace)
make_S3_methods_known(namespace)
if (doc)
attr(namespace, 'doc') = parse_documentation(namespace)
namespace
}
exhibit_namespace = function (namespace, name, parent, export_list) {
if (is.null(export_list))
export_list = ls(namespace)
else {
# Verify correctness.
exist = vapply(export_list, exists, logical(1), envir = namespace)
if (! all(exist))
stop(sprintf('Non-existent function(s) (%s) specified for import',
paste(export_list[! exist], collapse = ', ')))
}
# Skip one parent environment because this module is hooked into the chain
# between the calling environment and its ancestor, thus sitting in its
# local object search path.
structure(list2env(sapply(export_list, get, envir = namespace,
simplify = FALSE),
parent = parent.env(parent)),
name = paste('module', name, sep = ':'),
path = module_path(namespace),
doc = attr(namespace, 'doc'),
class = c('module', 'environment'))
}
export_operators = function (namespace, parent) {
ops = c('+', '-', '*', '/', '^', '**', '&', '|', ':', '::', ':::', '$',
'$<-', '=', '<-', '<<-', '==', '<', '<=', '>', '>=', '!=', '~',
'&&', '||', '!', '?', '@', '@<-', ':=')
is_predefined = function (f) f %in% ops
is_op = function (f) {
# `.` delimits an S3 method name, but only when not inside `%…%`.
prefix = regmatches(f, regexpr('^[^.]+|(%[^%]*%)', f))
is_predefined(prefix) || grepl('^%.*%$', prefix)
}
operators = Filter(is_op, lsf.str(namespace))
if (length(operators) == 0)
return()
name = module_name(namespace)
# Skip one parent environment because this module is hooked into the chain
# between the calling environment and its ancestor, thus sitting in its
# local object search path.
structure(list2env(sapply(operators, get, envir = namespace),
parent = parent.env(parent)),
name = paste('operators', name, sep = ':'),
path = module_path(namespace),
class = c('module', 'environment'))
}
#' Unload a given module
#'
#' Unset the module variable that is being passed as a parameter, and remove the
#' loaded module from cache.
#' @param module reference to the module which should be unloaded
#' @note Any other references to the loaded modules remain unchanged, and will
#' still work. However, subsequently importing the module again will reload its
#' source files, which would not have happened without \code{unload}.
#' Unloading modules is primarily useful for testing during development, and
#' should not be used in production code.
#'
#' \code{unload} comes with a few restrictions. It attempts to detach itself
#' if it was previously attached. This only works if it is called in the same
#' scope as the original \code{import}.
#' @seealso \code{import}
#' @seealso \code{reload}
#' @export
unload = function (module) {
stopifnot(inherits(module, 'module'))
module_ref = as.character(substitute(module))
rm(list = module_path(module), envir = .loaded_modules)
attached = attr(module, 'attached')
if (! is.null(attached))
detach(attached, character.only = TRUE)
# Unset the module reference in its scope, i.e. the caller’s environment or
# some parent thereof.
rm(list = module_ref, envir = parent.frame(), inherits = TRUE)
}
#' Reload a given module
#'
#' Remove the loaded module from the cache, forcing a reload. The newly reloaded
#' module is assigned to the module reference in the calling scope.
#' @param module reference to the module which should be unloaded
#' @note Any other references to the loaded modules remain unchanged, and will
#' still work. Reloading modules is primarily useful for testing during
#' development, and should not be used in production code.
#'
#' \code{reload} comes with a few restrictions. It attempts to re-attach itself
#' in parts or whole if it was previously attached in parts or whole. This only
#' works if it is called in the same scope as the original \code{import}.
#' @seealso \code{import}
#' @seealso \code{unload}
#' @export
reload = function (module) {
stopifnot(inherits(module, 'module'))
module_ref = as.character(substitute(module))
module_parent = parent.frame()
# Execute in parent scope, since `unload` deletes the scope’s reference to
# the module.
eval(call('unload', as.name(module_ref)), envir = module_parent)
# Use `eval` to replicate the exact call being made to `import`.
mod_env = eval(attr(module, 'call'), envir = module_parent)
assign(module_ref, mod_env, envir = module_parent, inherits = TRUE)
}
#' Pretty-print a module’s description
#'
#' @export
print.module = function (module) {
cat(sprintf('<%s>\n', attr(module, 'name')))
invisible(module)
}