Add (module_extensions ...) field to dune-project file

src/command.ml

@@ -123,3 +123,9 @@ let of_result_map res ~f =
   match res with
   | Ok    x -> f x
   | Error e -> fail e
+
+module Ml_kind = struct
+  let flag t = Ml_kind.choose ~impl:(Args.A "-impl") ~intf:(A "-intf") t
+
+  let ppx_driver_flag t = Ml_kind.choose ~impl:(Args.A "--impl") ~intf:(A "--intf") t
+end

src/command.mli

@@ -68,3 +68,8 @@ val quote_args : string -> string list -> _ Args.t
 val of_result : 'a Args.t Or_exn.t -> 'a Args.t
 val of_result_map : 'a Or_exn.t -> f:('a -> 'b Args.t) -> 'b Args.t
 val fail : exn -> 'a Args.t
+
+module Ml_kind : sig
+  val flag : Ml_kind.t -> _ Args.t
+  val ppx_driver_flag : Ml_kind.t -> _ Args.t
+end

src/dir_contents.ml

@@ -82,13 +82,20 @@ let coq_modules_of_library t ~name =
   let map = Memo.Lazy.force t.coq_modules in
   Lib_name.Map.find_exn map name
 
-let modules_of_files ~dir ~files =
+let modules_of_files ~module_extensions ~dir ~files =
   let dir = Path.build dir in
   let make_module syntax base fn =
     (Module.Name.of_string base,
      Module.File.make syntax (Path.relative dir fn))
   in
   let impl_files, intf_files =
+    let extra_exts =
+      let {Ml_kind.Dict.impl; intf} = module_extensions in
+      let f kind ext map = String.Map.add_exn map ext kind in
+      String.Set.fold intf
+        ~init:(String.Set.fold impl ~init:String.Map.empty ~f:(f Ml_kind.Impl))
+        ~f:(f Ml_kind.Intf)
+    in
     String.Set.to_list files
     |> List.filter_partition_map ~f:(fun fn ->
       (* we aren't using Filename.extension because we want to handle
@@ -98,7 +105,13 @@ let modules_of_files ~dir ~files =
       | Some (s, "re" ) -> Left  (make_module Reason s fn)
       | Some (s, "mli") -> Right (make_module OCaml  s fn)
       | Some (s, "rei") -> Right (make_module Reason s fn)
-      | _ -> Skip)
+      | Some (s, ext) ->
+        begin match String.Map.find extra_exts ext with
+        | Some Ml_kind.Impl -> Left  (make_module OCaml s fn)
+        | Some Intf         -> Right (make_module OCaml s fn)
+        | None              -> Skip
+        end
+      | None -> Skip)
   in
   let parse_one_set (files : (Module.Name.t * Module.File.t) list)  =
     match Module.Name.Map.of_list files with
@@ -458,13 +471,16 @@ end = struct
          let files, rules =
            Rules.collect_opt (fun () -> load_text_files sctx ft_dir d)
          in
+         let module_extensions =
+           Dune_project.module_extensions (Scope.project d.scope) in
          Here {
            t = { kind = Standalone
                ; dir
                ; text_files = files
                ; modules = Memo.lazy_ (fun () ->
                    make_modules sctx d
-                     ~modules:(modules_of_files ~dir:d.ctx_dir ~files))
+                     ~modules:(modules_of_files ~module_extensions
+                                 ~dir:d.ctx_dir ~files))
                ; mlds = Memo.lazy_ (fun () -> build_mlds_map d ~files)
                ; c_sources = Memo.lazy_ (fun () ->
                    let dune_version = d.dune_version in
@@ -524,9 +540,10 @@ end = struct
       let modules = Memo.lazy_ (fun () ->
         check_no_qualified Loc.none qualif_mode;
         let modules =
+          let module_extensions = Dune_project.module_extensions (Scope.project d.scope) in
           List.fold_left ((dir, [], files) :: subdirs) ~init:Module.Name.Map.empty
             ~f:(fun acc ((dir : Path.Build.t), _local, files) ->
-              let modules = modules_of_files ~dir ~files in
+              let modules = modules_of_files ~module_extensions ~dir ~files in
               Module.Name.Map.union acc modules ~f:(fun name x y ->
                 User_error.raise
                   ~loc:(Loc.in_file

src/dune_project.ml

@@ -193,6 +193,7 @@ type t =
   ; dune_version    : Syntax.Version.t
   ; allow_approx_merlin : bool
   ; generate_opam_files : bool
+  ; module_extensions : String.Set.t Ml_kind.Dict.t;
   }
 
 let equal = (==)
@@ -214,14 +215,15 @@ let file t = t.project_file.file
 let implicit_transitive_deps t = t.implicit_transitive_deps
 let allow_approx_merlin t = t.allow_approx_merlin
 let generate_opam_files t = t.generate_opam_files
+let module_extensions t = t.module_extensions
 
 let to_dyn
       { name ; root ; version ; source; license; authors
       ; homepage ; documentation ; project_file ; parsing_context = _
       ; bug_reports ; maintainers
       ; extension_args = _; stanza_parser = _ ; packages
       ; implicit_transitive_deps ; dune_version
-      ; allow_approx_merlin ; generate_opam_files } =
+      ; allow_approx_merlin ; generate_opam_files ; module_extensions } =
   let open Dyn.Encoder in
   record
     [ "name", Name.to_dyn name
@@ -243,6 +245,8 @@ let to_dyn
     ; "dune_version", Syntax.Version.to_dyn dune_version
     ; "allow_approx_merlin", bool allow_approx_merlin
     ; "generate_opam_files", bool generate_opam_files
+    ; "module_extensions",
+      Ml_kind.Dict.to_dyn String.Set.to_dyn module_extensions
     ]
 
 let find_extension_args t key =
@@ -495,7 +499,7 @@ let key =
          ; license; authors; homepage; documentation ; bug_reports ; maintainers
          ; stanza_parser = _; packages = _ ; extension_args = _
          ; parsing_context ; implicit_transitive_deps ; dune_version
-         ; allow_approx_merlin ; generate_opam_files } ->
+         ; allow_approx_merlin ; generate_opam_files ; module_extensions } ->
       let open Dyn.Encoder in
       record
         [ "name", Name.to_dyn name
@@ -514,6 +518,8 @@ let key =
         ; "dune_version", Syntax.Version.to_dyn dune_version
         ; "allow_approx_merlin", bool allow_approx_merlin
         ; "generate_opam_files", bool generate_opam_files
+        ; "module_extensions",
+          Ml_kind.Dict.to_dyn String.Set.to_dyn module_extensions
         ])
 
 let set t = Dune_lang.Decoder.set key t
@@ -562,6 +568,7 @@ let anonymous = lazy (
   ; dune_version = lang.version
   ; allow_approx_merlin = true
   ; generate_opam_files = false
+  ; module_extensions = Ml_kind.Dict.make_both String.Set.empty
   })
 
 let default_name ~dir ~packages =
@@ -624,6 +631,10 @@ let parse ~dir ~lang ~opam_packages ~file =
      and+ () = Versioned_file.no_more_lang
      and+ generate_opam_files = field_o_b "generate_opam_files"
                                   ~check:(Syntax.since Stanza.syntax (1, 10))
+     and+ module_extensions =
+       let f = map ~f:String.Set.of_list (repeat string) in
+       field_o "module_extensions"
+         (Ml_kind.Dict.decode ~default:String.Set.empty f)
      in
      let homepage =
        match homepage, source with
@@ -704,6 +715,10 @@ let parse ~dir ~lang ~opam_packages ~file =
      let allow_approx_merlin =
        Option.value ~default:false allow_approx_merlin in
      let generate_opam_files = Option.value ~default:false generate_opam_files in
+     let module_extensions =
+       Option.value ~default:(Ml_kind.Dict.make_both String.Set.empty)
+         module_extensions
+     in
      { name
      ; root = dir
      ; version
@@ -723,6 +738,7 @@ let parse ~dir ~lang ~opam_packages ~file =
      ; dune_version = lang.version
      ; allow_approx_merlin
      ; generate_opam_files
+     ; module_extensions
      })
 
 let load_dune_project ~dir opam_packages =
@@ -765,6 +781,7 @@ let make_jbuilder_project ~dir opam_packages =
   ; dune_version = lang.version
   ; allow_approx_merlin = true
   ; generate_opam_files = false
+  ; module_extensions = Ml_kind.Dict.make_both String.Set.empty
   }
 
 let load ~dir ~files =

src/dune_project.mli

@@ -68,6 +68,7 @@ val authors : t -> string list
 val stanza_parser : t -> Stanza.t list Dune_lang.Decoder.t
 val allow_approx_merlin : t -> bool
 val generate_opam_files : t -> bool
+val module_extensions : t -> String.Set.t Ml_kind.Dict.t
 
 val equal : t -> t -> bool
 val hash : t -> int

src/ml_kind.ml

@@ -17,10 +17,6 @@ let to_dyn t = Dyn.String (to_string t)
 
 let pp fmt t = Format.pp_print_string fmt (to_string t)
 
-let flag t = choose ~impl:(Command.Args.A "-impl") ~intf:(A "-intf") t
-
-let ppx_driver_flag t = choose ~impl:(Command.Args.A "--impl") ~intf:(A "--intf") t
-
 module Dict = struct
   type 'a t =
     { impl : 'a
@@ -53,4 +49,11 @@ module Dict = struct
       [ "impl", f impl
       ; "intf", f intf
       ]
+
+  let decode ~default f =
+    let open Dune_lang.Decoder in
+    fields
+      (let+ impl = field ~default "impl" f
+       and+ intf = field ~default "intf" f in
+       {impl; intf})
 end

src/ml_kind.mli

@@ -15,9 +15,6 @@ val to_string : t -> string
 
 val to_dyn : t -> Dyn.t
 
-val flag : t -> _ Command.Args.t
-val ppx_driver_flag : t -> _ Command.Args.t
-
 module Dict : sig
   type kind = t
 
@@ -41,4 +38,7 @@ module Dict : sig
   val mapi : 'a t -> f:(kind -> 'a -> 'b) -> 'b t
 
   val map : 'a t -> f:('a -> 'b) -> 'b t
+
+  val decode :
+    default:'a -> ('a Dune_lang.Decoder.t) -> 'a t Dune_lang.Decoder.t
 end with type kind := t

src/module_compilation.ml

@@ -173,7 +173,7 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) =
                     (* XXX why aren't these just normal library flags? *)
                     ["-nopervasives"; "-nostdlib"])
               ; A "-o"; Target dst
-              ; A "-c"; Ml_kind.flag ml_kind; Dep src
+              ; A "-c"; Command.Ml_kind.flag ml_kind; Dep src
               ; Hidden_targets other_targets
               ]))))
 
@@ -220,7 +220,7 @@ let ocamlc_i ?(flags=[]) ~dep_graphs cctx (m : Module.t) ~output =
              ; opens modules m
              ; As flags
              ; A "-short-paths"
-             ; A "-i"; Ml_kind.flag Impl; Dep src
+             ; A "-i"; Command.Ml_kind.flag Impl; Dep src
              ]))
      >>> Build.action_dyn () ~targets:[output])
 

src/ocamldep.ml

@@ -92,7 +92,7 @@ let deps_of cctx ~ml_kind unit =
          Command.run (Ok context.ocamldep) ~dir:(Path.build context.build_dir)
            [ A "-modules"
            ; Command.Args.dyn flags
-           ; Ml_kind.flag ml_kind
+           ; Command.Ml_kind.flag ml_kind
            ; Dep (Module.File.path source)
            ]
            ~stdout_to:ocamldep_output

src/preprocessing.ml

@@ -691,7 +691,7 @@ let lint_module sctx ~dir ~expander ~dep_kind ~lint ~lib_name ~scope ~dir_kind =
                          Command.run ~dir:(Path.build (SC.build_dir sctx))
                            (Ok (Path.build exe))
                            [ args
-                           ; Ml_kind.ppx_driver_flag ml_kind
+                           ; Command.Ml_kind.ppx_driver_flag ml_kind
                            ; Dep src.path
                            ; Command.Args.dyn flags
                            ]))))))
@@ -770,7 +770,7 @@ let make sctx ~dir ~expander ~dep_kind ~lint ~preprocess
                          (Ok (Path.build exe))
                          [ args
                          ; A "-o"; Target dst
-                         ; Ml_kind.ppx_driver_flag ml_kind; Dep (Path.build src)
+                         ; Command.Ml_kind.ppx_driver_flag ml_kind; Dep (Path.build src)
                          ; Command.Args.dyn flags
                          ])))))
       end else begin

test/blackbox-tests/dune.inc

@@ -1012,6 +1012,14 @@
    test-cases/missing-loc-run
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name module-extensions)
+ (deps (package dune) (source_tree test-cases/module-extensions))
+ (action
+  (chdir
+   test-cases/module-extensions
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name multi-dir)
  (deps (package dune) (source_tree test-cases/multi-dir))
@@ -1716,6 +1724,7 @@
   (alias meta-gen)
   (alias misc)
   (alias missing-loc-run)
+  (alias module-extensions)
   (alias multi-dir)
   (alias multiple-private-libs)
   (alias multiple-targets)
@@ -1898,6 +1907,7 @@
   (alias meta-gen)
   (alias misc)
   (alias missing-loc-run)
+  (alias module-extensions)
   (alias multi-dir)
   (alias multiple-targets)
   (alias name-field-validation)

test/blackbox-tests/test-cases/module-extensions/dune

@@ -0,0 +1,3 @@
+(executable
+ (name main)
+ (public_name main))

test/blackbox-tests/test-cases/module-extensions/dune-project

@@ -0,0 +1,3 @@
+(lang dune 1.11)
+
+(module_extensions (impl mf) (intf mfi))

test/blackbox-tests/test-cases/module-extensions/main.mf

@@ -0,0 +1 @@
+let () = print_endline "Hello, module_extensions!"

test/blackbox-tests/test-cases/module-extensions/run.t

@@ -0,0 +1,10 @@
+Test the module_extensions new field inside the dune-project file.
+
+The `dune build` should work.
+
+  $ dune build --display short
+      ocamldep .main.eobjs/main.mf.d
+      ocamldep .main.eobjs/main.mfi.d
+        ocamlc .main.eobjs/byte/main.{cmi,cmti}
+      ocamlopt .main.eobjs/native/main.{cmx,o}
+      ocamlopt main.exe