Remove unnecessary parens from layout annotations in type parameters (#…

…74)

* Add examples that fail to parse

* These now parse without parens but print with parens

* Eliminate unnecessary parens

* remove unnecessary [Ptyp_any]

Signed-off-by: David Vulakh <dvulakh@janestreet.com>

---------

Signed-off-by: David Vulakh <dvulakh@janestreet.com>
Co-authored-by: David Vulakh <dvulakh@janestreet.com>

lib/Ast.ml

@@ -1957,6 +1957,13 @@ end = struct
     | { ast= {ptyp_desc= Ptyp_poly _; _}
       ; ctx= Typ {ptyp_desc= Ptyp_arrow _; _} } ->
         true
+    | { ast= {ptyp_desc= Ptyp_var (_, _); _}
+      ; ctx= Typ {ptyp_desc= Ptyp_constr (_, args); _} }
+      when List.length args > 1 ->
+        (* Type variables and _ do not need parens when they appear as an
+           argument to a multi-parameter type constructor, even if they have
+           layout annotations. *)
+        false
     | {ast= {ptyp_desc= Ptyp_var (_, l); _}; ctx= _} when Option.is_some l ->
         true
     | { ast= {ptyp_desc= Ptyp_tuple ((Some _, _) :: _); _}

test/passing/tests/layout_annotation-erased.ml.js-ref

@@ -64,6 +64,13 @@ let g : (_ : value) -> unit = fun _ -> ()
 let f : (_ : immediate) -> (_ : value) = fun _ -> assert false
 let g : (_ : value) -> (_ : immediate) = fun _ -> assert false
 
+type ('a : any, 'b : any, 'c : any) t4
+type 'a t5 = ('a : float64, int, bool) t4
+
+let f : ('a, _ : value, bool) t4 -> int = fun _ -> 42
+
+type ('a, 'b, 'c) t6 = ('a, 'b, 'c : bits32) t4
+
 (********************************************)
 (* Test 3: Annotation on types in functions *)
 
@@ -198,7 +205,7 @@ let f_val : ('a : value). 'a -> 'a = fun x -> f_imm x
 
 type (_ : value) g = MkG : ('a : immediate). 'a g
 type t = int as (_ : immediate)
-type t = (('a : value), ('b : value)) t2
+type t = ('a : value, 'b : value) t2
 type ('a, 'b) t = ('a : value) * ('b : value)
 
 class c : object

test/passing/tests/layout_annotation-erased.ml.ref

@@ -94,6 +94,14 @@ let f : _ -> _ = fun _ -> assert false
 
 let g : _ -> _ = fun _ -> assert false
 
+type ('a, 'b, 'c) t4
+
+type 'a t5 = ('a, int, bool) t4
+
+let f : ('a, _, bool) t4 -> int = fun _ -> 42
+
+type ('a, 'b, 'c) t6 = ('a, 'b, 'c) t4
+
 (********************************************)
 (* Test 3: Annotation on types in functions *)
 

test/passing/tests/layout_annotation.ml

@@ -97,6 +97,14 @@ let f : (_ : immediate) -> (_ : value) = fun _ -> assert false
 
 let g : (_ : value) -> (_ : immediate) = fun _ -> assert false
 
+type ('a : any, 'b : any, 'c : any) t4
+
+type 'a t5 = ('a : float64, int, bool) t4
+
+let f : ('a, _ : value, bool) t4 -> int = fun _ -> 42;;
+
+type ('a, 'b, 'c) t6 = ('a, 'b, 'c : bits32) t4;;
+
 (********************************************)
 (* Test 3: Annotation on types in functions *)
 

test/passing/tests/layout_annotation.ml.js-ref

@@ -64,6 +64,13 @@ let g : (_ : value) -> unit = fun _ -> ()
 let f : (_ : immediate) -> (_ : value) = fun _ -> assert false
 let g : (_ : value) -> (_ : immediate) = fun _ -> assert false
 
+type ('a : any, 'b : any, 'c : any) t4
+type 'a t5 = ('a : float64, int, bool) t4
+
+let f : ('a, _ : value, bool) t4 -> int = fun _ -> 42
+
+type ('a, 'b, 'c) t6 = ('a, 'b, 'c : bits32) t4
+
 (********************************************)
 (* Test 3: Annotation on types in functions *)
 
@@ -198,7 +205,7 @@ let f_val : ('a : value). 'a -> 'a = fun x -> f_imm x
 
 type (_ : value) g = MkG : ('a : immediate). 'a g
 type t = int as (_ : immediate)
-type t = (('a : value), ('b : value)) t2
+type t = ('a : value, 'b : value) t2
 type ('a, 'b) t = ('a : value) * ('b : value)
 
 class c : object

test/passing/tests/layout_annotation.ml.ref

@@ -96,6 +96,14 @@ let f : (_ : immediate) -> (_ : value) = fun _ -> assert false
 
 let g : (_ : value) -> (_ : immediate) = fun _ -> assert false
 
+type ('a : any, 'b : any, 'c : any) t4
+
+type 'a t5 = ('a : float64, int, bool) t4
+
+let f : ('a, _ : value, bool) t4 -> int = fun _ -> 42
+
+type ('a, 'b, 'c) t6 = ('a, 'b, 'c : bits32) t4
+
 (********************************************)
 (* Test 3: Annotation on types in functions *)
 
@@ -252,7 +260,7 @@ type (_ : value) g = MkG : ('a : immediate). 'a g
 
 type t = int as (_ : immediate)
 
-type t = (('a : value), ('b : value)) t2
+type t = ('a : value, 'b : value) t2
 
 type ('a, 'b) t = ('a : value) * ('b : value)
 

vendor/parser-extended/parser.mly

@@ -4346,10 +4346,22 @@ atomic_type:
       { [] }
   | ty = atomic_type
       { [ty] }
-  | LPAREN tys = separated_nontrivial_llist(COMMA, core_type) RPAREN
+  | LPAREN
+    tys = separated_nontrivial_llist(COMMA, one_type_parameter_of_several)
+    RPAREN
       { tys }
 ;
 
+(* Layout annotations on type expressions typically require parens, as in [('a :
+   float64)].  But this is unnecessary when the type expression is used as the
+   parameter of a tconstr with more than one argument, as in [(int, 'b :
+   float64) t]. *)
+%inline one_type_parameter_of_several:
+  | core_type { $1 }
+  | name=mkrhs(tyvar_name_or_underscore) COLON jkind=jkind_annotation
+    { let descr = Ptyp_var (name, jkind) in
+      mktyp ~loc:$sloc descr }
+
 %inline package_core_type: module_type
       { let (lid, cstrs, attrs) = package_type_of_module_type $1 in
         let descr = Ptyp_package (lid, cstrs) in