Reduce nesting to improve readability

Rdatatable · Sep 27, 2024 · e4e5b8a · e4e5b8a
1 parent 3734726
commit e4e5b8a
Show file tree

Hide file tree

Showing 2 changed files with 23 additions and 22 deletions.
diff --git a/R/programming.R b/R/programming.R
@@ -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)) {
@@ -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)

diff --git a/src/programming.c b/src/programming.c
@@ -2,28 +2,29 @@
 
 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 (!len || !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