Revert some changes:
- Make targets explicitb7ad08df84
. - Get rid of Vfilee73fd90b65
. Without vfile we need some new concepts to avoid parsing the requires file multiple times and with vfile it's annoying to specify the dependencies by hand. Will leave that for future work. Just use memoize where it make sense, for instance when we read the result from only the current directory (for instance the ocamldep stuff).
This commit is contained in:
parent
5adfe2d668
commit
648b2b2990
|
@ -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 ~targets:[alias.file]
|
Build_interpret.Rule.make
|
||||||
(Build.path_set deps >>>
|
(Build.path_set deps >>>
|
||||||
Build.create_file alias.file)
|
Build.create_file alias.file)
|
||||||
in
|
in
|
||||||
|
|
|
@ -10,6 +10,7 @@ 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)
|
||||||
|
@ -26,6 +27,13 @@ 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
|
||||||
|
@ -49,6 +57,7 @@ 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
|
||||||
|
@ -59,6 +68,7 @@ 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
|
||||||
|
|
|
@ -8,10 +8,12 @@ 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
|
||||||
|
|
||||||
|
|
82
src/build.ml
82
src/build.ml
|
@ -2,6 +2,10 @@ open Import
|
||||||
|
|
||||||
module Pset = Path.Set
|
module Pset = Path.Set
|
||||||
|
|
||||||
|
module Vspec = struct
|
||||||
|
type 'a t = T : Path.t * 'a Vfile_kind.t -> 'a t
|
||||||
|
end
|
||||||
|
|
||||||
module Prog_spec = struct
|
module Prog_spec = struct
|
||||||
type 'a t =
|
type 'a t =
|
||||||
| Dep of Path.t
|
| Dep of Path.t
|
||||||
|
@ -21,6 +25,8 @@ 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.t list -> ('a, 'a) t
|
||||||
|
| Store_vfile : 'a Vspec.t -> ('a, Action.t) 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
|
||||||
|
@ -32,6 +38,7 @@ module Repr = struct
|
||||||
| If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
|
| If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
|
||||||
| Contents : Path.t -> ('a, string) t
|
| Contents : Path.t -> ('a, string) t
|
||||||
| Lines_of : Path.t -> ('a, string list) t
|
| Lines_of : Path.t -> ('a, string list) t
|
||||||
|
| Vpath : 'a Vspec.t -> (unit, 'a) t
|
||||||
| Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
|
| Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
|
||||||
| Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
|
| Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
|
||||||
| Fail : fail -> (_, _) t
|
| Fail : fail -> (_, _) t
|
||||||
|
@ -118,6 +125,7 @@ let path p = Paths (Pset.singleton p)
|
||||||
let paths ps = Paths (Pset.of_list ps)
|
let paths ps = Paths (Pset.of_list ps)
|
||||||
let path_set ps = Paths ps
|
let path_set ps = Paths ps
|
||||||
let paths_glob ~dir re = Paths_glob (dir, re)
|
let paths_glob ~dir re = Paths_glob (dir, re)
|
||||||
|
let vpath vp = Vpath vp
|
||||||
let dyn_paths t = Dyn_paths t
|
let dyn_paths t = Dyn_paths t
|
||||||
|
|
||||||
let contents p = Contents p
|
let contents p = Contents p
|
||||||
|
@ -136,24 +144,14 @@ 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 x = Fail x
|
let fail ?targets x =
|
||||||
|
match targets with
|
||||||
|
| None -> Fail x
|
||||||
|
| Some l -> Targets l >>> Fail x
|
||||||
|
|
||||||
let memoize ~name t =
|
let memoize name t =
|
||||||
Memo { name; t; state = Unevaluated }
|
Memo { name; t; state = Unevaluated }
|
||||||
|
|
||||||
let read_sexp path of_sexp =
|
|
||||||
memoize ~name:(Path.to_string path)
|
|
||||||
(contents path
|
|
||||||
>>^ fun s ->
|
|
||||||
let lb = Lexing.from_string s in
|
|
||||||
lb.lex_curr_p <-
|
|
||||||
{ pos_fname = Path.to_string path
|
|
||||||
; pos_lnum = 1
|
|
||||||
; pos_bol = 0
|
|
||||||
; pos_cnum = 0
|
|
||||||
};
|
|
||||||
of_sexp (Sexp_lexer.single lb))
|
|
||||||
|
|
||||||
let files_recursively_in ~dir ~file_tree =
|
let files_recursively_in ~dir ~file_tree =
|
||||||
let prefix_with, dir =
|
let prefix_with, dir =
|
||||||
match Path.extract_build_context_dir dir with
|
match Path.extract_build_context_dir dir with
|
||||||
|
@ -162,6 +160,8 @@ let files_recursively_in ~dir ~file_tree =
|
||||||
in
|
in
|
||||||
path_set (File_tree.files_recursively_in file_tree dir ~prefix_with)
|
path_set (File_tree.files_recursively_in file_tree dir ~prefix_with)
|
||||||
|
|
||||||
|
let store_vfile spec = Store_vfile spec
|
||||||
|
|
||||||
let get_prog (prog : _ Prog_spec.t) =
|
let get_prog (prog : _ Prog_spec.t) =
|
||||||
match prog with
|
match prog with
|
||||||
| Dep p -> path p >>> arr (fun _ -> p)
|
| Dep p -> path p >>> arr (fun _ -> p)
|
||||||
|
@ -177,9 +177,17 @@ let prog_and_args ~dir prog args =
|
||||||
>>>
|
>>>
|
||||||
arr fst))
|
arr fst))
|
||||||
|
|
||||||
let run ~context ?(dir=context.Context.build_dir) ?stdout_to
|
let run ~context ?(dir=context.Context.build_dir) ?stdout_to ?(extra_targets=[])
|
||||||
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 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 =
|
||||||
|
@ -193,48 +201,50 @@ let run ~context ?(dir=context.Context.build_dir) ?stdout_to
|
||||||
; action
|
; action
|
||||||
})
|
})
|
||||||
|
|
||||||
let action ~context ?(dir=context.Context.build_dir) action =
|
let action ~context ?(dir=context.Context.build_dir) ~targets action =
|
||||||
return { Action. context = Some context; dir; action }
|
Targets targets
|
||||||
|
>>^ fun () ->
|
||||||
|
{ Action. context = Some context; dir; action }
|
||||||
|
|
||||||
let action_dyn ~context ?(dir=context.Context.build_dir) () =
|
let action_dyn ~context ?(dir=context.Context.build_dir) ~targets () =
|
||||||
arr (fun action ->
|
Targets targets
|
||||||
{ Action. context = Some context; dir; action })
|
>>^ fun action ->
|
||||||
|
{ Action. context = Some context; dir; action }
|
||||||
|
|
||||||
let action_context_independent ?(dir=Path.root) action =
|
let action_context_independent ?(dir=Path.root) ~targets action =
|
||||||
return { Action. context = None; dir; action }
|
Targets targets
|
||||||
|
>>^ fun () ->
|
||||||
|
{ Action. context = None; dir; action }
|
||||||
|
|
||||||
let update_file fn s =
|
let update_file fn s =
|
||||||
action_context_independent (Update_file (fn, s))
|
action_context_independent ~targets:[fn] (Update_file (fn, s))
|
||||||
|
|
||||||
let update_file_dyn fn =
|
let update_file_dyn fn =
|
||||||
arr (fun s ->
|
Targets [fn]
|
||||||
|
>>^ 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 =
|
|
||||||
arr (fun x -> Sexp.to_string (to_sexp x))
|
|
||||||
>>>
|
|
||||||
update_file_dyn path
|
|
||||||
|
|
||||||
let copy ~src ~dst =
|
let copy ~src ~dst =
|
||||||
path src >>>
|
path src >>>
|
||||||
action_context_independent (Copy (src, dst))
|
action_context_independent ~targets:[dst] (Copy (src, dst))
|
||||||
|
|
||||||
let symlink ~src ~dst =
|
let symlink ~src ~dst =
|
||||||
path src >>>
|
path src >>>
|
||||||
action_context_independent (Symlink (src, dst))
|
action_context_independent ~targets:[dst] (Symlink (src, dst))
|
||||||
|
|
||||||
let create_file fn =
|
let create_file fn =
|
||||||
action_context_independent (Create_file fn)
|
action_context_independent ~targets:[fn] (Create_file fn)
|
||||||
|
|
||||||
let and_create_file fn =
|
let and_create_file fn =
|
||||||
arr (fun (action : Action.t) ->
|
Targets [fn]
|
||||||
|
>>^ fun (action : Action.t) ->
|
||||||
{ action with
|
{ action with
|
||||||
action = Progn [action.action; Create_file fn]
|
action = Progn [action.action; Create_file fn]
|
||||||
})
|
}
|
||||||
|
|
||||||
(*
|
(*
|
||||||
{[
|
{[
|
||||||
|
|
|
@ -8,6 +8,12 @@ val arr : ('a -> 'b) -> ('a, 'b) t
|
||||||
|
|
||||||
val return : 'a -> (unit, 'a) t
|
val return : 'a -> (unit, 'a) t
|
||||||
|
|
||||||
|
module Vspec : sig
|
||||||
|
type 'a t = T : Path.t * 'a Vfile_kind.t -> 'a t
|
||||||
|
end
|
||||||
|
|
||||||
|
val store_vfile : 'a Vspec.t -> ('a, Action.t) t
|
||||||
|
|
||||||
module O : sig
|
module O : sig
|
||||||
val ( >>> ) : ('a, 'b) t -> ('b, 'c) t -> ('a, 'c) t
|
val ( >>> ) : ('a, 'b) t -> ('b, 'c) t -> ('a, 'c) t
|
||||||
val ( ^>> ) : ('a -> 'b) -> ('b, 'c) t -> ('a, 'c) t
|
val ( ^>> ) : ('a -> 'b) -> ('b, 'c) t -> ('a, 'c) t
|
||||||
|
@ -32,9 +38,7 @@ val paths : Path.t list -> ('a, 'a) t
|
||||||
val path_set : Path.Set.t -> ('a, 'a) t
|
val path_set : Path.Set.t -> ('a, 'a) t
|
||||||
val paths_glob : dir:Path.t -> Re.re -> ('a, 'a) t
|
val paths_glob : dir:Path.t -> Re.re -> ('a, 'a) t
|
||||||
val files_recursively_in : dir:Path.t -> file_tree:File_tree.t -> ('a, 'a) t
|
val files_recursively_in : dir:Path.t -> file_tree:File_tree.t -> ('a, 'a) t
|
||||||
|
val vpath : 'a Vspec.t -> (unit, 'a) t
|
||||||
val read_sexp : Path.t -> 'a Sexp.Of_sexp.t -> (unit, 'a) t
|
|
||||||
val write_sexp : Path.t -> 'a Sexp.To_sexp.t -> ('a, Action.t) t
|
|
||||||
|
|
||||||
val dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
|
val dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
|
||||||
|
|
||||||
|
@ -59,11 +63,11 @@ 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 : fail -> (_, _) t
|
val fail : ?targets:Path.t list -> 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. *)
|
||||||
val memoize : name:string -> (unit, 'a) t -> (unit, 'a) t
|
val memoize : string -> (unit, 'a) t -> (unit, 'a) t
|
||||||
|
|
||||||
module Prog_spec : sig
|
module Prog_spec : sig
|
||||||
type 'a t =
|
type 'a t =
|
||||||
|
@ -75,6 +79,7 @@ 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
|
||||||
|
@ -82,17 +87,20 @@ 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
|
||||||
|
|
||||||
|
@ -129,6 +137,8 @@ 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.t list -> ('a, 'a) t
|
||||||
|
| Store_vfile : 'a Vspec.t -> ('a, Action.t) 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
|
||||||
|
@ -139,6 +149,7 @@ module Repr : sig
|
||||||
| If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
|
| If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
|
||||||
| Contents : Path.t -> ('a, string) t
|
| Contents : Path.t -> ('a, string) t
|
||||||
| Lines_of : Path.t -> ('a, string list) t
|
| Lines_of : Path.t -> ('a, string list) t
|
||||||
|
| Vpath : 'a Vspec.t -> (unit, 'a) t
|
||||||
| Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
|
| Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
|
||||||
| Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
|
| Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
|
||||||
| Fail : fail -> (_, _) t
|
| Fail : fail -> (_, _) t
|
||||||
|
|
|
@ -3,11 +3,28 @@ open Build.Repr
|
||||||
|
|
||||||
module Pset = Path.Set
|
module Pset = Path.Set
|
||||||
module Pmap = Path.Map
|
module Pmap = Path.Map
|
||||||
|
module Vspec = Build.Vspec
|
||||||
|
|
||||||
|
module Target = struct
|
||||||
|
type t =
|
||||||
|
| Normal of Path.t
|
||||||
|
| Vfile : _ Vspec.t -> t
|
||||||
|
|
||||||
|
let path = function
|
||||||
|
| Normal p -> p
|
||||||
|
| Vfile (Vspec.T (p, _)) -> p
|
||||||
|
|
||||||
|
let paths ts =
|
||||||
|
List.fold_left ts ~init:Pset.empty ~f:(fun acc t ->
|
||||||
|
Pset.add (path t) acc)
|
||||||
|
end
|
||||||
|
|
||||||
let rule_deps t ~all_targets_by_dir =
|
let rule_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
|
||||||
|
| Store_vfile _ -> 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
|
||||||
|
@ -33,6 +50,7 @@ let rule_deps t ~all_targets_by_dir =
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
| Dyn_paths t -> loop t acc
|
| Dyn_paths t -> loop t acc
|
||||||
|
| Vpath (Vspec.T (p, _)) -> Pset.add p acc
|
||||||
| Contents p -> Pset.add p acc
|
| Contents p -> Pset.add p acc
|
||||||
| Lines_of p -> Pset.add p acc
|
| Lines_of p -> Pset.add p acc
|
||||||
| Record_lib_deps _ -> acc
|
| Record_lib_deps _ -> acc
|
||||||
|
@ -45,6 +63,7 @@ let static_action_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
|
||||||
|
@ -59,6 +78,7 @@ let static_action_deps t ~all_targets_by_dir =
|
||||||
Re.execp re (Path.basename path))
|
Re.execp re (Path.basename path))
|
||||||
|> Pset.union acc
|
|> Pset.union acc
|
||||||
end
|
end
|
||||||
|
| Vpath _ -> acc
|
||||||
| If_file_exists (_, state) -> loop (get_if_file_exists_exn state) acc
|
| If_file_exists (_, state) -> loop (get_if_file_exists_exn state) acc
|
||||||
| Dyn_paths t -> loop t acc
|
| Dyn_paths t -> loop t acc
|
||||||
| Contents _ -> acc
|
| Contents _ -> acc
|
||||||
|
@ -66,6 +86,7 @@ let static_action_deps t ~all_targets_by_dir =
|
||||||
| Record_lib_deps _ -> acc
|
| Record_lib_deps _ -> acc
|
||||||
| Fail _ -> acc
|
| Fail _ -> acc
|
||||||
| Memo m -> loop m.t acc
|
| Memo m -> loop m.t acc
|
||||||
|
| Store_vfile _ -> acc
|
||||||
in
|
in
|
||||||
loop (Build.repr t) Pset.empty
|
loop (Build.repr t) Pset.empty
|
||||||
|
|
||||||
|
@ -74,12 +95,15 @@ let lib_deps =
|
||||||
= fun t acc ->
|
= fun t acc ->
|
||||||
match t with
|
match t with
|
||||||
| Arr _ -> acc
|
| Arr _ -> acc
|
||||||
|
| Targets _ -> acc
|
||||||
|
| Store_vfile _ -> 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
|
||||||
| Split (a, b) -> loop a (loop b acc)
|
| Split (a, b) -> loop a (loop b acc)
|
||||||
| Fanout (a, b) -> loop a (loop b acc)
|
| Fanout (a, b) -> loop a (loop b acc)
|
||||||
| Paths _ -> acc
|
| Paths _ -> acc
|
||||||
|
| Vpath _ -> acc
|
||||||
| Paths_glob _ -> acc
|
| Paths_glob _ -> acc
|
||||||
| Dyn_paths t -> loop t acc
|
| Dyn_paths t -> loop t acc
|
||||||
| Contents _ -> acc
|
| Contents _ -> acc
|
||||||
|
@ -98,16 +122,50 @@ 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 -> Target.t list -> Target.t list = fun t acc ->
|
||||||
|
match t with
|
||||||
|
| Arr _ -> acc
|
||||||
|
| Targets targets ->
|
||||||
|
List.fold_left targets ~init:acc ~f:(fun acc fn -> Target.Normal fn :: acc)
|
||||||
|
| Store_vfile spec -> Vfile spec :: acc
|
||||||
|
| 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
|
||||||
|
| Vpath _ -> 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) ->
|
||||||
|
match loop a [], loop b [] with
|
||||||
|
| [], [] -> acc
|
||||||
|
| _ ->
|
||||||
|
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) []
|
||||||
|
|
||||||
module Rule = struct
|
module Rule = struct
|
||||||
type t =
|
type t =
|
||||||
{ build : (unit, Action.t) Build.t
|
{ build : (unit, Action.t) Build.t
|
||||||
; targets : Path.Set.t
|
; targets : Target.t list
|
||||||
; sandbox : bool
|
; sandbox : bool
|
||||||
}
|
}
|
||||||
|
|
||||||
let make ?(sandbox=false) ~targets build =
|
let make ?(sandbox=false) build =
|
||||||
{ build
|
{ build
|
||||||
; targets = Path.Set.of_list targets
|
; targets = targets build
|
||||||
; sandbox
|
; sandbox
|
||||||
}
|
}
|
||||||
end
|
end
|
||||||
|
|
|
@ -1,13 +1,22 @@
|
||||||
open! Import
|
open! Import
|
||||||
|
|
||||||
|
module Target : sig
|
||||||
|
type t =
|
||||||
|
| Normal of Path.t
|
||||||
|
| Vfile : _ Build.Vspec.t -> t
|
||||||
|
|
||||||
|
val path : t -> Path.t
|
||||||
|
val paths : t list -> Path.Set.t
|
||||||
|
end
|
||||||
|
|
||||||
module Rule : sig
|
module Rule : sig
|
||||||
type t =
|
type t =
|
||||||
{ build : (unit, Action.t) Build.t
|
{ build : (unit, Action.t) Build.t
|
||||||
; targets : Path.Set.t
|
; targets : Target.t list
|
||||||
; sandbox : bool
|
; sandbox : bool
|
||||||
}
|
}
|
||||||
|
|
||||||
val make : ?sandbox:bool -> targets:Path.t list -> (unit, Action.t) Build.t -> t
|
val make : ?sandbox:bool -> (unit, Action.t) Build.t -> t
|
||||||
end
|
end
|
||||||
|
|
||||||
(* must be called first *)
|
(* must be called first *)
|
||||||
|
@ -24,3 +33,7 @@ val static_action_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
|
||||||
|
-> Target.t list
|
||||||
|
|
|
@ -3,6 +3,7 @@ open Future
|
||||||
|
|
||||||
module Pset = Path.Set
|
module Pset = Path.Set
|
||||||
module Pmap = Path.Map
|
module Pmap = Path.Map
|
||||||
|
module Vspec = Build.Vspec
|
||||||
|
|
||||||
module Exec_status = struct
|
module Exec_status = struct
|
||||||
module Starting = struct
|
module Starting = struct
|
||||||
|
@ -27,9 +28,36 @@ module Rule = struct
|
||||||
}
|
}
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module File_kind = struct
|
||||||
|
type 'a t =
|
||||||
|
| Ignore_contents : unit t
|
||||||
|
| Sexp_file : 'a Vfile_kind.t -> 'a t
|
||||||
|
|
||||||
|
let eq : type a b. a t -> b t -> (a, b) eq option = fun a b ->
|
||||||
|
match a, b with
|
||||||
|
| Ignore_contents, Ignore_contents -> Some Eq
|
||||||
|
| Sexp_file a , Sexp_file b -> Vfile_kind.eq a b
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let eq_exn a b = Option.value_exn (eq a b)
|
||||||
|
end
|
||||||
|
|
||||||
|
module File_spec = struct
|
||||||
|
type 'a t =
|
||||||
|
{ rule : Rule.t (* Rule which produces it *)
|
||||||
|
; mutable kind : 'a File_kind.t
|
||||||
|
; mutable data : 'a option
|
||||||
|
}
|
||||||
|
|
||||||
|
type packed = T : _ t -> packed
|
||||||
|
|
||||||
|
let create rule kind =
|
||||||
|
T { rule; kind; data = None }
|
||||||
|
end
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ (* File specification by targets *)
|
{ (* File specification by targets *)
|
||||||
files : (Path.t, Rule.t) Hashtbl.t
|
files : (Path.t, File_spec.packed) Hashtbl.t
|
||||||
; contexts : Context.t list
|
; contexts : Context.t list
|
||||||
; (* Table from target to digest of [(deps, targets, action)] *)
|
; (* Table from target to digest of [(deps, targets, action)] *)
|
||||||
trace : (Path.t, Digest.t) Hashtbl.t
|
trace : (Path.t, Digest.t) Hashtbl.t
|
||||||
|
@ -106,8 +134,8 @@ module Build_error = struct
|
||||||
let rec build_path acc targeting ~seen =
|
let rec build_path acc targeting ~seen =
|
||||||
assert (not (Pset.mem targeting seen));
|
assert (not (Pset.mem targeting seen));
|
||||||
let seen = Pset.add targeting seen in
|
let seen = Pset.add targeting seen in
|
||||||
let rule = find_file_exn t targeting in
|
let (File_spec.T file) = find_file_exn t targeting in
|
||||||
match rule.exec with
|
match file.rule.exec with
|
||||||
| Not_started _ -> assert false
|
| Not_started _ -> assert false
|
||||||
| Running { for_file; _ } | Starting { for_file } ->
|
| Running { for_file; _ } | Starting { for_file } ->
|
||||||
if for_file = targeting then
|
if for_file = targeting then
|
||||||
|
@ -128,10 +156,10 @@ let wait_for_file t fn ~targeting =
|
||||||
return ()
|
return ()
|
||||||
else
|
else
|
||||||
die "file unavailable: %s" (Path.to_string fn)
|
die "file unavailable: %s" (Path.to_string fn)
|
||||||
| Some rule ->
|
| Some (File_spec.T file) ->
|
||||||
match rule.exec with
|
match file.rule.exec with
|
||||||
| Not_started f ->
|
| Not_started f ->
|
||||||
rule.exec <- Starting { for_file = targeting };
|
file.rule.exec <- Starting { for_file = targeting };
|
||||||
let future =
|
let future =
|
||||||
with_exn_handler (fun () -> f ~targeting:fn)
|
with_exn_handler (fun () -> f ~targeting:fn)
|
||||||
~handler:(fun exn backtrace ->
|
~handler:(fun exn backtrace ->
|
||||||
|
@ -139,7 +167,7 @@ let wait_for_file t fn ~targeting =
|
||||||
| Build_error.E _ -> reraise exn
|
| Build_error.E _ -> reraise exn
|
||||||
| exn -> Build_error.raise t exn ~targeting:fn ~backtrace)
|
| exn -> Build_error.raise t exn ~targeting:fn ~backtrace)
|
||||||
in
|
in
|
||||||
rule.exec <- Running { for_file = targeting; future };
|
file.rule.exec <- Running { for_file = targeting; future };
|
||||||
future
|
future
|
||||||
| Running { future; _ } -> future
|
| Running { future; _ } -> future
|
||||||
| Starting _ ->
|
| Starting _ ->
|
||||||
|
@ -149,8 +177,8 @@ let wait_for_file t fn ~targeting =
|
||||||
if fn = targeting then
|
if fn = targeting then
|
||||||
acc
|
acc
|
||||||
else
|
else
|
||||||
let rule = find_file_exn t targeting in
|
let (File_spec.T file) = find_file_exn t targeting in
|
||||||
match rule.exec with
|
match file.rule.exec with
|
||||||
| Not_started _ | Running _ -> assert false
|
| Not_started _ | Running _ -> assert false
|
||||||
| Starting { for_file } ->
|
| Starting { for_file } ->
|
||||||
build_loop acc for_file
|
build_loop acc for_file
|
||||||
|
@ -160,15 +188,37 @@ let wait_for_file t fn ~targeting =
|
||||||
(String.concat ~sep:"\n--> "
|
(String.concat ~sep:"\n--> "
|
||||||
(List.map loop ~f:Path.to_string))
|
(List.map loop ~f:Path.to_string))
|
||||||
|
|
||||||
|
module Target = Build_interpret.Target
|
||||||
|
|
||||||
|
let get_file : type a. t -> Path.t -> a File_kind.t -> a File_spec.t = fun t fn kind ->
|
||||||
|
match Hashtbl.find t.files fn with
|
||||||
|
| None -> die "no rule found for %s" (Path.to_string fn)
|
||||||
|
| Some (File_spec.T file) ->
|
||||||
|
let Eq = File_kind.eq_exn kind file.kind in
|
||||||
|
file
|
||||||
|
|
||||||
|
let vfile_to_string (type a) (module K : Vfile_kind.S with type t = a) fn x =
|
||||||
|
K.to_string fn x
|
||||||
|
|
||||||
module Build_exec = struct
|
module Build_exec = struct
|
||||||
open Build.Repr
|
open Build.Repr
|
||||||
|
|
||||||
let exec t x =
|
let exec bs t x =
|
||||||
let dyn_deps = ref Pset.empty in
|
let dyn_deps = ref Pset.empty in
|
||||||
let rec exec
|
let rec exec
|
||||||
: 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
|
||||||
|
| Store_vfile (Vspec.T (fn, kind)) ->
|
||||||
|
let file = get_file bs fn (Sexp_file kind) in
|
||||||
|
assert (file.data = None);
|
||||||
|
file.data <- Some x;
|
||||||
|
{ Action.
|
||||||
|
context = None
|
||||||
|
; dir = Path.root
|
||||||
|
; action = Update_file (fn, vfile_to_string kind fn x)
|
||||||
|
}
|
||||||
| Compose (a, b) ->
|
| Compose (a, b) ->
|
||||||
exec a x |> exec b
|
exec a x |> exec b
|
||||||
| First t ->
|
| First t ->
|
||||||
|
@ -190,6 +240,9 @@ module Build_exec = struct
|
||||||
| Paths_glob _ -> x
|
| Paths_glob _ -> x
|
||||||
| Contents p -> read_file (Path.to_string p)
|
| Contents p -> read_file (Path.to_string p)
|
||||||
| Lines_of p -> lines_of_file (Path.to_string p)
|
| Lines_of p -> lines_of_file (Path.to_string p)
|
||||||
|
| Vpath (Vspec.T (fn, kind)) ->
|
||||||
|
let file : b File_spec.t = get_file bs fn (Sexp_file kind) in
|
||||||
|
Option.value_exn file.data
|
||||||
| Dyn_paths t ->
|
| Dyn_paths t ->
|
||||||
let fns = exec t x in
|
let fns = exec t x in
|
||||||
dyn_deps := Pset.union !dyn_deps (Pset.of_list fns);
|
dyn_deps := Pset.union !dyn_deps (Pset.of_list fns);
|
||||||
|
@ -213,13 +266,17 @@ module Build_exec = struct
|
||||||
(action, !dyn_deps)
|
(action, !dyn_deps)
|
||||||
end
|
end
|
||||||
|
|
||||||
let add_rule t fn rule ~allow_override =
|
let add_spec t fn spec ~allow_override =
|
||||||
if not allow_override && Hashtbl.mem t.files fn then
|
if not allow_override && Hashtbl.mem t.files fn then
|
||||||
die "multiple rules generated for %s" (Path.to_string fn);
|
die "multiple rules generated for %s" (Path.to_string fn);
|
||||||
Hashtbl.add t.files ~key:fn ~data:rule
|
Hashtbl.add t.files ~key:fn ~data:spec
|
||||||
|
|
||||||
let create_file_rules t targets rule ~allow_override =
|
let create_file_specs t targets rule ~allow_override =
|
||||||
Pset.iter targets ~f:(fun fn -> add_rule t fn rule ~allow_override)
|
List.iter targets ~f:(function
|
||||||
|
| Target.Normal fn ->
|
||||||
|
add_spec t fn (File_spec.create rule Ignore_contents) ~allow_override
|
||||||
|
| Target.Vfile (Vspec.T (fn, kind)) ->
|
||||||
|
add_spec t fn (File_spec.create rule (Sexp_file kind)) ~allow_override)
|
||||||
|
|
||||||
module Pre_rule = Build_interpret.Rule
|
module Pre_rule = Build_interpret.Rule
|
||||||
|
|
||||||
|
@ -276,7 +333,8 @@ let make_local_parent_dirs t paths ~map_path =
|
||||||
let sandbox_dir = Path.of_string "_build/.sandbox"
|
let sandbox_dir = Path.of_string "_build/.sandbox"
|
||||||
|
|
||||||
let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
|
let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
|
||||||
let { Pre_rule. build; targets; sandbox } = pre_rule in
|
let { Pre_rule. build; targets = target_specs; sandbox } = pre_rule in
|
||||||
|
let targets = Target.paths target_specs in
|
||||||
let rule_deps = Build_interpret.rule_deps build ~all_targets_by_dir in
|
let rule_deps = Build_interpret.rule_deps build ~all_targets_by_dir in
|
||||||
let static_deps = Build_interpret.static_action_deps build ~all_targets_by_dir in
|
let static_deps = Build_interpret.static_action_deps build ~all_targets_by_dir in
|
||||||
|
|
||||||
|
@ -310,7 +368,7 @@ let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
|
||||||
(wait_for_deps t static_deps ~targeting)
|
(wait_for_deps t static_deps ~targeting)
|
||||||
(wait_for_deps t rule_deps ~targeting
|
(wait_for_deps t rule_deps ~targeting
|
||||||
>>= fun () ->
|
>>= fun () ->
|
||||||
let action, dyn_deps = Build_exec.exec build () in
|
let action, dyn_deps = Build_exec.exec t build () in
|
||||||
wait_for_deps t ~targeting (Pset.diff dyn_deps static_deps)
|
wait_for_deps t ~targeting (Pset.diff dyn_deps static_deps)
|
||||||
>>| fun () ->
|
>>| fun () ->
|
||||||
(action, dyn_deps))
|
(action, dyn_deps))
|
||||||
|
@ -421,7 +479,7 @@ let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
|
||||||
; exec
|
; exec
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
create_file_rules t targets rule ~allow_override
|
create_file_specs t target_specs rule ~allow_override
|
||||||
|
|
||||||
let setup_copy_rules t ~all_non_target_source_files ~all_targets_by_dir =
|
let setup_copy_rules t ~all_non_target_source_files ~all_targets_by_dir =
|
||||||
List.iter t.contexts ~f:(fun (ctx : Context.t) ->
|
List.iter t.contexts ~f:(fun (ctx : Context.t) ->
|
||||||
|
@ -440,7 +498,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 ~targets:[ctx_path])
|
compile_rule t (Pre_rule.make build)
|
||||||
~all_targets_by_dir
|
~all_targets_by_dir
|
||||||
~allow_override:true))
|
~allow_override:true))
|
||||||
|
|
||||||
|
@ -494,7 +552,8 @@ let create ~contexts ~file_tree ~rules =
|
||||||
in
|
in
|
||||||
let all_other_targets =
|
let all_other_targets =
|
||||||
List.fold_left rules ~init:Pset.empty ~f:(fun acc { Pre_rule.targets; _ } ->
|
List.fold_left rules ~init:Pset.empty ~f:(fun acc { Pre_rule.targets; _ } ->
|
||||||
Pset.union acc targets)
|
List.fold_left targets ~init:acc ~f:(fun acc target ->
|
||||||
|
Pset.add (Target.path target) acc))
|
||||||
in
|
in
|
||||||
let all_targets_by_dir = lazy (
|
let all_targets_by_dir = lazy (
|
||||||
Pset.elements (Pset.union all_copy_targets all_other_targets)
|
Pset.elements (Pset.union all_copy_targets all_other_targets)
|
||||||
|
@ -566,7 +625,7 @@ let rules_for_files t paths =
|
||||||
List.filter_map paths ~f:(fun path ->
|
List.filter_map paths ~f:(fun path ->
|
||||||
match Hashtbl.find t.files path with
|
match Hashtbl.find t.files path with
|
||||||
| None -> None
|
| None -> None
|
||||||
| Some rule -> Some (path, rule))
|
| Some (File_spec.T { rule; _ }) -> Some (path, rule))
|
||||||
|
|
||||||
module File_closure =
|
module File_closure =
|
||||||
Top_closure.Make(Path)
|
Top_closure.Make(Path)
|
||||||
|
|
|
@ -63,11 +63,6 @@ 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 ->
|
||||||
|
@ -80,8 +75,12 @@ 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"; Path target
|
; A "-a"; A "-o"; Target 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 ->
|
||||||
|
@ -109,7 +108,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 ~targets:[dst]
|
SC.add_rule sctx
|
||||||
(Build.paths h_files
|
(Build.paths h_files
|
||||||
>>>
|
>>>
|
||||||
Build.fanout
|
Build.fanout
|
||||||
|
@ -129,7 +128,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"; Path dst
|
; A "-o"; Target dst
|
||||||
; Dep src
|
; Dep src
|
||||||
]);
|
]);
|
||||||
dst
|
dst
|
||||||
|
@ -137,7 +136,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 ~targets:[dst]
|
SC.add_rule sctx
|
||||||
(Build.paths h_files
|
(Build.paths h_files
|
||||||
>>>
|
>>>
|
||||||
Build.fanout
|
Build.fanout
|
||||||
|
@ -158,7 +157,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"; Path dst
|
; A "-o"; Target dst
|
||||||
; A "-c"; Dep src
|
; A "-c"; Dep src
|
||||||
]);
|
]);
|
||||||
dst
|
dst
|
||||||
|
@ -232,8 +231,7 @@ 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 ->
|
||||||
let target = Path.relative dir m.impl.name in
|
SC.add_rule sctx
|
||||||
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) ->
|
||||||
|
@ -242,7 +240,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 target));
|
>>> Build.update_file_dyn (Path.relative dir m.impl.name)));
|
||||||
|
|
||||||
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
|
||||||
|
@ -295,10 +293,11 @@ module Gen(P : Params) = struct
|
||||||
| Some _ -> ()
|
| Some _ -> ()
|
||||||
| None ->
|
| None ->
|
||||||
let ocamlmklib ~sandbox ~custom ~targets =
|
let ocamlmklib ~sandbox ~custom ~targets =
|
||||||
SC.add_rule sctx ~sandbox ~targets
|
SC.add_rule sctx ~sandbox
|
||||||
(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 []
|
||||||
|
@ -330,8 +329,9 @@ 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 *)
|
||||||
(let src = lib_archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) in
|
SC.add_rules sctx (
|
||||||
Js_of_ocaml_rules.build_cm sctx ~dir ~src ~js_of_ocaml:lib.buildable.js_of_ocaml);
|
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);
|
||||||
|
|
||||||
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"; Path dst
|
; A "-o"; Target 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 ~targets:[dst]
|
SC.add_rule sctx build
|
||||||
);
|
);
|
||||||
|
|
||||||
let flags =
|
let flags =
|
||||||
|
@ -383,33 +383,32 @@ 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 top_closed_cm_files =
|
let libs_and_cm =
|
||||||
dep_graph
|
Build.fanout
|
||||||
>>^ fun dep_graph ->
|
(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
|
Ocamldep.names_to_top_closed_cm_files
|
||||||
~dir
|
~dir
|
||||||
~dep_graph
|
~dep_graph
|
||||||
~modules
|
~modules
|
||||||
~mode
|
~mode
|
||||||
[String.capitalize_ascii name]
|
[String.capitalize_ascii name]))
|
||||||
in
|
in
|
||||||
SC.add_rule sctx ~targets:[exe]
|
SC.add_rule sctx
|
||||||
(Build.fanout
|
(libs_and_cm >>>
|
||||||
(requires
|
|
||||||
>>> Build.dyn_paths (Build.arr (Lib.archive_files ~mode ~ext_lib:ctx.ext_lib)))
|
|
||||||
top_closed_cm_files
|
|
||||||
>>>
|
|
||||||
Build.run ~context:ctx
|
Build.run ~context:ctx
|
||||||
(Dep compiler)
|
(Dep compiler)
|
||||||
[ Ocaml_flags.get flags mode
|
[ Ocaml_flags.get flags mode
|
||||||
; A "-o"; Path exe
|
; A "-o"; Target 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
|
||||||
Js_of_ocaml_rules.build_exe sctx ~dir ~js_of_ocaml ~src:exe
|
let rules = Js_of_ocaml_rules.build_exe sctx ~dir ~js_of_ocaml ~src:exe in
|
||||||
~requires ~top_closed_cm_files
|
SC.add_rules sctx (List.map rules ~f:(fun r -> libs_and_cm >>> r))
|
||||||
|
|
||||||
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
|
||||||
|
@ -467,7 +466,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 ~targets
|
SC.add_rule sctx
|
||||||
(SC.Deps.interpret sctx ~dir rule.deps
|
(SC.Deps.interpret sctx ~dir rule.deps
|
||||||
>>>
|
>>>
|
||||||
SC.Action.run
|
SC.Action.run
|
||||||
|
@ -495,7 +494,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 ~targets:[digest_path]
|
SC.add_rule sctx
|
||||||
(match alias_conf.action with
|
(match alias_conf.action with
|
||||||
| None ->
|
| None ->
|
||||||
deps
|
deps
|
||||||
|
@ -503,14 +502,13 @@ module Gen(P : Params) = struct
|
||||||
Build.create_file digest_path
|
Build.create_file digest_path
|
||||||
| Some action ->
|
| Some action ->
|
||||||
deps
|
deps
|
||||||
>>>
|
>>> SC.Action.run
|
||||||
SC.Action.run
|
|
||||||
sctx
|
sctx
|
||||||
action
|
action
|
||||||
~dir
|
~dir
|
||||||
~dep_kind:Required
|
~dep_kind:Required
|
||||||
~deps:(SC.Deps.only_plain_files sctx ~dir alias_conf.deps)
|
|
||||||
~targets:[]
|
~targets:[]
|
||||||
|
~deps:(SC.Deps.only_plain_files sctx ~dir alias_conf.deps)
|
||||||
~package_context
|
~package_context
|
||||||
>>>
|
>>>
|
||||||
Build.and_create_file digest_path)
|
Build.and_create_file digest_path)
|
||||||
|
@ -561,9 +559,10 @@ 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
|
||||||
let src = Path.relative dir intf.name in
|
SC.add_rule sctx
|
||||||
let dst = Path.relative dir impl_fname in
|
(Build.copy
|
||||||
SC.add_rule sctx ~targets:[dst] (Build.copy ~src ~dst);
|
~src:(Path.relative dir intf.name)
|
||||||
|
~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 =
|
||||||
|
@ -621,7 +620,8 @@ 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 () = Js_of_ocaml_rules.setup_separate_compilation_rules sctx
|
let () =
|
||||||
|
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 ~targets:[meta_path]
|
SC.add_rule sctx
|
||||||
(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 ~targets:[dst] sctx (Build.symlink ~src:entry.src ~dst);
|
SC.add_rule 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 ~targets:[fn]
|
SC.add_rule sctx
|
||||||
(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,8 +896,7 @@ 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 ~targets:[src_install_file]
|
SC.add_rule sctx (Build.copy ~src:ctx_install_file ~dst: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
|
||||||
|
|
|
@ -1,5 +1,4 @@
|
||||||
open Import
|
open Import
|
||||||
open Build.O
|
|
||||||
|
|
||||||
module SC = Super_context
|
module SC = Super_context
|
||||||
|
|
||||||
|
@ -28,45 +27,42 @@ 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 ~dep =
|
let js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target =
|
||||||
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
|
||||||
SC.add_rule sctx ~targets:[target]
|
|
||||||
(dep
|
|
||||||
>>>
|
|
||||||
Build.run ~context:(SC.context sctx) ~dir
|
Build.run ~context:(SC.context sctx) ~dir
|
||||||
jsoo
|
jsoo
|
||||||
[ Arg_spec.As flags
|
[ Arg_spec.As flags
|
||||||
; Arg_spec.A "-o"; Path target
|
; Arg_spec.A "-o"; Target target
|
||||||
; Arg_spec.A "--no-runtime"; runtime
|
; Arg_spec.A "--no-runtime"; runtime
|
||||||
; spec
|
; spec
|
||||||
])
|
]
|
||||||
|
|
||||||
let standalone_runtime_rule ~sctx ~dir ~flags ~javascript_files ~target ~requires =
|
let standalone_runtime_rule ~sctx ~dir ~flags ~javascript_files ~target =
|
||||||
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 ~dep:requires
|
js_of_ocaml_rule ~sctx ~dir ~flags ~target ~spec
|
||||||
|
|
||||||
let exe_rule ~sctx ~dir ~flags ~javascript_files ~src ~target ~requires =
|
let exe_rule ~sctx ~dir ~flags ~javascript_files ~src ~target =
|
||||||
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 ~dep:requires
|
js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target
|
||||||
|
|
||||||
let link_rule ~sctx ~dir ~runtime ~target ~requires ~top_closed_cm_files =
|
let link_rule ~sctx ~dir ~runtime ~target =
|
||||||
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 =
|
||||||
|
@ -84,31 +80,29 @@ let link_rule ~sctx ~dir ~runtime ~target ~requires ~top_closed_cm_files =
|
||||||
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
|
||||||
SC.add_rule sctx ~targets:[target]
|
|
||||||
(Build.fanout requires top_closed_cm_files
|
|
||||||
>>>
|
|
||||||
Build.run ~context:(SC.context sctx) ~dir
|
Build.run ~context:(SC.context sctx) ~dir
|
||||||
jsoo_link
|
jsoo_link
|
||||||
[ Arg_spec.A "-o"; Path target
|
[ Arg_spec.A "-o"; Target target
|
||||||
; Arg_spec.Dep runtime
|
; Arg_spec.Dep runtime
|
||||||
; Arg_spec.As (sourcemap ())
|
; Arg_spec.As (sourcemap ())
|
||||||
; Arg_spec.Dyn get_all
|
; 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 () then begin
|
if separate_compilation_enabled ()
|
||||||
let target = Path.extend_basename src ~suffix:".js" in
|
then 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 ~dep:(Build.return ())
|
[ js_of_ocaml_rule ~sctx ~dir ~flags ~spec ~target ]
|
||||||
end
|
else []
|
||||||
|
|
||||||
let setup_separate_compilation_rules sctx =
|
let setup_separate_compilation_rules sctx =
|
||||||
if separate_compilation_enabled () then begin
|
if separate_compilation_enabled ()
|
||||||
|
then
|
||||||
let ctx = SC.context sctx in
|
let ctx = SC.context sctx in
|
||||||
let all_pkg =
|
let all_pkg =
|
||||||
List.map
|
List.map
|
||||||
|
@ -123,25 +117,28 @@ 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.iter all_pkg ~f:(fun (pkg_name, pkg_dir, archives) ->
|
List.concat_map all_pkg
|
||||||
List.iter archives ~f:(fun name ->
|
~f:(fun (pkg_name,pkg_dir,archives) ->
|
||||||
|
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 ~requires ~top_closed_cm_files =
|
let build_exe sctx ~dir ~js_of_ocaml ~src =
|
||||||
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 begin
|
if separate_compilation_enabled () then
|
||||||
link_rule ~sctx ~dir ~runtime:standalone_runtime ~target ~requires ~top_closed_cm_files;
|
[ link_rule ~sctx ~dir ~runtime:standalone_runtime ~target
|
||||||
standalone_runtime_rule ~sctx ~dir ~flags ~javascript_files
|
; standalone_runtime_rule ~sctx ~dir ~flags ~javascript_files
|
||||||
~target:standalone_runtime ~requires
|
~target:standalone_runtime
|
||||||
end else
|
]
|
||||||
exe_rule ~sctx ~dir ~flags ~javascript_files ~src ~target ~requires
|
else
|
||||||
|
[ exe_rule ~sctx ~dir ~flags ~javascript_files ~src ~target ]
|
||||||
|
|
|
@ -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
|
-> (unit, Action.t) Build.t list
|
||||||
|
|
||||||
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
|
||||||
-> requires:(unit, Lib.t list) Build.t
|
-> (Lib.t list * Path.t list, Action.t) Build.t list
|
||||||
-> top_closed_cm_files:(unit, Path.t list) Build.t
|
|
||||||
-> unit
|
|
||||||
|
|
||||||
val setup_separate_compilation_rules : Super_context.t -> unit
|
val setup_separate_compilation_rules
|
||||||
|
: Super_context.t
|
||||||
|
-> (unit, Action.t) Build.t list
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -30,12 +30,11 @@ 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
|
||||||
let merlin_exists = Path.relative dir ".merlin-exists" in
|
SC.add_rule sctx
|
||||||
SC.add_rule sctx ~targets:[merlin_exists]
|
|
||||||
(Build.path path
|
(Build.path path
|
||||||
>>>
|
>>>
|
||||||
Build.update_file merlin_exists "");
|
Build.update_file (Path.relative dir ".merlin-exists") "");
|
||||||
SC.add_rule sctx ~targets:[path] (
|
SC.add_rule sctx (
|
||||||
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
|
||||||
|
|
|
@ -71,12 +71,13 @@ 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 ~targets:(dst :: extra_targets)
|
SC.add_rule sctx ?sandbox
|
||||||
(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
|
||||||
|
@ -87,7 +88,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"; Path dst
|
; A "-o"; Target dst
|
||||||
; A "-c"; Ml_kind.flag ml_kind; Dep src
|
; A "-c"; Ml_kind.flag ml_kind; Dep src
|
||||||
])))
|
])))
|
||||||
|
|
||||||
|
@ -98,7 +99,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
|
||||||
Js_of_ocaml_rules.build_cm sctx ~dir ~js_of_ocaml ~src
|
SC.add_rules sctx (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
|
||||||
|
|
|
@ -59,10 +59,10 @@ 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 ~targets:[ocamldep_output]
|
SC.add_rule sctx
|
||||||
(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 (Path.to_string ocamldep_output)
|
||||||
(Build.lines_of ocamldep_output
|
(Build.lines_of ocamldep_output
|
||||||
>>^ parse_deps ~dir ~modules ~alias_module)
|
>>^ parse_deps ~dir ~modules ~alias_module)
|
||||||
|
|
||||||
|
|
|
@ -21,6 +21,7 @@ type t =
|
||||||
; mutable rules : Build_interpret.Rule.t list
|
; mutable rules : Build_interpret.Rule.t list
|
||||||
; stanzas_to_consider_for_install : (Path.t * Stanza.t) list
|
; stanzas_to_consider_for_install : (Path.t * Stanza.t) list
|
||||||
; mutable known_targets_by_src_dir_so_far : String_set.t Path.Map.t
|
; mutable known_targets_by_src_dir_so_far : String_set.t Path.Map.t
|
||||||
|
; libs_vfile : (module Vfile_kind.S with type t = Lib.t list)
|
||||||
; cxx_flags : string list
|
; cxx_flags : string list
|
||||||
; vars : string String_map.t
|
; vars : string String_map.t
|
||||||
; ppx_dir : Path.t
|
; ppx_dir : Path.t
|
||||||
|
@ -97,6 +98,19 @@ let create
|
||||||
List.concat_map stanzas ~f:(fun { ctx_dir; stanzas; _ } ->
|
List.concat_map stanzas ~f:(fun { ctx_dir; stanzas; _ } ->
|
||||||
List.map stanzas ~f:(fun s -> (ctx_dir, s)))
|
List.map stanzas ~f:(fun s -> (ctx_dir, s)))
|
||||||
in
|
in
|
||||||
|
let module Libs_vfile =
|
||||||
|
Vfile_kind.Make_full
|
||||||
|
(struct type t = Lib.t list end)
|
||||||
|
(struct
|
||||||
|
open Sexp.To_sexp
|
||||||
|
let t _dir l = list string (List.map l ~f:Lib.best_name)
|
||||||
|
end)
|
||||||
|
(struct
|
||||||
|
open Sexp.Of_sexp
|
||||||
|
let t dir sexp =
|
||||||
|
List.map (list string sexp) ~f:(Lib_db.find_exn libs ~from:dir)
|
||||||
|
end)
|
||||||
|
in
|
||||||
let artifacts =
|
let artifacts =
|
||||||
Artifacts.create context (List.map stanzas ~f:(fun (d : Dir_with_jbuild.t) ->
|
Artifacts.create context (List.map stanzas ~f:(fun (d : Dir_with_jbuild.t) ->
|
||||||
(d.ctx_dir, d.stanzas)))
|
(d.ctx_dir, d.stanzas)))
|
||||||
|
@ -146,6 +160,7 @@ let create
|
||||||
; rules = []
|
; rules = []
|
||||||
; stanzas_to_consider_for_install
|
; stanzas_to_consider_for_install
|
||||||
; known_targets_by_src_dir_so_far = Path.Map.empty
|
; known_targets_by_src_dir_so_far = Path.Map.empty
|
||||||
|
; libs_vfile = (module Libs_vfile)
|
||||||
; artifacts
|
; artifacts
|
||||||
; cxx_flags
|
; cxx_flags
|
||||||
; vars
|
; vars
|
||||||
|
@ -153,13 +168,13 @@ 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 ~targets build =
|
let add_rule t ?sandbox build =
|
||||||
let rule = Build_interpret.Rule.make ?sandbox ~targets build in
|
let rule = Build_interpret.Rule.make ?sandbox 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
|
List.fold_left rule.targets ~init:t.known_targets_by_src_dir_so_far
|
||||||
~f:(fun path acc ->
|
~f:(fun acc target ->
|
||||||
match Path.extract_build_context path with
|
match Path.extract_build_context (Build_interpret.Target.path target) with
|
||||||
| None -> acc
|
| None -> acc
|
||||||
| Some (_, path) ->
|
| Some (_, path) ->
|
||||||
let dir = Path.parent path in
|
let dir = Path.parent path in
|
||||||
|
@ -171,6 +186,9 @@ let add_rule t ?sandbox ~targets 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
|
||||||
|
@ -188,22 +206,19 @@ module Libs = struct
|
||||||
|
|
||||||
let find t ~from name = find t.libs ~from name
|
let find t ~from name = find t.libs ~from name
|
||||||
|
|
||||||
let requires_file ~dir ~item =
|
let vrequires t ~dir ~item =
|
||||||
Path.relative dir (item ^ ".requires.sexp")
|
let fn = Path.relative dir (item ^ ".requires.sexp") in
|
||||||
|
Build.Vspec.T (fn, t.libs_vfile)
|
||||||
let load_deps t ~dir fn =
|
|
||||||
Build.read_sexp fn (fun sexp ->
|
|
||||||
Sexp.Of_sexp.(list string) sexp
|
|
||||||
|> List.map ~f:(fun name -> Lib_db.find_exn t.libs ~from:dir name))
|
|
||||||
|
|
||||||
let load_requires t ~dir ~item =
|
let load_requires t ~dir ~item =
|
||||||
load_deps t ~dir (requires_file ~dir ~item)
|
Build.vpath (vrequires t ~dir ~item)
|
||||||
|
|
||||||
let runtime_deps_file ~dir ~item =
|
let vruntime_deps t ~dir ~item =
|
||||||
Path.relative dir (item ^ ".runtime-deps.sexp")
|
let fn = Path.relative dir (item ^ ".runtime-deps.sexp") in
|
||||||
|
Build.Vspec.T (fn, t.libs_vfile)
|
||||||
|
|
||||||
let load_runtime_deps t ~dir ~item =
|
let load_runtime_deps t ~dir ~item =
|
||||||
load_deps t ~dir (runtime_deps_file ~dir ~item)
|
Build.vpath (vruntime_deps t ~dir ~item)
|
||||||
|
|
||||||
let with_fail ~fail build =
|
let with_fail ~fail build =
|
||||||
match fail with
|
match fail with
|
||||||
|
@ -252,21 +267,18 @@ 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 ~targets:[dst]
|
add_rule t
|
||||||
(Build.path src
|
(Build.path src
|
||||||
>>>
|
>>>
|
||||||
Build.action_context_independent
|
Build.action_context_independent ~targets:[dst]
|
||||||
(Copy_and_add_line_directive (src, dst))))
|
(Copy_and_add_line_directive (src, dst))))
|
||||||
|
|
||||||
let write_deps fn =
|
|
||||||
Build.write_sexp fn (fun l -> Sexp.To_sexp.(list string) (List.map l ~f:Lib.best_name))
|
|
||||||
|
|
||||||
let real_requires t ~dir ~dep_kind ~item ~libraries ~preprocess ~virtual_deps =
|
let real_requires t ~dir ~dep_kind ~item ~libraries ~preprocess ~virtual_deps =
|
||||||
let all_pps =
|
let all_pps =
|
||||||
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 vrequires = vrequires t ~dir ~item in
|
||||||
add_rule t ~targets:[requires_file]
|
add_rule t
|
||||||
(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
|
||||||
|
@ -277,8 +289,8 @@ 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);
|
Build.store_vfile vrequires);
|
||||||
load_deps t ~dir requires_file
|
Build.vpath vrequires
|
||||||
|
|
||||||
let requires t ~dir ~dep_kind ~item ~libraries ~preprocess ~virtual_deps =
|
let requires t ~dir ~dep_kind ~item ~libraries ~preprocess ~virtual_deps =
|
||||||
let real_requires =
|
let real_requires =
|
||||||
|
@ -302,8 +314,8 @@ module Libs = struct
|
||||||
(requires, real_requires)
|
(requires, real_requires)
|
||||||
|
|
||||||
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 vruntime_deps = vruntime_deps t ~dir ~item in
|
||||||
add_rule t ~targets:[runtime_deps_file]
|
add_rule t
|
||||||
(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)
|
||||||
|
@ -311,7 +323,7 @@ module Libs = struct
|
||||||
Build.arr (fun (rt_deps, rt_deps_of_deps) ->
|
Build.arr (fun (rt_deps, rt_deps_of_deps) ->
|
||||||
Lib.remove_dups_preserve_order (rt_deps @ rt_deps_of_deps))
|
Lib.remove_dups_preserve_order (rt_deps @ rt_deps_of_deps))
|
||||||
>>>
|
>>>
|
||||||
write_deps runtime_deps_file)
|
Build.store_vfile vruntime_deps)
|
||||||
end
|
end
|
||||||
|
|
||||||
module Deps = struct
|
module Deps = struct
|
||||||
|
@ -355,17 +367,24 @@ end
|
||||||
module Pkg_version = struct
|
module Pkg_version = struct
|
||||||
open Build.O
|
open Build.O
|
||||||
|
|
||||||
let spec_file sctx (p : Package.t) =
|
module V = Vfile_kind.Make(struct type t = string option end)
|
||||||
|
(functor (C : Sexp.Combinators) -> struct
|
||||||
|
let t = C.option C.string
|
||||||
|
end)
|
||||||
|
|
||||||
|
let spec sctx (p : Package.t) =
|
||||||
|
let fn =
|
||||||
Path.relative (Path.append sctx.context.build_dir p.path)
|
Path.relative (Path.append sctx.context.build_dir p.path)
|
||||||
(sprintf "%s.version.sexp" p.name)
|
(sprintf "%s.version.sexp" p.name)
|
||||||
|
in
|
||||||
|
Build.Vspec.T (fn, (module V))
|
||||||
|
|
||||||
let read sctx p = Build.read_sexp (spec_file sctx p) Sexp.Of_sexp.(option string)
|
let read sctx p = Build.vpath (spec sctx p)
|
||||||
|
|
||||||
let set sctx p get =
|
let set sctx p get =
|
||||||
let fn = spec_file sctx p in
|
let spec = spec sctx p in
|
||||||
add_rule sctx ~targets:[fn]
|
add_rule sctx (get >>> Build.store_vfile spec);
|
||||||
(get >>> Build.write_sexp fn Sexp.To_sexp.(option string));
|
Build.vpath spec
|
||||||
Build.read_sexp fn Sexp.Of_sexp.(option string)
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module Action = struct
|
module Action = struct
|
||||||
|
@ -491,7 +510,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
|
Build.action_dyn () ~context:sctx.context ~dir ~targets
|
||||||
in
|
in
|
||||||
match forms.failures with
|
match forms.failures with
|
||||||
| [] -> build
|
| [] -> build
|
||||||
|
@ -580,13 +599,13 @@ module PP = struct
|
||||||
| Some _ ->
|
| Some _ ->
|
||||||
libs
|
libs
|
||||||
in
|
in
|
||||||
add_rule sctx ~targets:[target]
|
add_rule sctx
|
||||||
(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" ; Path target
|
[ A "-o" ; Target target
|
||||||
; Dyn (Lib.link_flags ~mode)
|
; Dyn (Lib.link_flags ~mode)
|
||||||
])
|
])
|
||||||
|
|
||||||
|
@ -624,37 +643,32 @@ 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 refmt src target =
|
let rule src target =
|
||||||
let src_path = Path.relative dir src in
|
let src_path = Path.relative dir src in
|
||||||
let target = Path.relative dir target in
|
Build.run ~context:ctx refmt
|
||||||
add_rule sctx ~targets:[target]
|
|
||||||
(Build.run ~context:ctx refmt
|
|
||||||
[ A "--print"
|
[ A "--print"
|
||||||
; A "binary"
|
; A "binary"
|
||||||
; Dep src_path ]
|
; Dep src_path ]
|
||||||
~stdout_to:target)
|
~stdout_to:(Path.relative dir target) in
|
||||||
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
|
||||||
refmt m.impl.name ml.name;
|
add_rule sctx (rule m.impl.name ml.name);
|
||||||
ml
|
ml in
|
||||||
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
|
||||||
refmt f.name mli.name;
|
add_rule sctx (rule f.name mli.name);
|
||||||
mli)
|
mli) in
|
||||||
in
|
|
||||||
{ m with impl ; intf }
|
{ m with impl ; intf }
|
||||||
|
|
||||||
(* Generate rules to build the .pp files and return a new module map
|
(* Generate rules to build the .pp files and return a new module map where all filenames
|
||||||
where all filenames point to the .pp files *)
|
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
|
||||||
|
@ -664,7 +678,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 ~targets:[dst]
|
add_rule sctx
|
||||||
(preprocessor_deps
|
(preprocessor_deps
|
||||||
>>>
|
>>>
|
||||||
Build.path src
|
Build.path src
|
||||||
|
@ -683,7 +697,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 ~targets:[dst]
|
add_rule sctx
|
||||||
(preprocessor_deps
|
(preprocessor_deps
|
||||||
>>>
|
>>>
|
||||||
Build.run ~context:sctx.context
|
Build.run ~context:sctx.context
|
||||||
|
@ -691,7 +705,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"; Path dst
|
; A "-o"; Target dst
|
||||||
; Ml_kind.ppx_driver_flag kind; Dep src
|
; Ml_kind.ppx_driver_flag kind; Dep src
|
||||||
])
|
])
|
||||||
)
|
)
|
||||||
|
|
|
@ -42,7 +42,8 @@ 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 -> targets:Path.t list -> (unit, Action.t) Build.t -> unit
|
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 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
|
||||||
|
|
|
@ -0,0 +1,78 @@
|
||||||
|
open Import
|
||||||
|
|
||||||
|
module Id = struct
|
||||||
|
type 'a tag = ..
|
||||||
|
|
||||||
|
module type S = sig
|
||||||
|
type t
|
||||||
|
type 'a tag += X : t tag
|
||||||
|
end
|
||||||
|
|
||||||
|
type 'a t = (module S with type t = 'a)
|
||||||
|
|
||||||
|
let create (type a) () =
|
||||||
|
let module M = struct
|
||||||
|
type t = a
|
||||||
|
type 'a tag += X : t tag
|
||||||
|
end in
|
||||||
|
(module M : S with type t = a)
|
||||||
|
|
||||||
|
let eq (type a) (type b)
|
||||||
|
(module A : S with type t = a)
|
||||||
|
(module B : S with type t = b)
|
||||||
|
: (a, b) eq option =
|
||||||
|
match A.X with
|
||||||
|
| B.X -> Some Eq
|
||||||
|
| _ -> None
|
||||||
|
end
|
||||||
|
|
||||||
|
module type S = sig
|
||||||
|
type t
|
||||||
|
|
||||||
|
val id : t Id.t
|
||||||
|
|
||||||
|
val load : Path.t -> t
|
||||||
|
val to_string : Path.t -> t -> string
|
||||||
|
end
|
||||||
|
|
||||||
|
type 'a t = (module S with type t = 'a)
|
||||||
|
|
||||||
|
let eq (type a) (type b)
|
||||||
|
(module A : S with type t = a)
|
||||||
|
(module B : S with type t = b) =
|
||||||
|
Id.eq A.id B.id
|
||||||
|
|
||||||
|
module Make_full
|
||||||
|
(T : sig type t end)
|
||||||
|
(To_sexp : sig val t : Path.t -> T.t -> Sexp.t end)
|
||||||
|
(Of_sexp : sig val t : Path.t -> Sexp.Ast.t -> T.t end)
|
||||||
|
: S with type t = T.t =
|
||||||
|
struct
|
||||||
|
type t = T.t
|
||||||
|
|
||||||
|
let id = Id.create ()
|
||||||
|
|
||||||
|
let to_string path x = To_sexp.t path x |> Sexp.to_string
|
||||||
|
|
||||||
|
let load path =
|
||||||
|
Of_sexp.t path (Sexp_load.single (Path.to_string path))
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
module Make
|
||||||
|
(T : sig type t end)
|
||||||
|
(F : functor (C : Sexp.Combinators) -> sig val t : T.t C.t end)
|
||||||
|
: S with type t = T.t =
|
||||||
|
struct
|
||||||
|
module Of_sexp = struct
|
||||||
|
include F(Sexp.Of_sexp)
|
||||||
|
let t _ sexp = t sexp
|
||||||
|
end
|
||||||
|
module To_sexp = struct
|
||||||
|
include F(Sexp.To_sexp)
|
||||||
|
let t _ x = t x
|
||||||
|
end
|
||||||
|
|
||||||
|
include Make_full(T)(To_sexp)(Of_sexp)
|
||||||
|
end
|
||||||
|
|
|
@ -0,0 +1,31 @@
|
||||||
|
open Import
|
||||||
|
|
||||||
|
module Id : sig
|
||||||
|
type 'a t
|
||||||
|
|
||||||
|
val eq : 'a t -> 'b t -> ('a, 'b) eq option
|
||||||
|
end
|
||||||
|
|
||||||
|
module type S = sig
|
||||||
|
type t
|
||||||
|
|
||||||
|
val id : t Id.t
|
||||||
|
|
||||||
|
val load : Path.t -> t
|
||||||
|
val to_string : Path.t -> t -> string
|
||||||
|
end
|
||||||
|
|
||||||
|
type 'a t = (module S with type t = 'a)
|
||||||
|
|
||||||
|
val eq : 'a t -> 'b t -> ('a, 'b) eq option
|
||||||
|
|
||||||
|
module Make
|
||||||
|
(T : sig type t end)
|
||||||
|
(F : functor (C : Sexp.Combinators) -> sig val t : T.t C.t end)
|
||||||
|
: S with type t = T.t
|
||||||
|
|
||||||
|
module Make_full
|
||||||
|
(T : sig type t end)
|
||||||
|
(To_sexp : sig val t : Path.t -> T.t -> Sexp.t end)
|
||||||
|
(Of_sexp : sig val t : Path.t -> Sexp.Ast.t -> T.t end)
|
||||||
|
: S with type t = T.t
|
Loading…
Reference in New Issue