Keep regexp statements parseable after formatting

changes/regexp-statement-formatting.fix.md

@@ -0,0 +1,2 @@
+- Preserve parentheses around statements that start with a regexp literal, so formatting cannot turn them into division continuing the previous statement. https://github.com/rescript-lang/rescript/pull/8720
+- Preserve the scope of attributes on ternary conditions when formatting. https://github.com/rescript-lang/rescript/pull/8720

compiler/syntax/src/res_parens.ml

@@ -280,7 +280,7 @@ let field_expr expr =
     | _ when Parsetree_viewer.expr_is_await expr -> Parenthesized
     | _ -> Nothing)
 
-let ternary_operand expr =
+let ternary_operand ?(is_condition = false) expr =
   let opt_braces, _ = Parsetree_viewer.process_braces expr in
   match opt_braces with
   | Some braces_loc -> Braced braces_loc
@@ -291,6 +291,8 @@ let ternary_operand expr =
        Pexp_constraint ({pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _});
     } ->
       Nothing
+    (* A leading condition attribute otherwise attaches to the whole statement. *)
+    | _ when is_condition && expr.pexp_attributes <> [] -> Parenthesized
     | {pexp_desc = Pexp_ternary _} -> Parenthesized
     | {pexp_desc = Pexp_constraint _ | Pexp_coerce _} -> Parenthesized
     | _ when Res_parsetree_viewer.is_fun_expr expr -> (
@@ -451,3 +453,57 @@ let pattern_record_row_rhs (pattern : Parsetree.pattern) =
     false
   | Ppat_constraint _ -> true
   | _ -> false
+
+(* Follow the printed left edge, stopping where operand rules add delimiters
+   or attributes add a prefix. *)
+let rec starts_with_regexp e =
+  match e.Parsetree.pexp_desc with
+  | _ when e.pexp_attributes <> [] -> false
+  | Pexp_regexp _ -> true
+  | Pexp_apply
+      {
+        funct =
+          {
+            pexp_desc =
+              Pexp_ident {txt = Lident "##" | Ldot (Lident "Array", "get")};
+          };
+        args = [(Nolabel, parent); (Nolabel, _)];
+      }
+  | Pexp_apply
+      {
+        funct = {pexp_desc = Pexp_ident {txt = Ldot (Lident "Array", "set")}};
+        args = [(Nolabel, parent); (Nolabel, _); (Nolabel, _)];
+      }
+  | Pexp_object_get (parent, _)
+  | Pexp_object_set (parent, _, _) ->
+    starts_unwrapped (unary_expr_operand parent) parent
+  | Pexp_apply
+      {
+        funct = {pexp_desc = Pexp_ident {txt = Longident.Lident operator}};
+        args = [(Nolabel, lhs); (Nolabel, _rhs)];
+      }
+    when Parsetree_viewer.is_binary_expression e -> (
+    match lhs.pexp_desc with
+    | Pexp_apply
+        {
+          funct =
+            {pexp_desc = Pexp_ident {txt = Longident.Lident child_operator}};
+        }
+      when Parsetree_viewer.is_binary_expression lhs ->
+      (not (sub_binary_expr_operand operator child_operator))
+      && starts_with_regexp lhs
+    | Pexp_setfield _ | Pexp_object_set _ -> false
+    | _ -> starts_unwrapped (binary_expr_operand ~is_lhs:true lhs) lhs)
+  | Pexp_apply {funct} -> starts_unwrapped (call_expr funct) funct
+  | Pexp_ternary (condition, _consequent, _alternate) ->
+    starts_unwrapped (ternary_operand ~is_condition:true condition) condition
+  | Pexp_field (obj, _) | Pexp_setfield (obj, _, _) ->
+    starts_unwrapped (field_expr obj) obj
+  | Pexp_fun {body} when Parsetree_viewer.is_underscore_apply_sugar e ->
+    starts_with_regexp body
+  | _ -> false
+
+and starts_unwrapped kind e =
+  match kind with
+  | Nothing -> starts_with_regexp e
+  | Parenthesized | Braced _ -> false

compiler/syntax/src/res_parens.mli

@@ -1,6 +1,7 @@
 type kind = Parenthesized | Braced of Location.t | Nothing
 
 val expr : Parsetree.expression -> kind
+val starts_with_regexp : Parsetree.expression -> bool
 
 (* Unlike [expr], this does not request parentheses for a top-level coercion.
    Use only where the surrounding grammar delimits the expression, such as call
@@ -20,7 +21,7 @@ val assert_or_await_expr_rhs : ?in_await:bool -> Parsetree.expression -> kind
 
 val field_expr : Parsetree.expression -> kind
 
-val ternary_operand : Parsetree.expression -> kind
+val ternary_operand : ?is_condition:bool -> Parsetree.expression -> kind
 
 val jsx_prop_expr : Parsetree.expression -> kind
 

compiler/syntax/src/res_printer.ml

@@ -28,6 +28,12 @@ let add_parens doc =
          Doc.rparen;
        ])
 
+(* Keep the delimiters on the expression's first and last lines. The parser
+   excludes parentheses from expression locations, so breaking just inside
+   them would create blank lines or move comments on the next formatting pass. *)
+let add_statement_parens doc =
+  Doc.group (Doc.concat [Doc.lparen; doc; Doc.rparen])
+
 (* Module expressions hug their parens, so a multi-line structure or
    signature keeps its braces next to them: [(M: {...})] *)
 let add_mod_expr_parens doc = Doc.concat [Doc.lparen; doc; Doc.rparen]
@@ -702,13 +708,29 @@ let rec print_structure ~state (s : Parsetree.structure) t =
   match s with
   | [] -> print_comments_inside_file t
   | structure ->
+    let previous_can_continue = ref false in
     print_list
       ~get_loc:(fun s -> s.Parsetree.pstr_loc)
       ~nodes:structure
-      ~print:(print_structure_item ~state)
+      ~print:(fun item cmt_tbl ->
+        let protect_regexp = !previous_can_continue in
+        (previous_can_continue :=
+           match item.Parsetree.pstr_desc with
+           | Pstr_value _ | Pstr_eval _ -> true
+           | _ -> false);
+        print_structure_item ~state ~protect_regexp item cmt_tbl)
       t
 
-and print_structure_item ~state (si : Parsetree.structure_item) cmt_tbl =
+and print_statement_expr ~protect_regexp expr kind doc =
+  match kind with
+  | Parens.Parenthesized -> add_parens doc
+  | Braced braces -> print_braces doc expr braces
+  | Nothing when protect_regexp && Parens.starts_with_regexp expr ->
+    add_statement_parens doc
+  | Nothing -> doc
+
+and print_structure_item ~state ?(protect_regexp = false)
+    (si : Parsetree.structure_item) cmt_tbl =
   let clear_pending () =
     state.State.pending_inline_record_defs_for_external <- None
   in
@@ -728,11 +750,9 @@ and print_structure_item ~state (si : Parsetree.structure_item) cmt_tbl =
   | Pstr_eval (expr, attrs) ->
     clear_pending ();
     let expr_doc =
+      let protect_regexp = protect_regexp && attrs = [] in
       let doc = print_expression_with_comments ~state expr cmt_tbl in
-      match Parens.structure_expr expr with
-      | Parens.Parenthesized -> add_parens doc
-      | Braced braces -> print_braces doc expr braces
-      | Nothing -> doc
+      print_statement_expr ~protect_regexp expr (Parens.structure_expr expr) doc
     in
     Doc.concat [print_attributes ~state attrs cmt_tbl; expr_doc]
   | Pstr_attribute attr ->
@@ -3563,7 +3583,8 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl =
           Doc.group
             (Doc.concat
                [
-                 print_ternary_operand ~state condition1 cmt_tbl;
+                 print_ternary_operand ~is_condition:true ~state condition1
+                   cmt_tbl;
                  Doc.indent
                    (Doc.concat
                       [
@@ -3581,8 +3602,8 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl =
                                  [
                                    Doc.line;
                                    Doc.text ": ";
-                                   print_ternary_operand ~state condition
-                                     cmt_tbl;
+                                   print_ternary_operand ~is_condition:true
+                                     ~state condition cmt_tbl;
                                    Doc.line;
                                    Doc.text "? ";
                                    print_ternary_operand ~state consequent
@@ -3817,6 +3838,7 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl =
   in
   let should_print_its_own_attributes =
     match e.pexp_desc with
+    | Pexp_fun _ when Parsetree_viewer.is_underscore_apply_sugar e -> false
     | Pexp_apply _ | Pexp_fun _ | Pexp_setfield _ | Pexp_ifthenelse _
     | Pexp_ternary _ ->
       true
@@ -3925,9 +3947,9 @@ and print_pexp_fun ~state ~in_callback e cmt_tbl =
   | NoCallback -> Doc.group doc
   | FitsOnOneLine | ArgumentsFitOnOneLine -> doc
 
-and print_ternary_operand ~state expr cmt_tbl =
+and print_ternary_operand ?(is_condition = false) ~state expr cmt_tbl =
   let doc = print_expression_with_comments ~state expr cmt_tbl in
-  match Parens.ternary_operand expr with
+  match Parens.ternary_operand ~is_condition expr with
   | Parens.Parenthesized -> add_parens doc
   | Braced braces -> print_braces doc expr braces
   | Nothing -> doc
@@ -5705,7 +5727,21 @@ and print_exp_fun_parameter ~state parameter cmt_tbl =
 
 and print_expression_block ~state ~braces expr cmt_tbl =
   let expr = Parsetree_viewer.unwrap_braces expr in
-  let rec collect_rows acc expr =
+  (* Include attributes and leading comments when preserving blank lines, but
+     look up comments using the original expression location. *)
+  let statement_row (expr : Parsetree.expression) doc =
+    let loc =
+      match get_first_leading_comment cmt_tbl expr.pexp_loc with
+      | Some comment ->
+        {(Comment.loc comment) with loc_end = expr.pexp_loc.loc_end}
+      | None -> (
+        match expr.pexp_attributes with
+        | ({loc}, _) :: _ -> {expr.pexp_loc with loc_start = loc.loc_start}
+        | [] -> expr.pexp_loc)
+    in
+    (loc, print_comments doc cmt_tbl expr.pexp_loc)
+  in
+  let rec collect_rows ~protect_regexp acc expr =
     match expr.Parsetree.pexp_desc with
     | Parsetree.Pexp_letmodule (mod_name, mod_expr, expr2) ->
       let name =
@@ -5733,7 +5769,7 @@ and print_expression_block ~state ~braces expr cmt_tbl =
           ]
       in
       let loc = {expr.pexp_loc with loc_end = mod_expr.pmod_loc.loc_end} in
-      collect_rows ((loc, let_module_doc) :: acc) expr2
+      collect_rows ~protect_regexp:false ((loc, let_module_doc) :: acc) expr2
     | Pexp_letexception (extension_constructor, expr2) ->
       let loc =
         let loc =
@@ -5748,7 +5784,7 @@ and print_expression_block ~state ~braces expr cmt_tbl =
       let let_exception_doc =
         print_exception_def ~state extension_constructor cmt_tbl
       in
-      collect_rows ((loc, let_exception_doc) :: acc) expr2
+      collect_rows ~protect_regexp:false ((loc, let_exception_doc) :: acc) expr2
     | Pexp_open (override_flag, longident_loc, expr2) ->
       let open_doc =
         Doc.concat
@@ -5760,17 +5796,15 @@ and print_expression_block ~state ~braces expr cmt_tbl =
           ]
       in
       let loc = {expr.pexp_loc with loc_end = longident_loc.loc.loc_end} in
-      collect_rows ((loc, open_doc) :: acc) expr2
+      collect_rows ~protect_regexp:false ((loc, open_doc) :: acc) expr2
     | Pexp_sequence (expr1, expr2) ->
       let expr_doc =
         let doc = print_expression ~state expr1 cmt_tbl in
-        match Parens.expr expr1 with
-        | Parens.Parenthesized -> add_parens doc
-        | Braced braces -> print_braces doc expr1 braces
-        | Nothing -> doc
+        print_statement_expr ~protect_regexp expr1 (Parens.expr expr1) doc
       in
-      let loc = expr1.pexp_loc in
-      collect_rows ((loc, expr_doc) :: acc) expr2
+      collect_rows ~protect_regexp:true
+        (statement_row expr1 expr_doc :: acc)
+        expr2
     | Pexp_let (rec_flag, value_bindings, expr2) -> (
       let loc =
         let loc =
@@ -5802,18 +5836,15 @@ and print_expression_block ~state ~braces expr cmt_tbl =
       match expr2.pexp_desc with
       | Pexp_construct ({txt = Longident.Lident "()"}, _) ->
         List.rev ((loc, let_doc) :: acc)
-      | _ -> collect_rows ((loc, let_doc) :: acc) expr2)
+      | _ -> collect_rows ~protect_regexp:true ((loc, let_doc) :: acc) expr2)
     | _ ->
       let expr_doc =
         let doc = print_expression ~state expr cmt_tbl in
-        match Parens.expr expr with
-        | Parens.Parenthesized -> add_parens doc
-        | Braced braces -> print_braces doc expr braces
-        | Nothing -> doc
+        print_statement_expr ~protect_regexp expr (Parens.expr expr) doc
       in
-      List.rev ((expr.pexp_loc, expr_doc) :: acc)
+      List.rev (statement_row expr expr_doc :: acc)
   in
-  let rows = collect_rows [] expr in
+  let rows = collect_rows ~protect_regexp:false [] expr in
   let block =
     print_list ~get_loc:fst ~nodes:rows
       ~print:(fun (_, doc) _ -> doc)

tests/build_tests/regexp_statement_formatting/Main.res

@@ -0,0 +1,115 @@
+let afterLet = s => {
+  let t = s
+  (/a/->RegExp.test(t))
+}
+
+let afterExpression = s => {
+  ignore(s)
+  (/a/->RegExp.test(s))
+}
+
+let afterOpen = s => {
+  open RegExp
+  /a/->test(s)
+}
+
+let afterModule = s => {
+  module RE = RegExp
+  /a/->RE.test(s)
+}
+
+let intermediate = () => {
+  let seen = ref(false)
+  (/a/->RegExp.test("a")->(result => seen := result))
+  seen.contents
+}
+
+let bare = () => {
+  ignore()
+  (/a/)
+}
+
+let dotAndWhitespace = s => {
+  ignore(s)
+  (/./s->RegExp.test(s)->ignore)
+  (/ a/->RegExp.test(s))
+}
+
+let ternaryAndBinary = s => {
+  let t = s
+  (/a/->RegExp.test(t) && true ? 1 : 0)
+}
+
+module Array = {
+  @get_index external get: (RegExp.t, string) => int = ""
+  @set_index external set: (RegExp.t, string, int) => unit = ""
+}
+
+let arrayAccess = key => {
+  ignore(key)
+  (/a/g[key])
+}
+
+let arrayMutation = (key, value) => {
+  let written = ref(0)
+  module Array = {
+    let set = (regexp, key, value) => {
+      regexp[key] = value
+      written := regexp[key]
+    }
+  }
+  ignore(key)
+  (/a/g[key] = value)
+  written.contents
+}
+
+type field = {mutable value: int}
+type predicate = {test: unit => bool}
+
+let fieldAccess = key => {
+  module Array = {
+    let get = (regexp, key) => {value: regexp->RegExp.test(key) ? 1 : 2}
+  }
+  ignore(key)
+  (/a/[key].value)
+}
+
+let fieldMutation = (key, value) => {
+  let field = {value: 0}
+  module Array = {
+    let get = (regexp, key) => regexp->RegExp.test(key) ? field : {value: -1}
+  }
+  ignore(key)
+  (/a/[key].value = value)
+  field.value
+}
+
+let fieldCall = key => {
+  module Array = {
+    let get = (regexp, key) => {test: () => regexp->RegExp.test(key)}
+  }
+  ignore(key)
+  @warning("-26")
+  /a/[key].test()
+}
+
+let attributedPlaceholder = () => {
+  module Array = {
+    let get = (regexp, _index) => (value, suffix) => regexp->RegExp.test(value ++ suffix)
+  }
+  ignore()
+  @warning("-26") /^a$/[0](_, "a")
+}
+
+let division = a => {
+  let b = a / 2 / 3
+  b
+}
+
+let floatDivision = a => {
+  let b = a /. 2. /. 3.
+  b
+}
+
+let s = "a"
+(/a/->RegExp.test(s)->ignore)