Op assignment indention

DESCRIPTION

@@ -40,6 +40,7 @@ Collate:
     'nested.R'
     'nested_to_tree.R'
     'parsed.R'
+    'token.R'
     'relevel.R'
     'rules-line_break.R'
     'rules-other.R'

R/get_transformers.R

@@ -83,7 +83,6 @@ get_transformers_nested <- function(
       partial(indent_curly, indent_by = indent_by),
       partial(indent_op, indent_by = indent_by),
       partial(indent_without_paren, indent_by = indent_by),
-      partial(indent_assign, indent_by = indent_by),
       get_transformers_flat(strict, start_comments_with_one_space),
       remove_space_after_unary_pm_nested,
       set_space_before_comments,
@@ -112,7 +111,6 @@ get_transformers_nested <- function(
     line_break = line_break_manipulators,
     space      = space_manipulators,
     token      = token_manipulators,
-    eol        = strip_eol_spaces,
     NULL
   )
 }

R/modify_pd.R

@@ -23,16 +23,16 @@ indent_curly <- function(pd, indent_by) {
 
 #' @rdname update_indention
 indent_op <- function(pd, indent_by, token = c(math_token,
-                                               "SPECIAL-PIPE")) {
+                                               "SPECIAL-PIPE",
+                                               "LEFT_ASSIGN")) {
   indent_indices <- compute_indent_indices(pd, token, indent_last = TRUE)
   pd$indent[indent_indices] <- pd$indent[indent_indices] + indent_by
   pd
 }
 
 #' @describeIn update_indention Same as indent_op, but only indents one token
 #'   after `token`, not all remaining.
-indent_assign <- function(pd, indent_by, token = c("LEFT_ASSIGN", "
-                                                   EQ_ASSIGN")) {
+indent_assign <- function(pd, indent_by, token = NULL) {
   indent_indices <- compute_indent_indices(pd, token, indent_last = TRUE)
   pd$indent[indent_indices] <- pd$indent[indent_indices] + indent_by
   pd
@@ -43,7 +43,7 @@ indent_assign <- function(pd, indent_by, token = c("LEFT_ASSIGN", "
 indent_without_paren <- function(pd, indent_by = 2) {
   nrow <- nrow(pd)
   if (!(pd$token[1] %in% c("IF", "FOR", "WHILE"))) return(pd)
-  if (pd$child[[nrow]]$token[1] == "'{'") return(pd)
+  if (pd$lag_newlines[nrow] == 0) return(pd)
   pd$indent[nrow] <- indent_by
   pd
 }
@@ -110,15 +110,3 @@ set_multi_line <- function(pd) {
 token_is_multi_line <- function(pd) {
   any(pd$multi_line, pd$lag_newlines > 0)
 }
-
-
-#' Strip EOL spaces
-#'
-#' Remove end-of-line spaces.
-#' @param pd_flat A flat parse table.
-#' @return A nested parse table.
-strip_eol_spaces <- function(pd_flat) {
-  idx <- lead(pd_flat$lag_newlines, default = 0) != 0
-  pd_flat$spaces[idx] <- 0
-  pd_flat
-}

R/nested.R

@@ -69,26 +69,6 @@ special_and <- function(text) {
   paste0("SPECIAL-", text)
 }
 
-
-#' lookup which new tokens were created from "SPECIAL"
-#'
-#' @param regex A regular expression pattern to search for.
-#' @importFrom purrr map_chr
-lookup_new_special <- function(regex = NA) {
-  new_special <- c("PIPE", "IN", "OTHER")
-
-  potential_regex <- grep(regex, new_special, value = TRUE, ignore.case = TRUE)
-  if (is.na(regex)) {
-    mapping <- new_special
-  } else if (length(potential_regex) > 0) {
-    mapping <- potential_regex
-  } else {
-    return(NA)
-  }
-  map_chr(mapping, special_and)
-}
-
-
 #' Add information about previous / next token to each terminal
 #'
 #' @param pd_flat A flat parse table.
@@ -131,7 +111,6 @@ set_spaces <- function(spaces_after_prefix, force_one) {
     n_of_spaces <- rep(1, length(spaces_after_prefix))
   } else {
     n_of_spaces <- pmax(spaces_after_prefix, 1L)
-    n_of_spaces[spaces_after_prefix == 0L] <- 0L
   }
   n_of_spaces
 }

R/relevel.R

@@ -12,19 +12,56 @@ flatten_operators <- function(pd_nested) {
     post_visit(c(flatten_operators_one))
 }
 
-
+#' Flatten one level of nesting with its child
+#'
+#' Flattening is done in two ways. We can flatten a parse table by moving
+#'   the left hand token of an operator one level up. Or doing that with the
+#'   right hand token.
+#' @param pd_nested A nested parse table.
+#' @include token.R
 flatten_operators_one <- function(pd_nested) {
-  token <- c("'+'", "'-'", special_token, "'/'", "'*'")
-  token_pos <- which(pd_nested$token %in% token)
-  if (length(token_pos) == 0) return(pd_nested)
-  stopifnot(length(token_pos) == 1)
+  pd_token_left <- c(special_token, math_token)
+  pd_token_right <- c(special_token, left_assignment_token,  "'+'", "'-'")
+  bound <- pd_nested %>%
+    flatten_pd(pd_token_left, left = TRUE) %>%
+    flatten_pd(pd_token_right, left = FALSE)
+  bound
+}
+
 
-  lhs_pos <- token_pos - 1L
-  if (lhs_pos < 1) return(pd_nested)
-  if (!any(pd_nested$child[[lhs_pos]]$token %in% token)) return(pd_nested)
+#' Flatten a parse table
+#'
+#' Flattens a parse table if certain tokens occur in this table or its child,
+#' either flattening from left or from right. If one of `token` is present in
+#' `pd_nested`  and one of `child_token` is present in one of the children next
+#' to `token` in `pd_nested`, the nested parse table is flattened. Otherwise, it
+#' is returned unodified.
+#' @param pd_nested A nested parse table.
+#' @param token A character vector with tokens of which at least one has to
+#'   occur in `pd_nested` in order to flatten it.
+#' @param child_token A character vector of tokens of which at least one has to
+#'   occur in the child in order to flatten the parse table.
+#' @param left Flag that indicates whether the parse table should be flattened
+#'   from left or from right.
+flatten_pd <- function(pd_nested, token, child_token = token, left = TRUE) {
+  token_pos <- which(pd_nested$token[-1] %in% token) + 1
+  if (length(token_pos) == 0) return(pd_nested)
+  pos <- token_pos[ifelse(left, 1, length(token_pos))] + ifelse(left, -1L, 1L)
+  if (pos < 1) return(pd_nested)
+  if (!any(pd_nested$child[[pos]]$token[-1] %in% child_token)) return(pd_nested)
+  bind_with_child(pd_nested, pos)
+}
 
+#' Bind a parse table with one of its children
+#'
+#' Bind a parse table with one of its children and return the **unordered**
+#' parse table (that is, rows are not arranged according to line1 / line2).
+#' @param pd_nested A nested parse table.
+#' @param pos The position of the child to bind.
+bind_with_child <- function(pd_nested, pos) {
   pd_nested %>%
-    slice(-lhs_pos) %>%
-    bind_rows(pd_nested$child[[lhs_pos]]) %>%
+    slice(-pos) %>%
+    bind_rows(pd_nested$child[[pos]]) %>%
     arrange(line1, col1)
 }
+

R/rules-spacing.R

@@ -1,18 +1,4 @@
-math_token <- c("'+'", "'-'", "'*'", "'/'", "'^'")
-
-#' @include nested.R
-special_token <- lookup_new_special()
-
-op_token <- c(
-  math_token,
-  special_token,
-  "AND", "AND2", "EQ", "EQ_ASSIGN",
-  "GE", "GT", "LE", "LEFT_ASSIGN", "LT", "NE", "OR", "OR2", "RIGHT_ASSIGN",
-  "EQ_SUB", "ELSE"
-)
-
-
-
+#' @include token.R
 add_space_around_op <- function(pd_flat) {
   op_after <- pd_flat$token %in% op_token
   op_before <- lead(op_after, default = FALSE)
@@ -23,6 +9,7 @@ add_space_around_op <- function(pd_flat) {
   pd_flat
 }
 
+#' @include token.R
 set_space_around_op <- function(pd_flat) {
   op_after <- pd_flat$token %in% op_token
   if (!any(op_after)) return(pd_flat)
@@ -33,6 +20,7 @@ set_space_around_op <- function(pd_flat) {
 }
 
 # depreciated!
+#' @include token.R
 remove_space_after_unary_pm <- function(pd_flat) {
   op_pm <- c("'+'", "'-'")
   op_pm_unary_after <- c(op_pm, op_token, "'('", "','")

R/serialize.R

@@ -41,7 +41,8 @@ serialize_parse_data_nested <- function(pd_nested) {
     unlist() %>%
     paste0(collapse = "") %>%
     strsplit("\n", fixed = TRUE) %>%
-    .[[1L]]
+    .[[1L]] %>%
+    trimws(which = "right")
   out
 }
 

R/serialized_tests.R

@@ -139,7 +139,6 @@ style_indent_round <- function(text) {
     line_break = NULL,
     space      = partial(indent_round, indent_by = 2),
     token      = NULL,
-    eol        = strip_eol_spaces,
     NULL
   )
   transformed_text <- parse_transform_serialize(text, transformers)
@@ -157,7 +156,6 @@ style_empty <- function(text) {
     line_break = NULL,
     space      = NULL,
     token      = NULL,
-    eol        = strip_eol_spaces,
     NULL
   )
   transformed_text <- parse_transform_serialize(text, transformers)
@@ -173,7 +171,6 @@ style_indent_curly <- function(text) {
     line_break = NULL,
     space      =  partial(indent_curly, indent_by = 2),
     token      = NULL,
-    eol        = strip_eol_spaces,
     NULL
   )
   transformed_text <- parse_transform_serialize(text, transformers)
@@ -190,7 +187,6 @@ style_indent_curly_round <- function(text) {
     space      = c(partial(indent_curly, indent_by = 2),
                     partial(indent_round, indent_by = 2)),
     token      = NULL,
-    eol        = strip_eol_spaces,
     NULL
   )
 
@@ -209,7 +205,6 @@ style_op <- function(text) {
     line_break = NULL,
     space      = partial(indent_op, indent_by = 2),
     token      = NULL,
-    eol        = strip_eol_spaces,
     NULL
   )
 

R/token.R

@@ -0,0 +1,58 @@
+token <- tribble(
+  ~text, ~class, ~token,
+  "&"  , "logical"     , "AND",
+  "&&" , "logical"     , "AND2",
+  "|"  , "logical"     , "OR",
+  "||" , "logical"     , "OR2",
+  ">"  , "logical"     , "GT",
+  "<"  , "logical"     , "LT",
+  "<=" , "logical"     , "LE",
+  ">=" , "logical"     , "GE",
+  "!=" , "logical"     , "NE",
+  "==" , "logical"     , "EQ",
+  "="  , "assign_left" , "EQ_ASSIGN",
+  "<-" , "assign_left" , "LEFT_ASSIGN",
+  "->" , "assign_right", "RIGHT_ASSIGN",
+  "+"  , "math"        , "'+'",
+  "-"  , "math"        , "'-'",
+  "*"  , "math"        , "'*'",
+  "/"  , "math"        , "'/'",
+  "^"  , "math"        , "'^'"
+)
+
+math_token <- token$token[token$class == "math"]
+logical_token <- token$token[token$class == "logical"]
+left_assignment_token <- token$token[token$class == "assign_left"]
+right_assignment_token <- token$token[token$class == "assign_right"]
+
+#' lookup which new tokens were created from "SPECIAL"
+#'
+#' @param regex A regular expression pattern to search for.
+#' @importFrom purrr map_chr
+lookup_new_special <- function(regex = NA) {
+  new_special <- c("PIPE", "IN", "OTHER")
+
+  potential_regex <- grep(regex, new_special, value = TRUE, ignore.case = TRUE)
+  if (is.na(regex)) {
+    mapping <- new_special
+  } else if (length(potential_regex) > 0) {
+    mapping <- potential_regex
+  } else {
+    return(NA)
+  }
+  map_chr(mapping, special_and)
+}
+
+special_token <- lookup_new_special()
+
+op_token <- c(
+  math_token,
+  special_token,
+  logical_token,
+  left_assignment_token,
+  right_assignment_token,
+  "EQ_SUB", "ELSE"
+)
+
+
+

R/transform.R

@@ -112,8 +112,6 @@ apply_transformers <- function(pd_nested, transformers) {
                                                c(set_multi_line))
 
   transformed_all <- pre_visit(transformed_updated_multi_line,
-                               c(transformers$space,
-                                 transformers$token,
-                                 transformers$eol))
+                               c(transformers$space, transformers$token))
   transformed_all
 }