Introduce (menhir) field in (env) stanza

Signed-off-by: Nicolás Ojeda Bär <n.oje.bar@gmail.com>

bin/printenv.ml

@@ -7,12 +7,13 @@ let dump sctx ~dir =
   let module Link_flags = Dune_rules.Link_flags in
   let module Ocaml_flags = Dune_rules.Ocaml_flags in
   let module Js_of_ocaml = Dune_rules.Js_of_ocaml in
+  let module Menhir_env = Dune_rules.Menhir_env in
   let node = Super_context.env_node sctx ~dir in
   let open Memo.O in
   let ocaml_flags = node >>= Env_node.ocaml_flags in
   let foreign_flags = node >>| Env_node.foreign_flags in
   let link_flags = node >>= Env_node.link_flags in
-  let menhir_flags = node >>| Env_node.menhir_flags in
+  let menhir = node >>= Env_node.menhir in
   let coq_flags = node >>= Env_node.coq_flags in
   let js_of_ocaml = node >>= Env_node.js_of_ocaml in
   let open Action_builder.O in
@@ -30,8 +31,8 @@ let dump sctx ~dir =
     let* link_flags = Action_builder.of_memo link_flags in
     Link_flags.dump link_flags
   and+ menhir_dump =
-    let+ flags = Action_builder.of_memo_join menhir_flags in
-    [ "menhir_flags", flags ] |> List.map ~f:Dune_lang.Encoder.(pair string (list string))
+    let* env = Action_builder.of_memo menhir in
+    Menhir_env.dump env
   and+ coq_dump = Action_builder.of_memo_join coq_flags >>| Dune_rules.Coq.Coq_flags.dump
   and+ jsoo_dump =
     let* jsoo = Action_builder.of_memo js_of_ocaml in

doc/changes/9512.md

@@ -1,3 +1,6 @@
 - Menhir: generate `.conflicts` file by default. Add new field to the `(menhir)`
   stanza to control the generation of this file: `(explain <blang expression>)`.
+  Introduce `(menhir (flags ...) (explain ...))` field in the `(env)` stanza,
+  delete `(menhir_flags)` field. All changes are guarded under a new version of
+  the Menhir extension, 2.2.
   (#9512, @nojb)

doc/stanzas/env.rst

@@ -32,7 +32,13 @@ Fields supported in ``<settings>`` are:
   variables to the environment where the build commands are executed and are
   used by ``dune exec``.
 
-- ``(menhir_flags <flags>))`` specifies flags for Menhir stanzas.
+- ``(menhir_flags <flags>))`` specifies flags for Menhir stanzas. This flag was
+  replaced by the ``(menhir)`` field (see below) starting in version 2.2 of the
+  Menhir extension.
+
+- ``(menhir (flags <flags) (explain <blang expression>))`` specifies the Menhir
+  settings. See `menhir`_ for more details. This field was introduced in version
+  2.2 of the Menhir extension.
 
 - ``(js_of_ocaml (flags <flags>)(build_runtime <flags>)(link_flags <flags>))``
   specifies ``js_of_ocaml`` flags. See `jsoo-field`_ for more details.

src/dune_lang/blang.ml

@@ -15,6 +15,20 @@ module Ast = struct
   let true_ = Const true
   let false_ = Const false
 
+  let rec equal f t1 t2 =
+    match t1, t2 with
+    | Const b1, Const b2 -> Bool.equal b1 b2
+    | Not t1, Not t2 -> equal f t1 t2
+    | Expr x1, Expr x2 -> f x1 x2
+    | And tl1, And tl2 | Or tl1, Or tl2 ->
+      (match List.for_all2 ~f:(equal f) tl1 tl2 with
+       | Ok b -> b
+       | Error `Length_mismatch -> false)
+    | Compare (op1, x1, y1), Compare (op2, x2, y2) ->
+      Relop.equal op1 op2 && f x1 x2 && f y1 y2
+    | (Const _ | Not _ | Expr _ | And _ | Or _ | Compare _), _ -> false
+  ;;
+
   let rec to_dyn string_to_dyn =
     let open Dyn in
     function
@@ -72,3 +86,4 @@ let false_ = Ast.false_
 let to_dyn = Ast.to_dyn String_with_vars.to_dyn
 let decode = Ast.decode String_with_vars.decode
 let encode = Ast.encode String_with_vars.encode
+let equal = Ast.equal String_with_vars.equal

src/dune_lang/blang.mli

@@ -18,6 +18,7 @@ val false_ : t
 val to_dyn : t -> Dyn.t
 val decode : t Decoder.t
 val encode : t Encoder.t
+val equal : t -> t -> bool
 
 module Ast : sig
   type 'string t = 'string ast

src/dune_rules/dune_env.ml

@@ -10,12 +10,14 @@ let foreign_flags ~since =
   Foreign_language.Dict.make ~c ~cxx
 ;;
 
-let menhir_flags ~since =
+let menhir_flags ~since ~deleted_in =
   let decode =
-    let decode = Ordered_set_lang.Unexpanded.decode in
-    match since with
-    | None -> decode
-    | Some since -> Dune_lang.Syntax.since Menhir_stanza.syntax since >>> decode
+    Dune_lang.Syntax.since Menhir_stanza.syntax since
+    >>> Dune_lang.Syntax.deleted_in
+          ~extra_info:"Use (menhir (flags ...)) instead."
+          Menhir_stanza.syntax
+          deleted_in
+    >>> Ordered_set_lang.Unexpanded.decode
   in
   field_o "menhir_flags" decode
 ;;
@@ -75,7 +77,7 @@ type config =
   ; env_vars : Env.t
   ; binaries : File_binding.Unexpanded.t list option
   ; inline_tests : Inline_tests.t option
-  ; menhir_flags : Ordered_set_lang.Unexpanded.t option
+  ; menhir : Ordered_set_lang.Unexpanded.t Menhir_env.t
   ; odoc : Odoc.t
   ; js_of_ocaml : Ordered_set_lang.Unexpanded.t Js_of_ocaml.Env.t
   ; coq : Coq_env.t
@@ -97,7 +99,7 @@ let equal_config
   ; env_vars
   ; binaries
   ; inline_tests
-  ; menhir_flags
+  ; menhir
   ; odoc
   ; js_of_ocaml
   ; coq
@@ -117,7 +119,7 @@ let equal_config
   && Env.equal env_vars t.env_vars
   && Option.equal (List.equal File_binding.Unexpanded.equal) binaries t.binaries
   && Option.equal Inline_tests.equal inline_tests t.inline_tests
-  && Option.equal Ordered_set_lang.Unexpanded.equal menhir_flags t.menhir_flags
+  && Menhir_env.equal menhir t.menhir
   && Odoc.equal odoc t.odoc
   && Coq_env.equal coq t.coq
   && Option.equal Format_config.equal format_config t.format_config
@@ -136,7 +138,7 @@ let empty_config =
   ; env_vars = Env.empty
   ; binaries = None
   ; inline_tests = None
-  ; menhir_flags = None
+  ; menhir = Menhir_env.empty
   ; odoc = Odoc.empty
   ; js_of_ocaml = Js_of_ocaml.Env.empty
   ; coq = Coq_env.default
@@ -209,6 +211,13 @@ let odoc_field =
     (Dune_lang.Syntax.since Stanza.syntax (2, 4) >>> Odoc.decode)
 ;;
 
+let menhir_field ~since =
+  field
+    "menhir"
+    ~default:Menhir_env.empty
+    (Dune_lang.Syntax.since Menhir_stanza.syntax since >>> Menhir_env.decode)
+;;
+
 let js_of_ocaml_field =
   field
     "js_of_ocaml"
@@ -229,7 +238,8 @@ let config =
       "binaries"
       (Dune_lang.Syntax.since Stanza.syntax (1, 6) >>> File_binding.Unexpanded.L.decode)
   and+ inline_tests = inline_tests_field
-  and+ menhir_flags = menhir_flags ~since:(Some (2, 1))
+  and+ menhir = menhir_field ~since:Menhir_stanza.explain_since
+  and+ _menhir_flags = menhir_flags ~since:(2, 1) ~deleted_in:Menhir_stanza.explain_since
   and+ odoc = odoc_field
   and+ js_of_ocaml = js_of_ocaml_field
   and+ coq = Coq_env.decode
@@ -241,7 +251,7 @@ let config =
   ; env_vars
   ; binaries
   ; inline_tests
-  ; menhir_flags
+  ; menhir
   ; odoc
   ; js_of_ocaml
   ; coq

src/dune_rules/dune_env.mli

@@ -27,7 +27,7 @@ type config =
   ; env_vars : Env.t
   ; binaries : File_binding.Unexpanded.t list option
   ; inline_tests : Inline_tests.t option
-  ; menhir_flags : Ordered_set_lang.Unexpanded.t option
+  ; menhir : Ordered_set_lang.Unexpanded.t Menhir_env.t
   ; odoc : Odoc.t
   ; js_of_ocaml : Ordered_set_lang.Unexpanded.t Js_of_ocaml.Env.t
   ; coq : Coq_env.t

src/dune_rules/dune_rules.ml

@@ -6,6 +6,7 @@ module Env_node = Env_node
 module Link_flags = Link_flags
 module Ocaml_flags = Ocaml_flags
 module Js_of_ocaml = Js_of_ocaml
+module Menhir_env = Menhir_env
 module Super_context = Super_context
 module Compilation_context = Compilation_context
 module Colors = Colors

src/dune_rules/env_node.ml

@@ -8,7 +8,7 @@ type t =
   ; link_flags : Link_flags.t Memo.Lazy.t
   ; external_env : Env.t Memo.Lazy.t
   ; artifacts : Artifacts.t Memo.Lazy.t
-  ; menhir_flags : string list Action_builder.t Memo.Lazy.t
+  ; menhir : string list Action_builder.t Menhir_env.t Memo.Lazy.t
   ; js_of_ocaml : string list Action_builder.t Js_of_ocaml.Env.t Memo.Lazy.t
   ; coq_flags : Coq_flags.t Action_builder.t Memo.Lazy.t
   }
@@ -21,7 +21,7 @@ let link_flags t = Memo.Lazy.force t.link_flags
 let external_env t = Memo.Lazy.force t.external_env
 let artifacts t = Memo.Lazy.force t.artifacts
 let js_of_ocaml t = Memo.Lazy.force t.js_of_ocaml
-let menhir_flags t = Memo.Lazy.force t.menhir_flags |> Action_builder.of_memo_join
+let menhir t = Memo.Lazy.force t.menhir
 let coq_flags t = Memo.Lazy.force t.coq_flags
 
 let expand_str_lazy expander sw =
@@ -139,16 +139,17 @@ let make
         ~default:link_flags
         ~eval:(Expander.expand_and_eval_set expander))
   in
-  let menhir_flags =
+  let menhir =
     inherited
-      ~field:(fun t -> Memo.return (menhir_flags t))
-      ~root:(Action_builder.return [])
-      (fun flags ->
-        match config.menhir_flags with
-        | None -> Memo.return flags
-        | Some menhir_flags ->
-          let+ expander = Memo.Lazy.force expander in
-          Expander.expand_and_eval_set expander menhir_flags ~standard:flags)
+      ~field:menhir
+      ~root:(Menhir_env.map ~f:Action_builder.return Menhir_env.default)
+      (fun (menhir : _ Action_builder.t Menhir_env.t) ->
+         let local = config.menhir in
+         let+ expander = Memo.Lazy.force expander in
+         let flags =
+           Expander.expand_and_eval_set expander local.flags ~standard:menhir.flags
+         in
+         { Menhir_env.flags; explain = Option.first_some local.explain menhir.explain })
   in
   let coq_flags : Coq_flags.t Action_builder.t Memo.Lazy.t =
     inherited
@@ -178,7 +179,7 @@ let make
   ; artifacts
   ; local_binaries
   ; js_of_ocaml
-  ; menhir_flags
+  ; menhir
   ; coq_flags
   }
 ;;

src/dune_rules/env_node.mli

@@ -31,4 +31,4 @@ val local_binaries : t -> File_binding.Expanded.t list Memo.t
 
 val artifacts : t -> Artifacts.t Memo.t
 val coq_flags : t -> Coq_flags.t Action_builder.t Memo.t
-val menhir_flags : t -> string list Action_builder.t
+val menhir : t -> string list Action_builder.t Menhir_env.t Memo.t

src/dune_rules/menhir/menhir_env.ml

@@ -0,0 +1,34 @@
+open Import
+
+type 'a t =
+  { flags : 'a
+  ; explain : Blang.t option
+  }
+
+let map ~f t = { t with flags = f t.flags }
+
+let equal { flags; explain } t =
+  Ordered_set_lang.Unexpanded.equal flags t.flags
+  && Option.equal Blang.equal explain t.explain
+;;
+
+let decode =
+  let open Dune_lang.Decoder in
+  fields
+  @@ let+ flags = Ordered_set_lang.Unexpanded.field "flags"
+     and+ explain = field_o "explain" Blang.decode in
+     { flags; explain }
+;;
+
+let empty = { flags = Ordered_set_lang.Unexpanded.standard; explain = None }
+let default = { flags = []; explain = None }
+
+let dump t =
+  let open Action_builder.O in
+  let+ flags = t.flags in
+  List.map
+    ~f:Dune_lang.Encoder.(pair string Fun.id)
+    [ "menhir_flags", Dune_lang.Encoder.(list string) flags
+    ; "menhir_explain", Dune_lang.Encoder.option Blang.encode t.explain
+    ]
+;;

src/dune_rules/menhir/menhir_env.mli

@@ -0,0 +1,13 @@
+open Import
+
+type 'a t =
+  { flags : 'a
+  ; explain : Blang.t option
+  }
+
+val map : f:('a -> 'b) -> 'a t -> 'b t
+val equal : Ordered_set_lang.Unexpanded.t t -> Ordered_set_lang.Unexpanded.t t -> bool
+val decode : Ordered_set_lang.Unexpanded.t t Dune_lang.Decoder.t
+val empty : Ordered_set_lang.Unexpanded.t t
+val default : string list t
+val dump : string list Action_builder.t t -> Dune_lang.t list Action_builder.t