matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Make targets explicit

This commit is contained in:
Jérémie Dimino 2017-05-14 23:35:51 +01:00
parent b6b417e640
commit b7ad08df84
16 changed files with 183 additions and 251 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/alias.ml
View File

@ -101,7 +101,7 @@ let rules store ~prefixes ~tree =
Hashtbl.fold store ~init:[] ~f:(fun ~key:_ ~data:{ Store. alias; deps } acc -> Hashtbl.fold store ~init:[] ~f:(fun ~key:_ ~data:{ Store. alias; deps } acc ->
let open Build.O in let open Build.O in
let rule = let rule =
Build_interpret.Rule.make Build_interpret.Rule.make ~targets:[alias.file]
(Build.path_set deps >>> (Build.path_set deps >>>
Build.create_file alias.file) Build.create_file alias.file)
in in

10
src/arg_spec.ml
View File

@ -10,7 +10,6 @@ type 'a t =
| Deps of Path.t list | Deps of Path.t list
| Dep_rel of Path.t * string | Dep_rel of Path.t * string
| Deps_rel of Path.t * string list | Deps_rel of Path.t * string list
| Target of Path.t
| Path of Path.t | Path of Path.t
| Paths of Path.t list | Paths of Path.t list
| Dyn of ('a -> nothing t) | Dyn of ('a -> nothing t)
@ -27,13 +26,6 @@ let rec add_deps ts set =
| S ts -> add_deps ts set | S ts -> add_deps ts set
| _ -> 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 expand ~dir ts x =
let dyn_deps = ref Path.Set.empty in let dyn_deps = ref Path.Set.empty in
let add_dep path = dyn_deps := Path.Set.add path !dyn_deps 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 -> | Paths fns ->
List.map fns ~f:(Path.reach ~from:dir) List.map fns ~f:(Path.reach ~from:dir)
| S ts -> List.concat_map ts ~f:loop_dyn | S ts -> List.concat_map ts ~f:loop_dyn
| Target _ -> die "Target not allowed under Dyn"
| Dyn _ -> assert false | Dyn _ -> assert false
in in
let rec loop = function let rec loop = function
@ -68,7 +59,6 @@ let expand ~dir ts x =
| (Dep fn | Path fn) -> [Path.reach fn ~from:dir] | (Dep fn | Path fn) -> [Path.reach fn ~from:dir]
| (Deps fns | Paths fns) -> List.map fns ~f:(Path.reach ~from:dir) | (Deps fns | Paths fns) -> List.map fns ~f:(Path.reach ~from:dir)
| S ts -> List.concat_map ts ~f:loop | S ts -> List.concat_map ts ~f:loop
| Target fn -> [Path.reach fn ~from:dir]
| Dyn f -> loop_dyn (f x) | Dyn f -> loop_dyn (f x)
in in
let l = List.concat_map ts ~f:loop in let l = List.concat_map ts ~f:loop in

6
src/arg_spec.mli
View File

@ -8,12 +8,10 @@ type 'a t =
| Deps of Path.t list | Deps of Path.t list
| Dep_rel of Path.t * string | Dep_rel of Path.t * string
| Deps_rel of Path.t * string list | Deps_rel of Path.t * string list
| Target of Path.t
| Path of Path.t | Path of Path.t
| Paths of Path.t list | Paths of Path.t list
| Dyn of ('a -> nothing t) | Dyn of ('a -> nothing t)
val add_deps : _ t list -> Path.Set.t -> Path.Set.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 expand : dir:Path.t -> 'a t list -> 'a -> string list * Path.Set.t

65
src/build.ml
View File

@ -21,7 +21,6 @@ let merge_lib_dep_kind a b =
module Repr = struct module Repr = struct
type ('a, 'b) t = type ('a, 'b) t =
| Arr : ('a -> 'b) -> ('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 | Compose : ('a, 'b) t * ('b, 'c) t -> ('a, 'c) t
| First : ('a, 'b) t -> ('a * 'c, 'b * 'c) t | First : ('a, 'b) t -> ('a * 'c, 'b * 'c) t
| Second : ('a, 'b) t -> ('c * 'a, 'c * 'b) 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) ~then_:(t >>^ fun x -> Some x)
~else_:(arr (fun _ -> None)) ~else_:(arr (fun _ -> None))
let fail ?targets x = let fail x = Fail x
match targets with
| None -> Fail x
| Some l -> Targets (Pset.of_list l) >>> Fail x
let memoize ~name t = let memoize ~name t =
Memo { name; t; state = Unevaluated } Memo { name; t; state = Unevaluated }
@ -181,17 +177,9 @@ let prog_and_args ~dir prog args =
>>> >>>
arr fst)) 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 = 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 prog_and_args ~dir prog args
>>>
Targets (Pset.of_list targets)
>>^ (fun (prog, args) -> >>^ (fun (prog, args) ->
let action : Action.Mini_shexp.t = Run (prog, args) in let action : Action.Mini_shexp.t = Run (prog, args) in
let action = let action =
@ -205,32 +193,26 @@ let run ~context ?(dir=context.Context.build_dir) ?stdout_to ?(extra_targets=[])
; action ; action
}) })
let action ~context ?(dir=context.Context.build_dir) ~targets action = let action ~context ?(dir=context.Context.build_dir) action =
Targets (Pset.of_list targets) return { Action. context = Some context; dir; action }
>>^ fun () ->
{ Action. context = Some context; dir; action }
let action_dyn ~context ?(dir=context.Context.build_dir) ~targets () = let action_dyn ~context ?(dir=context.Context.build_dir) () =
Targets (Pset.of_list targets) arr (fun action ->
>>^ fun action -> { Action. context = Some context; dir; action })
{ Action. context = Some context; dir; action }
let action_context_independent ?(dir=Path.root) ~targets action = let action_context_independent ?(dir=Path.root) action =
Targets (Pset.of_list targets) return { Action. context = None; dir; action }
>>^ fun () ->
{ Action. context = None; dir; action }
let update_file fn s = 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 = let update_file_dyn fn =
Targets (Pset.singleton fn) arr (fun s ->
>>^ fun s -> { Action.
{ Action. context = None
context = None ; dir = Path.root
; dir = Path.root ; action = Update_file (fn, s)
; action = Update_file (fn, s) })
}
let write_sexp path to_sexp = let write_sexp path to_sexp =
arr (fun x -> Sexp.to_string (to_sexp x)) arr (fun x -> Sexp.to_string (to_sexp x))
@ -239,21 +221,20 @@ let write_sexp path to_sexp =
let copy ~src ~dst = let copy ~src ~dst =
path src >>> path src >>>
action_context_independent ~targets:[dst] (Copy (src, dst)) action_context_independent (Copy (src, dst))
let symlink ~src ~dst = let symlink ~src ~dst =
path src >>> path src >>>
action_context_independent ~targets:[dst] (Symlink (src, dst)) action_context_independent (Symlink (src, dst))
let create_file fn = let create_file fn =
action_context_independent ~targets:[fn] (Create_file fn) action_context_independent (Create_file fn)
let and_create_file fn = let and_create_file fn =
Targets (Pset.singleton fn) arr (fun (action : Action.t) ->
>>^ fun (action : Action.t) -> { action with
{ action with action = Progn [action.action; Create_file fn]
action = Progn [action.action; Create_file fn] })
}
(* (*
{[ {[

7
src/build.mli
View File

@ -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 (** Always fail when executed. We pass a function rather than an exception to get a proper
backtrace *) 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 (** [memoize ~name t] is an arrow that behaves like [t] except that its
result is computed only once. *) result is computed only once. *)
@ -75,7 +75,6 @@ val run
: context:Context.t : context:Context.t
-> ?dir:Path.t (* default: context.build_dir *) -> ?dir:Path.t (* default: context.build_dir *)
-> ?stdout_to:Path.t -> ?stdout_to:Path.t
-> ?extra_targets:Path.t list
-> 'a Prog_spec.t -> 'a Prog_spec.t
-> 'a Arg_spec.t list -> 'a Arg_spec.t list
-> ('a, Action.t) t -> ('a, Action.t) t
@ -83,20 +82,17 @@ val run
val action val action
: context:Context.t : context:Context.t
-> ?dir:Path.t (* default: context.build_dir *) -> ?dir:Path.t (* default: context.build_dir *)
-> targets:Path.t list
-> Action.Mini_shexp.t -> Action.Mini_shexp.t
-> (unit, Action.t) t -> (unit, Action.t) t
val action_dyn val action_dyn
: context:Context.t : context:Context.t
-> ?dir:Path.t (* default: context.build_dir *) -> ?dir:Path.t (* default: context.build_dir *)
-> targets:Path.t list
-> unit -> unit
-> (Action.Mini_shexp.t, Action.t) t -> (Action.Mini_shexp.t, Action.t) t
val action_context_independent val action_context_independent
: ?dir:Path.t (* default: Path.root *) : ?dir:Path.t (* default: Path.root *)
-> targets:Path.t list
-> Action.Mini_shexp.t -> Action.Mini_shexp.t
-> (unit, Action.t) 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 module Repr : sig
type ('a, 'b) t = type ('a, 'b) t =
| Arr : ('a -> 'b) -> ('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 | Compose : ('a, 'b) t * ('b, 'c) t -> ('a, 'c) t
| First : ('a, 'b) t -> ('a * 'c, 'b * 'c) t | First : ('a, 'b) t -> ('a * 'c, 'b * 'c) t
| Second : ('a, 'b) t -> ('c * 'a, 'c * 'b) t | Second : ('a, 'b) t -> ('c * 'a, 'c * 'b) t

37
src/build_interpret.ml
View File

@ -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 -> let rec loop : type a b. (a, b) t -> Pset.t -> Pset.t = fun t acc ->
match t with match t with
| Arr _ -> acc | Arr _ -> acc
| Targets _ -> acc
| Compose (a, b) -> loop a (loop b acc) | Compose (a, b) -> loop a (loop b acc)
| First t -> loop t acc | First t -> loop t acc
| Second t -> loop t acc | Second t -> loop t acc
@ -54,7 +53,6 @@ let lib_deps =
= fun t acc -> = fun t acc ->
match t with match t with
| Arr _ -> acc | Arr _ -> acc
| Targets _ -> acc
| Compose (a, b) -> loop a (loop b acc) | Compose (a, b) -> loop a (loop b acc)
| First t -> loop t acc | First t -> loop t acc
| Second t -> loop t acc | Second t -> loop t acc
@ -79,37 +77,6 @@ let lib_deps =
in in
fun t -> loop (Build.repr t) Pmap.empty 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 module Rule = struct
type t = type t =
{ build : (unit, Action.t) Build.t { build : (unit, Action.t) Build.t
@ -117,9 +84,9 @@ module Rule = struct
; sandbox : bool ; sandbox : bool
} }
let make ?(sandbox=false) build = let make ?(sandbox=false) ~targets build =
{ build { build
; targets = targets build ; targets = Path.Set.of_list targets
; sandbox ; sandbox
} }
end end

6
src/build_interpret.mli
View File

@ -7,7 +7,7 @@ module Rule : sig
; sandbox : bool ; 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 end
val deps val deps
@ -18,7 +18,3 @@ val deps
val lib_deps val lib_deps
: (_, _) Build.t : (_, _) Build.t
-> Build.lib_deps Path.Map.t -> Build.lib_deps Path.Map.t
val targets
: (_, _) Build.t
-> Path.Set.t

3
src/build_system.ml
View File

@ -168,7 +168,6 @@ module Build_exec = struct
: type a b. (a, b) t -> a -> b = fun t x -> : type a b. (a, b) t -> a -> b = fun t x ->
match t with match t with
| Arr f -> f x | Arr f -> f x
| Targets _ -> x
| Compose (a, b) -> | Compose (a, b) ->
exec a x |> exec b exec a x |> exec b
| First t -> | 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 This allows to keep generated files in tarballs. Maybe we
should allow it on a case-by-case basis though. *) 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 ~all_targets_by_dir
~allow_override:true)) ~allow_override:true))

109
src/gen_rules.ml
View File

@ -63,6 +63,11 @@ module Gen(P : Params) = struct
| Native -> ["-cclib"; "-l" ^ stubs_name] | Native -> ["-cclib"; "-l" ^ stubs_name]
in in
SC.add_rule sctx SC.add_rule sctx
~targets:
(target
:: match mode with
| Byte -> []
| Native -> [lib_archive lib ~dir ~ext:ctx.ext_lib])
(Build.fanout (Build.fanout
(dep_graph >>> (dep_graph >>>
Build.arr (fun 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:[]) (SC.expand_and_eval_set ~dir lib.c_library_flags ~standard:[])
>>> >>>
Build.run ~context:ctx (Dep compiler) 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 [ Ocaml_flags.get flags mode
; A "-a"; A "-o"; Target target ; A "-a"; A "-o"; Path target
; As stubs_flags ; As stubs_flags
; Dyn (fun (_, cclibs) -> ; Dyn (fun (_, cclibs) ->
S (List.map cclibs ~f:(fun flag -> 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 build_c_file (lib : Library.t) ~dir ~requires ~h_files c_name =
let src = Path.relative dir (c_name ^ ".c") in let src = Path.relative dir (c_name ^ ".c") in
let dst = Path.relative dir (c_name ^ ctx.ext_obj) 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.paths h_files
>>> >>>
Build.fanout Build.fanout
@ -128,7 +129,7 @@ module Gen(P : Params) = struct
S [ Lib.c_include_flags libs S [ Lib.c_include_flags libs
; As (List.concat_map c_flags ~f:(fun f -> ["-ccopt"; f])) ; As (List.concat_map c_flags ~f:(fun f -> ["-ccopt"; f]))
]) ])
; A "-o"; Target dst ; A "-o"; Path dst
; Dep src ; Dep src
]); ]);
dst dst
@ -136,7 +137,7 @@ module Gen(P : Params) = struct
let build_cxx_file (lib : Library.t) ~dir ~requires ~h_files c_name = let build_cxx_file (lib : Library.t) ~dir ~requires ~h_files c_name =
let src = Path.relative dir (c_name ^ ".cpp") in let src = Path.relative dir (c_name ^ ".cpp") in
let dst = Path.relative dir (c_name ^ ctx.ext_obj) 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.paths h_files
>>> >>>
Build.fanout Build.fanout
@ -157,7 +158,7 @@ module Gen(P : Params) = struct
S [ Lib.c_include_flags libs S [ Lib.c_include_flags libs
; As cxx_flags ; As cxx_flags
]) ])
; A "-o"; Target dst ; A "-o"; Path dst
; A "-c"; Dep src ; A "-c"; Dep src
]); ]);
dst dst
@ -231,7 +232,8 @@ module Gen(P : Params) = struct
let dep_graph = Ocamldep.rules sctx ~dir ~item:lib.name ~modules ~alias_module in let dep_graph = Ocamldep.rules sctx ~dir ~item:lib.name ~modules ~alias_module in
Option.iter alias_module ~f:(fun m -> 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 (Build.return
(String_map.values (String_map.remove m.name modules) (String_map.values (String_map.remove m.name modules)
|> List.map ~f:(fun (m : Module.t) -> |> List.map ~f:(fun (m : Module.t) ->
@ -240,7 +242,7 @@ module Gen(P : Params) = struct
main_module_name m.name main_module_name m.name
m.name (Module.real_unit_name m)) m.name (Module.real_unit_name m))
|> String.concat ~sep:"\n") |> String.concat ~sep:"\n")
>>> Build.update_file_dyn (Path.relative dir m.impl.name))); >>> Build.update_file_dyn target));
let requires, real_requires = let requires, real_requires =
SC.Libs.requires sctx ~dir ~dep_kind ~item:lib.name SC.Libs.requires sctx ~dir ~dep_kind ~item:lib.name
@ -293,11 +295,10 @@ module Gen(P : Params) = struct
| Some _ -> () | Some _ -> ()
| None -> | None ->
let ocamlmklib ~sandbox ~custom ~targets = 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:[] (SC.expand_and_eval_set ~dir lib.c_library_flags ~standard:[]
>>> >>>
Build.run ~context:ctx Build.run ~context:ctx
~extra_targets:targets
(Dep ctx.ocamlmklib) (Dep ctx.ocamlmklib)
[ As (Utils.g ()) [ As (Utils.g ())
; if custom then A "-custom" else As [] ; if custom then A "-custom" else As []
@ -329,9 +330,8 @@ module Gen(P : Params) = struct
List.iter Mode.all ~f:(fun mode -> List.iter Mode.all ~f:(fun mode ->
build_lib lib ~flags ~dir ~mode ~modules ~dep_graph); build_lib lib ~flags ~dir ~mode ~modules ~dep_graph);
(* Build *.cma.js *) (* Build *.cma.js *)
SC.add_rules sctx ( (let src = lib_archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) in
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);
Js_of_ocaml_rules.build_cm sctx ~dir ~js_of_ocaml:lib.buildable.js_of_ocaml ~src);
if ctx.natdynlink_supported then if ctx.natdynlink_supported then
Option.iter ctx.ocamlopt ~f:(fun ocamlopt -> Option.iter ctx.ocamlopt ~f:(fun ocamlopt ->
@ -343,7 +343,7 @@ module Gen(P : Params) = struct
[ Ocaml_flags.get flags Native [ Ocaml_flags.get flags Native
; A "-shared"; A "-linkall" ; A "-shared"; A "-linkall"
; A "-I"; Path dir ; A "-I"; Path dir
; A "-o"; Target dst ; A "-o"; Path dst
; Dep src ; Dep src
] ]
in in
@ -355,7 +355,7 @@ module Gen(P : Params) = struct
else else
build build
in in
SC.add_rule sctx build SC.add_rule sctx build ~targets:[dst]
); );
let flags = let flags =
@ -383,32 +383,33 @@ module Gen(P : Params) = struct
in in
let dep_graph = Ml_kind.Dict.get dep_graph Impl in let dep_graph = Ml_kind.Dict.get dep_graph Impl in
let exe = Path.relative dir (name ^ exe_ext) in let exe = Path.relative dir (name ^ exe_ext) in
let libs_and_cm = let top_closed_cm_files =
Build.fanout 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 (requires
>>> Build.dyn_paths (Build.arr (Lib.archive_files ~mode ~ext_lib:ctx.ext_lib))) >>> Build.dyn_paths (Build.arr (Lib.archive_files ~mode ~ext_lib:ctx.ext_lib)))
(dep_graph top_closed_cm_files
>>> 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 >>>
Build.run ~context:ctx Build.run ~context:ctx
(Dep compiler) (Dep compiler)
[ Ocaml_flags.get flags mode [ Ocaml_flags.get flags mode
; A "-o"; Target exe ; A "-o"; Path exe
; As link_flags ; As link_flags
; Dyn (fun (libs, _) -> Lib.link_flags libs ~mode) ; Dyn (fun (libs, _) -> Lib.link_flags libs ~mode)
; Dyn (fun (_, cm_files) -> Deps cm_files) ; Dyn (fun (_, cm_files) -> Deps cm_files)
]); ]);
if mode = Mode.Byte then if mode = Mode.Byte then
let rules = Js_of_ocaml_rules.build_exe sctx ~dir ~js_of_ocaml ~src:exe in Js_of_ocaml_rules.build_exe sctx ~dir ~js_of_ocaml ~src:exe
SC.add_rules sctx (List.map rules ~f:(fun r -> libs_and_cm >>> r)) ~requires ~top_closed_cm_files
let executables_rules (exes : Executables.t) ~dir ~all_modules ~package_context = let executables_rules (exes : Executables.t) ~dir ~all_modules ~package_context =
let dep_kind = Build.Required in 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 user_rule (rule : Rule.t) ~dir ~package_context =
let targets = List.map rule.targets ~f:(Path.relative dir) in 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.Deps.interpret sctx ~dir rule.deps
>>> >>>
SC.Action.run SC.Action.run
@ -494,7 +495,7 @@ module Gen(P : Params) = struct
let digest_path = Alias.file_with_digest_suffix alias ~digest in let digest_path = Alias.file_with_digest_suffix alias ~digest in
Alias.add_deps (SC.aliases sctx) alias [digest_path]; Alias.add_deps (SC.aliases sctx) alias [digest_path];
let deps = SC.Deps.interpret sctx ~dir alias_conf.deps in 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 (match alias_conf.action with
| None -> | None ->
deps deps
@ -502,14 +503,15 @@ module Gen(P : Params) = struct
Build.create_file digest_path Build.create_file digest_path
| Some action -> | Some action ->
deps deps
>>> SC.Action.run >>>
sctx SC.Action.run
action sctx
~dir action
~dep_kind:Required ~dir
~targets:[] ~dep_kind:Required
~deps:(SC.Deps.only_plain_files sctx ~dir alias_conf.deps) ~deps:(SC.Deps.only_plain_files sctx ~dir alias_conf.deps)
~package_context ~targets:[]
~package_context
>>> >>>
Build.and_create_file digest_path) Build.and_create_file digest_path)
@ -559,10 +561,9 @@ module Gen(P : Params) = struct
| Reason -> "re") | Reason -> "re")
intf.name impl_fname; intf.name impl_fname;
let dir = Path.append ctx.build_dir dir in let dir = Path.append ctx.build_dir dir in
SC.add_rule sctx let src = Path.relative dir intf.name in
(Build.copy let dst = Path.relative dir impl_fname in
~src:(Path.relative dir intf.name) SC.add_rule sctx ~targets:[dst] (Build.copy ~src ~dst);
~dst:(Path.relative dir impl_fname));
{ intf with name = impl_fname } in { intf with name = impl_fname } in
String_map.merge impls intfs ~f:(fun name impl intf -> String_map.merge impls intfs ~f:(fun name impl intf ->
let impl = let impl =
@ -620,8 +621,7 @@ module Gen(P : Params) = struct
|> Merlin.add_rules sctx ~dir:ctx_dir |> Merlin.add_rules sctx ~dir:ctx_dir
let () = List.iter (SC.stanzas sctx) ~f:rules let () = List.iter (SC.stanzas sctx) ~f:rules
let () = let () = Js_of_ocaml_rules.setup_separate_compilation_rules sctx
SC.add_rules sctx (Js_of_ocaml_rules.setup_separate_compilation_rules sctx)
(* +-----------------------------------------------------------------+ (* +-----------------------------------------------------------------+
| META | | META |
@ -713,7 +713,7 @@ module Gen(P : Params) = struct
>>^ List.map ~f:Lib.best_name >>^ List.map ~f:Lib.best_name
| _ -> Build.arr (fun _ -> [])) | _ -> Build.arr (fun _ -> []))
in in
SC.add_rule sctx SC.add_rule sctx ~targets:[meta_path]
(Build.fanout meta template (Build.fanout meta template
>>^ (fun ((meta : Meta.t), template) -> >>^ (fun ((meta : Meta.t), template) ->
let buf = Buffer.create 1024 in let buf = Buffer.create 1024 in
@ -830,7 +830,7 @@ module Gen(P : Params) = struct
let dst = let dst =
Path.append install_dir (Install.Entry.relative_installed_path entry ~package) Path.append install_dir (Install.Entry.relative_installed_path entry ~package)
in 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 }) { entry with src = dst })
let install_file package_path package = 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") Path.relative (Path.append ctx.build_dir package_path) (package ^ ".install")
in in
let entries = local_install_rules entries ~package 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) (Build.path_set (Install.files entries)
>>^ (fun () -> >>^ (fun () ->
Install.gen_install_file entries) Install.gen_install_file entries)
@ -896,7 +896,8 @@ module Gen(P : Params) = struct
if is_default then begin if is_default then begin
let src_install_alias = Alias.install ~dir:src_path in let src_install_alias = Alias.install ~dir:src_path in
let src_install_file = Path.relative src_path install_fn 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] Alias.add_deps (SC.aliases sctx) src_install_alias [src_install_file]
end) end)
end end

99
src/js_of_ocaml_rules.ml
View File

@ -1,4 +1,5 @@
open Import open Import
open Build.O
module SC = Super_context module SC = Super_context
@ -27,42 +28,45 @@ let runtime_file ~sctx ~dir fname =
"js_of_ocaml-compiler") "js_of_ocaml-compiler")
| Ok f -> Arg_spec.Dep f | 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 jsoo = SC.resolve_program sctx ~hint:install_jsoo_hint "js_of_ocaml" in
let runtime = runtime_file ~sctx ~dir "runtime.js" in let runtime = runtime_file ~sctx ~dir "runtime.js" in
Build.run ~context:(SC.context sctx) ~dir SC.add_rule sctx ~targets:[target]
jsoo (dep
[ Arg_spec.As flags >>>
; Arg_spec.A "-o"; Target target Build.run ~context:(SC.context sctx) ~dir
; Arg_spec.A "--no-runtime"; runtime jsoo
; spec [ 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 = let spec =
Arg_spec.S 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.Deps javascript_files
] ]
in in
let flags = Ordered_set_lang.eval_with_standard flags ~standard:(standard ()) in let flags = Ordered_set_lang.eval_with_standard flags ~standard:(standard ()) in
let flags = "--runtime-only" :: flags 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 = let spec =
Arg_spec.S 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.Deps javascript_files
; Arg_spec.Dep src ; Arg_spec.Dep src
] ]
in in
let flags = Ordered_set_lang.eval_with_standard flags ~standard:(standard ()) 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 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 *) (* 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 stdlib = Lib.External (Findlib.stdlib_with_archives ctx.findlib) in
let all_libs = let all_libs =
@ -80,29 +84,31 @@ let link_rule ~sctx ~dir ~runtime ~target =
Arg_spec.Deps (List.concat [all_libs;all_other_modules]) Arg_spec.Deps (List.concat [all_libs;all_other_modules])
in in
let jsoo_link = SC.resolve_program sctx ~hint:install_jsoo_hint "jsoo_link" in let jsoo_link = SC.resolve_program sctx ~hint:install_jsoo_hint "jsoo_link" in
Build.run ~context:(SC.context sctx) ~dir SC.add_rule sctx ~targets:[target]
jsoo_link (Build.fanout requires top_closed_cm_files
[ Arg_spec.A "-o"; Target target >>>
; Arg_spec.Dep runtime Build.run ~context:(SC.context sctx) ~dir
; Arg_spec.As (sourcemap ()) jsoo_link
; Arg_spec.Dyn get_all [ 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 = let build_cm sctx ~dir ~js_of_ocaml ~src =
if separate_compilation_enabled () if separate_compilation_enabled () then begin
then let target = Path.extend_basename src ~suffix:".js" in let target = Path.extend_basename src ~suffix:".js" in
let spec = Arg_spec.Dep src in let spec = Arg_spec.Dep src in
let flags = let flags =
Ordered_set_lang.eval_with_standard Ordered_set_lang.eval_with_standard
js_of_ocaml.Jbuild_types.Js_of_ocaml.flags js_of_ocaml.Jbuild_types.Js_of_ocaml.flags
~standard:(standard ()) ~standard:(standard ())
in in
[ js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target ] js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target ~dep:(Build.return ())
else [] end
let setup_separate_compilation_rules sctx = let setup_separate_compilation_rules sctx =
if separate_compilation_enabled () if separate_compilation_enabled () then begin
then
let ctx = SC.context sctx in let ctx = SC.context sctx in
let all_pkg = let all_pkg =
List.map List.map
@ -117,28 +123,25 @@ let setup_separate_compilation_rules sctx =
let archives = Mode.Dict.get pkg.Findlib.archives Mode.Byte in let archives = Mode.Dict.get pkg.Findlib.archives Mode.Byte in
pkg.Findlib.name, pkg.dir, archives) pkg.Findlib.name, pkg.dir, archives)
in in
List.concat_map all_pkg List.iter all_pkg ~f:(fun (pkg_name, pkg_dir, archives) ->
~f:(fun (pkg_name,pkg_dir,archives) -> List.iter archives ~f:(fun name ->
List.map archives ~f:(fun name -> let src = Path.relative pkg_dir name in
let src = Path.relative pkg_dir name in let target = in_build_dir ~ctx [ pkg_name; sprintf "%s.js" 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 dir = in_build_dir ~ctx [ pkg_name ] in let spec = Arg_spec.Dep src in
let spec = Arg_spec.Dep src in let flags = standard () in
let flags = standard () in js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target ~dep:(Build.return ())))
js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target end
))
else []
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 {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 javascript_files = List.map javascript_files ~f:(Path.relative dir) in
let mk_target ext = Path.extend_basename src ~suffix:ext in let mk_target ext = Path.extend_basename src ~suffix:ext in
let target = mk_target ".js" in let target = mk_target ".js" in
let standalone_runtime = mk_target ".runtime.js" in let standalone_runtime = mk_target ".runtime.js" in
if separate_compilation_enabled () then if separate_compilation_enabled () then begin
[ link_rule ~sctx ~dir ~runtime:standalone_runtime ~target link_rule ~sctx ~dir ~runtime:standalone_runtime ~target ~requires ~top_closed_cm_files;
; standalone_runtime_rule ~sctx ~dir ~flags ~javascript_files standalone_runtime_rule ~sctx ~dir ~flags ~javascript_files
~target:standalone_runtime ~target:standalone_runtime ~requires
] end else
else exe_rule ~sctx ~dir ~flags ~javascript_files ~src ~target ~requires
[ exe_rule ~sctx ~dir ~flags ~javascript_files ~src ~target ]

10
src/js_of_ocaml_rules.mli
View File

@ -7,17 +7,17 @@ val build_cm
-> dir:Path.t -> dir:Path.t
-> js_of_ocaml:Js_of_ocaml.t -> js_of_ocaml:Js_of_ocaml.t
-> src:Path.t -> src:Path.t
-> (unit, Action.t) Build.t list -> unit
val build_exe val build_exe
: Super_context.t : Super_context.t
-> dir:Path.t -> dir:Path.t
-> js_of_ocaml:Js_of_ocaml.t -> js_of_ocaml:Js_of_ocaml.t
-> src:Path.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 val setup_separate_compilation_rules : Super_context.t -> unit
: Super_context.t
-> (unit, Action.t) Build.t list

7
src/merlin.ml
View File

@ -30,11 +30,12 @@ let dot_merlin sctx ~dir ({ requires; flags; _ } as t) =
match Path.extract_build_context dir with match Path.extract_build_context dir with
| Some (_, remaindir) -> | Some (_, remaindir) ->
let path = Path.relative remaindir ".merlin" in 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.path path
>>> >>>
Build.update_file (Path.relative dir ".merlin-exists") ""); Build.update_file merlin_exists "");
SC.add_rule sctx ( SC.add_rule sctx ~targets:[path] (
requires requires
>>^ (fun libs -> >>^ (fun libs ->
let ppx_flags = ppx_flags sctx ~dir ~src_dir:remaindir t in let ppx_flags = ppx_flags sctx ~dir ~src_dir:remaindir t in

7
src/module_compilation.ml
View File

@ -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 let fn = Option.value_exn (Module.cmt_file m ~dir ml_kind) in
(fn :: extra_targets, A "-bin-annot") (fn :: extra_targets, A "-bin-annot")
in in
SC.add_rule sctx ?sandbox SC.add_rule sctx ?sandbox ~targets:(dst :: extra_targets)
(Build.paths extra_deps >>> (Build.paths extra_deps >>>
other_cm_files >>> other_cm_files >>>
requires >>> requires >>>
Build.dyn_paths (Build.arr (lib_dependencies ~cm_kind)) >>> Build.dyn_paths (Build.arr (lib_dependencies ~cm_kind)) >>>
Build.run ~context:ctx (Dep compiler) Build.run ~context:ctx (Dep compiler)
~extra_targets
[ Ocaml_flags.get_for_cm flags ~cm_kind [ Ocaml_flags.get_for_cm flags ~cm_kind
; cmt_args ; cmt_args
; Dyn Lib.include_flags ; 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 ; (match alias_module with
| None -> S [] | None -> S []
| Some (m : Module.t) -> As ["-open"; m.name]) | 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 ; 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); ~alias_module);
(* Build *.cmo.js *) (* Build *.cmo.js *)
let src = Module.cm_file m ~dir Cm_kind.Cmo in 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 = let build_modules sctx ~dynlink ~js_of_ocaml ~flags ~dir ~dep_graph ~modules ~requires ~alias_module =
String_map.iter String_map.iter

2
src/ocamldep.ml
View File

@ -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) Path.relative dir (sprintf "%s.depends%s.ocamldep-output" item suffix)
in in
let ctx = SC.context sctx 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] (Build.run ~context:ctx (Dep ctx.ocamldep) [A "-modules"; S files]
~stdout_to:ocamldep_output); ~stdout_to:ocamldep_output);
Build.memoize ~name:(Path.to_string ocamldep_output) Build.memoize ~name:(Path.to_string ocamldep_output)

61
src/super_context.ml
View File

@ -153,8 +153,8 @@ let create
; ppx_dir = Path.of_string (sprintf "_build/.ppx/%s" context.name) ; ppx_dir = Path.of_string (sprintf "_build/.ppx/%s" context.name)
} }
let add_rule t ?sandbox build = let add_rule t ?sandbox ~targets build =
let rule = Build_interpret.Rule.make ?sandbox build in let rule = Build_interpret.Rule.make ?sandbox ~targets build in
t.rules <- rule :: t.rules; t.rules <- rule :: t.rules;
t.known_targets_by_src_dir_so_far <- t.known_targets_by_src_dir_so_far <-
Path.Set.fold rule.targets ~init: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 in
Path.Map.add acc ~key:dir ~data:files) 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_and_targets_known_so_far t ~src_path =
let sources = let sources =
match File_tree.find_dir t.file_tree src_path with 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 } -> 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 src = Path.relative dir src_fn in
let dst = Path.relative dir dst_fn in let dst = Path.relative dir dst_fn in
add_rule t add_rule t ~targets:[dst]
(Build.path src (Build.path src
>>> >>>
Build.action_context_independent ~targets:[dst] Build.action_context_independent
(Copy_and_add_line_directive (src, dst)))) (Copy_and_add_line_directive (src, dst))))
let write_deps fn = let write_deps fn =
@ -269,7 +266,7 @@ module Libs = struct
List.map (Preprocess_map.pps preprocess) ~f:Pp.to_string List.map (Preprocess_map.pps preprocess) ~f:Pp.to_string
in in
let requires_file = requires_file ~dir ~item 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.record_lib_deps ~dir ~kind:dep_kind (List.map virtual_deps ~f:Lib_dep.direct)
>>> >>>
Build.fanout Build.fanout
@ -280,7 +277,7 @@ module Libs = struct
Build.arr (fun (libs, rt_deps) -> Build.arr (fun (libs, rt_deps) ->
Lib.remove_dups_preserve_order (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 load_deps t ~dir requires_file
let requires t ~dir ~dep_kind ~item ~libraries ~preprocess ~virtual_deps = 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 setup_runtime_deps t ~dir ~dep_kind ~item ~libraries ~ppx_runtime_libraries =
let runtime_deps_file = runtime_deps_file ~dir ~item in let runtime_deps_file = runtime_deps_file ~dir ~item in
add_rule t add_rule t ~targets:[runtime_deps_file]
(Build.fanout (Build.fanout
(closure t ~dir ~dep_kind (List.map ppx_runtime_libraries ~f:Lib_dep.direct)) (closure t ~dir ~dep_kind (List.map ppx_runtime_libraries ~f:Lib_dep.direct))
(closed_ppx_runtime_deps_of t ~dir ~dep_kind libraries) (closed_ppx_runtime_deps_of t ~dir ~dep_kind libraries)
@ -366,7 +363,8 @@ module Pkg_version = struct
let set sctx p get = let set sctx p get =
let fn = spec_file sctx p in 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) Build.read_sexp fn Sexp.Of_sexp.(option string)
end end
@ -493,7 +491,7 @@ module Action = struct
U.expand sctx.context dir t U.expand sctx.context dir t
~f:(expand_var sctx ~artifacts ~targets ~deps)) ~f:(expand_var sctx ~artifacts ~targets ~deps))
>>> >>>
Build.action_dyn () ~context:sctx.context ~dir ~targets Build.action_dyn () ~context:sctx.context ~dir
in in
match forms.failures with match forms.failures with
| [] -> build | [] -> build
@ -582,13 +580,13 @@ module PP = struct
| Some _ -> | Some _ ->
libs libs
in in
add_rule sctx add_rule sctx ~targets:[target]
(libs (libs
>>> >>>
Build.dyn_paths (Build.arr (Lib.archive_files ~mode ~ext_lib:ctx.ext_lib)) Build.dyn_paths (Build.arr (Lib.archive_files ~mode ~ext_lib:ctx.ext_lib))
>>> >>>
Build.run ~context:ctx (Dep compiler) Build.run ~context:ctx (Dep compiler)
[ A "-o" ; Target target [ A "-o" ; Path target
; Dyn (Lib.link_flags ~mode) ; Dyn (Lib.link_flags ~mode)
]) ])
@ -626,32 +624,37 @@ module PP = struct
let setup_reason_rules sctx ~dir (m : Module.t) = let setup_reason_rules sctx ~dir (m : Module.t) =
let ctx = sctx.context in let ctx = sctx.context in
let refmt = resolve_program sctx "refmt" ~hint:"opam install reason" 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 let src_path = Path.relative dir src in
Build.run ~context:ctx refmt let target = Path.relative dir target in
[ A "--print" add_rule sctx ~targets:[target]
; A "binary" (Build.run ~context:ctx refmt
; Dep src_path ] [ A "--print"
~stdout_to:(Path.relative dir target) in ; A "binary"
; Dep src_path ]
~stdout_to:target)
in
let impl = let impl =
match m.impl.syntax with match m.impl.syntax with
| OCaml -> m.impl | OCaml -> m.impl
| Reason -> | Reason ->
let ml = Module.File.to_ocaml m.impl in let ml = Module.File.to_ocaml m.impl in
add_rule sctx (rule m.impl.name ml.name); refmt m.impl.name ml.name;
ml in ml
in
let intf = let intf =
Option.map m.intf ~f:(fun f -> Option.map m.intf ~f:(fun f ->
match f.syntax with match f.syntax with
| OCaml -> f | OCaml -> f
| Reason -> | Reason ->
let mli = Module.File.to_ocaml f in let mli = Module.File.to_ocaml f in
add_rule sctx (rule f.name mli.name); refmt f.name mli.name;
mli) in mli)
in
{ m with impl ; intf } { m with impl ; intf }
(* Generate rules to build the .pp files and return a new module map where all filenames (* Generate rules to build the .pp files and return a new module map
point to the .pp files *) where all filenames point to the .pp files *)
let pped_modules sctx ~dir ~dep_kind ~modules ~preprocess ~preprocessor_deps ~lib_name let pped_modules sctx ~dir ~dep_kind ~modules ~preprocess ~preprocessor_deps ~lib_name
~package_context = ~package_context =
let preprocessor_deps = Deps.interpret sctx ~dir preprocessor_deps in let preprocessor_deps = Deps.interpret sctx ~dir preprocessor_deps in
@ -661,7 +664,7 @@ module PP = struct
| No_preprocessing -> m | No_preprocessing -> m
| Action action -> | Action action ->
pped_module m ~dir ~f:(fun _kind src dst -> pped_module m ~dir ~f:(fun _kind src dst ->
add_rule sctx add_rule sctx ~targets:[dst]
(preprocessor_deps (preprocessor_deps
>>> >>>
Build.path src Build.path src
@ -680,7 +683,7 @@ module PP = struct
| Pps { pps; flags } -> | Pps { pps; flags } ->
let ppx_exe = get_ppx_driver sctx pps ~dir ~dep_kind in let ppx_exe = get_ppx_driver sctx pps ~dir ~dep_kind in
pped_module m ~dir ~f:(fun kind src dst -> pped_module m ~dir ~f:(fun kind src dst ->
add_rule sctx add_rule sctx ~targets:[dst]
(preprocessor_deps (preprocessor_deps
>>> >>>
Build.run ~context:sctx.context Build.run ~context:sctx.context
@ -688,7 +691,7 @@ module PP = struct
[ As flags [ As flags
; A "--dump-ast" ; A "--dump-ast"
; As (cookie_library_name lib_name) ; As (cookie_library_name lib_name)
; A "-o"; Target dst ; A "-o"; Path dst
; Ml_kind.ppx_driver_flag kind; Dep src ; Ml_kind.ppx_driver_flag kind; Dep src
]) ])
) )

3
src/super_context.mli
View File

@ -42,8 +42,7 @@ val cxx_flags : t -> string list
val expand_var_no_root : t -> string -> string option val expand_var_no_root : t -> string -> string option
val expand_vars : t -> dir:Path.t -> String_with_vars.t -> string 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_rule : t -> ?sandbox:bool -> targets:Path.t list -> (unit, Action.t) Build.t -> unit
val add_rules : t -> ?sandbox:bool -> (unit, Action.t) Build.t list -> unit
val rules : t -> Build_interpret.Rule.t list val rules : t -> Build_interpret.Rule.t list
val sources_and_targets_known_so_far : t -> src_path:Path.t -> String_set.t val sources_and_targets_known_so_far : t -> src_path:Path.t -> String_set.t