Fix LR(1) abiguity in fexpr parsing of variant subkinds (ocaml-flambd…

…a#1160)

Also add `tests11.ml` to the flexpect tests, and pass `--strict` to Menhir so
that shift/reduce conflicts cause errors in the future.

middle_end/flambda2/parser/dune

@@ -48,7 +48,7 @@
  (targets flambda_parser_in.ml flambda_parser_in.mli)
  (deps flambda_parser.mly)
  (action
-  (run menhir --table %{deps} --base flambda_parser_in)))
+  (run menhir --strict --table %{deps} --base flambda_parser_in)))
 
 ; NOTE: flambda_parser.messages is massively out of date.
 

middle_end/flambda2/parser/flambda_parser.mly

@@ -221,7 +221,7 @@ let make_boxed_const_int (i, m) : static_data =
 %type <float Fexpr.or_variable> float_or_variable
 %type <Fexpr.infix_binop> infix_binop
 %type <Fexpr.signed_or_unsigned -> Fexpr.signed_or_unsigned Fexpr.comparison_behaviour> int_comp
-%type <Fexpr.kind> kind
+(* %type <Fexpr.kind> kind *)
 %type <Fexpr.kind_with_subkind> kind_with_subkind
 %type <Fexpr.kind_with_subkind list> kinds_with_subkinds
 %type <Fexpr.mutability> mutability
@@ -530,12 +530,14 @@ naked_number_kind:
   | KWD_INT64 { Naked_int64 }
   | KWD_NATIVEINT { Naked_nativeint }
 ;
+(*
 kind:
   | KWD_VAL { Flambda_kind.value }
   | nnk = naked_number_kind { Flambda_kind.naked_number nnk }
   | KWD_REGION { Flambda_kind.region }
   | KWD_REC_INFO { Flambda_kind.rec_info }
 ;
+*)
 kind_with_subkind:
   | nnk = naked_number_kind { Naked_number nnk }
   | subkind = subkind { Value subkind }
@@ -565,17 +567,16 @@ subkind:
 subkinds_nonempty:
   | sks = separated_nonempty_list(STAR, subkind) { sks }
 ;
+(* LR(1) restrictions make this a bit awkward to write *)
 ctors:
   | { [], [] }
-  | consts = const_ctors { consts, [] }
-  | non_consts = nonconst_ctors { [], non_consts }
-  | consts = const_ctors; PIPE; non_consts = nonconst_ctors
-    { consts, non_consts }
-;
-const_ctors:
-  | consts = separated_nonempty_list(PIPE, targetint) { consts }
-;
-nonconst_ctors:
+  | ctors = ctors_nonempty { ctors }
+ctors_nonempty:
+  | tag = targetint { [ tag ], [] }
+  | tag = targetint; PIPE; ctors = ctors_nonempty
+      { let (c, nc) = ctors in (tag :: c, nc) }
+  | nonconsts = nonconst_ctors_nonempty { [], nonconsts }
+nonconst_ctors_nonempty:
   | ctors = separated_nonempty_list(PIPE, nonconst_ctor) { ctors }
 ;
 nonconst_ctor:
@@ -585,10 +586,6 @@ return_arity:
   | { None }
   | COLON k = kinds_with_subkinds { Some k }
 ;
-kind_arg_opt:
-  | { None }
-  | LBRACE; k = kind; RBRACE { Some k }
-;
 
 /* expr is staged so that let and where play nicely together. In particular, in
    let ... in ... where, we want the where to be on the inside so that the

middle_end/flambda2/parser/print_fexpr.ml

@@ -157,7 +157,7 @@ and variant_subkind ppf consts non_consts =
     let () =
       match consts, non_consts with
       | [], _ | _, [] -> ()
-      | _ :: _, _ :: _ -> Format.fprintf ppf "@ |"
+      | _ :: _, _ :: _ -> Format.fprintf ppf "@ | "
     in
     let pp_pair ppf (tag, sk) =
       Format.fprintf ppf "@[<hov 2>%d of %a@]" tag (pp_star_list subkind) sk

middle_end/flambda2/tests/mlexamples/dune

@@ -10,5 +10,6 @@
     (run tools/gen_dune_rules.exe
          tests0
          tests4
-         tests5))
+         tests5
+         tests11))
    (diff generated-rules.inc generated-rules.inc.new))))

middle_end/flambda2/tests/mlexamples/generated-rules.inc

@@ -131,3 +131,46 @@
 (rule
  (alias regen)
  (action (diff tests5.flt tests5.flt.new)))
+
+(rule
+ (alias runtest)
+ (action
+  (progn
+   (run ../tools/flexpect.exe tests11.flt)
+   (diff? tests11.flt tests11.flt.corrected))))
+
+(rule
+ (alias runtest)
+ (action
+  (progn
+   (run ../tools/roundtrip.exe tests11_in.fl)
+   (diff? tests11_in.fl tests11_in.fl.corrected))))
+
+(rule
+ (alias runtest)
+ (action
+  (progn
+   (run ../tools/roundtrip.exe tests11_out.fl)
+   (diff? tests11_out.fl tests11_out.fl.corrected))))
+
+(rule
+ (alias regen)
+ (targets tests11.flt.new tests11_in.fl.new tests11_out.fl.new)
+ (deps tests11.ml)
+ (action
+   (run ocamlopt -c tests11.ml -nopervasives -nostdlib
+        -drawfexpr-to tests11_in.fl.new
+        -dfexpr-to tests11_out.fl.new
+        -dflexpect-to tests11.flt.new)))
+
+(rule
+ (alias regen)
+ (action (diff tests11_in.fl tests11_in.fl.new)))
+
+(rule
+ (alias regen)
+ (action (diff tests11_out.fl tests11_out.fl.new)))
+
+(rule
+ (alias regen)
+ (action (diff tests11.flt tests11.flt.new)))