fix the extended parser

Signed-off-by: David Vulakh <[email protected]>

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

@@ -63,6 +63,19 @@ let f : (_ : immediate) -> unit = fun _ -> ()
 let g : (_ : value) -> unit = fun _ -> ()
 let f : (_ : immediate) -> (_ : value) = fun _ -> assert false
 let g : (_ : value) -> (_ : immediate) = fun _ -> assert false
+let f : ((_ : any), _) t = ()
+let g : (_, (_ : any)) t = ()
+let f : ((_ : any), _) t -> t = ()
+let g : (_, (_ : any)) t -> t = ()
+
+let f
+  :  (_, (_ : any), (_ : any), (_ : any), (_ : any), (_ : any), (_ : any), (_ : any)) t
+  -> t
+  =
+  ()
+;;
+
+let g : (_, _, _, _, _, _, _, _, (_ : any)) t -> t = ()
 
 (********************************************)
 (* Test 3: Annotation on types in functions *)

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

@@ -94,6 +94,18 @@ let f : _ -> _ = fun _ -> assert false
 
 let g : _ -> _ = fun _ -> assert false
 
+let f : (_, _) t = ()
+
+let g : (_, _) t = ()
+
+let f : (_, _) t -> t = ()
+
+let g : (_, _) t -> t = ()
+
+let f : (_, _, _, _, _, _, _, _) t -> t = ()
+
+let g : (_, _, _, _, _, _, _, _, _) t -> t = ()
+
 (********************************************)
 (* Test 3: Annotation on types in functions *)
 

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

@@ -63,6 +63,19 @@ let f : (_ : immediate) -> unit = fun _ -> ()
 let g : (_ : value) -> unit = fun _ -> ()
 let f : (_ : immediate) -> (_ : value) = fun _ -> assert false
 let g : (_ : value) -> (_ : immediate) = fun _ -> assert false
+let f : ((_ : any), _) t = ()
+let g : (_, (_ : any)) t = ()
+let f : ((_ : any), _) t -> t = ()
+let g : (_, (_ : any)) t -> t = ()
+
+let f
+  :  (_, (_ : any), (_ : any), (_ : any), (_ : any), (_ : any), (_ : any), (_ : any)) t
+  -> t
+  =
+  ()
+;;
+
+let g : (_, _, _, _, _, _, _, _, (_ : any)) t -> t = ()
 
 (********************************************)
 (* Test 3: Annotation on types in functions *)

test/passing/tests/layout_annotation.ml.ref

@@ -96,6 +96,29 @@ let f : (_ : immediate) -> (_ : value) = fun _ -> assert false
 
 let g : (_ : value) -> (_ : immediate) = fun _ -> assert false
 
+let f : ((_ : any), _) t = ()
+
+let g : (_, (_ : any)) t = ()
+
+let f : ((_ : any), _) t -> t = ()
+
+let g : (_, (_ : any)) t -> t = ()
+
+let f :
+       ( _
+       , (_ : any)
+       , (_ : any)
+       , (_ : any)
+       , (_ : any)
+       , (_ : any)
+       , (_ : any)
+       , (_ : any) )
+       t
+    -> t =
+  ()
+
+let g : (_, _, _, _, _, _, _, _, (_ : any)) t -> t = ()
+
 (********************************************)
 (* Test 3: Annotation on types in functions *)
 

vendor/parser-extended/parser.mly

@@ -4346,10 +4346,24 @@ 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 }
+  | QUOTE id=mkrhs(ident {Some $1}) COLON jkind=jkind_annotation
+    { mktyp ~loc:$sloc (Ptyp_var (id, jkind)) }
+  | mkrhs(UNDERSCORE {None}) COLON jkind=jkind_annotation
+    { mktyp ~loc:$sloc (Ptyp_var ($1, jkind)) }
+;
+
 %inline package_core_type: module_type
       { let (lid, cstrs, attrs) = package_type_of_module_type $1 in
         let descr = Ptyp_package (lid, cstrs) in