From b7ad08df84f85429c978ec855d40b2fd4c3e213b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= Date: Sun, 14 May 2017 23:35:51 +0100 Subject: [PATCH] Make targets explicit --- src/alias.ml | 2 +- src/arg_spec.ml | 10 ---- src/arg_spec.mli | 6 +-- src/build.ml | 65 ++++++++--------------- src/build.mli | 7 +-- src/build_interpret.ml | 37 +------------ src/build_interpret.mli | 6 +-- src/build_system.ml | 3 +- src/gen_rules.ml | 109 +++++++++++++++++++------------------- src/js_of_ocaml_rules.ml | 99 +++++++++++++++++----------------- src/js_of_ocaml_rules.mli | 10 ++-- src/merlin.ml | 7 +-- src/module_compilation.ml | 7 ++- src/ocamldep.ml | 2 +- src/super_context.ml | 61 +++++++++++---------- src/super_context.mli | 3 +- 16 files changed, 183 insertions(+), 251 deletions(-) diff --git a/src/alias.ml b/src/alias.ml index 6caa2055..795b78ae 100644 --- a/src/alias.ml +++ b/src/alias.ml @@ -101,7 +101,7 @@ let rules store ~prefixes ~tree = Hashtbl.fold store ~init:[] ~f:(fun ~key:_ ~data:{ Store. alias; deps } acc -> let open Build.O in let rule = - Build_interpret.Rule.make + Build_interpret.Rule.make ~targets:[alias.file] (Build.path_set deps >>> Build.create_file alias.file) in diff --git a/src/arg_spec.ml b/src/arg_spec.ml index 73c35ffe..4cf1b97b 100644 --- a/src/arg_spec.ml +++ b/src/arg_spec.ml @@ -10,7 +10,6 @@ type 'a t = | Deps of Path.t list | Dep_rel of Path.t * string | Deps_rel of Path.t * string list - | Target of Path.t | Path of Path.t | Paths of Path.t list | Dyn of ('a -> nothing t) @@ -27,13 +26,6 @@ let rec add_deps ts set = | S ts -> add_deps ts set | _ -> set) -let rec add_targets ts acc = - List.fold_left ts ~init:acc ~f:(fun acc t -> - match t with - | Target fn -> fn :: acc - | S ts -> add_targets ts acc - | _ -> acc) - let expand ~dir ts x = let dyn_deps = ref Path.Set.empty in let add_dep path = dyn_deps := Path.Set.add path !dyn_deps in @@ -57,7 +49,6 @@ let expand ~dir ts x = | Paths fns -> List.map fns ~f:(Path.reach ~from:dir) | S ts -> List.concat_map ts ~f:loop_dyn - | Target _ -> die "Target not allowed under Dyn" | Dyn _ -> assert false in let rec loop = function @@ -68,7 +59,6 @@ let expand ~dir ts x = | (Dep fn | Path fn) -> [Path.reach fn ~from:dir] | (Deps fns | Paths fns) -> List.map fns ~f:(Path.reach ~from:dir) | S ts -> List.concat_map ts ~f:loop - | Target fn -> [Path.reach fn ~from:dir] | Dyn f -> loop_dyn (f x) in let l = List.concat_map ts ~f:loop in diff --git a/src/arg_spec.mli b/src/arg_spec.mli index b36ce6d6..7d99bdc3 100644 --- a/src/arg_spec.mli +++ b/src/arg_spec.mli @@ -8,12 +8,10 @@ type 'a t = | Deps of Path.t list | Dep_rel of Path.t * string | Deps_rel of Path.t * string list - | Target of Path.t | Path of Path.t | Paths of Path.t list | Dyn of ('a -> nothing t) -val add_deps : _ t list -> Path.Set.t -> Path.Set.t -val add_targets : _ t list -> Path.t list -> Path.t list -val expand : dir:Path.t -> 'a t list -> 'a -> string list * Path.Set.t +val add_deps : _ t list -> Path.Set.t -> Path.Set.t +val expand : dir:Path.t -> 'a t list -> 'a -> string list * Path.Set.t diff --git a/src/build.ml b/src/build.ml index ffbca685..86f52b9b 100644 --- a/src/build.ml +++ b/src/build.ml @@ -21,7 +21,6 @@ let merge_lib_dep_kind a b = module Repr = struct type ('a, 'b) t = | Arr : ('a -> 'b) -> ('a, 'b) t - | Targets : Path.Set.t -> ('a, 'a) t | Compose : ('a, 'b) t * ('b, 'c) t -> ('a, 'c) t | First : ('a, 'b) t -> ('a * 'c, 'b * 'c) t | Second : ('a, 'b) t -> ('c * 'a, 'c * 'b) t @@ -137,10 +136,7 @@ let file_exists_opt p t = ~then_:(t >>^ fun x -> Some x) ~else_:(arr (fun _ -> None)) -let fail ?targets x = - match targets with - | None -> Fail x - | Some l -> Targets (Pset.of_list l) >>> Fail x +let fail x = Fail x let memoize ~name t = Memo { name; t; state = Unevaluated } @@ -181,17 +177,9 @@ let prog_and_args ~dir prog args = >>> arr fst)) -let run ~context ?(dir=context.Context.build_dir) ?stdout_to ?(extra_targets=[]) +let run ~context ?(dir=context.Context.build_dir) ?stdout_to prog args = - let extra_targets = - match stdout_to with - | None -> extra_targets - | Some fn -> fn :: extra_targets - in - let targets = Arg_spec.add_targets args extra_targets in prog_and_args ~dir prog args - >>> - Targets (Pset.of_list targets) >>^ (fun (prog, args) -> let action : Action.Mini_shexp.t = Run (prog, args) in let action = @@ -205,32 +193,26 @@ let run ~context ?(dir=context.Context.build_dir) ?stdout_to ?(extra_targets=[]) ; action }) -let action ~context ?(dir=context.Context.build_dir) ~targets action = - Targets (Pset.of_list targets) - >>^ fun () -> - { Action. context = Some context; dir; action } +let action ~context ?(dir=context.Context.build_dir) action = + return { Action. context = Some context; dir; action } -let action_dyn ~context ?(dir=context.Context.build_dir) ~targets () = - Targets (Pset.of_list targets) - >>^ fun action -> - { Action. context = Some context; dir; action } +let action_dyn ~context ?(dir=context.Context.build_dir) () = + arr (fun action -> + { Action. context = Some context; dir; action }) -let action_context_independent ?(dir=Path.root) ~targets action = - Targets (Pset.of_list targets) - >>^ fun () -> - { Action. context = None; dir; action } +let action_context_independent ?(dir=Path.root) action = + return { Action. context = None; dir; action } let update_file fn s = - action_context_independent ~targets:[fn] (Update_file (fn, s)) + action_context_independent (Update_file (fn, s)) let update_file_dyn fn = - Targets (Pset.singleton fn) - >>^ fun s -> - { Action. - context = None - ; dir = Path.root - ; action = Update_file (fn, s) - } + arr (fun s -> + { Action. + context = None + ; dir = Path.root + ; action = Update_file (fn, s) + }) let write_sexp path to_sexp = arr (fun x -> Sexp.to_string (to_sexp x)) @@ -239,21 +221,20 @@ let write_sexp path to_sexp = let copy ~src ~dst = path src >>> - action_context_independent ~targets:[dst] (Copy (src, dst)) + action_context_independent (Copy (src, dst)) let symlink ~src ~dst = path src >>> - action_context_independent ~targets:[dst] (Symlink (src, dst)) + action_context_independent (Symlink (src, dst)) let create_file fn = - action_context_independent ~targets:[fn] (Create_file fn) + action_context_independent (Create_file fn) let and_create_file fn = - Targets (Pset.singleton fn) - >>^ fun (action : Action.t) -> - { action with - action = Progn [action.action; Create_file fn] - } + arr (fun (action : Action.t) -> + { action with + action = Progn [action.action; Create_file fn] + }) (* {[ diff --git a/src/build.mli b/src/build.mli index 9616efff..344e8f66 100644 --- a/src/build.mli +++ b/src/build.mli @@ -59,7 +59,7 @@ val file_exists_opt : Path.t -> ('a, 'b) t -> ('a, 'b option) t (** Always fail when executed. We pass a function rather than an exception to get a proper backtrace *) -val fail : ?targets:Path.t list -> fail -> (_, _) t +val fail : fail -> (_, _) t (** [memoize ~name t] is an arrow that behaves like [t] except that its result is computed only once. *) @@ -75,7 +75,6 @@ val run : context:Context.t -> ?dir:Path.t (* default: context.build_dir *) -> ?stdout_to:Path.t - -> ?extra_targets:Path.t list -> 'a Prog_spec.t -> 'a Arg_spec.t list -> ('a, Action.t) t @@ -83,20 +82,17 @@ val run val action : context:Context.t -> ?dir:Path.t (* default: context.build_dir *) - -> targets:Path.t list -> Action.Mini_shexp.t -> (unit, Action.t) t val action_dyn : context:Context.t -> ?dir:Path.t (* default: context.build_dir *) - -> targets:Path.t list -> unit -> (Action.Mini_shexp.t, Action.t) t val action_context_independent : ?dir:Path.t (* default: Path.root *) - -> targets:Path.t list -> Action.Mini_shexp.t -> (unit, Action.t) t @@ -133,7 +129,6 @@ val record_lib_deps_simple : dir:Path.t -> lib_deps -> ('a, 'a) t module Repr : sig type ('a, 'b) t = | Arr : ('a -> 'b) -> ('a, 'b) t - | Targets : Path.Set.t -> ('a, 'a) t | Compose : ('a, 'b) t * ('b, 'c) t -> ('a, 'c) t | First : ('a, 'b) t -> ('a * 'c, 'b * 'c) t | Second : ('a, 'b) t -> ('c * 'a, 'c * 'b) t diff --git a/src/build_interpret.ml b/src/build_interpret.ml index ee647f45..bd8f94ab 100644 --- a/src/build_interpret.ml +++ b/src/build_interpret.ml @@ -8,7 +8,6 @@ let deps t ~all_targets_by_dir = let rec loop : type a b. (a, b) t -> Pset.t -> Pset.t = fun t acc -> match t with | Arr _ -> acc - | Targets _ -> acc | Compose (a, b) -> loop a (loop b acc) | First t -> loop t acc | Second t -> loop t acc @@ -54,7 +53,6 @@ let lib_deps = = fun t acc -> match t with | Arr _ -> acc - | Targets _ -> acc | Compose (a, b) -> loop a (loop b acc) | First t -> loop t acc | Second t -> loop t acc @@ -79,37 +77,6 @@ let lib_deps = in fun t -> loop (Build.repr t) Pmap.empty -let targets = - let rec loop : type a b. (a, b) t -> Pset.t -> Pset.t = fun t acc -> - match t with - | Arr _ -> acc - | Targets targets -> Pset.union acc targets - | Compose (a, b) -> loop a (loop b acc) - | First t -> loop t acc - | Second t -> loop t acc - | Split (a, b) -> loop a (loop b acc) - | Fanout (a, b) -> loop a (loop b acc) - | Paths _ -> acc - | Paths_glob _ -> acc - | Dyn_paths t -> loop t acc - | Contents _ -> acc - | Lines_of _ -> acc - | Record_lib_deps _ -> acc - | Fail _ -> acc - | If_file_exists (_, state) -> begin - match !state with - | Decided _ -> code_errorf "Build_interpret.targets got decided if_file_exists" - | Undecided (a, b) -> - if Pset.is_empty (loop a Pset.empty) && Pset.is_empty (loop b Pset.empty) then - acc - else - code_errorf "Build_interpret.targets: cannot have targets \ - under a [if_file_exists]" - end - | Memo m -> loop m.t acc - in - fun t -> loop (Build.repr t) Pset.empty - module Rule = struct type t = { build : (unit, Action.t) Build.t @@ -117,9 +84,9 @@ module Rule = struct ; sandbox : bool } - let make ?(sandbox=false) build = + let make ?(sandbox=false) ~targets build = { build - ; targets = targets build + ; targets = Path.Set.of_list targets ; sandbox } end diff --git a/src/build_interpret.mli b/src/build_interpret.mli index f44ce610..24ef66a1 100644 --- a/src/build_interpret.mli +++ b/src/build_interpret.mli @@ -7,7 +7,7 @@ module Rule : sig ; sandbox : bool } - val make : ?sandbox:bool -> (unit, Action.t) Build.t -> t + val make : ?sandbox:bool -> targets:Path.t list -> (unit, Action.t) Build.t -> t end val deps @@ -18,7 +18,3 @@ val deps val lib_deps : (_, _) Build.t -> Build.lib_deps Path.Map.t - -val targets - : (_, _) Build.t - -> Path.Set.t diff --git a/src/build_system.ml b/src/build_system.ml index 707ecf2f..92401125 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -168,7 +168,6 @@ module Build_exec = struct : type a b. (a, b) t -> a -> b = fun t x -> match t with | Arr f -> f x - | Targets _ -> x | Compose (a, b) -> exec a x |> exec b | First t -> @@ -433,7 +432,7 @@ let setup_copy_rules t ~all_non_target_source_files ~all_targets_by_dir = This allows to keep generated files in tarballs. Maybe we should allow it on a case-by-case basis though. *) - compile_rule t (Pre_rule.make build) + compile_rule t (Pre_rule.make build ~targets:[ctx_path]) ~all_targets_by_dir ~allow_override:true)) diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 152fcee6..318ff448 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -63,6 +63,11 @@ module Gen(P : Params) = struct | Native -> ["-cclib"; "-l" ^ stubs_name] in SC.add_rule sctx + ~targets: + (target + :: match mode with + | Byte -> [] + | Native -> [lib_archive lib ~dir ~ext:ctx.ext_lib]) (Build.fanout (dep_graph >>> Build.arr (fun dep_graph -> @@ -75,12 +80,8 @@ module Gen(P : Params) = struct (SC.expand_and_eval_set ~dir lib.c_library_flags ~standard:[]) >>> Build.run ~context:ctx (Dep compiler) - ~extra_targets:( - match mode with - | Byte -> [] - | Native -> [lib_archive lib ~dir ~ext:ctx.ext_lib]) [ Ocaml_flags.get flags mode - ; A "-a"; A "-o"; Target target + ; A "-a"; A "-o"; Path target ; As stubs_flags ; Dyn (fun (_, cclibs) -> S (List.map cclibs ~f:(fun flag -> @@ -108,7 +109,7 @@ module Gen(P : Params) = struct let build_c_file (lib : Library.t) ~dir ~requires ~h_files c_name = let src = Path.relative dir (c_name ^ ".c") in let dst = Path.relative dir (c_name ^ ctx.ext_obj) in - SC.add_rule sctx + SC.add_rule sctx ~targets:[dst] (Build.paths h_files >>> Build.fanout @@ -128,7 +129,7 @@ module Gen(P : Params) = struct S [ Lib.c_include_flags libs ; As (List.concat_map c_flags ~f:(fun f -> ["-ccopt"; f])) ]) - ; A "-o"; Target dst + ; A "-o"; Path dst ; Dep src ]); dst @@ -136,7 +137,7 @@ module Gen(P : Params) = struct let build_cxx_file (lib : Library.t) ~dir ~requires ~h_files c_name = let src = Path.relative dir (c_name ^ ".cpp") in let dst = Path.relative dir (c_name ^ ctx.ext_obj) in - SC.add_rule sctx + SC.add_rule sctx ~targets:[dst] (Build.paths h_files >>> Build.fanout @@ -157,7 +158,7 @@ module Gen(P : Params) = struct S [ Lib.c_include_flags libs ; As cxx_flags ]) - ; A "-o"; Target dst + ; A "-o"; Path dst ; A "-c"; Dep src ]); dst @@ -231,7 +232,8 @@ module Gen(P : Params) = struct let dep_graph = Ocamldep.rules sctx ~dir ~item:lib.name ~modules ~alias_module in Option.iter alias_module ~f:(fun m -> - SC.add_rule sctx + let target = Path.relative dir m.impl.name in + SC.add_rule sctx ~targets:[target] (Build.return (String_map.values (String_map.remove m.name modules) |> List.map ~f:(fun (m : Module.t) -> @@ -240,7 +242,7 @@ module Gen(P : Params) = struct main_module_name m.name m.name (Module.real_unit_name m)) |> String.concat ~sep:"\n") - >>> Build.update_file_dyn (Path.relative dir m.impl.name))); + >>> Build.update_file_dyn target)); let requires, real_requires = SC.Libs.requires sctx ~dir ~dep_kind ~item:lib.name @@ -293,11 +295,10 @@ module Gen(P : Params) = struct | Some _ -> () | None -> let ocamlmklib ~sandbox ~custom ~targets = - SC.add_rule sctx ~sandbox + SC.add_rule sctx ~sandbox ~targets (SC.expand_and_eval_set ~dir lib.c_library_flags ~standard:[] >>> Build.run ~context:ctx - ~extra_targets:targets (Dep ctx.ocamlmklib) [ As (Utils.g ()) ; if custom then A "-custom" else As [] @@ -329,9 +330,8 @@ module Gen(P : Params) = struct List.iter Mode.all ~f:(fun mode -> build_lib lib ~flags ~dir ~mode ~modules ~dep_graph); (* Build *.cma.js *) - SC.add_rules sctx ( - let src = lib_archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) in - Js_of_ocaml_rules.build_cm sctx ~dir ~js_of_ocaml:lib.buildable.js_of_ocaml ~src); + (let src = lib_archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) in + Js_of_ocaml_rules.build_cm sctx ~dir ~src ~js_of_ocaml:lib.buildable.js_of_ocaml); if ctx.natdynlink_supported then Option.iter ctx.ocamlopt ~f:(fun ocamlopt -> @@ -343,7 +343,7 @@ module Gen(P : Params) = struct [ Ocaml_flags.get flags Native ; A "-shared"; A "-linkall" ; A "-I"; Path dir - ; A "-o"; Target dst + ; A "-o"; Path dst ; Dep src ] in @@ -355,7 +355,7 @@ module Gen(P : Params) = struct else build in - SC.add_rule sctx build + SC.add_rule sctx build ~targets:[dst] ); let flags = @@ -383,32 +383,33 @@ module Gen(P : Params) = struct in let dep_graph = Ml_kind.Dict.get dep_graph Impl in let exe = Path.relative dir (name ^ exe_ext) in - let libs_and_cm = - Build.fanout + let top_closed_cm_files = + dep_graph + >>^ fun dep_graph -> + Ocamldep.names_to_top_closed_cm_files + ~dir + ~dep_graph + ~modules + ~mode + [String.capitalize_ascii name] + in + SC.add_rule sctx ~targets:[exe] + (Build.fanout (requires >>> Build.dyn_paths (Build.arr (Lib.archive_files ~mode ~ext_lib:ctx.ext_lib))) - (dep_graph - >>> Build.arr (fun dep_graph -> - Ocamldep.names_to_top_closed_cm_files - ~dir - ~dep_graph - ~modules - ~mode - [String.capitalize_ascii name])) - in - SC.add_rule sctx - (libs_and_cm >>> + top_closed_cm_files + >>> Build.run ~context:ctx (Dep compiler) [ Ocaml_flags.get flags mode - ; A "-o"; Target exe + ; A "-o"; Path exe ; As link_flags ; Dyn (fun (libs, _) -> Lib.link_flags libs ~mode) ; 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 - SC.add_rules sctx (List.map rules ~f:(fun r -> libs_and_cm >>> r)) + Js_of_ocaml_rules.build_exe sctx ~dir ~js_of_ocaml ~src:exe + ~requires ~top_closed_cm_files let executables_rules (exes : Executables.t) ~dir ~all_modules ~package_context = let dep_kind = Build.Required in @@ -466,7 +467,7 @@ module Gen(P : Params) = struct let user_rule (rule : Rule.t) ~dir ~package_context = let targets = List.map rule.targets ~f:(Path.relative dir) in - SC.add_rule sctx + SC.add_rule sctx ~targets (SC.Deps.interpret sctx ~dir rule.deps >>> SC.Action.run @@ -494,7 +495,7 @@ module Gen(P : Params) = struct let digest_path = Alias.file_with_digest_suffix alias ~digest in Alias.add_deps (SC.aliases sctx) alias [digest_path]; let deps = SC.Deps.interpret sctx ~dir alias_conf.deps in - SC.add_rule sctx + SC.add_rule sctx ~targets:[digest_path] (match alias_conf.action with | None -> deps @@ -502,14 +503,15 @@ module Gen(P : Params) = struct Build.create_file digest_path | Some action -> deps - >>> SC.Action.run - sctx - action - ~dir - ~dep_kind:Required - ~targets:[] - ~deps:(SC.Deps.only_plain_files sctx ~dir alias_conf.deps) - ~package_context + >>> + SC.Action.run + sctx + action + ~dir + ~dep_kind:Required + ~deps:(SC.Deps.only_plain_files sctx ~dir alias_conf.deps) + ~targets:[] + ~package_context >>> Build.and_create_file digest_path) @@ -559,10 +561,9 @@ module Gen(P : Params) = struct | Reason -> "re") intf.name impl_fname; let dir = Path.append ctx.build_dir dir in - SC.add_rule sctx - (Build.copy - ~src:(Path.relative dir intf.name) - ~dst:(Path.relative dir impl_fname)); + let src = Path.relative dir intf.name in + let dst = Path.relative dir impl_fname in + SC.add_rule sctx ~targets:[dst] (Build.copy ~src ~dst); { intf with name = impl_fname } in String_map.merge impls intfs ~f:(fun name impl intf -> let impl = @@ -620,8 +621,7 @@ module Gen(P : Params) = struct |> Merlin.add_rules sctx ~dir:ctx_dir let () = List.iter (SC.stanzas sctx) ~f:rules - let () = - SC.add_rules sctx (Js_of_ocaml_rules.setup_separate_compilation_rules sctx) + let () = Js_of_ocaml_rules.setup_separate_compilation_rules sctx (* +-----------------------------------------------------------------+ | META | @@ -713,7 +713,7 @@ module Gen(P : Params) = struct >>^ List.map ~f:Lib.best_name | _ -> Build.arr (fun _ -> [])) in - SC.add_rule sctx + SC.add_rule sctx ~targets:[meta_path] (Build.fanout meta template >>^ (fun ((meta : Meta.t), template) -> let buf = Buffer.create 1024 in @@ -830,7 +830,7 @@ module Gen(P : Params) = struct let dst = Path.append install_dir (Install.Entry.relative_installed_path entry ~package) in - SC.add_rule sctx (Build.symlink ~src:entry.src ~dst); + SC.add_rule ~targets:[dst] sctx (Build.symlink ~src:entry.src ~dst); { entry with src = dst }) let install_file package_path package = @@ -872,7 +872,7 @@ module Gen(P : Params) = struct Path.relative (Path.append ctx.build_dir package_path) (package ^ ".install") in let entries = local_install_rules entries ~package in - SC.add_rule sctx + SC.add_rule sctx ~targets:[fn] (Build.path_set (Install.files entries) >>^ (fun () -> Install.gen_install_file entries) @@ -896,7 +896,8 @@ module Gen(P : Params) = struct if is_default then begin let src_install_alias = Alias.install ~dir:src_path in let src_install_file = Path.relative src_path install_fn in - SC.add_rule sctx (Build.copy ~src:ctx_install_file ~dst:src_install_file); + SC.add_rule sctx ~targets:[src_install_file] + (Build.copy ~src:ctx_install_file ~dst:src_install_file); Alias.add_deps (SC.aliases sctx) src_install_alias [src_install_file] end) end diff --git a/src/js_of_ocaml_rules.ml b/src/js_of_ocaml_rules.ml index f69a6caa..eb462e2a 100644 --- a/src/js_of_ocaml_rules.ml +++ b/src/js_of_ocaml_rules.ml @@ -1,4 +1,5 @@ open Import +open Build.O module SC = Super_context @@ -27,42 +28,45 @@ let runtime_file ~sctx ~dir fname = "js_of_ocaml-compiler") | Ok f -> Arg_spec.Dep f -let js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target = +let js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target ~dep = let jsoo = SC.resolve_program sctx ~hint:install_jsoo_hint "js_of_ocaml" in let runtime = runtime_file ~sctx ~dir "runtime.js" in - Build.run ~context:(SC.context sctx) ~dir - jsoo - [ Arg_spec.As flags - ; Arg_spec.A "-o"; Target target - ; Arg_spec.A "--no-runtime"; runtime - ; spec - ] + SC.add_rule sctx ~targets:[target] + (dep + >>> + Build.run ~context:(SC.context sctx) ~dir + jsoo + [ Arg_spec.As flags + ; Arg_spec.A "-o"; Path target + ; Arg_spec.A "--no-runtime"; runtime + ; spec + ]) -let standalone_runtime_rule ~sctx ~dir ~flags ~javascript_files ~target = +let standalone_runtime_rule ~sctx ~dir ~flags ~javascript_files ~target ~requires = let spec = Arg_spec.S - [ Arg_spec.Dyn (fun (libs,_) -> Arg_spec.Deps (Lib.jsoo_runtime_files libs)) + [ Arg_spec.Dyn (fun libs -> Arg_spec.Deps (Lib.jsoo_runtime_files libs)) ; Arg_spec.Deps javascript_files ] in let flags = Ordered_set_lang.eval_with_standard flags ~standard:(standard ()) in let flags = "--runtime-only" :: flags in - js_of_ocaml_rule ~sctx ~dir ~flags ~target ~spec + js_of_ocaml_rule ~sctx ~dir ~flags ~target ~spec ~dep:requires -let exe_rule ~sctx ~dir ~flags ~javascript_files ~src ~target = +let exe_rule ~sctx ~dir ~flags ~javascript_files ~src ~target ~requires = let spec = Arg_spec.S - [ Arg_spec.Dyn (fun (libs,_) -> Arg_spec.Deps (Lib.jsoo_runtime_files libs)) + [ Arg_spec.Dyn (fun libs -> Arg_spec.Deps (Lib.jsoo_runtime_files libs)) ; Arg_spec.Deps javascript_files ; Arg_spec.Dep src ] in let flags = Ordered_set_lang.eval_with_standard flags ~standard:(standard ()) in - js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target + js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target ~dep:requires -let link_rule ~sctx ~dir ~runtime ~target = +let link_rule ~sctx ~dir ~runtime ~target ~requires ~top_closed_cm_files = let ctx = SC.context sctx in - let get_all (libs,cm) = + let get_all (libs, cm) = (* Special case for the stdlib because it is not referenced in the META *) let stdlib = Lib.External (Findlib.stdlib_with_archives ctx.findlib) in let all_libs = @@ -80,29 +84,31 @@ let link_rule ~sctx ~dir ~runtime ~target = Arg_spec.Deps (List.concat [all_libs;all_other_modules]) in let jsoo_link = SC.resolve_program sctx ~hint:install_jsoo_hint "jsoo_link" in - Build.run ~context:(SC.context sctx) ~dir - jsoo_link - [ Arg_spec.A "-o"; Target target - ; Arg_spec.Dep runtime - ; Arg_spec.As (sourcemap ()) - ; Arg_spec.Dyn get_all - ] + SC.add_rule sctx ~targets:[target] + (Build.fanout requires top_closed_cm_files + >>> + Build.run ~context:(SC.context sctx) ~dir + jsoo_link + [ Arg_spec.A "-o"; Path target + ; Arg_spec.Dep runtime + ; Arg_spec.As (sourcemap ()) + ; Arg_spec.Dyn get_all + ]) let build_cm sctx ~dir ~js_of_ocaml ~src = - if separate_compilation_enabled () - then let target = Path.extend_basename src ~suffix:".js" in + if separate_compilation_enabled () then begin + let target = Path.extend_basename src ~suffix:".js" in let spec = Arg_spec.Dep src in let flags = Ordered_set_lang.eval_with_standard js_of_ocaml.Jbuild_types.Js_of_ocaml.flags ~standard:(standard ()) in - [ js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target ] - else [] + js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target ~dep:(Build.return ()) + end let setup_separate_compilation_rules sctx = - if separate_compilation_enabled () - then + if separate_compilation_enabled () then begin let ctx = SC.context sctx in let all_pkg = List.map @@ -117,28 +123,25 @@ let setup_separate_compilation_rules sctx = let archives = Mode.Dict.get pkg.Findlib.archives Mode.Byte in pkg.Findlib.name, pkg.dir, archives) in - List.concat_map all_pkg - ~f:(fun (pkg_name,pkg_dir,archives) -> - List.map archives ~f:(fun name -> - let src = Path.relative pkg_dir name in - let target = in_build_dir ~ctx [ pkg_name; sprintf "%s.js" name] in - let dir = in_build_dir ~ctx [ pkg_name ] in - let spec = Arg_spec.Dep src in - let flags = standard () in - js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target - )) - else [] + List.iter all_pkg ~f:(fun (pkg_name, pkg_dir, archives) -> + List.iter archives ~f:(fun name -> + let src = Path.relative pkg_dir name in + let target = in_build_dir ~ctx [ pkg_name; sprintf "%s.js" name] in + let dir = in_build_dir ~ctx [ pkg_name ] in + let spec = Arg_spec.Dep src in + let flags = standard () in + js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target ~dep:(Build.return ()))) + end -let build_exe sctx ~dir ~js_of_ocaml ~src = +let build_exe sctx ~dir ~js_of_ocaml ~src ~requires ~top_closed_cm_files = let {Jbuild_types.Js_of_ocaml.javascript_files; flags} = js_of_ocaml in let javascript_files = List.map javascript_files ~f:(Path.relative dir) in let mk_target ext = Path.extend_basename src ~suffix:ext in let target = mk_target ".js" in let standalone_runtime = mk_target ".runtime.js" in - if separate_compilation_enabled () then - [ link_rule ~sctx ~dir ~runtime:standalone_runtime ~target - ; standalone_runtime_rule ~sctx ~dir ~flags ~javascript_files - ~target:standalone_runtime - ] - else - [ exe_rule ~sctx ~dir ~flags ~javascript_files ~src ~target ] + if separate_compilation_enabled () then begin + link_rule ~sctx ~dir ~runtime:standalone_runtime ~target ~requires ~top_closed_cm_files; + standalone_runtime_rule ~sctx ~dir ~flags ~javascript_files + ~target:standalone_runtime ~requires + end else + exe_rule ~sctx ~dir ~flags ~javascript_files ~src ~target ~requires diff --git a/src/js_of_ocaml_rules.mli b/src/js_of_ocaml_rules.mli index a454db2a..20df018d 100644 --- a/src/js_of_ocaml_rules.mli +++ b/src/js_of_ocaml_rules.mli @@ -7,17 +7,17 @@ val build_cm -> dir:Path.t -> js_of_ocaml:Js_of_ocaml.t -> src:Path.t - -> (unit, Action.t) Build.t list + -> unit val build_exe : Super_context.t -> dir:Path.t -> js_of_ocaml:Js_of_ocaml.t -> src:Path.t - -> (Lib.t list * Path.t list, Action.t) Build.t list + -> requires:(unit, Lib.t list) Build.t + -> top_closed_cm_files:(unit, Path.t list) Build.t + -> unit -val setup_separate_compilation_rules - : Super_context.t - -> (unit, Action.t) Build.t list +val setup_separate_compilation_rules : Super_context.t -> unit diff --git a/src/merlin.ml b/src/merlin.ml index 7e2650be..34880ba9 100644 --- a/src/merlin.ml +++ b/src/merlin.ml @@ -30,11 +30,12 @@ let dot_merlin sctx ~dir ({ requires; flags; _ } as t) = match Path.extract_build_context dir with | Some (_, remaindir) -> let path = Path.relative remaindir ".merlin" in - SC.add_rule sctx + let merlin_exists = Path.relative dir ".merlin-exists" in + SC.add_rule sctx ~targets:[merlin_exists] (Build.path path >>> - Build.update_file (Path.relative dir ".merlin-exists") ""); - SC.add_rule sctx ( + Build.update_file merlin_exists ""); + SC.add_rule sctx ~targets:[path] ( requires >>^ (fun libs -> let ppx_flags = ppx_flags sctx ~dir ~src_dir:remaindir t in diff --git a/src/module_compilation.ml b/src/module_compilation.ml index 7f4b59ca..88b739ba 100644 --- a/src/module_compilation.ml +++ b/src/module_compilation.ml @@ -71,13 +71,12 @@ let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~(dep_graph:Ocamldep.dep_gra 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 + SC.add_rule sctx ?sandbox ~targets:(dst :: extra_targets) (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 @@ -88,7 +87,7 @@ let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~(dep_graph:Ocamldep.dep_gra ; (match alias_module with | None -> S [] | Some (m : Module.t) -> As ["-open"; m.name]) - ; A "-o"; Target dst + ; A "-o"; Path dst ; A "-c"; Ml_kind.flag ml_kind; Dep src ]))) @@ -99,7 +98,7 @@ let build_module sctx ?sandbox ~dynlink ~js_of_ocaml ~flags m ~dir ~dep_graph ~m ~alias_module); (* Build *.cmo.js *) let src = Module.cm_file m ~dir Cm_kind.Cmo in - SC.add_rules sctx (Js_of_ocaml_rules.build_cm sctx ~dir ~js_of_ocaml ~src) + Js_of_ocaml_rules.build_cm sctx ~dir ~js_of_ocaml ~src let build_modules sctx ~dynlink ~js_of_ocaml ~flags ~dir ~dep_graph ~modules ~requires ~alias_module = String_map.iter diff --git a/src/ocamldep.ml b/src/ocamldep.ml index 99507236..4e72e5cb 100644 --- a/src/ocamldep.ml +++ b/src/ocamldep.ml @@ -59,7 +59,7 @@ let rules sctx ~ml_kind ~dir ~item ~modules ~alias_module = Path.relative dir (sprintf "%s.depends%s.ocamldep-output" item suffix) in let ctx = SC.context sctx in - SC.add_rule sctx + SC.add_rule sctx ~targets:[ocamldep_output] (Build.run ~context:ctx (Dep ctx.ocamldep) [A "-modules"; S files] ~stdout_to:ocamldep_output); Build.memoize ~name:(Path.to_string ocamldep_output) diff --git a/src/super_context.ml b/src/super_context.ml index 04d1cecd..1cbeb913 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -153,8 +153,8 @@ let create ; ppx_dir = Path.of_string (sprintf "_build/.ppx/%s" context.name) } -let add_rule t ?sandbox build = - let rule = Build_interpret.Rule.make ?sandbox build in +let add_rule t ?sandbox ~targets build = + let rule = Build_interpret.Rule.make ?sandbox ~targets build in t.rules <- rule :: t.rules; t.known_targets_by_src_dir_so_far <- Path.Set.fold rule.targets ~init:t.known_targets_by_src_dir_so_far @@ -171,9 +171,6 @@ let add_rule t ?sandbox build = in Path.Map.add acc ~key:dir ~data:files) -let add_rules t ?sandbox builds = - List.iter builds ~f:(add_rule t ?sandbox) - let sources_and_targets_known_so_far t ~src_path = let sources = match File_tree.find_dir t.file_tree src_path with @@ -255,10 +252,10 @@ module Libs = struct List.iter (Lib_db.resolve_selects t.libs ~from:dir lib_deps) ~f:(fun { dst_fn; src_fn } -> let src = Path.relative dir src_fn in let dst = Path.relative dir dst_fn in - add_rule t + add_rule t ~targets:[dst] (Build.path src >>> - Build.action_context_independent ~targets:[dst] + Build.action_context_independent (Copy_and_add_line_directive (src, dst)))) let write_deps fn = @@ -269,7 +266,7 @@ module Libs = struct List.map (Preprocess_map.pps preprocess) ~f:Pp.to_string in let requires_file = requires_file ~dir ~item in - add_rule t + add_rule t ~targets:[requires_file] (Build.record_lib_deps ~dir ~kind:dep_kind (List.map virtual_deps ~f:Lib_dep.direct) >>> Build.fanout @@ -280,7 +277,7 @@ module Libs = struct Build.arr (fun (libs, rt_deps) -> Lib.remove_dups_preserve_order (libs @ rt_deps)) >>> - write_deps requires_file); + write_deps requires_file); load_deps t ~dir requires_file let requires t ~dir ~dep_kind ~item ~libraries ~preprocess ~virtual_deps = @@ -306,7 +303,7 @@ module Libs = struct let setup_runtime_deps t ~dir ~dep_kind ~item ~libraries ~ppx_runtime_libraries = let runtime_deps_file = runtime_deps_file ~dir ~item in - add_rule t + add_rule t ~targets:[runtime_deps_file] (Build.fanout (closure t ~dir ~dep_kind (List.map ppx_runtime_libraries ~f:Lib_dep.direct)) (closed_ppx_runtime_deps_of t ~dir ~dep_kind libraries) @@ -366,7 +363,8 @@ module Pkg_version = struct let set sctx p get = let fn = spec_file sctx p in - add_rule sctx (get >>> Build.write_sexp fn Sexp.To_sexp.(option string)); + add_rule sctx ~targets:[fn] + (get >>> Build.write_sexp fn Sexp.To_sexp.(option string)); Build.read_sexp fn Sexp.Of_sexp.(option string) end @@ -493,7 +491,7 @@ module Action = struct U.expand sctx.context dir t ~f:(expand_var sctx ~artifacts ~targets ~deps)) >>> - Build.action_dyn () ~context:sctx.context ~dir ~targets + Build.action_dyn () ~context:sctx.context ~dir in match forms.failures with | [] -> build @@ -582,13 +580,13 @@ module PP = struct | Some _ -> libs in - add_rule sctx + add_rule sctx ~targets:[target] (libs >>> Build.dyn_paths (Build.arr (Lib.archive_files ~mode ~ext_lib:ctx.ext_lib)) >>> Build.run ~context:ctx (Dep compiler) - [ A "-o" ; Target target + [ A "-o" ; Path target ; Dyn (Lib.link_flags ~mode) ]) @@ -626,32 +624,37 @@ module PP = struct let setup_reason_rules sctx ~dir (m : Module.t) = let ctx = sctx.context in let refmt = resolve_program sctx "refmt" ~hint:"opam install reason" in - let rule src target = + let refmt src target = let src_path = Path.relative dir src in - Build.run ~context:ctx refmt - [ A "--print" - ; A "binary" - ; Dep src_path ] - ~stdout_to:(Path.relative dir target) in + let target = Path.relative dir target in + add_rule sctx ~targets:[target] + (Build.run ~context:ctx refmt + [ A "--print" + ; A "binary" + ; Dep src_path ] + ~stdout_to:target) + in let impl = match m.impl.syntax with | OCaml -> m.impl | Reason -> let ml = Module.File.to_ocaml m.impl in - add_rule sctx (rule m.impl.name ml.name); - ml in + refmt m.impl.name ml.name; + ml + in let intf = Option.map m.intf ~f:(fun f -> match f.syntax with | OCaml -> f | Reason -> let mli = Module.File.to_ocaml f in - add_rule sctx (rule f.name mli.name); - mli) in + refmt f.name mli.name; + mli) + in { m with impl ; intf } - (* Generate rules to build the .pp files and return a new module map where all filenames - point to the .pp files *) + (* Generate rules to build the .pp files and return a new module map + where all filenames point to the .pp files *) let pped_modules sctx ~dir ~dep_kind ~modules ~preprocess ~preprocessor_deps ~lib_name ~package_context = let preprocessor_deps = Deps.interpret sctx ~dir preprocessor_deps in @@ -661,7 +664,7 @@ module PP = struct | No_preprocessing -> m | Action action -> pped_module m ~dir ~f:(fun _kind src dst -> - add_rule sctx + add_rule sctx ~targets:[dst] (preprocessor_deps >>> Build.path src @@ -680,7 +683,7 @@ module PP = struct | Pps { pps; flags } -> let ppx_exe = get_ppx_driver sctx pps ~dir ~dep_kind in pped_module m ~dir ~f:(fun kind src dst -> - add_rule sctx + add_rule sctx ~targets:[dst] (preprocessor_deps >>> Build.run ~context:sctx.context @@ -688,7 +691,7 @@ module PP = struct [ As flags ; A "--dump-ast" ; As (cookie_library_name lib_name) - ; A "-o"; Target dst + ; A "-o"; Path dst ; Ml_kind.ppx_driver_flag kind; Dep src ]) ) diff --git a/src/super_context.mli b/src/super_context.mli index 3223c1f3..2c2f31ea 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -42,8 +42,7 @@ val cxx_flags : t -> string list val expand_var_no_root : t -> string -> string option val expand_vars : t -> dir:Path.t -> String_with_vars.t -> string -val add_rule : t -> ?sandbox:bool -> (unit, Action.t) Build.t -> unit -val add_rules : t -> ?sandbox:bool -> (unit, Action.t) Build.t list -> unit +val add_rule : t -> ?sandbox:bool -> targets:Path.t list -> (unit, Action.t) Build.t -> unit val rules : t -> Build_interpret.Rule.t list val sources_and_targets_known_so_far : t -> src_path:Path.t -> String_set.t