Add an Exe module to build and link executables (#533)

src/exe.ml

@@ -0,0 +1,189 @@
+open Import
+open Build.O
+
+module SC = Super_context
+
+module Program = struct
+  type t =
+    { name             : string
+    ; main_module_name : string
+    }
+end
+
+module Linkage = struct
+  type t =
+    { mode  : Mode.t
+    ; ext   : string
+    ; flags : string list
+    }
+
+  let byte =
+    { mode  = Byte
+    ; ext   = ".bc"
+    ; flags = []
+    }
+
+  let native =
+    { mode  = Native
+    ; ext   = ".exe"
+    ; flags = []
+    }
+
+  let custom =
+    { mode  = Byte
+    ; ext   = ".exe"
+    ; flags = ["-custom"]
+    }
+
+  let native_or_custom (context : Context.t) =
+    match context.ocamlopt with
+    | None   -> custom
+    | Some _ -> native
+
+  let make ~mode ~ext ?(flags=[]) () =
+    { mode
+    ; ext
+    ; flags
+    }
+end
+
+let link_exe
+      ~dir
+      ~obj_dir
+      ~scope
+      ~requires
+      ~name
+      ~(linkage:Linkage.t)
+      ~top_sorted_modules
+      ?(flags=Ocaml_flags.empty)
+      ?(link_flags=Build.arr (fun _ -> []))
+      ?(js_of_ocaml=Jbuild.Js_of_ocaml.default)
+      sctx
+  =
+  let ctx = SC.context sctx in
+  let mode = linkage.mode in
+  let exe = Path.relative dir (name ^ linkage.ext) in
+  let compiler = Option.value_exn (Context.compiler ctx mode) in
+  let artifacts ~ext modules =
+    List.map modules ~f:(Module.obj_file ~obj_dir ~ext)
+  in
+  let modules_and_cm_files =
+    Build.memoize "cm files"
+      (top_sorted_modules >>^ fun modules ->
+       (modules,
+        artifacts modules ~ext:(Cm_kind.ext (Mode.cm_kind mode))))
+  in
+  let register_native_objs_deps build =
+    match mode with
+    | Byte -> build
+    | Native ->
+      build >>>
+      Build.dyn_paths (Build.arr (fun (modules, _) ->
+        artifacts modules ~ext:ctx.ext_obj))
+  in
+  SC.add_rule sctx
+    (Build.fanout4
+       requires
+       (register_native_objs_deps modules_and_cm_files >>^ snd)
+       (Ocaml_flags.get flags mode)
+       link_flags
+     >>>
+     Build.dyn_paths (Build.arr (fun (libs, _, _, _) ->
+       Lib.L.archive_files libs ~mode ~ext_lib:ctx.ext_lib))
+     >>>
+     Build.run ~context:ctx
+       (Ok compiler)
+       [ Dyn (fun (_, _, flags,_) -> As flags)
+       ; A "-o"; Target exe
+       ; As linkage.flags
+       ; Dyn (fun (_, _, _, link_flags) -> As link_flags)
+       ; Dyn (fun (libs, _, _, _) ->
+           Lib.L.link_flags libs ~mode ~stdlib_dir:ctx.stdlib_dir)
+       ; Dyn (fun (_, cm_files, _, _) -> Deps cm_files)
+       ]);
+  if mode = Mode.Byte then
+    let rules = Js_of_ocaml_rules.build_exe sctx ~dir ~js_of_ocaml ~src:exe in
+    let libs_and_cm_and_flags =
+      (requires &&& (modules_and_cm_files >>^ snd))
+      &&&
+      SC.expand_and_eval_set sctx ~scope ~dir js_of_ocaml.flags
+        ~standard:(Js_of_ocaml_rules.standard ())
+    in
+    SC.add_rules sctx (List.map rules ~f:(fun r -> libs_and_cm_and_flags >>> r))
+
+let build_and_link_many
+      ~loc ~dir ~programs ~modules
+      ~scope
+      ~linkages
+      ?(libraries=[])
+      ?(flags=Ocaml_flags.empty)
+      ?link_flags
+      ?(preprocess=Jbuild.Preprocess_map.default)
+      ?(preprocessor_deps=Build.arr (fun () -> []))
+      ?(lint=Jbuild.Preprocess_map.default)
+      ?(js_of_ocaml=Jbuild.Js_of_ocaml.default)
+      ?(has_dot_merlin=false)
+      sctx
+  =
+  let item = (List.hd programs).Program.name in
+  (* Use "eobjs" rather than "objs" to avoid a potential conflict with a library of the
+     same name *)
+  let obj_dir = Path.relative dir ("." ^ item ^ ".eobjs") in
+  let dep_kind = Build.Required in
+  let modules =
+    String_map.map modules ~f:(Module.set_obj_name ~wrapper:None)
+  in
+
+  let modules =
+    SC.PP.pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~scope
+      ~preprocess
+      ~preprocessor_deps
+      ~lint
+      ~lib_name:None
+  in
+
+  let dep_graphs =
+    Ocamldep.rules sctx ~dir ~modules ~alias_module:None
+      ~lib_interface_module:None
+  in
+
+  let requires, real_requires =
+    SC.Libs.requires sctx
+      ~loc
+      ~dir
+      ~scope
+      ~dep_kind
+      ~libraries
+      ~has_dot_merlin
+      ~preprocess
+  in
+
+  (* CR-someday jdimino: this should probably say [~dynlink:false] *)
+  Module_compilation.build_modules sctx
+    ~js_of_ocaml
+    ~dynlink:true ~flags ~scope:scope ~dir ~obj_dir ~dep_graphs ~modules
+    ~requires ~alias_module:None;
+
+  List.iter programs ~f:(fun { Program.name; main_module_name } ->
+    let top_sorted_modules =
+      let main = Option.value_exn (String_map.find main_module_name modules) in
+      Ocamldep.Dep_graph.top_closed_implementations dep_graphs.impl
+        [main]
+    in
+    List.iter linkages ~f:(fun linkage ->
+      link_exe sctx
+        ~dir
+        ~obj_dir
+        ~scope
+        ~requires
+        ~name
+        ~linkage
+        ~top_sorted_modules
+        ~js_of_ocaml
+        ~flags
+        ?link_flags));
+
+  (obj_dir, real_requires)
+
+let build_and_link ~loc ~dir ~program =
+  build_and_link_many ~loc ~dir ~programs:[program]

src/exe.mli

@@ -0,0 +1,91 @@
+(** Compilation and linking of executables *)
+
+open Import
+
+module Program : sig
+  type t =
+    { name             : string
+    ; main_module_name : string
+    }
+end
+
+module Linkage : sig
+  type t
+
+  (** Byte compilation, exetension [.bc] *)
+  val byte : t
+
+  (** Native compilation, extension [.exe] *)
+  val native : t
+
+  (** Byte compilation, link with [-custom], extension [.exe] *)
+  val custom : t
+
+  (** [native] if supported, [custom] if not *)
+  val native_or_custom : Context.t -> t
+
+  val make
+    :  mode:Mode.t
+    -> ext:string
+    -> ?flags:string list
+    -> unit
+    -> t
+end
+
+(** {1 High-level functions} *)
+
+(** Build and link one or more executables. Return the object
+    directory and the resolved list of library dependencies. *)
+
+val build_and_link
+  :  loc:Loc.t
+  -> dir:Path.t
+  -> program:Program.t
+  -> modules:Module.t String_map.t
+  -> scope:Scope.t
+  -> linkages:Linkage.t list
+  -> ?libraries:Jbuild.Lib_deps.t
+  -> ?flags:Ocaml_flags.t
+  -> ?link_flags:(unit, string list) Build.t
+  -> ?preprocess:Jbuild.Preprocess_map.t
+  -> ?preprocessor_deps:(unit, Path.t list) Build.t
+  -> ?lint:Jbuild.Preprocess_map.t
+  -> ?js_of_ocaml:Jbuild.Js_of_ocaml.t
+  -> ?has_dot_merlin:bool
+  -> Super_context.t
+  -> Path.t * (unit, Lib.t list) Build.t
+
+val build_and_link_many
+  :  loc:Loc.t
+  -> dir:Path.t
+  -> programs:Program.t list
+  -> modules:Module.t String_map.t
+  -> scope:Scope.t
+  -> linkages:Linkage.t list
+  -> ?libraries:Jbuild.Lib_deps.t
+  -> ?flags:Ocaml_flags.t
+  -> ?link_flags:(unit, string list) Build.t
+  -> ?preprocess:Jbuild.Preprocess_map.t
+  -> ?preprocessor_deps:(unit, Path.t list) Build.t
+  -> ?lint:Jbuild.Preprocess_map.t
+  -> ?js_of_ocaml:Jbuild.Js_of_ocaml.t
+  -> ?has_dot_merlin:bool
+  -> Super_context.t
+  -> Path.t * (unit, Lib.t list) Build.t
+
+(** {1 Low-level functions} *)
+
+(** Link a single executable *)
+val link_exe
+  :  dir:Path.t
+  -> obj_dir:Path.t
+  -> scope:Scope.t
+  -> requires:(unit, Lib.t list) Build.t
+  -> name:string
+  -> linkage:Linkage.t
+  -> top_sorted_modules:(unit, Module.t list) Build.t
+  -> ?flags:Ocaml_flags.t
+  -> ?link_flags:(unit, string list) Build.t
+  -> ?js_of_ocaml:Jbuild.Js_of_ocaml.t
+  -> Super_context.t
+  -> unit

src/gen_rules.ml

@@ -502,7 +502,9 @@ module Gen(P : Params) = struct
     let modules =
       SC.PP.pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~scope
         ~preprocess:lib.buildable.preprocess
-        ~preprocessor_deps:lib.buildable.preprocessor_deps
+        ~preprocessor_deps:
+          (SC.Deps.interpret sctx ~scope ~dir
+             lib.buildable.preprocessor_deps)
         ~lint:lib.buildable.lint
         ~lib_name:(Some lib.name)
     in
@@ -700,7 +702,9 @@ module Gen(P : Params) = struct
     let flags =
       match alias_module with
       | None -> Ocaml_flags.common flags
-      | Some m -> Ocaml_flags.prepend_common ["-open"; m.name] flags |> Ocaml_flags.common
+      | Some m ->
+        Ocaml_flags.prepend_common ["-open"; m.name] flags
+        |> Ocaml_flags.common
     in
     { Merlin.
       requires = real_requires
@@ -715,73 +719,10 @@ module Gen(P : Params) = struct
      | Executables stuff                                               |
      +-----------------------------------------------------------------+ *)
 
-  let build_exe ~js_of_ocaml ~flags ~scope ~dir ~obj_dir ~requires ~name ~mode
-        ~top_sorted_modules ~link_flags ~force_custom_bytecode =
-    let exe_ext = Mode.exe_ext mode in
-    let mode, link_custom, compiler =
-      match force_custom_bytecode, Context.compiler ctx mode with
-      | false, Some compiler -> (mode, [], compiler)
-      | _                    -> (Byte, ["-custom"], ctx.ocamlc)
-    in
-    let exe = Path.relative dir (name ^ exe_ext) in
-    let artifacts ~ext modules =
-      List.map modules ~f:(Module.obj_file ~obj_dir ~ext)
-    in
-    let modules_and_cm_files =
-      Build.memoize "cm files"
-        (top_sorted_modules >>^ fun modules ->
-         (modules,
-          artifacts modules ~ext:(Cm_kind.ext (Mode.cm_kind mode))))
-    in
-    let register_native_objs_deps build =
-      match mode with
-      | Byte -> build
-      | Native ->
-        build >>>
-        Build.dyn_paths (Build.arr (fun (modules, _) ->
-          artifacts modules ~ext:ctx.ext_obj))
-    in
-    SC.add_rule sctx
-      (Build.fanout4
-         requires
-         (register_native_objs_deps modules_and_cm_files >>^ snd)
-         (Ocaml_flags.get flags mode)
-         (SC.expand_and_eval_set sctx ~scope ~dir link_flags ~standard:[])
-       >>>
-       Build.dyn_paths (Build.arr (fun (libs, _, _, _) ->
-         Lib.L.archive_files libs ~mode ~ext_lib:ctx.ext_lib))
-       >>>
-       Build.run ~context:ctx
-         (Ok compiler)
-         [ Dyn (fun (_, _, flags,_) -> As flags)
-         ; A "-o"; Target exe
-         ; Dyn (fun (_, _, _, link_flags) ->
-             As (link_custom @ link_flags))
-         ; Dyn (fun (libs, _, _, _) ->
-             Lib.L.link_flags libs ~mode ~stdlib_dir:ctx.stdlib_dir)
-         ; Dyn (fun (_, cm_files, _, _) -> Deps cm_files)
-         ]);
-    if mode = Mode.Byte then
-      let rules = Js_of_ocaml_rules.build_exe sctx ~dir ~js_of_ocaml ~src:exe in
-      let libs_and_cm_and_flags =
-        (requires &&& (modules_and_cm_files >>^ snd))
-        &&&
-        SC.expand_and_eval_set sctx ~scope ~dir js_of_ocaml.flags
-          ~standard:(Js_of_ocaml_rules.standard ())
-      in
-      SC.add_rules sctx (List.map rules ~f:(fun r -> libs_and_cm_and_flags >>> r))
-
   let executables_rules (exes : Executables.t) ~dir ~all_modules ~scope =
-    let item = snd (List.hd exes.names) in
-    let obj_dir = Utils.executable_object_directory ~dir item in
-    let dep_kind = Build.Required in
-    let flags = Ocaml_flags.make exes.buildable sctx ~scope ~dir in
     let modules =
       parse_modules ~all_modules ~buildable:exes.buildable
     in
-    let modules =
-      String_map.map modules ~f:(Module.set_obj_name ~wrapper:None)
-    in
     let programs =
       List.map exes.names ~f:(fun (loc, name) ->
         let mod_name = String.capitalize_ascii name in
@@ -790,50 +731,58 @@ module Gen(P : Params) = struct
           if not (Module.has_impl m) then
             Loc.fail loc "Module %s has no implementation." mod_name
           else
-            (name, m)
+            { Exe.Program.name; main_module_name = mod_name }
         | None -> Loc.fail loc "Module %s doesn't exist." mod_name)
     in
 
-    let modules =
-      SC.PP.pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~scope
+    let linkages =
+      [ Exe.Linkage.byte
+      ; if exes.modes.native then
+          Exe.Linkage.native_or_custom ctx
+        else
+          Exe.Linkage.custom
+      ]
+    in
+
+    let flags =
+      Ocaml_flags.make exes.buildable sctx ~scope ~dir
+    in
+    let link_flags =
+      SC.expand_and_eval_set sctx exes.link_flags
+        ~scope
+        ~dir
+        ~standard:[]
+    in
+    let preprocessor_deps =
+      SC.Deps.interpret sctx exes.buildable.preprocessor_deps
+        ~scope ~dir
+    in
+
+    let obj_dir, requires =
+      Exe.build_and_link_many sctx
+        ~loc:exes.buildable.loc
+        ~dir
+        ~programs
+        ~modules
+        ~scope
+        ~linkages
+        ~libraries:exes.buildable.libraries
+        ~flags
+        ~link_flags
         ~preprocess:exes.buildable.preprocess
-        ~preprocessor_deps:exes.buildable.preprocessor_deps
+        ~preprocessor_deps
         ~lint:exes.buildable.lint
-        ~lib_name:None
+        ~js_of_ocaml:exes.buildable.js_of_ocaml
+        ~has_dot_merlin:exes.buildable.gen_dot_merlin
     in
 
-    let dep_graphs =
-      Ocamldep.rules sctx ~dir ~modules ~alias_module:None
-        ~lib_interface_module:None
-    in
-
-    let requires, real_requires =
-      SC.Libs.requires_for_executables sctx ~dir ~scope ~dep_kind exes
-    in
-
-    (* CR-someday jdimino: this should probably say [~dynlink:false] *)
-    Module_compilation.build_modules sctx
-      ~js_of_ocaml:exes.buildable.js_of_ocaml
-      ~dynlink:true ~flags ~scope ~dir ~obj_dir ~dep_graphs ~modules
-      ~requires ~alias_module:None;
-
-    List.iter programs ~f:(fun (name, unit) ->
-      let top_sorted_modules =
-        Ocamldep.Dep_graph.top_closed_implementations dep_graphs.impl
-          [unit]
-      in
-      List.iter Mode.all ~f:(fun mode ->
-        build_exe ~js_of_ocaml:exes.buildable.js_of_ocaml ~flags ~scope
-          ~dir ~obj_dir ~requires ~name ~mode ~top_sorted_modules
-          ~link_flags:exes.link_flags
-          ~force_custom_bytecode:(mode = Native && not exes.modes.native)));
     { Merlin.
-      requires   = real_requires
-    ; flags      = Ocaml_flags.common flags
-    ; preprocess = Buildable.single_preprocess exes.buildable
-    ; libname    = None
+      requires    = requires
+    ; flags       = Ocaml_flags.common flags
+    ; preprocess  = Buildable.single_preprocess exes.buildable
+    ; libname     = None
     ; source_dirs = Path.Set.empty
-    ; objs_dirs  = Path.Set.singleton obj_dir
+    ; objs_dirs   = Path.Set.singleton obj_dir
     }
 
   (* +-----------------------------------------------------------------+

src/ocaml_flags.ml

@@ -37,6 +37,12 @@ type t =
   ; specific   : (unit, string list) Build.t Mode.Dict.t
   }
 
+let empty =
+  let build = Build.arr (fun () -> []) in
+  { common   = build
+  ; specific = Mode.Dict.make_both build
+  }
+
 let make { Jbuild.Buildable. flags; ocamlc_flags; ocamlopt_flags; _ } ctx ~scope ~dir =
   let eval = Super_context.expand_and_eval_set ctx ~scope ~dir in
   { common   = Build.memoize "common flags" (eval flags ~standard:(default_flags ()))

src/ocaml_flags.mli

@@ -11,6 +11,8 @@ val make
 
 val default : unit -> t
 
+val empty : t
+
 val get : t -> Mode.t -> (unit, string list) Build.t
 val get_for_cm : t -> cm_kind:Cm_kind.t -> (unit, string list) Build.t
 

src/super_context.ml

@@ -229,23 +229,22 @@ module Libs = struct
 
   let requires_generic
         t
+        ~loc
         ~dir
         ~requires
-        ~(buildable:Buildable.t)
+        ~libraries
         ~dep_kind
-        ~virtual_deps
+        ~has_dot_merlin
     =
     let requires =
-      requires_to_build requires ~required_by:[Loc buildable.loc]
+      requires_to_build requires ~required_by:[Loc loc]
     in
     let requires =
-      Build.record_lib_deps ~kind:dep_kind
-        (List.fold_left virtual_deps ~init:buildable.libraries ~f:(fun acc s ->
-           Lib_dep.Direct s :: acc))
+      Build.record_lib_deps ~kind:dep_kind libraries
       >>> requires
     in
     let requires_with_merlin =
-      if t.context.merlin && buildable.gen_dot_merlin then
+      if t.context.merlin && has_dot_merlin then
         Build.path (Path.relative dir ".merlin-exists")
         >>>
         requires
@@ -283,24 +282,29 @@ module Libs = struct
       (build, build)
     | Ok lib ->
       add_select_rules t ~dir (Lib.Compile.resolved_selects lib);
-      requires_generic t ~dir
+      let libraries =
+        List.fold_left conf.virtual_deps ~init:conf.buildable.libraries
+          ~f:(fun acc s -> Lib_dep.Direct s :: acc)
+      in
+      requires_generic t ~dir ~loc:conf.buildable.loc
         ~requires:(Lib.Compile.requires lib)
-        ~buildable:conf.buildable
-        ~virtual_deps:conf.virtual_deps
+        ~libraries
         ~dep_kind
+        ~has_dot_merlin:conf.buildable.gen_dot_merlin
 
-  let requires_for_executables t ~dir ~scope ~dep_kind
-        (exes : Jbuild.Executables.t) =
+  let requires t ~loc ~dir ~scope ~dep_kind ~libraries
+        ~preprocess ~has_dot_merlin =
     let requires, resolved_selects =
       Lib.DB.resolve_user_written_deps (Scope.libs scope)
-        exes.buildable.libraries
-        ~pps:(Jbuild.Preprocess_map.pps exes.buildable.preprocess)
+        libraries
+        ~pps:(Jbuild.Preprocess_map.pps preprocess)
     in
     add_select_rules t ~dir resolved_selects;
-    requires_generic t ~dir ~requires
-      ~buildable:exes.buildable
-      ~virtual_deps:[]
+    requires_generic t ~dir ~loc
+      ~requires
+      ~libraries
       ~dep_kind
+      ~has_dot_merlin
 
   let lib_files_alias ~dir ~name ~ext =
     Alias.make (sprintf "lib-%s%s-all" name ext) ~dir
@@ -1025,8 +1029,7 @@ module PP = struct
   let pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~lint ~preprocess
         ~preprocessor_deps ~lib_name ~scope =
     let preprocessor_deps =
-      Build.memoize "preprocessor deps"
-        (Deps.interpret sctx ~scope ~dir preprocessor_deps)
+      Build.memoize "preprocessor deps" preprocessor_deps
     in
     let lint_module =
       Staged.unstage (lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope)

src/super_context.mli

@@ -121,12 +121,15 @@ module Libs : sig
     -> dep_kind:Build.lib_dep_kind
     -> Jbuild.Library.t
     -> (unit, Lib.L.t) Build.t * (unit, Lib.L.t) Build.t
-  val requires_for_executables
+  val requires
     :  t
+    -> loc:Loc.t
     -> dir:Path.t
     -> scope:Scope.t
     -> dep_kind:Build.lib_dep_kind
-    -> Jbuild.Executables.t
+    -> libraries:Lib_deps.t
+    -> preprocess:Preprocess_map.t
+    -> has_dot_merlin:bool
     -> (unit, Lib.L.t) Build.t * (unit, Lib.L.t) Build.t
 
   (** [file_deps ~ext] is an arrow that record dependencies on all the
@@ -207,7 +210,7 @@ module PP : sig
     -> modules:Module.t String_map.t
     -> lint:Preprocess_map.t
     -> preprocess:Preprocess_map.t
-    -> preprocessor_deps:Dep_conf.t list
+    -> preprocessor_deps:(unit, Path.t list) Build.t
     -> lib_name:string option
     -> scope:Scope.t
     -> Module.t String_map.t

src/utils.mli

@@ -2,8 +2,8 @@
 
 open! Import
 
-(** Return the absolute path to the shell and the argument to pass it (-c or /c). Raise in
-    case in cannot be found. *)
+(** Return the absolute path to the shell and the argument to pass it
+    (-c or /c). Raise in case in cannot be found. *)
 val system_shell_exn : needed_to:string -> Path.t * string
 
 (** Same as [system_shell_exn] but for bash *)