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 ->
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

10
src/arg_spec.ml
View File

@ -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

6
src/arg_spec.mli
View File

@ -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

65
src/build.ml
View File

@ -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]
})
(*
{[

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
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

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 ->
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

6
src/build_interpret.mli
View File

@ -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

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 ->
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))

109
src/gen_rules.ml
View File

@ -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

99
src/js_of_ocaml_rules.ml
View File

@ -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

10
src/js_of_ocaml_rules.mli
View File

@ -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

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
| 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

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
(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

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)
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)

61
src/super_context.ml
View File

@ -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
])
)

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_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