Skip to content

Commit

Permalink
Early returns to reduce nesting and improve readability (#6542)
Browse files Browse the repository at this point in the history
  • Loading branch information
MichaelChirico authored Oct 1, 2024
1 parent 7419796 commit d62aac9
Show file tree
Hide file tree
Showing 2 changed files with 23 additions and 23 deletions.
6 changes: 3 additions & 3 deletions R/programming.R
Original file line number Diff line number Diff line change
Expand Up @@ -14,8 +14,8 @@ list2lang = function(x) {
stopf("'x' must be a list")
if (is.AsIs(x))
return(rm.AsIs(x))
asis = vapply(x, is.AsIs, FALSE)
char = vapply(x, is.character, FALSE)
asis = vapply_1b(x, is.AsIs)
char = vapply_1b(x, is.character)
to.name = !asis & char
if (any(to.name)) { ## turns "my_name" character scalar into `my_name` symbol, for convenience
if (any(non.scalar.char <- lengths(x[to.name])!=1L)) {
Expand All @@ -24,7 +24,7 @@ list2lang = function(x) {
x[to.name] = lapply(x[to.name], as.name)
}
if (isTRUE(getOption("datatable.enlist", TRUE))) { ## recursively enlist for nested lists, see note section in substitute2 manual
islt = vapply(x, only.list, FALSE) #5057 nested DT that inherits from a list must not be turned into list call
islt = vapply_1b(x, only.list) #5057 nested DT that inherits from a list must not be turned into list call
to.enlist = !asis & islt
if (any(to.enlist)) {
x[to.enlist] = lapply(x[to.enlist], enlist)
Expand Down
40 changes: 20 additions & 20 deletions src/programming.c
Original file line number Diff line number Diff line change
@@ -1,29 +1,29 @@
#include "data.table.h"

static void substitute_call_arg_names(SEXP expr, SEXP env) {
R_len_t len = length(expr);
if (len && isLanguage(expr)) { // isLanguage is R's is.call
SEXP arg_names = getAttrib(expr, R_NamesSymbol);
if (!isNull(arg_names)) {
SEXP env_names = getAttrib(env, R_NamesSymbol);
int *imatches = INTEGER(PROTECT(chmatch(arg_names, env_names, 0)));
const SEXP *env_sub = SEXPPTR_RO(env);
SEXP tmp = expr;
for (int i=0; i<length(arg_names); i++, tmp=CDR(tmp)) { // substitute call arg names
if (imatches[i]) {
SEXP sym = env_sub[imatches[i]-1];
if (!isSymbol(sym))
error(_("Attempting to substitute '%s' element with object of type '%s' but it has to be 'symbol' type when substituting name of the call argument, functions 'as.name' and 'I' can be used to work out proper substitution, see ?substitute2 examples."), CHAR(STRING_ELT(arg_names, i)), type2char(TYPEOF(sym)));
SET_TAG(tmp, sym);
}
}
UNPROTECT(1); // chmatch
}
for (SEXP tmp=expr; tmp!=R_NilValue; tmp=CDR(tmp)) { // recursive call to substitute in nested expressions
substitute_call_arg_names(CADR(tmp), env);
if (!length(expr) || !isLanguage(expr))
return; // isLanguage is R's is.call
SEXP arg_names = getAttrib(expr, R_NamesSymbol);
if (!isNull(arg_names)) {
SEXP env_names = getAttrib(env, R_NamesSymbol);
int *imatches = INTEGER(PROTECT(chmatch(arg_names, env_names, 0)));
const SEXP *env_sub = SEXPPTR_RO(env);
SEXP tmp = expr;
for (int i=0; i<length(arg_names); i++, tmp=CDR(tmp)) { // substitute call arg names
if (!imatches[i])
continue;
SEXP sym = env_sub[imatches[i]-1];
if (!isSymbol(sym))
error(_("Attempting to substitute '%s' element with object of type '%s' but it has to be 'symbol' type when substituting name of the call argument, functions 'as.name' and 'I' can be used to work out proper substitution, see ?substitute2 examples."), CHAR(STRING_ELT(arg_names, i)), type2char(TYPEOF(sym)));
SET_TAG(tmp, sym);
}
UNPROTECT(1); // chmatch
}
for (SEXP tmp=expr; tmp!=R_NilValue; tmp=CDR(tmp)) { // recursive call to substitute in nested expressions
substitute_call_arg_names(CADR(tmp), env);
}
}

SEXP substitute_call_arg_namesR(SEXP expr, SEXP env) {
SEXP ans = PROTECT(MAYBE_REFERENCED(expr) ? duplicate(expr) : expr);
substitute_call_arg_names(ans, env); // updates in-place
Expand Down

0 comments on commit d62aac9

Please sign in to comment.