flambda-backend: Improve parsing of layout annotations in type parame…

…ters (#2688)

parsing/parser.mly

@@ -4536,9 +4536,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=ident COLON jkind=jkind_annotation
+    { Jane_syntax.Layouts.type_of ~loc:(make_loc $sloc) @@
+      Ltyp_var { name = Some id; jkind } }
+  | UNDERSCORE COLON jkind=jkind_annotation
+    { Jane_syntax.Layouts.type_of ~loc:(make_loc $sloc) @@
+      Ltyp_var { name = None; jkind } }
+
 %inline package_type: module_type
       { let (lid, cstrs, attrs) = package_type_of_module_type $1 in
         let descr = Ptyp_package (lid, cstrs) in

testsuite/tests/typing-layouts/parsing.ml

@@ -0,0 +1,36 @@
+(* TEST
+ {
+   compiler_reference = "${test_source_directory}/parsing_stable_beta.compilers.reference";
+   toplevel;
+ }{
+   flags = "-extension layouts_beta";
+   compiler_reference = "${test_source_directory}/parsing_stable_beta.compilers.reference";
+   toplevel;
+ }{
+   flags = "-extension layouts_alpha";
+   compiler_reference = "${test_source_directory}/parsing_alpha.compilers.reference";
+   toplevel;
+ }
+*)
+
+type ('a : value) t0 = 'a list;;
+
+type ('a : immediate) t0 = 'a list;;
+
+type ('a : void) t0 = 'a list;;
+
+type ('a : valu) t0 = 'a list;;
+
+type t = float#;;
+
+type t = int#;;
+
+type t = Float.t#;;
+
+type ('a : any, 'b : any, 'c : any) t;;
+
+type 'a s1 = ('a : float64, int, bool) t;;
+
+let f : ('a, _ : value, bool) t -> int = fun _ -> 42;;
+
+type ('a, 'b, 'c) s2 = ('a, 'b, 'c : bits32) t;;

testsuite/tests/typing-layouts/parsing_alpha.compilers.reference

@@ -22,4 +22,8 @@ Line 2, characters 9-17:
 2 | type t = Float.t#;;
              ^^^^^^^^
 Error: Unbound type constructor Float.t#
+type ('a : any, 'b : any, 'c : any) t
+type ('a : float64) s1 = ('a, int, bool) t
+val f : ('a : any) 'b. ('a, 'b, bool) t -> int = <fun>
+type ('a, 'b, 'c : bits32) s2 = ('a, 'b, 'c) t
 

testsuite/tests/typing-layouts/parsing_beta.compilers.reference → testsuite/tests/typing-layouts/parsing_stable_beta.compilers.reference

@@ -19,4 +19,8 @@ Line 2, characters 9-17:
 2 | type t = Float.t#;;
              ^^^^^^^^
 Error: Unbound type constructor Float.t#
+type ('a : any, 'b : any, 'c : any) t
+type ('a : float64) s1 = ('a, int, bool) t
+val f : ('a : any) 'b. ('a, 'b, bool) t -> int = <fun>
+type ('a, 'b, 'c : bits32) s2 = ('a, 'b, 'c) t