Merge pull request #979 from r-lib/f-558-speed

Optimize visiting code

R/initialize.R

@@ -10,7 +10,7 @@
 #'   {
 #'     string_to_format <- "call( 3)"
 #'     pd <- styler:::compute_parse_data_nested(string_to_format)
-#'     styler:::pre_visit(pd, c(default_style_guide_attributes))
+#'     styler:::pre_visit_one(pd, default_style_guide_attributes)
 #'   }
 #' )
 #' @export

R/nested-to-tree.R

@@ -8,7 +8,7 @@
 #' @keywords internal
 create_tree <- function(text, structure_only = FALSE) {
   compute_parse_data_nested(text, transformers = NULL) %>%
-    pre_visit(c(default_style_guide_attributes)) %>%
+    pre_visit_one(default_style_guide_attributes) %>%
     create_tree_from_pd_with_default_style_attributes(structure_only)
 }
 
@@ -36,8 +36,8 @@ create_tree_from_pd_with_default_style_attributes <- function(pd,
 #'     {
 #'       code <- "a <- function(x) { if(x > 1) { 1+1 } else {x} }"
 #'       nested_pd <- styler:::compute_parse_data_nested(code)
-#'       initialized <- styler:::pre_visit(
-#'         nested_pd, c(default_style_guide_attributes)
+#'       initialized <- styler:::pre_visit_one(
+#'         nested_pd, default_style_guide_attributes
 #'       )
 #'       styler:::create_node_from_nested_root(initialized,
 #'         structure_only = FALSE

R/relevel.R

@@ -12,8 +12,7 @@
 #' @param pd_nested A nested parse table to partially flatten.
 #' @keywords internal
 flatten_operators <- function(pd_nested) {
-  pd_nested %>%
-    post_visit(c(flatten_operators_one))
+  post_visit_one(pd_nested, flatten_operators_one)
 }
 
 #' Flatten one level of nesting with its child
@@ -144,8 +143,7 @@ wrap_expr_in_expr <- function(pd) {
 #' @keywords internal
 relocate_eq_assign <- function(pd) {
   if (parser_version_get() < 2) {
-    pd %>%
-      post_visit(c(relocate_eq_assign_nest))
+    post_visit_one(pd, relocate_eq_assign_nest)
   } else {
     pd
   }

R/transform-block.R

@@ -28,7 +28,7 @@ parse_transform_serialize_r_block <- function(pd_nested,
                                               base_indention) {
   if (!all(pd_nested$is_cached, na.rm = TRUE) || !cache_is_activated()) {
     transformed_pd <- apply_transformers(pd_nested, transformers)
-    flattened_pd <- post_visit(transformed_pd, list(extract_terminals)) %>%
+    flattened_pd <- post_visit_one(transformed_pd, extract_terminals) %>%
       enrich_terminals(transformers$use_raw_indention) %>%
       apply_ref_indention() %>%
       set_regex_indention(

R/visit.R

@@ -20,9 +20,38 @@ pre_visit <- function(pd_nested, funs) {
   if (is.null(pd_nested)) {
     return()
   }
+  if (length(funs) == 0) {
+    return(pd_nested)
+  }
   pd_nested <- visit_one(pd_nested, funs)
 
-  pd_nested$child <- map(pd_nested$child, pre_visit, funs = funs)
+  children <- pd_nested$child
+  for (i in seq_along(children)) {
+    child <- children[[i]]
+    if (!is.null(child)) {
+      children[[i]] <- pre_visit(child, funs)
+    }
+  }
+  pd_nested$child <- children
+  pd_nested
+}
+
+#' @rdname visit
+#' @keywords internal
+pre_visit_one <- function(pd_nested, fun) {
+  if (is.null(pd_nested)) {
+    return()
+  }
+  pd_nested <- fun(pd_nested)
+
+  children <- pd_nested$child
+  for (i in seq_along(children)) {
+    child <- children[[i]]
+    if (!is.null(child)) {
+      children[[i]] <- pre_visit_one(child, fun)
+    }
+  }
+  pd_nested$child <- children
   pd_nested
 }
 
@@ -32,11 +61,42 @@ post_visit <- function(pd_nested, funs) {
   if (is.null(pd_nested)) {
     return()
   }
+  if (length(funs) == 0) {
+    return(pd_nested)
+  }
+
+  children <- pd_nested$child
+  for (i in seq_along(children)) {
+    child <- children[[i]]
+    if (!is.null(child)) {
+      children[[i]] <- post_visit(child, funs)
+    }
+  }
+  pd_nested$child <- children
 
-  pd_nested$child <- map(pd_nested$child, post_visit, funs = funs)
   visit_one(pd_nested, funs)
 }
 
+#' @rdname visit
+#' @keywords internal
+post_visit_one <- function(pd_nested, fun) {
+  if (is.null(pd_nested)) {
+    return()
+  }
+  force(fun)
+
+  children <- pd_nested$child
+  for (i in seq_along(children)) {
+    child <- children[[i]]
+    if (!is.null(child)) {
+      children[[i]] <- post_visit_one(child, fun)
+    }
+  }
+  pd_nested$child <- children
+
+  fun(pd_nested)
+}
+
 #' Transform a flat parse table with a list of transformers
 #'
 #' Uses [Reduce()] to apply each function of `funs` sequentially to
@@ -46,7 +106,10 @@ post_visit <- function(pd_nested, funs) {
 #' @family visitors
 #' @keywords internal
 visit_one <- function(pd_flat, funs) {
-  Reduce(function(x, fun) fun(x), funs, init = pd_flat)
+  for (f in funs) {
+    pd_flat <- f(pd_flat)
+  }
+  pd_flat
 }
 
 #' Propagate context to terminals

vignettes/customizing_styler.Rmd

@@ -40,7 +40,7 @@ As the name says, this function removes spaces after the opening parenthesis. Bu
 ```{r}
 string_to_format <- "call( 3)"
 pd <- styler:::compute_parse_data_nested(string_to_format) %>%
-  styler:::pre_visit(c(default_style_guide_attributes))
+  styler:::pre_visit_one(default_style_guide_attributes)
 pd$child[[1]] %>%
   select(token, terminal, text, newlines, spaces)
 ```