feat(menhir): allow expanding (modules ..) field

Signed-off-by: Antonio Nuno Monteiro <anmonteiro@gmail.com>

Author: anmonteiro

doc/changes/added/13105.md

@@ -1,4 +1,4 @@
 - Allow expansion of special forms like `(:include ..)` and `%{read-lines:..}`
-  in the `modules` specification for the `ocamllex` and `ocamlyacc` stanzas.
-  (#13105, #13135, @anmonteiro)
+  in the `modules` specification for the `ocamllex`, `ocamlyacc` and `menhir`
+  stanzas. (#13105, #13135, #13157, @anmonteiro)
 

src/dune_rules/dir_contents.ml

@@ -160,7 +160,6 @@ end = struct
               Path.Build.set_extension mlg_file ~ext:".ml" |> Path.Build.basename)
           | Rocq_stanza.Extraction.T s ->
             Memo.return (Rocq_stanza.Extraction.ml_target_fnames s)
-          | Menhir_stanza.T menhir -> Memo.return (Menhir_stanza.targets menhir)
           | Rule_conf.T rule ->
             Simple_rules.user_rule sctx rule ~dir ~expander
             >>| (function

src/dune_rules/gen_rules.ml

@@ -243,6 +243,12 @@ let gen_rules_for_stanzas sctx dir_contents cctxs expander ~dune_file ~dir:ctx_d
          | false -> Memo.return ()
          | true ->
            let* ml_sources = Dir_contents.ocaml dir_contents in
+           let { Ml_sources.Parser_generators.deps = _; targets } =
+             Ml_sources.Parser_generators.modules ml_sources ~for_:(Menhir m.loc)
+           in
+           let menhir_module_names =
+             Module_trie.to_list_map targets ~f:Module.Source.name
+           in
            let base_path =
              match Ml_sources.include_subdirs ml_sources with
              | Include Unqualified | No -> []
@@ -254,8 +260,7 @@ let gen_rules_for_stanzas sctx dir_contents cctxs expander ~dune_file ~dir:ctx_d
                |> Path.Local.explode
                |> List.map ~f:Module_name.of_string
            in
-           Menhir_rules.module_names m
-           |> Memo.List.find_map ~f:(fun name ->
+           Memo.List.find_map menhir_module_names ~f:(fun name ->
              let path = Nonempty_list.(base_path @ [ name ]) in
              Ml_sources.find_origin ml_sources ~libs:(Scope.libs scope) path)
            >>| Option.bind ~f:(fun loc -> Loc.Map.find cctxs (Ml_sources.Origin.loc loc))
@@ -266,7 +271,10 @@ let gen_rules_for_stanzas sctx dir_contents cctxs expander ~dune_file ~dir:ctx_d
               (* This happens often when passing a [-p ...] option that hides a
                  library *)
               let file_targets =
-                Menhir_stanza.targets m |> List.map ~f:(Path.Build.relative ctx_dir)
+                Module_trie.to_list_map targets ~f:(fun m ->
+                  List.map (Module.Source.files m) ~f:(fun m ->
+                    Module.File.path m |> Path.as_in_build_dir_exn))
+                |> List.concat
               in
               Super_context.add_rule
                 sctx

src/dune_rules/menhir/menhir_rules.ml

@@ -97,15 +97,11 @@ module Run (P : PARAMS) = struct
      corresponding source file, and [targets m] is the list of targets that
      Menhir must build. *)
 
-  let source m = Path.relative (Path.build dir) (m ^ ".mly")
-
   let targets m ~cmly =
     let base = [ m ^ ".ml"; m ^ ".mli" ] in
     List.map ~f:(Path.Build.relative dir) (if cmly then (m ^ ".cmly") :: base else base)
   ;;
 
-  let sources ms = List.map ~f:source ms
-
   (* The following definitions control where the mock [.ml] file and the
      inferred [.mli] file are created and how they are named. *)
 
@@ -187,49 +183,64 @@ module Run (P : PARAMS) = struct
   (* The current concrete name for [base] clauses is [merge_into], but I would
      like to change it in the future. *)
 
-  let stanzas : stanza list =
-    match stanza.merge_into with
-    | None ->
-      List.map
-        ~f:(fun m -> { stanza with modules = [ m ]; merge_into = Some m })
-        stanza.modules
-    | Some _ -> [ stanza ]
+  let stanzas : (stanza * Path.Set.t) list Memo.Lazy.t =
+    Memo.lazy_ (fun () ->
+      let open Memo.O in
+      let+ { Ml_sources.Parser_generators.deps; targets = _ } =
+        let sctx = Compilation_context.super_context cctx in
+        Dir_contents.get sctx ~dir
+        >>= Dir_contents.ocaml
+        >>| Ml_sources.Parser_generators.modules ~for_:(Menhir stanza.loc)
+      in
+      match stanza.merge_into with
+      | None ->
+        Path.Set.fold deps ~init:[] ~f:(fun p acc ->
+          let merge_into = Filename.remove_extension (Path.basename p) in
+          ({ stanza with merge_into = Some merge_into }, Path.Set.singleton p) :: acc)
+      | Some _ -> [ stanza, deps ])
   ;;
 
   (* ------------------------------------------------------------------------ *)
 
   (* The [--infer-*] commands should not be passed by the user; we take care of
      using these commands appropriately. Fail if they are present. *)
 
-  let () =
-    List.iter stanzas ~f:(fun (stanza : stanza) ->
-      Ordered_set_lang.Unexpanded.fold_strings stanza.flags ~init:() ~f:(fun _pos sw () ->
-        match String_with_vars.text_only sw with
-        | None -> ()
-        | Some "--explain" ->
-          if stanza.menhir_syntax >= Dune_lang.Menhir.explain_since
-          then
-            User_error.raise
-              ~loc:(String_with_vars.loc sw)
-              [ Pp.textf
-                  "The Menhir '.conflicts' file is generated by default, so '--explain' \
-                   should not be explicitly added to the list of Menhir flags."
-              ]
-        | Some text ->
-          if
-            List.mem
-              ~equal:String.equal
-              [ "--depend"
-              ; "--raw-depend"
-              ; "--infer"
-              ; "--infer-write-query"
-              ; "--infer-read-reply"
-              ]
-              text
-          then
-            User_error.raise
-              ~loc:(String_with_vars.loc sw)
-              [ Pp.textf "The flag %s must not be used in a menhir stanza." text ]))
+  let check =
+    Memo.lazy_ (fun () ->
+      let open Memo.O in
+      Memo.Lazy.force stanzas
+      >>| List.iter ~f:(fun ((stanza, _) : stanza * Path.Set.t) ->
+        Ordered_set_lang.Unexpanded.fold_strings
+          stanza.flags
+          ~init:()
+          ~f:(fun _pos sw () ->
+            match String_with_vars.text_only sw with
+            | None -> ()
+            | Some "--explain" ->
+              if stanza.menhir_syntax >= Dune_lang.Menhir.explain_since
+              then
+                User_error.raise
+                  ~loc:(String_with_vars.loc sw)
+                  [ Pp.textf
+                      "The Menhir '.conflicts' file is generated by default, so \
+                       '--explain' should not be explicitly added to the list of Menhir \
+                       flags."
+                  ]
+            | Some text ->
+              if
+                List.mem
+                  ~equal:String.equal
+                  [ "--depend"
+                  ; "--raw-depend"
+                  ; "--infer"
+                  ; "--infer-write-query"
+                  ; "--infer-read-reply"
+                  ]
+                  text
+              then
+                User_error.raise
+                  ~loc:(String_with_vars.loc sw)
+                  [ Pp.textf "The flag %s must not be used in a menhir stanza." text ])))
   ;;
 
   (* ------------------------------------------------------------------------ *)
@@ -238,14 +249,15 @@ module Run (P : PARAMS) = struct
      is the three-step process where Menhir is invoked twice and OCaml type
      inference is performed in between. *)
 
-  let process3 base ~cmly (stanza : stanza) : unit Memo.t =
+  let process3 base ~cmly ((stanza, deps) : stanza * Path.Set.t) : unit Memo.t =
     let open Memo.O in
     let* expanded_flags = expand_flags stanza.flags in
     (* 1. A first invocation of Menhir creates a mock [.ml] file. *)
+    let source_deps = Path.Set.to_list deps in
     let* () =
       menhir
         [ Command.Args.dyn expanded_flags
-        ; Deps (sources stanza.modules)
+        ; Deps source_deps
         ; A "--base"
         ; Path (Path.relative (Path.build dir) base)
         ; A "--infer-write-query"
@@ -296,7 +308,7 @@ module Run (P : PARAMS) = struct
     menhir
       [ Command.Args.dyn expanded_flags
       ; S explain_flags
-      ; Deps (sources stanza.modules)
+      ; Deps source_deps
       ; A "--base"
       ; Path (Path.relative (Path.build dir) base)
       ; A "--infer-read-reply"
@@ -311,7 +323,7 @@ module Run (P : PARAMS) = struct
   (* [process3 stanza] converts a Menhir stanza into a set of build rules. This
      is a simpler one-step process where Menhir is invoked directly. *)
 
-  let process1 base ~cmly (stanza : stanza) : unit Memo.t =
+  let process1 base ~cmly ((stanza, deps) : stanza * Path.Set.t) : unit Memo.t =
     let open Memo.O in
     let* expanded_flags = expand_flags stanza.flags
     and* explain_flags = explain_flags base stanza
@@ -323,7 +335,7 @@ module Run (P : PARAMS) = struct
     menhir
       [ Command.Args.dyn expanded_flags
       ; S explain_flags
-      ; Deps (sources stanza.modules)
+      ; Deps (Path.Set.to_list deps)
       ; A "--base"
       ; Path (Path.relative (Path.build dir) base)
       ; Hidden_targets (targets base ~cmly)
@@ -339,7 +351,7 @@ module Run (P : PARAMS) = struct
   (* Because Menhir processes [--only-tokens] before the [--infer-*] commands,
      when [--only-tokens] is present, no [--infer-*] command should be used. *)
 
-  let process (stanza : stanza) : unit Memo.t =
+  let process ((stanza, sources) : stanza * Path.Set.t) : unit Memo.t =
     let base = Option.value_exn stanza.merge_into in
     let ocaml_type_inference_disabled, cmly =
       Ordered_set_lang.Unexpanded.fold_strings
@@ -355,24 +367,23 @@ module Run (P : PARAMS) = struct
              | Some _ | None -> acc))
     in
     if ocaml_type_inference_disabled || not stanza.infer
-    then process1 base stanza ~cmly
-    else process3 base stanza ~cmly
+    then process1 base (stanza, sources) ~cmly
+    else process3 base (stanza, sources) ~cmly
   ;;
 
   (* ------------------------------------------------------------------------ *)
-  let gen_rules () = Memo.sequential_iter ~f:process stanzas
+  let gen_rules () =
+    let open Memo.O in
+    let* () = Memo.Lazy.force check
+    and* stanzas = Memo.Lazy.force stanzas in
+    Memo.sequential_iter stanzas ~f:process
+  ;;
 end
 
 (* -------------------------------------------------------------------------- *)
 
 (* The final glue. *)
 
-let module_names (stanza : Menhir_stanza.t) : Module_name.t list =
-  List.map (Menhir_stanza.modules stanza) ~f:(fun s ->
-    (* TODO the loc can improved here *)
-    Module_name.of_string_allow_invalid (stanza.loc, s))
-;;
-
 let gen_rules ~dir ~module_path cctx stanza =
   let module R =
     Run (struct

src/dune_rules/menhir/menhir_rules.mli

@@ -2,9 +2,6 @@
 
 open Import
 
-(** Return the list of modules that are generated by this stanza. *)
-val module_names : Menhir_stanza.t -> Module_name.t list
-
 (** Generate the rules for a [(menhir ...)] stanza. *)
 val gen_rules
   :  dir:Path.Build.t

src/dune_rules/menhir/menhir_stanza.ml

@@ -7,7 +7,7 @@ open Dune_lang.Decoder
 type t =
   { merge_into : string option
   ; flags : Ordered_set_lang.Unexpanded.t
-  ; modules : string list
+  ; modules : Ordered_set_lang.Unexpanded.t
   ; mode : Rule_mode.t
   ; loc : Loc.t
   ; infer : bool
@@ -20,7 +20,10 @@ let decode =
   fields
     (let+ merge_into = field_o "merge_into" string
      and+ flags = Ordered_set_lang.Unexpanded.field "flags"
-     and+ modules = field "modules" (repeat string)
+     and+ modules =
+       Ordered_set_lang.Unexpanded.field
+         "modules"
+         ~since_expanded:Parser_generators.since_expanded
      and+ mode = Rule_mode_decoder.field
      and+ infer = field_o_b "infer" ~check:(Dune_lang.Syntax.since syntax (2, 0))
      and+ menhir_syntax = Dune_lang.Syntax.get_exn syntax
@@ -50,14 +53,3 @@ let () =
     syntax
     (return [ "menhir", decode_stanza decode ])
 ;;
-
-let modules (stanza : t) : string list =
-  match stanza.merge_into with
-  | Some m -> [ m ]
-  | None -> stanza.modules
-;;
-
-let targets (stanza : t) : string list =
-  let f m = [ m ^ ".ml"; m ^ ".mli" ] in
-  List.concat_map (modules stanza) ~f
-;;

src/dune_rules/menhir/menhir_stanza.mli

@@ -5,7 +5,7 @@ val syntax : Syntax.t
 type t =
   { merge_into : string option
   ; flags : Ordered_set_lang.Unexpanded.t
-  ; modules : string list
+  ; modules : Ordered_set_lang.Unexpanded.t
   ; mode : Rule_mode.t
   ; loc : Loc.t
   ; infer : bool
@@ -14,11 +14,4 @@ type t =
   ; menhir_syntax : Syntax.Version.t
   }
 
-val modules : t -> string list
-
-(** Return the list of targets that are generated by this stanza. This list of
-    targets is used by the code that computes the list of modules in the
-    directory. *)
-val targets : t -> string list
-
 include Stanza.S with type t := t