Using environments to manage parser versions

Author: lorenzwalthert

DESCRIPTION

@@ -40,6 +40,7 @@ Collate:
     'communicate.R'
     'compat-dplyr.R'
     'compat-tidyr.R'
+    'environments.R'
     'expr-is.R'
     'indent.R'
     'initialize.R'

R/environments.R

@@ -0,0 +1,50 @@
+#' Work with parser versions
+#'
+#' The structure of the parse data affects many operations in styler. There was
+#' unexpected behaviour of the parser that styler was initially designed to work
+#' around. Examples are [#187](https://github.com/r-lib/styler/issues/187),
+#' [#216](https://github.com/r-lib/styler/issues/216),
+#' [#100](https://github.com/r-lib/styler/issues/100) and others. With
+#' [#419](https://github.com/r-lib/styler/issues/419), the structrure of the parse
+#' data changes and we need to dispatch for older versions. As it is inconvenient
+#' to pass a parser version down in the call stack in various places, the
+#' environment `env_current` is used to store the current version *globally*
+#' but internally.
+#'
+#' We version the parser as follows:
+#'
+#' * version 1: Before fix mentioned in #419.
+#' * version 2: After #419.
+#'
+#'The following utilities are available:
+#'
+#' * `parser_version_set()` sets the parser version in the environment
+#'   `env_current`.
+#' * `parser_version_get()` retrieves the parser version from the
+#'   environment `env_current`.
+#' * `parser_version_find()` determines the version of the parser from parse
+#'   data. This does not necessarily mean that the version found is the
+#'   actual version, but it *behaves* like it. For example, code that does not
+#'   contain `EQ_ASSIGN` is parsed the same way with version 1 and 2. If the
+#'   behaviour is identical, the version is set to 1.
+#' @param version The version of the parser to be used.
+#' @param pd A parse table such as the output from
+#'   `utils::getParseData(parse(text = text))`.
+#' @keywords internal
+parser_version_set <- function(version) {
+  env_current$parser_version <- version
+}
+
+#' @rdname parser_version_set
+parser_version_get <- function() {
+  env_current$parser_version
+}
+
+#' @rdname parser_version_set
+parser_version_find <- function(pd) {
+  ifelse(any(pd$token == "equal_assign"), 2, 1)
+}
+
+
+
+env_current <- rlang::new_environment(parent = rlang::empty_env())

R/parse.R

@@ -91,8 +91,10 @@ get_parse_data <- function(text, include_text = TRUE, ...) {
   # avoid https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=16041
   parse_safely(text, keep.source = TRUE)
   parsed <- parse_safely(text, keep.source = TRUE)
-  as_tibble(utils::getParseData(parsed, includeText = include_text)) %>%
+  pd <- as_tibble(utils::getParseData(parsed, includeText = include_text)) %>%
     add_id_and_short()
+  parser_version_set(parser_version_find(pd))
+  pd
 }
 
 #' Add column `pos_id` and `short`

R/relevel.R

@@ -26,7 +26,10 @@ flatten_operators <- function(pd_nested) {
 #' @keywords internal
 flatten_operators_one <- function(pd_nested) {
   pd_token_left <- c(special_token, math_token, "'$'")
-  pd_token_right <- c(special_token, "LEFT_ASSIGN", "'+'", "'-'")
+  pd_token_right <- c(
+    special_token, "LEFT_ASSIGN", if (parser_version_get() > 1) "EQ_ASSIGN",
+    "'+'", "'-'"
+  )
   bound <- pd_nested %>%
     flatten_pd(pd_token_left, left = TRUE) %>%
     flatten_pd(pd_token_right, left = FALSE)
@@ -125,8 +128,13 @@ 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))
+  } else {
+    pd
+  }
+
 }
 
 
@@ -152,17 +160,13 @@ relocate_eq_assign <- function(pd) {
 #' @importFrom rlang seq2
 #' @keywords internal
 relocate_eq_assign_nest <- function(pd) {
-  if (any(pd$token == "equal_assign")) {
-    pd
-  } else {
-    idx_eq_assign <- which(pd$token == "EQ_ASSIGN")
-    if (length(idx_eq_assign) > 0) {
-      block_id <- find_block_id(pd)
-      blocks <- split(pd, block_id)
-      pd <- map_dfr(blocks, relocate_eq_assign_one)
-    }
-    pd
+  idx_eq_assign <- which(pd$token == "EQ_ASSIGN")
+  if (length(idx_eq_assign) > 0) {
+    block_id <- find_block_id(pd)
+    blocks <- split(pd, block_id)
+    pd <- map_dfr(blocks, relocate_eq_assign_one)
   }
+  pd
 }
 
 #' Find the block to which a token belongs