Allow expansion in (modules) field (#9578)

Signed-off-by: Nicolás Ojeda Bär <[email protected]>

doc/changes/9578.md

@@ -0,0 +1,4 @@
+- It is now possible to use special forms such as `(:include)` and variables
+  `%{read-lines:}` in `(modules)` and similar fields. Note that the dependencies
+  introduced in this way (ie the files being read) must live in a different
+  directory than the stanza making use of them. (#9578, @nojb)

doc/stanzas/library.rst

@@ -54,7 +54,11 @@ order to declare a multi-directory library, you need to use the
   <modules>)`` field. ``<modules>`` uses the
   :doc:`reference/ordered-set-language`, where elements are module names and
   don't need to start with an uppercase letter. For instance, to exclude module
-  ``Foo``, use ``(modules (:standard \ foo))``
+  ``Foo``, use ``(modules (:standard \ foo))``.  Starting in Dune 3.13, one can
+  also use special forms ``(:include <file>)`` and variables such as
+  ``%{read-lines:<file>}`` in this field to customize the list of modules using
+  Dune rules. The dependencies introduced in this way *must live in a different
+  directory that the stanza making use of them*.
 
 - ``(libraries <library-dependencies>)`` specifies the library's dependencies.
   See :doc:`reference/library-dependencies` for more details.

src/dune_lang/ordered_set_lang.ml

@@ -238,6 +238,7 @@ module Unexpanded = struct
   type ast = (String_with_vars.t, Ast.unexpanded) Ast.t
   type t = ast generic
 
+  let loc t = t.loc
   let equal x y = equal_generic (Ast.equal String_with_vars.equal_no_loc) x y
 
   let decode : t Decoder.t =
@@ -287,13 +288,56 @@ module Unexpanded = struct
     }
   ;;
 
-  let field ?check name =
+  let is_expanded t =
+    let rec loop (t : ast) =
+      let open Ast in
+      match t with
+      | Standard -> true
+      | Include _ -> false
+      | Element s -> Option.is_some (String_with_vars.text_only s)
+      | Union l -> List.for_all l ~f:loop
+      | Diff (l, r) -> loop l && loop r
+    in
+    loop t.ast
+  ;;
+
+  let field_gen field ?check ?since_expanded is_expanded =
     let decode =
       match check with
       | None -> decode
       | Some x -> Decoder.( >>> ) x decode
     in
-    Decoder.field name decode ~default:standard
+    let x = field decode in
+    match since_expanded with
+    | None -> x
+    | Some since_expanded ->
+      let open Decoder in
+      let+ loc, x = located x
+      and+ ver = Syntax.get_exn Stanza.syntax in
+      if ver < since_expanded && not (is_expanded x)
+      then
+        Syntax.Error.since
+          loc
+          Stanza.syntax
+          since_expanded
+          ~what:"the ability to specify non-constant module lists";
+      x
+  ;;
+
+  let field ?check ?since_expanded name =
+    field_gen
+      (Decoder.field name ~default:standard ?on_dup:None)
+      ?check
+      ?since_expanded
+      is_expanded
+  ;;
+
+  let field_o ?check ?since_expanded name =
+    field_gen
+      (Decoder.field_o name ?on_dup:None)
+      ?check
+      ?since_expanded
+      (Option.forall ~f:is_expanded)
   ;;
 
   let has_special_forms t =
@@ -367,7 +411,13 @@ module Unexpanded = struct
             let* sexp =
               let* path = expand_template fn ~mode:Single in
               let path = Value.to_path path ?error_loc:(Some loc) ~dir in
-              Action_builder.read_sexp path
+              Action_builder.push_stack_frame
+                ~human_readable_description:(fun () ->
+                  Pp.textf
+                    "(:include %s) at %s"
+                    (Path.to_string path)
+                    (Loc.to_file_colon_line loc))
+                (fun () -> Action_builder.read_sexp path)
             in
             let t = Decoder.parse decode context sexp in
             expand t.ast ~allow_include:false

src/dune_lang/ordered_set_lang.mli

@@ -44,6 +44,7 @@ module Unexpanded : sig
   type expanded := t
   type t
 
+  val loc : t -> Loc.t option
   val equal : t -> t -> bool
 
   include Dune_sexp.Conv.S with type t := t
@@ -52,7 +53,19 @@ module Unexpanded : sig
   val standard : t
   val of_strings : pos:string * int * int * int -> string list -> t
   val include_single : context:Univ_map.t -> pos:string * int * int * int -> string -> t
-  val field : ?check:unit Decoder.t -> string -> t Decoder.fields_parser
+
+  val field
+    :  ?check:unit Decoder.t
+    -> ?since_expanded:Syntax.Version.t
+    -> string
+    -> t Decoder.fields_parser
+
+  val field_o
+    :  ?check:unit Decoder.t
+    -> ?since_expanded:Syntax.Version.t
+    -> string
+    -> t option Decoder.fields_parser
+
   val has_special_forms : t -> bool
   val has_standard : t -> bool
 

src/dune_lang/ordered_set_lang_intf.ml

@@ -46,6 +46,11 @@ module type Action_builder = sig
   val all : 'a t list -> 'a list t
   val read_sexp : Path.t -> Dune_sexp.Ast.t t
 
+  val push_stack_frame
+    :  human_readable_description:(unit -> User_message.Style.t Pp.t)
+    -> (unit -> 'a t)
+    -> 'a t
+
   module O : sig
     val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
     val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t

src/dune_rules/artifacts.ml

@@ -77,3 +77,40 @@ let create =
     in
     { context; local_bins }
 ;;
+
+module Objs = struct
+  type t =
+    { libraries : Lib_info.local Lib_name.Map.t
+    ; modules : (Path.Build.t Obj_dir.t * Module.t) Module_name.Map.t
+    }
+
+  let empty = { libraries = Lib_name.Map.empty; modules = Module_name.Map.empty }
+  let lookup_module { modules; libraries = _ } = Module_name.Map.find modules
+  let lookup_library { libraries; modules = _ } = Lib_name.Map.find libraries
+
+  let make ~dir ~lib_config ~libs ~exes =
+    let+ libraries =
+      Memo.List.map libs ~f:(fun ((lib : Dune_file.Library.t), _, _, _) ->
+        let* lib_config = lib_config in
+        let name = Lib_name.of_local lib.name in
+        let+ info = Dune_file.Library.to_lib_info lib ~dir ~lib_config in
+        name, info)
+      >>| Lib_name.Map.of_list_exn
+    in
+    let modules =
+      let by_name modules obj_dir =
+        Modules.fold_user_available ~init:modules ~f:(fun m modules ->
+          Module_name.Map.add_exn modules (Module.name m) (obj_dir, m))
+      in
+      let init =
+        List.fold_left
+          exes
+          ~init:Module_name.Map.empty
+          ~f:(fun modules (_, _, m, obj_dir) -> by_name modules obj_dir m)
+      in
+      List.fold_left libs ~init ~f:(fun modules (_, _, m, obj_dir) ->
+        by_name modules obj_dir m)
+    in
+    { libraries; modules }
+  ;;
+end

src/dune_rules/artifacts.mli

@@ -20,3 +20,19 @@ val binary : t -> ?hint:string -> loc:Loc.t option -> string -> Action.Prog.t Me
 val binary_available : t -> string -> bool Memo.t
 val add_binaries : t -> dir:Path.Build.t -> File_binding.Expanded.t list -> t
 val create : Context.t -> local_bins:Path.Build.Set.t Memo.Lazy.t -> t
+
+module Objs : sig
+  type t
+
+  val empty : t
+
+  val make
+    :  dir:Path.Build.t
+    -> lib_config:Lib_config.t Memo.t
+    -> libs:(Dune_file.Library.t * _ * Modules.t * Path.Build.t Obj_dir.t) list
+    -> exes:(_ * _ * Modules.t * Path.Build.t Obj_dir.t) list
+    -> t Memo.t
+
+  val lookup_module : t -> Module_name.t -> (Path.Build.t Obj_dir.t * Module.t) option
+  val lookup_library : t -> Lib_name.t -> Lib_info.local option
+end

src/dune_rules/dir_contents.ml

@@ -278,8 +278,10 @@ end = struct
               let lookup_vlib = lookup_vlib sctx ~current_dir:dir in
               let loc = loc_of_dune_file st_dir in
               let libs = Scope.DB.find_by_dir dir >>| Scope.libs in
+              let* expander = Super_context.expander sctx ~dir in
               Ml_sources.make
                 d.stanzas
+                ~expander
                 ~dir
                 ~libs
                 ~project:d.project
@@ -360,8 +362,10 @@ end = struct
               let lookup_vlib = lookup_vlib sctx ~current_dir:dir in
               let libs = Scope.DB.find_by_dir dir >>| Scope.libs in
               let project = dune_file.project in
+              let* expander = Super_context.expander sctx ~dir in
               Ml_sources.make
                 dune_file.stanzas
+                ~expander
                 ~dir
                 ~project
                 ~libs

src/dune_rules/dir_contents.mli

@@ -24,7 +24,7 @@ val foreign_sources : t -> Foreign_sources.t Memo.t
 val ocaml : t -> Ml_sources.t Memo.t
 
 (** Artifacts defined in this directory *)
-val artifacts : t -> Ml_sources.Artifacts.t Memo.t
+val artifacts : t -> Artifacts.Objs.t Memo.t
 
 (** All mld files attached to this documentation stanza *)
 val mlds : t -> Dune_file.Documentation.t -> Path.Build.t list Memo.t

src/dune_rules/dune_file.ml

@@ -601,10 +601,10 @@ module Library = struct
     ; project : Dune_project.t
     ; sub_systems : Sub_system_info.t Sub_system_name.Map.t
     ; dune_version : Dune_lang.Syntax.Version.t
-    ; virtual_modules : Ordered_set_lang.t option
+    ; virtual_modules : Ordered_set_lang.Unexpanded.t option
     ; implements : (Loc.t * Lib_name.t) option
     ; default_implementation : (Loc.t * Lib_name.t) option
-    ; private_modules : Ordered_set_lang.t option
+    ; private_modules : Ordered_set_lang.Unexpanded.t option
     ; stdlib : Ocaml_stdlib.t option
     ; special_builtin_support : (Loc.t * Lib_info.Special_builtin_support.t) option
     ; enabled_if : Blang.t
@@ -665,9 +665,10 @@ module Library = struct
          ()
        and+ sub_systems = Sub_system_info.record_parser
        and+ virtual_modules =
-         field_o
+         Ordered_set_lang.Unexpanded.field_o
+           ~check:(Dune_lang.Syntax.since Stanza.syntax (1, 7))
+           ~since_expanded:Stanza_common.Modules_settings.since_expanded
            "virtual_modules"
-           (Dune_lang.Syntax.since Stanza.syntax (1, 7) >>> Ordered_set_lang.decode)
        and+ implements =
          field_o
            "implements"
@@ -677,9 +678,10 @@ module Library = struct
            "default_implementation"
            (Dune_lang.Syntax.since Stanza.syntax (2, 6) >>> located Lib_name.decode)
        and+ private_modules =
-         field_o
+         Ordered_set_lang.Unexpanded.field_o
+           ~check:(Dune_lang.Syntax.since Stanza.syntax (1, 2))
+           ~since_expanded:Stanza_common.Modules_settings.since_expanded
            "private_modules"
-           (Dune_lang.Syntax.since Stanza.syntax (1, 2) >>> Ordered_set_lang.decode)
        and+ stdlib =
          field_o
            "stdlib"
@@ -766,7 +768,7 @@ module Library = struct
        Option.both virtual_modules implements
        |> Option.iter ~f:(fun (virtual_modules, (_, impl)) ->
          User_error.raise
-           ~loc:(Ordered_set_lang.loc virtual_modules |> Option.value_exn)
+           ~loc:(Ordered_set_lang.Unexpanded.loc virtual_modules |> Option.value_exn)
            [ Pp.textf
                "A library cannot be both virtual and implement %s"
                (Lib_name.to_string impl)

src/dune_rules/dune_file.mli

@@ -160,10 +160,10 @@ module Library : sig
     ; project : Dune_project.t
     ; sub_systems : Sub_system_info.t Sub_system_name.Map.t
     ; dune_version : Dune_lang.Syntax.Version.t
-    ; virtual_modules : Ordered_set_lang.t option
+    ; virtual_modules : Ordered_set_lang.Unexpanded.t option
     ; implements : (Loc.t * Lib_name.t) option
     ; default_implementation : (Loc.t * Lib_name.t) option
-    ; private_modules : Ordered_set_lang.t option
+    ; private_modules : Ordered_set_lang.Unexpanded.t option
     ; stdlib : Ocaml_stdlib.t option
     ; special_builtin_support : (Loc.t * Lib_info.Special_builtin_support.t) option
     ; enabled_if : Blang.t

src/dune_rules/exe_rules.ml

@@ -57,7 +57,7 @@ let programs ~modules ~(exes : Executables.t) =
           [ Pp.textf "Module %S has no implementation." (Module_name.to_string mod_name) ]
     | None ->
       let msg =
-        match Ordered_set_lang.loc exes.buildable.modules.modules with
+        match Ordered_set_lang.Unexpanded.loc exes.buildable.modules.modules with
         | None -> Pp.textf "Module %S doesn't exist." (Module_name.to_string mod_name)
         | Some _ ->
           Pp.textf

src/dune_rules/expander.ml

@@ -55,7 +55,7 @@ type t =
   ; scope : Scope.t
   ; scope_host : Scope.t
   ; context : Context.t
-  ; lookup_artifacts : (dir:Path.Build.t -> Ml_sources.Artifacts.t Memo.t) option
+  ; lookup_artifacts : (dir:Path.Build.t -> Artifacts.Objs.t Memo.t) option
   ; expanding_what : Expanding_what.t
   }
 
@@ -165,7 +165,7 @@ let expand_artifact ~source t a s =
        let name =
          Module_name.of_string_allow_invalid (Dune_lang.Template.Pform.loc source, name)
        in
-       (match Ml_sources.Artifacts.lookup_module artifacts name with
+       (match Artifacts.Objs.lookup_module artifacts name with
         | None ->
           does_not_exist
             ~loc:(Dune_lang.Template.Pform.loc source)
@@ -177,7 +177,7 @@ let expand_artifact ~source t a s =
            | Some path -> dep (Path.build path)))
      | Lib mode ->
        let name = Lib_name.parse_string_exn (Dune_lang.Template.Pform.loc source, name) in
-       (match Ml_sources.Artifacts.lookup_library artifacts name with
+       (match Artifacts.Objs.lookup_library artifacts name with
         | None ->
           does_not_exist
             ~loc:(Dune_lang.Template.Pform.loc source)

src/dune_rules/expander.mli

@@ -21,11 +21,7 @@ val set_local_env_var : t -> var:string -> value:string Action_builder.t -> t
 val set_dir : t -> dir:Path.Build.t -> t
 val set_scope : t -> scope:Scope.t -> scope_host:Scope.t -> t
 val set_artifacts : t -> artifacts_host:Artifacts.t -> t
-
-val set_lookup_ml_sources
-  :  t
-  -> f:(dir:Path.Build.t -> Ml_sources.Artifacts.t Memo.t)
-  -> t
+val set_lookup_ml_sources : t -> f:(dir:Path.Build.t -> Artifacts.Objs.t Memo.t) -> t
 
 module Expanding_what : sig
   type t =
@@ -111,6 +107,12 @@ module With_reduced_var_set : sig
   val eval_blang : context:Context.t -> dir:Path.Build.t -> Blang.t -> bool Memo.t
 end
 
+val expand_ordered_set_lang
+  :  Ordered_set_lang.Unexpanded.t
+  -> dir:Path.t
+  -> f:Value.t list Action_builder.t String_with_vars.expander
+  -> Ordered_set_lang.t Action_builder.t
+
 (** Expand forms of the form (:standard \ foo bar). Expansion is only possible
     inside [Action_builder.t] because such forms may contain the form (:include
     ..) which needs files to be built. *)