From 416d4c6ead98a34bbc30b071e14744a5a0db6947 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Fri, 28 Apr 2017 15:12:05 +0100 Subject: [PATCH] Move rules for module compilation in their own file --- src/alias.ml | 3 + src/alias.mli | 2 + src/gen_rules.ml | 120 +++---------------------------------- src/module_compilation.ml | 108 +++++++++++++++++++++++++++++++++ src/module_compilation.mli | 29 +++++++++ src/ocamldep.ml | 2 + src/ocamldep.mli | 4 +- 7 files changed, 155 insertions(+), 113 deletions(-) create mode 100644 src/module_compilation.ml create mode 100644 src/module_compilation.mli diff --git a/src/alias.ml b/src/alias.ml index 16ac4df0..bb2ebc1a 100644 --- a/src/alias.ml +++ b/src/alias.ml @@ -36,6 +36,9 @@ let default = make "DEFAULT" let runtest = make "runtest" let install = make "install" +let lib_cm_all ~dir lib_name cm_kind = + make (sprintf "%s%s-all" lib_name (Cm_kind.ext cm_kind)) ~dir + let recursive_aliases = [ default ; runtest diff --git a/src/alias.mli b/src/alias.mli index aac32d0c..87204af5 100644 --- a/src/alias.mli +++ b/src/alias.mli @@ -6,6 +6,8 @@ val default : dir:Path.t -> t val runtest : dir:Path.t -> t val install : dir:Path.t -> t +val lib_cm_all : dir:Path.t -> string -> Cm_kind.t -> t + val dep : t -> ('a, 'a) Build.t val file : t -> Path.t diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 78e9276f..767b2ef6 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -16,112 +16,6 @@ module Gen(P : Params) = struct let ctx = SC.context sctx - (* +-----------------------------------------------------------------+ - | ml/mli compilation | - +-----------------------------------------------------------------+ *) - - let lib_cm_all ~dir (lib : Library.t) cm_kind = - Path.relative dir - (sprintf "%s%s-all" lib.name (Cm_kind.ext cm_kind)) - - let lib_dependencies (libs : Lib.t list) ~(cm_kind : Cm_kind.t) = - List.concat_map libs ~f:(function - | External _ -> [] - | Internal (dir, lib) -> - match cm_kind with - | Cmi | Cmo -> - [lib_cm_all ~dir lib Cmi] - | Cmx -> - [lib_cm_all ~dir lib Cmx]) - - let build_cm ?sandbox ~dynlink ~flags ~cm_kind ~dep_graph ~requires - ~(modules : Module.t String_map.t) ~dir ~alias_module (m : Module.t) = - Option.iter (Mode.of_cm_kind cm_kind |> Context.compiler ctx) ~f:(fun compiler -> - Option.iter (Module.cm_source ~dir m cm_kind) ~f:(fun src -> - let ml_kind = Cm_kind.source cm_kind in - let dst = Module.cm_file m ~dir cm_kind in - let extra_args, extra_deps, extra_targets = - match cm_kind, m.intf with - (* If there is no mli, [ocamlY -c file.ml] produces both the - .cmY and .cmi. We choose to use ocamlc to produce the cmi - and to produce the cmx we have to wait to avoid race - conditions. *) - | Cmo, None -> [], [], [Module.cm_file m ~dir Cmi] - | Cmx, None -> - (* Change [-intf-suffix] so that the compiler thinks the - cmi exists and reads it instead of re-creating it, which - could create a race condition. *) - ([ "-intf-suffix" - ; Filename.extension m.impl.name - ], - [Module.cm_file m ~dir Cmi], []) - | Cmi, None -> assert false - | Cmi, Some _ -> [], [], [] - (* We need the .cmi to build either the .cmo or .cmx *) - | (Cmo | Cmx), Some _ -> [], [Module.cm_file m ~dir Cmi], [] - in - let extra_targets = - match cm_kind with - | Cmx -> Path.relative dir (m.obj_name ^ ctx.ext_obj) :: extra_targets - | Cmi | Cmo -> extra_targets - in - let dep_graph = Ml_kind.Dict.get dep_graph ml_kind in - let other_cm_files = - Build.dyn_paths - (dep_graph >>^ (fun dep_graph -> - let deps = - List.map (Utils.find_deps ~dir dep_graph m.name) - ~f:(Utils.find_module ~dir modules) - in - List.concat_map - deps - ~f:(fun m -> - match cm_kind with - | Cmi | Cmo -> [Module.cm_file m ~dir Cmi] - | Cmx -> [Module.cm_file m ~dir Cmi; Module.cm_file m ~dir Cmx]))) - in - let extra_targets, cmt_args = - match cm_kind with - | Cmx -> (extra_targets, Arg_spec.S []) - | Cmi | Cmo -> - let fn = Option.value_exn (Module.cmt_file m ~dir ml_kind) in - (fn :: extra_targets, A "-bin-annot") - in - SC.add_rule sctx ?sandbox - (Build.paths extra_deps >>> - other_cm_files >>> - requires >>> - Build.dyn_paths (Build.arr (lib_dependencies ~cm_kind)) >>> - Build.run ~context:ctx (Dep compiler) - ~extra_targets - [ Ocaml_flags.get_for_cm flags ~cm_kind - ; cmt_args - ; Dyn Lib.include_flags - ; As extra_args - ; if dynlink || cm_kind <> Cmx then As [] else A "-nodynlink" - ; A "-no-alias-deps" - ; A "-I"; Path dir - ; (match alias_module with - | None -> S [] - | Some (m : Module.t) -> As ["-open"; m.name]) - ; A "-o"; Target dst - ; A "-c"; Ml_kind.flag ml_kind; Dep src - ]))) - - let build_module ?sandbox ~dynlink ~flags m ~dir ~dep_graph ~modules ~requires - ~alias_module = - List.iter Cm_kind.all ~f:(fun cm_kind -> - build_cm ?sandbox ~dynlink ~flags ~dir ~dep_graph ~modules m ~cm_kind ~requires - ~alias_module) - - let build_modules ~dynlink ~flags ~dir ~dep_graph ~modules ~requires ~alias_module = - String_map.iter - (match alias_module with - | None -> modules - | Some (m : Module.t) -> String_map.remove m.name modules) - ~f:(fun ~key:_ ~data:m -> - build_module m ~dynlink ~flags ~dir ~dep_graph ~modules ~requires ~alias_module) - (* +-----------------------------------------------------------------+ | Interpretation of [modules] fields | +-----------------------------------------------------------------+ *) @@ -203,8 +97,9 @@ module Gen(P : Params) = struct String_map.fold modules ~init:[] ~f:(fun ~key:_ ~data:m acc -> Module.cm_file m ~dir cm_kind :: acc) in - SC.add_rule sctx (Build.paths deps >>> - Build.create_file (lib_cm_all lib ~dir cm_kind)) + Alias.add_deps (SC.aliases sctx) + (Alias.lib_cm_all ~dir lib.name cm_kind) + deps let expand_includes ~dir includes = Arg_spec.As (List.concat_map includes ~f:(fun s -> @@ -357,10 +252,11 @@ module Gen(P : Params) = struct SC.Libs.add_select_rules sctx ~dir lib.buildable.libraries; let dynlink = lib.dynlink in - build_modules ~dynlink ~flags ~dir ~dep_graph ~modules ~requires ~alias_module; + Module_compilation.build_modules sctx + ~dynlink ~flags ~dir ~dep_graph ~modules ~requires ~alias_module; Option.iter alias_module ~f:(fun m -> let flags = Ocaml_flags.default () in - build_module m + Module_compilation.build_module sctx m ~dynlink ~sandbox:alias_module_build_sandbox ~flags:{ flags with common = flags.common @ ["-w"; "-49"] } @@ -533,8 +429,8 @@ module Gen(P : Params) = struct SC.Libs.add_select_rules sctx ~dir exes.buildable.libraries; (* CR-someday jdimino: this should probably say [~dynlink:false] *) - build_modules ~dynlink:true ~flags ~dir ~dep_graph ~modules ~requires - ~alias_module:None; + Module_compilation.build_modules sctx ~dynlink:true ~flags ~dir ~dep_graph ~modules + ~requires ~alias_module:None; List.iter exes.names ~f:(fun name -> List.iter Mode.all ~f:(fun mode -> diff --git a/src/module_compilation.ml b/src/module_compilation.ml new file mode 100644 index 00000000..83eea5cd --- /dev/null +++ b/src/module_compilation.ml @@ -0,0 +1,108 @@ +open Import +open Jbuild_types +open Build.O + +module SC = Super_context + +let lib_cm_all ~dir (lib : Library.t) cm_kind = + Alias.file (Alias.lib_cm_all ~dir lib.name cm_kind) + +let lib_dependencies (libs : Lib.t list) ~(cm_kind : Cm_kind.t) = + List.concat_map libs ~f:(function + | External _ -> [] + | Internal (dir, lib) -> + match cm_kind with + | Cmi | Cmo -> + [lib_cm_all ~dir lib Cmi] + | Cmx -> + [lib_cm_all ~dir lib Cmx]) + +let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~(dep_graph:Ocamldep.dep_graph) + ~requires ~(modules : Module.t String_map.t) ~dir ~alias_module (m : Module.t) = + let ctx = SC.context sctx in + Option.iter (Mode.of_cm_kind cm_kind |> Context.compiler ctx) ~f:(fun compiler -> + Option.iter (Module.cm_source ~dir m cm_kind) ~f:(fun src -> + let ml_kind = Cm_kind.source cm_kind in + let dst = Module.cm_file m ~dir cm_kind in + let extra_args, extra_deps, extra_targets = + match cm_kind, m.intf with + (* If there is no mli, [ocamlY -c file.ml] produces both the + .cmY and .cmi. We choose to use ocamlc to produce the cmi + and to produce the cmx we have to wait to avoid race + conditions. *) + | Cmo, None -> [], [], [Module.cm_file m ~dir Cmi] + | Cmx, None -> + (* Change [-intf-suffix] so that the compiler thinks the + cmi exists and reads it instead of re-creating it, which + could create a race condition. *) + ([ "-intf-suffix" + ; Filename.extension m.impl.name + ], + [Module.cm_file m ~dir Cmi], []) + | Cmi, None -> assert false + | Cmi, Some _ -> [], [], [] + (* We need the .cmi to build either the .cmo or .cmx *) + | (Cmo | Cmx), Some _ -> [], [Module.cm_file m ~dir Cmi], [] + in + let extra_targets = + match cm_kind with + | Cmx -> Path.relative dir (m.obj_name ^ ctx.ext_obj) :: extra_targets + | Cmi | Cmo -> extra_targets + in + let dep_graph = Ml_kind.Dict.get dep_graph ml_kind in + let other_cm_files = + Build.dyn_paths + (dep_graph >>^ (fun dep_graph -> + let deps = + List.map (Utils.find_deps ~dir dep_graph m.name) + ~f:(Utils.find_module ~dir modules) + in + List.concat_map + deps + ~f:(fun m -> + match cm_kind with + | Cmi | Cmo -> [Module.cm_file m ~dir Cmi] + | Cmx -> [Module.cm_file m ~dir Cmi; Module.cm_file m ~dir Cmx]))) + in + let extra_targets, cmt_args = + match cm_kind with + | Cmx -> (extra_targets, Arg_spec.S []) + | Cmi | Cmo -> + let fn = Option.value_exn (Module.cmt_file m ~dir ml_kind) in + (fn :: extra_targets, A "-bin-annot") + in + SC.add_rule sctx ?sandbox + (Build.paths extra_deps >>> + other_cm_files >>> + requires >>> + Build.dyn_paths (Build.arr (lib_dependencies ~cm_kind)) >>> + Build.run ~context:ctx (Dep compiler) + ~extra_targets + [ Ocaml_flags.get_for_cm flags ~cm_kind + ; cmt_args + ; Dyn Lib.include_flags + ; As extra_args + ; if dynlink || cm_kind <> Cmx then As [] else A "-nodynlink" + ; A "-no-alias-deps" + ; A "-I"; Path dir + ; (match alias_module with + | None -> S [] + | Some (m : Module.t) -> As ["-open"; m.name]) + ; A "-o"; Target dst + ; A "-c"; Ml_kind.flag ml_kind; Dep src + ]))) + +let build_module sctx ?sandbox ~dynlink ~flags m ~dir ~dep_graph ~modules ~requires + ~alias_module = + List.iter Cm_kind.all ~f:(fun cm_kind -> + build_cm sctx ?sandbox ~dynlink ~flags ~dir ~dep_graph ~modules m ~cm_kind ~requires + ~alias_module) + +let build_modules sctx ~dynlink ~flags ~dir ~dep_graph ~modules ~requires ~alias_module = + String_map.iter + (match alias_module with + | None -> modules + | Some (m : Module.t) -> String_map.remove m.name modules) + ~f:(fun ~key:_ ~data:m -> + build_module sctx m ~dynlink ~flags ~dir ~dep_graph ~modules ~requires + ~alias_module) diff --git a/src/module_compilation.mli b/src/module_compilation.mli new file mode 100644 index 00000000..fb5ca9a1 --- /dev/null +++ b/src/module_compilation.mli @@ -0,0 +1,29 @@ +(** OCaml module compilation *) + +open Import + +(** Setup rules to build a single module *) +val build_module + : Super_context.t + -> ?sandbox:bool + -> dynlink:bool + -> flags:Ocaml_flags.t + -> Module.t + -> dir:Path.t + -> dep_graph:Ocamldep.dep_graph + -> modules:Module.t String_map.t + -> requires:(unit, Lib.t list) Build.t + -> alias_module:Module.t option + -> unit + +(** Setup rules to build all of [modules] *) +val build_modules + : Super_context.t + -> dynlink:bool + -> flags:Ocaml_flags.t + -> dir:Path.t + -> dep_graph:Ocamldep.dep_graph + -> modules:Module.t String_map.t + -> requires:(unit, Lib.t list) Build.t + -> alias_module:Module.t option + -> unit diff --git a/src/ocamldep.ml b/src/ocamldep.ml index 7b1da25d..b9a43f59 100644 --- a/src/ocamldep.ml +++ b/src/ocamldep.ml @@ -3,6 +3,8 @@ open Build.O module SC = Super_context +type dep_graph = (unit, string list String_map.t) Build.t Ml_kind.Dict.t + let parse_deps ~dir lines ~modules ~alias_module = List.map lines ~f:(fun line -> match String.index line ':' with diff --git a/src/ocamldep.mli b/src/ocamldep.mli index 8c940522..d44a738e 100644 --- a/src/ocamldep.mli +++ b/src/ocamldep.mli @@ -2,6 +2,8 @@ open Import +type dep_graph = (unit, string list String_map.t) Build.t Ml_kind.Dict.t + (** Generate ocamldep rules for the given modules. [item] is either the internal name of a library of the first name of a list of executables. @@ -13,7 +15,7 @@ val rules -> item:string -> modules:Module.t String_map.t -> alias_module:Module.t option - -> (unit, string list String_map.t) Build.t Ml_kind.Dict.t + -> dep_graph (** Close and convert a list of module names to a list of .cm file names *) val names_to_top_closed_cm_files