From 19f1c6f6b3b3714fdab3e3541b849c642c4564b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= Date: Tue, 20 Feb 2018 16:38:22 +0000 Subject: [PATCH] Add an Exe module to build and link executables (#533) --- src/exe.ml | 189 ++++++++++++++++++++++++++++++++++++++++++ src/exe.mli | 91 ++++++++++++++++++++ src/gen_rules.ml | 149 +++++++++++---------------------- src/ocaml_flags.ml | 6 ++ src/ocaml_flags.mli | 2 + src/super_context.ml | 41 ++++----- src/super_context.mli | 9 +- src/utils.mli | 4 +- 8 files changed, 367 insertions(+), 124 deletions(-) create mode 100644 src/exe.ml create mode 100644 src/exe.mli diff --git a/src/exe.ml b/src/exe.ml new file mode 100644 index 00000000..0fd0a42f --- /dev/null +++ b/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] diff --git a/src/exe.mli b/src/exe.mli new file mode 100644 index 00000000..204f8580 --- /dev/null +++ b/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 diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 8f6b3d09..57a3b688 100644 --- a/src/gen_rules.ml +++ b/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 } (* +-----------------------------------------------------------------+ diff --git a/src/ocaml_flags.ml b/src/ocaml_flags.ml index ce7d91ad..235af5bb 100644 --- a/src/ocaml_flags.ml +++ b/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 ())) diff --git a/src/ocaml_flags.mli b/src/ocaml_flags.mli index 0b98ac28..d8003dbb 100644 --- a/src/ocaml_flags.mli +++ b/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 diff --git a/src/super_context.ml b/src/super_context.ml index 90c83bc8..02eba1d0 100644 --- a/src/super_context.ml +++ b/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) diff --git a/src/super_context.mli b/src/super_context.mli index dd25ef5f..4fc00dbe 100644 --- a/src/super_context.mli +++ b/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 diff --git a/src/utils.mli b/src/utils.mli index 6f809e8b..d52364fd 100644 --- a/src/utils.mli +++ b/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 *)