Add bar position to case (#7407)

* Add bar position to case

* Add changelog entry

Author: nojaf

CHANGELOG.md

@@ -20,6 +20,10 @@
 
 - Fix broken `bstracing` CLI location. https://github.com/rescript-lang/rescript/pull/7398
 
+#### :house: Internal
+
+- AST: Add bar location to `case`. https://github.com/rescript-lang/rescript/pull/7407
+
 # 12.0.0-alpha.12
 
 #### :bug: Bug fix

compiler/frontend/bs_ast_mapper.ml

@@ -539,8 +539,9 @@ let default_mapper =
           ~attrs:(this.attributes this pld_attributes));
     cases = (fun this l -> List.map (this.case this) l);
     case =
-      (fun this {pc_lhs; pc_guard; pc_rhs} ->
+      (fun this {pc_bar; pc_lhs; pc_guard; pc_rhs} ->
         {
+          pc_bar;
           pc_lhs = this.pat this pc_lhs;
           pc_guard = map_opt (this.expr this) pc_guard;
           pc_rhs = this.expr this pc_rhs;

compiler/frontend/bs_builtin_ppx.ml

@@ -165,7 +165,9 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
         {
           e with
           pexp_desc =
-            Pexp_match (pvb_expr, [{pc_lhs = p; pc_guard = None; pc_rhs = body}]);
+            Pexp_match
+              ( pvb_expr,
+                [{pc_bar = None; pc_lhs = p; pc_guard = None; pc_rhs = body}] );
           pexp_attributes = e.pexp_attributes @ pvb_attributes;
         })
   (* let [@warning "a"] {a;b} = c in body

compiler/ml/ast_helper.ml

@@ -208,7 +208,8 @@ module Exp = struct
               jsx_container_element_closing_tag = e;
             }))
 
-  let case lhs ?guard rhs = {pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs}
+  let case ?bar lhs ?guard rhs =
+    {pc_bar = bar; pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs}
 
   let make_list_expression loc seq ext_opt =
     let rec handle_seq = function

compiler/ml/ast_helper.mli

@@ -231,7 +231,8 @@ module Exp : sig
     Parsetree.jsx_closing_container_tag option ->
     expression
 
-  val case : pattern -> ?guard:expression -> expression -> case
+  val case :
+    ?bar:Lexing.position -> pattern -> ?guard:expression -> expression -> case
   val await : ?loc:loc -> ?attrs:attrs -> expression -> expression
 
   val make_list_expression :

compiler/ml/ast_mapper.ml

@@ -488,8 +488,9 @@ let default_mapper =
           ~attrs:(this.attributes this pld_attributes));
     cases = (fun this l -> List.map (this.case this) l);
     case =
-      (fun this {pc_lhs; pc_guard; pc_rhs} ->
+      (fun this {pc_bar; pc_lhs; pc_guard; pc_rhs} ->
         {
+          pc_bar;
           pc_lhs = this.pat this pc_lhs;
           pc_guard = map_opt (this.expr this) pc_guard;
           pc_rhs = this.expr this pc_rhs;

compiler/ml/ast_mapper_from0.ml

@@ -665,6 +665,7 @@ let default_mapper =
     case =
       (fun this {pc_lhs; pc_guard; pc_rhs} ->
         {
+          pc_bar = None;
           pc_lhs = this.pat this pc_lhs;
           pc_guard = map_opt (this.expr this) pc_guard;
           pc_rhs = this.expr this pc_rhs;

compiler/ml/parsetree.ml

@@ -381,6 +381,7 @@ and jsx_closing_container_tag = {
 
 and case = {
   (* (P -> E) or (P when E0 -> E) *)
+  pc_bar: Lexing.position option;
   pc_lhs: pattern;
   pc_guard: expression option;
   pc_rhs: expression;

compiler/ml/printast.ml

@@ -681,8 +681,10 @@ and longident_x_pattern i ppf (li, p, opt) =
   line i ppf "%a%s\n" fmt_longident_loc li (if opt then "?" else "");
   pattern (i + 1) ppf p
 
-and case i ppf {pc_lhs; pc_guard; pc_rhs} =
+and case i ppf {pc_bar; pc_lhs; pc_guard; pc_rhs} =
   line i ppf "<case>\n";
+  pc_bar
+  |> Option.iter (fun bar -> line i ppf "| %a\n" (fmt_position false) bar);
   pattern (i + 1) ppf pc_lhs;
   (match pc_guard with
   | None -> ()

compiler/syntax/src/res_core.ml

@@ -3543,6 +3543,7 @@ and parse_pattern_match_case p =
   Parser.leave_breadcrumb p Grammar.PatternMatchCase;
   match p.Parser.token with
   | Token.Bar ->
+    let bar = p.start_pos in
     Parser.next p;
     Parser.leave_breadcrumb p Grammar.Pattern;
     let lhs = parse_pattern p in
@@ -3556,7 +3557,7 @@ and parse_pattern_match_case p =
     let rhs = parse_expr_block p in
     Parser.end_region p;
     Parser.eat_breadcrumb p;
-    Some (Ast_helper.Exp.case lhs ?guard rhs)
+    Some (Ast_helper.Exp.case ~bar lhs ?guard rhs)
   | _ ->
     Parser.end_region p;
     Parser.eat_breadcrumb p;