Restore short form formatting of record field aliases

CHANGES.md

@@ -11,7 +11,8 @@
 ### Changes
 
 - JaneStreet profile: add extra parens around tuple with type annotation (#2281, @gpetiot)
-- Module patterns with a module type constraint (`((module M) : (module S))`) are formatted using the short syntax (`(module M : S)`) (#2280, @gpetiot)
+- Restore short form formatting of module patterns with a module type constraint (`((module M) : (module S))` formatted as `(module M : S)`) (#2280, @gpetiot)
+- Restore short form formatting of record field aliases (#2282, @gpetiot)
 
 ### New features
 

lib/Extended_ast.ml

@@ -46,18 +46,78 @@ module Parse = struct
     let open Asttypes in
     let open Ast_mapper in
     let record_field m (f, t, v) =
-      match v with
-      | Some {pexp_desc= Pexp_ident {txt= v_txt; _}; pexp_attributes= []; _}
+      match (t, v) with
+      (* [{ x = x }] -> [{ x }] *)
+      | ( _
+        , Some {pexp_desc= Pexp_ident {txt= v_txt; _}; pexp_attributes= []; _}
+        )
         when Std_longident.field_alias ~field:f.txt v_txt ->
           (f, t, None)
-      | v -> (f, t, Option.map ~f:(m.expr m) v)
+      (* [{ x = (x : t) }] -> [{ x : t }] *)
+      (* [{ x :> t = (x : t) }] -> [{ x : t :> t }] *)
+      | ( (None, t2)
+        , Some
+            { pexp_desc=
+                Pexp_constraint
+                  ( { pexp_desc= Pexp_ident {txt= v_txt; _}
+                    ; pexp_attributes= []
+                    ; _ }
+                  , t1 )
+            ; pexp_attributes= []
+            ; _ } )
+        when Std_longident.field_alias ~field:f.txt v_txt ->
+          (f, (Some t1, t2), None)
+      (* [{ x = (x :> t) }] -> [{ x :> t }] *)
+      (* [{ x = (x : t :> t) }] -> [{ x : t :> t }] *)
+      | ( (None, None)
+        , Some
+            { pexp_desc=
+                Pexp_coerce
+                  ( { pexp_desc= Pexp_ident {txt= v_txt; _}
+                    ; pexp_attributes= []
+                    ; _ }
+                  , t1
+                  , t2 )
+            ; pexp_attributes= []
+            ; _ } )
+        when Std_longident.field_alias ~field:f.txt v_txt ->
+          (f, (t1, Some t2), None)
+      (* [{ x : t = (x :> t) }] -> [{ x : t :> t }] *)
+      | ( (Some t1, None)
+        , Some
+            { pexp_desc=
+                Pexp_coerce
+                  ( { pexp_desc= Pexp_ident {txt= v_txt; _}
+                    ; pexp_attributes= []
+                    ; _ }
+                  , None
+                  , t2 )
+            ; pexp_attributes= []
+            ; _ } )
+        when Std_longident.field_alias ~field:f.txt v_txt ->
+          (f, (Some t1, Some t2), None)
+      | _ -> (f, t, Option.map ~f:(m.expr m) v)
     in
     let pat_record_field m (f, t, v) =
-      match v with
-      | Some {ppat_desc= Ppat_var {txt= v_txt; _}; ppat_attributes= []; _}
+      match (t, v) with
+      (* [{ x = x }] -> [{ x }] *)
+      | _, Some {ppat_desc= Ppat_var {txt= v_txt; _}; ppat_attributes= []; _}
         when Std_longident.field_alias ~field:f.txt (Lident v_txt) ->
           (f, t, None)
-      | v -> (f, t, Option.map ~f:(m.pat m) v)
+      (* [{ x = (x : t) }] -> [{ x : t}] *)
+      | ( None
+        , Some
+            { ppat_desc=
+                Ppat_constraint
+                  ( { ppat_desc= Ppat_var {txt= v_txt; _}
+                    ; ppat_attributes= []
+                    ; _ }
+                  , t )
+            ; ppat_attributes= []
+            ; _ } )
+        when Std_longident.field_alias ~field:f.txt (Lident v_txt) ->
+          (f, Some t, None)
+      | _ -> (f, t, Option.map ~f:(m.pat m) v)
     in
     let binding_op (m : Ast_mapper.mapper) b =
       let b' =
@@ -78,7 +138,7 @@ module Parse = struct
              | _ -> false ->
           let pats = List.(rev (tl_exn (rev l))) in
           {p with ppat_desc= Ppat_list pats}
-      (* [{ x = x }] -> [{ x }] *)
+      (* Field alias shorthand *)
       | {ppat_desc= Ppat_record (fields, flag); _} as e ->
           let fields = List.map ~f:(pat_record_field m) fields in
           {e with ppat_desc= Ppat_record (fields, flag)}
@@ -105,7 +165,7 @@ module Parse = struct
       | {pexp_desc= Pexp_beginend e'; pexp_attributes= []; _}
         when not preserve_beginend ->
           m.expr m e'
-      (* [{ x = x }] -> [{ x }] *)
+      (* Field alias shorthand *)
       | {pexp_desc= Pexp_record (fields, with_); _} as e ->
           let fields = List.map ~f:(record_field m) fields in
           { e with

test/passing/tests/js_syntax.ml.ref

@@ -3,9 +3,9 @@
 let _ =
   [%raise_structural_sexp
     "feature's tip is already an ancestor of new base"
-      {feature_tip= (old_tip : Rev.t); new_base= (new_base : Rev.t)}]
+      {feature_tip= (old_tip : Rev.t); new_base: Rev.t}]
 
 let _ =
   [%raise_structural_sexp
     "feature's tip is already an ancestor of new base"
-      {feature_tip= (old_tip : Rev.t); new_base= (new_base : Rev.t)}]
+      {feature_tip= (old_tip : Rev.t); new_base: Rev.t}]

test/passing/tests/record-loose.ml.ref

@@ -126,3 +126,15 @@ let _ = {(*a*) x (*b*) : (*c*) t (*d*) :> (*e*) t (*f*) = (*g*) e (*h*)}
 type t = C of (*a*) {(*b*) x (*c*) : (*d*) t (*e*)} (*f*)
 
 type t = C : (*a*) {(*b*) x (*c*) : (*d*) t (*e*)} (*f*) -> t
+
+let _ = {x : t}
+
+let _ = {x : t :> t}
+
+let _ = {x :> t}
+
+let _ = {x : t :> t}
+
+let _ = {x : t :> t}
+
+let {x : t} = x

test/passing/tests/record-tight_decl.ml.ref

@@ -126,3 +126,15 @@ let _ = {(*a*) x (*b*) : (*c*) t (*d*) :> (*e*) t (*f*) = (*g*) e (*h*)}
 type t = C of (*a*) {(*b*) x (*c*): (*d*) t (*e*)} (*f*)
 
 type t = C : (*a*) {(*b*) x (*c*): (*d*) t (*e*)} (*f*) -> t
+
+let _ = {x : t}
+
+let _ = {x : t :> t}
+
+let _ = {x :> t}
+
+let _ = {x : t :> t}
+
+let _ = {x : t :> t}
+
+let {x : t} = x

test/passing/tests/record.ml

@@ -131,3 +131,11 @@ let _ = { (*a*)x(*b*) : (*c*)t(*d*) :> (*e*)t(*f*) = (*g*)e(*h*) }
 type t = C of (*a*) { (*b*) x (*c*) : (*d*) t (*e*)} (*f*)
 
 type t = C : (*a*) { (*b*) x (*c*) : (*d*) t (*e*)} (*f*) -> t
+
+let _ = { x = (x : t) }
+let _ = { x :> t = (x : t) }
+let _ = { x = (x :> t) }
+let _ = { x = (x : t :> t) }
+let _ = { x : t = (x :> t) }
+
+let { x = (x : t) } = x

test/passing/tests/record.ml.ref

@@ -126,3 +126,15 @@ let _ = {(*a*) x (*b*): (*c*) t (*d*) :> (*e*) t (*f*) = (*g*) e (*h*)}
 type t = C of (*a*) {(*b*) x (*c*): (*d*) t (*e*)} (*f*)
 
 type t = C : (*a*) {(*b*) x (*c*): (*d*) t (*e*)} (*f*) -> t
+
+let _ = {x: t}
+
+let _ = {x: t :> t}
+
+let _ = {x:> t}
+
+let _ = {x: t :> t}
+
+let _ = {x: t :> t}
+
+let {x: t} = x