Manual dependency sort in super_context
Code is re-arranged so that evaling the OSL can access the Expander module Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
e421884bd4
commit
2690415242
|
@ -87,287 +87,6 @@ let installed_libs t = t.installed_libs
|
||||||
let find_scope_by_dir t dir = Scope.DB.find_by_dir t.scopes dir
|
let find_scope_by_dir t dir = Scope.DB.find_by_dir t.scopes dir
|
||||||
let find_scope_by_name t name = Scope.DB.find_by_name t.scopes name
|
let find_scope_by_name t name = Scope.DB.find_by_name t.scopes name
|
||||||
|
|
||||||
let expand_ocaml_config t pform name =
|
|
||||||
match String.Map.find t.ocaml_config name with
|
|
||||||
| Some x -> x
|
|
||||||
| None ->
|
|
||||||
Loc.fail (String_with_vars.Var.loc pform)
|
|
||||||
"Unknown ocaml configuration variable %S"
|
|
||||||
name
|
|
||||||
|
|
||||||
let expand_vars t ~mode ~scope ~dir ?(bindings=Pform.Map.empty) s =
|
|
||||||
String_with_vars.expand ~mode ~dir s ~f:(fun pform syntax_version ->
|
|
||||||
(match Pform.Map.expand bindings pform syntax_version with
|
|
||||||
| None -> Pform.Map.expand t.pforms pform syntax_version
|
|
||||||
| Some _ as x -> x)
|
|
||||||
|> Option.map ~f:(function
|
|
||||||
| Pform.Expansion.Var (Values l) -> l
|
|
||||||
| Macro (Ocaml_config, s) -> expand_ocaml_config t pform s
|
|
||||||
| Var Project_root -> [Value.Dir (Scope.root scope)]
|
|
||||||
| _ ->
|
|
||||||
Loc.fail (String_with_vars.Var.loc pform)
|
|
||||||
"%s isn't allowed in this position"
|
|
||||||
(String_with_vars.Var.describe pform)))
|
|
||||||
|
|
||||||
let expand_vars_string t ~scope ~dir ?bindings s =
|
|
||||||
expand_vars t ~mode:Single ~scope ~dir ?bindings s
|
|
||||||
|> Value.to_string ~dir
|
|
||||||
|
|
||||||
let expand_vars_path t ~scope ~dir ?bindings s =
|
|
||||||
expand_vars t ~mode:Single ~scope ~dir ?bindings s
|
|
||||||
|> Value.to_path ~error_loc:(String_with_vars.loc s) ~dir
|
|
||||||
|
|
||||||
let expand_and_eval_set t ~scope ~dir ?bindings set ~standard =
|
|
||||||
let open Build.O in
|
|
||||||
let parse ~loc:_ s = s in
|
|
||||||
let (syntax, files) =
|
|
||||||
let f = expand_vars_path t ~scope ~dir ?bindings in
|
|
||||||
Ordered_set_lang.Unexpanded.files set ~f in
|
|
||||||
let f = expand_vars t ~mode:Many ~scope ~dir ?bindings in
|
|
||||||
match Path.Set.to_list files with
|
|
||||||
| [] ->
|
|
||||||
let set =
|
|
||||||
Ordered_set_lang.Unexpanded.expand set ~dir
|
|
||||||
~files_contents:Path.Map.empty ~f
|
|
||||||
in
|
|
||||||
standard >>^ fun standard ->
|
|
||||||
Ordered_set_lang.String.eval set ~standard ~parse
|
|
||||||
| paths ->
|
|
||||||
Build.fanout standard (Build.all (List.map paths ~f:(fun f ->
|
|
||||||
Build.read_sexp f syntax)))
|
|
||||||
>>^ fun (standard, sexps) ->
|
|
||||||
let files_contents = List.combine paths sexps |> Path.Map.of_list_exn in
|
|
||||||
let set = Ordered_set_lang.Unexpanded.expand set ~dir ~files_contents ~f in
|
|
||||||
Ordered_set_lang.String.eval set ~standard ~parse
|
|
||||||
|
|
||||||
module Env : sig
|
|
||||||
val ocaml_flags : t -> dir:Path.t -> Ocaml_flags.t
|
|
||||||
val get : t -> dir:Path.t -> Env_node.t
|
|
||||||
end = struct
|
|
||||||
open Env_node
|
|
||||||
|
|
||||||
let rec get t ~dir =
|
|
||||||
match Hashtbl.find t.env dir with
|
|
||||||
| None ->
|
|
||||||
begin match Path.parent dir with
|
|
||||||
| None -> raise_notrace Exit
|
|
||||||
| Some parent ->
|
|
||||||
let node = get t ~dir:parent in
|
|
||||||
Hashtbl.add t.env dir node;
|
|
||||||
node
|
|
||||||
end
|
|
||||||
| Some node -> node
|
|
||||||
|
|
||||||
let get t ~dir =
|
|
||||||
match get t ~dir with
|
|
||||||
| node -> node
|
|
||||||
| exception Exit ->
|
|
||||||
Exn.code_error "Super_context.Env.get called on invalid directory"
|
|
||||||
[ "dir", Path.sexp_of_t dir ]
|
|
||||||
|
|
||||||
let ocaml_flags t ~dir =
|
|
||||||
let rec loop t node =
|
|
||||||
match node.ocaml_flags with
|
|
||||||
| Some x -> x
|
|
||||||
| None ->
|
|
||||||
let default =
|
|
||||||
match node.inherit_from with
|
|
||||||
| None -> Ocaml_flags.default ~profile:(profile t)
|
|
||||||
| Some (lazy node) -> loop t node
|
|
||||||
in
|
|
||||||
let flags =
|
|
||||||
match List.find_map node.config.rules ~f:(fun (pat, cfg) ->
|
|
||||||
match (pat : Env.pattern), profile t with
|
|
||||||
| Any, _ -> Some cfg
|
|
||||||
| Profile a, b -> Option.some_if (a = b) cfg)
|
|
||||||
with
|
|
||||||
| None -> default
|
|
||||||
| Some cfg ->
|
|
||||||
Ocaml_flags.make
|
|
||||||
~flags:cfg.flags
|
|
||||||
~ocamlc_flags:cfg.ocamlc_flags
|
|
||||||
~ocamlopt_flags:cfg.ocamlopt_flags
|
|
||||||
~default
|
|
||||||
~eval:(expand_and_eval_set t ~scope:node.scope ~dir:node.dir
|
|
||||||
?bindings:None)
|
|
||||||
in
|
|
||||||
node.ocaml_flags <- Some flags;
|
|
||||||
flags
|
|
||||||
in
|
|
||||||
loop t (get t ~dir)
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
let ocaml_flags t ~dir ~scope (x : Buildable.t) =
|
|
||||||
Ocaml_flags.make
|
|
||||||
~flags:x.flags
|
|
||||||
~ocamlc_flags:x.ocamlc_flags
|
|
||||||
~ocamlopt_flags:x.ocamlopt_flags
|
|
||||||
~default:(Env.ocaml_flags t ~dir)
|
|
||||||
~eval:(expand_and_eval_set t ~scope ~dir ?bindings:None)
|
|
||||||
|
|
||||||
let dump_env t ~dir =
|
|
||||||
Ocaml_flags.dump (Env.ocaml_flags t ~dir)
|
|
||||||
|
|
||||||
let resolve_program t ?hint bin =
|
|
||||||
Artifacts.binary ?hint t.artifacts bin
|
|
||||||
|
|
||||||
let create
|
|
||||||
~(context:Context.t)
|
|
||||||
?host
|
|
||||||
~projects
|
|
||||||
~file_tree
|
|
||||||
~packages
|
|
||||||
~stanzas
|
|
||||||
~external_lib_deps_mode
|
|
||||||
~build_system
|
|
||||||
=
|
|
||||||
let installed_libs =
|
|
||||||
Lib.DB.create_from_findlib context.findlib ~external_lib_deps_mode
|
|
||||||
in
|
|
||||||
let internal_libs =
|
|
||||||
List.concat_map stanzas ~f:(fun { Jbuild_load.Jbuild. dir; stanzas; _ } ->
|
|
||||||
let ctx_dir = Path.append context.build_dir dir in
|
|
||||||
List.filter_map stanzas ~f:(fun stanza ->
|
|
||||||
match (stanza : Stanza.t) with
|
|
||||||
| Library lib -> Some (ctx_dir, lib)
|
|
||||||
| _ -> None))
|
|
||||||
in
|
|
||||||
let scopes, public_libs =
|
|
||||||
Scope.DB.create
|
|
||||||
~projects
|
|
||||||
~context:context.name
|
|
||||||
~installed_libs
|
|
||||||
internal_libs
|
|
||||||
in
|
|
||||||
let stanzas =
|
|
||||||
List.map stanzas
|
|
||||||
~f:(fun { Jbuild_load.Jbuild. dir; project; stanzas; kind } ->
|
|
||||||
let ctx_dir = Path.append context.build_dir dir in
|
|
||||||
{ Dir_with_jbuild.
|
|
||||||
src_dir = dir
|
|
||||||
; ctx_dir
|
|
||||||
; stanzas
|
|
||||||
; scope = Scope.DB.find_by_name scopes project.Dune_project.name
|
|
||||||
; kind
|
|
||||||
})
|
|
||||||
in
|
|
||||||
let stanzas_per_dir =
|
|
||||||
List.map stanzas ~f:(fun stanzas ->
|
|
||||||
(stanzas.Dir_with_jbuild.ctx_dir, stanzas))
|
|
||||||
|> Path.Map.of_list_exn
|
|
||||||
in
|
|
||||||
let stanzas_to_consider_for_install =
|
|
||||||
if not external_lib_deps_mode then
|
|
||||||
List.concat_map stanzas ~f:(fun { ctx_dir; stanzas; scope; kind; _ } ->
|
|
||||||
List.filter_map stanzas ~f:(fun stanza ->
|
|
||||||
let keep =
|
|
||||||
match (stanza : Stanza.t) with
|
|
||||||
| Library lib -> Lib.DB.available (Scope.libs scope) lib.name
|
|
||||||
| Documentation _
|
|
||||||
| Install _ -> true
|
|
||||||
| _ -> false
|
|
||||||
in
|
|
||||||
Option.some_if keep { Installable.
|
|
||||||
dir = ctx_dir
|
|
||||||
; scope
|
|
||||||
; stanza
|
|
||||||
; kind
|
|
||||||
}))
|
|
||||||
else
|
|
||||||
List.concat_map stanzas ~f:(fun { ctx_dir; stanzas; scope; kind; _ } ->
|
|
||||||
List.map stanzas ~f:(fun stanza ->
|
|
||||||
{ Installable.
|
|
||||||
dir = ctx_dir
|
|
||||||
; scope
|
|
||||||
; stanza
|
|
||||||
; kind
|
|
||||||
}))
|
|
||||||
in
|
|
||||||
let artifacts =
|
|
||||||
Artifacts.create context ~public_libs stanzas
|
|
||||||
~f:(fun (d : Dir_with_jbuild.t) -> d.stanzas)
|
|
||||||
in
|
|
||||||
let cxx_flags =
|
|
||||||
List.filter context.ocamlc_cflags
|
|
||||||
~f:(fun s -> not (String.is_prefix s ~prefix:"-std="))
|
|
||||||
in
|
|
||||||
let pforms = Pform.Map.create ~context ~cxx_flags in
|
|
||||||
let ocaml_config =
|
|
||||||
let string s = [Value.String s] in
|
|
||||||
Ocaml_config.to_list context.ocaml_config
|
|
||||||
|> List.map ~f:(fun (k, v) ->
|
|
||||||
( k
|
|
||||||
, match (v : Ocaml_config.Value.t) with
|
|
||||||
| Bool x -> string (string_of_bool x)
|
|
||||||
| Int x -> string (string_of_int x)
|
|
||||||
| String x -> string x
|
|
||||||
| Words x -> Value.L.strings x
|
|
||||||
| Prog_and_args x -> Value.L.strings (x.prog :: x.args)))
|
|
||||||
|> String.Map.of_list_exn
|
|
||||||
in
|
|
||||||
let t =
|
|
||||||
{ context
|
|
||||||
; host
|
|
||||||
; build_system
|
|
||||||
; scopes
|
|
||||||
; public_libs
|
|
||||||
; installed_libs
|
|
||||||
; stanzas
|
|
||||||
; stanzas_per_dir
|
|
||||||
; packages
|
|
||||||
; file_tree
|
|
||||||
; stanzas_to_consider_for_install
|
|
||||||
; artifacts
|
|
||||||
; cxx_flags
|
|
||||||
; pforms
|
|
||||||
; ocaml_config
|
|
||||||
; chdir = Build.arr (fun (action : Action.t) ->
|
|
||||||
match action with
|
|
||||||
| Chdir _ -> action
|
|
||||||
| _ -> Chdir (context.build_dir, action))
|
|
||||||
; libs_by_package =
|
|
||||||
Lib.DB.all public_libs
|
|
||||||
|> Lib.Set.to_list
|
|
||||||
|> List.map ~f:(fun lib ->
|
|
||||||
(Option.value_exn (Lib.package lib), lib))
|
|
||||||
|> Package.Name.Map.of_list_multi
|
|
||||||
|> Package.Name.Map.merge packages ~f:(fun _name pkg libs ->
|
|
||||||
let pkg = Option.value_exn pkg in
|
|
||||||
let libs = Option.value libs ~default:[] in
|
|
||||||
Some (pkg, Lib.Set.of_list libs))
|
|
||||||
; env = Hashtbl.create 128
|
|
||||||
}
|
|
||||||
in
|
|
||||||
List.iter stanzas
|
|
||||||
~f:(fun { Dir_with_jbuild. ctx_dir; scope; stanzas; _ } ->
|
|
||||||
List.iter stanzas ~f:(function
|
|
||||||
| Env config ->
|
|
||||||
let inherit_from =
|
|
||||||
if ctx_dir = Scope.root scope then
|
|
||||||
None
|
|
||||||
else
|
|
||||||
Some (lazy (Env.get t ~dir:(Path.parent_exn ctx_dir)))
|
|
||||||
in
|
|
||||||
Hashtbl.add t.env ctx_dir
|
|
||||||
{ dir = ctx_dir
|
|
||||||
; inherit_from = inherit_from
|
|
||||||
; scope = scope
|
|
||||||
; config = config
|
|
||||||
; ocaml_flags = None
|
|
||||||
}
|
|
||||||
| _ -> ()));
|
|
||||||
if not (Hashtbl.mem t.env context.build_dir) then
|
|
||||||
Hashtbl.add t.env context.build_dir
|
|
||||||
{ Env_node.
|
|
||||||
dir = context.build_dir
|
|
||||||
; inherit_from = None
|
|
||||||
; scope = Scope.DB.find_by_dir scopes context.build_dir
|
|
||||||
; config = { loc = Loc.none; rules = [] }
|
|
||||||
; ocaml_flags = None
|
|
||||||
};
|
|
||||||
t
|
|
||||||
|
|
||||||
let prefix_rules t prefix ~f =
|
let prefix_rules t prefix ~f =
|
||||||
Build_system.prefix_rules t.build_system prefix ~f
|
Build_system.prefix_rules t.build_system prefix ~f
|
||||||
|
|
||||||
|
@ -404,126 +123,41 @@ let source_files t ~src_path =
|
||||||
| None -> String.Set.empty
|
| None -> String.Set.empty
|
||||||
| Some dir -> File_tree.Dir.files dir
|
| Some dir -> File_tree.Dir.files dir
|
||||||
|
|
||||||
module Libs = struct
|
|
||||||
open Build.O
|
|
||||||
|
|
||||||
let gen_select_rules t ~dir compile_info =
|
let expand_ocaml_config t pform name =
|
||||||
List.iter (Lib.Compile.resolved_selects compile_info) ~f:(fun rs ->
|
match String.Map.find t.ocaml_config name with
|
||||||
let { Lib.Compile.Resolved_select.dst_fn; src_fn } = rs in
|
| Some x -> x
|
||||||
let dst = Path.relative dir dst_fn in
|
| None ->
|
||||||
add_rule t
|
Loc.fail (String_with_vars.Var.loc pform)
|
||||||
(match src_fn with
|
"Unknown ocaml configuration variable %S"
|
||||||
| Ok src_fn ->
|
name
|
||||||
let src = Path.relative dir src_fn in
|
|
||||||
Build.copy_and_add_line_directive ~src ~dst
|
|
||||||
| Error e ->
|
|
||||||
Build.fail ~targets:[dst]
|
|
||||||
{ fail = fun () ->
|
|
||||||
raise (Lib.Error (No_solution_found_for_select e))
|
|
||||||
}))
|
|
||||||
|
|
||||||
let with_lib_deps t compile_info ~dir ~f =
|
let expand_vars t ~mode ~scope ~dir ?(bindings=Pform.Map.empty) s =
|
||||||
let prefix =
|
String_with_vars.expand ~mode ~dir s ~f:(fun pform syntax_version ->
|
||||||
Build.record_lib_deps (Lib.Compile.user_written_deps compile_info)
|
(match Pform.Map.expand bindings pform syntax_version with
|
||||||
~kind:(if Lib.Compile.optional compile_info then
|
| None -> Pform.Map.expand t.pforms pform syntax_version
|
||||||
Optional
|
| Some _ as x -> x)
|
||||||
else
|
|> Option.map ~f:(function
|
||||||
Required)
|
| Pform.Expansion.Var (Values l) -> l
|
||||||
in
|
| Macro (Ocaml_config, s) -> expand_ocaml_config t pform s
|
||||||
let prefix =
|
| Var Project_root -> [Value.Dir (Scope.root scope)]
|
||||||
if t.context.merlin then
|
| _ ->
|
||||||
Build.path (Path.relative dir ".merlin-exists")
|
Loc.fail (String_with_vars.Var.loc pform)
|
||||||
>>>
|
"%s isn't allowed in this position"
|
||||||
prefix
|
(String_with_vars.Var.describe pform)))
|
||||||
else
|
|
||||||
prefix
|
|
||||||
in
|
|
||||||
prefix_rules t prefix ~f
|
|
||||||
|
|
||||||
let lib_files_alias ~dir ~name ~ext =
|
let expand_vars_string t ~scope ~dir ?bindings s =
|
||||||
Alias.make (sprintf "lib-%s%s-all" name ext) ~dir
|
expand_vars t ~mode:Single ~scope ~dir ?bindings s
|
||||||
|
|> Value.to_string ~dir
|
||||||
|
|
||||||
let setup_file_deps_alias t ~dir ~ext lib files =
|
let expand_vars_path t ~scope ~dir ?bindings s =
|
||||||
add_alias_deps t
|
expand_vars t ~mode:Single ~scope ~dir ?bindings s
|
||||||
(lib_files_alias ~dir ~name:(Library.best_name lib) ~ext) files
|
|> Value.to_path ~error_loc:(String_with_vars.loc s) ~dir
|
||||||
|
|
||||||
let setup_file_deps_group_alias t ~dir ~exts lib =
|
type targets =
|
||||||
setup_file_deps_alias t lib ~dir
|
| Static of Path.t list
|
||||||
~ext:(String.concat exts ~sep:"-and-")
|
| Infer
|
||||||
(List.map exts ~f:(fun ext ->
|
| Alias
|
||||||
Alias.stamp_file
|
|
||||||
(lib_files_alias ~dir ~name:(Library.best_name lib) ~ext))
|
|
||||||
|> Path.Set.of_list)
|
|
||||||
|
|
||||||
let file_deps t libs ~ext =
|
|
||||||
List.rev_map libs ~f:(fun (lib : Lib.t) ->
|
|
||||||
if Lib.is_local lib then
|
|
||||||
Alias.stamp_file
|
|
||||||
(lib_files_alias ~dir:(Lib.src_dir lib) ~name:(Lib.name lib) ~ext)
|
|
||||||
else
|
|
||||||
Build_system.stamp_file_for_files_of t.build_system
|
|
||||||
~dir:(Lib.obj_dir lib) ~ext)
|
|
||||||
end
|
|
||||||
|
|
||||||
module Deps = struct
|
|
||||||
open Build.O
|
|
||||||
open Dep_conf
|
|
||||||
|
|
||||||
let make_alias t ~scope ~dir s =
|
|
||||||
let loc = String_with_vars.loc s in
|
|
||||||
Alias.of_user_written_path ~loc (expand_vars_path t ~scope ~dir s)
|
|
||||||
|
|
||||||
let dep t ~scope ~dir = function
|
|
||||||
| File s ->
|
|
||||||
let path = expand_vars_path t ~scope ~dir s in
|
|
||||||
Build.path path
|
|
||||||
>>^ fun () -> [path]
|
|
||||||
| Alias s ->
|
|
||||||
Alias.dep (make_alias t ~scope ~dir s)
|
|
||||||
>>^ fun () -> []
|
|
||||||
| Alias_rec s ->
|
|
||||||
Alias.dep_rec ~loc:(String_with_vars.loc s) ~file_tree:t.file_tree
|
|
||||||
(make_alias t ~scope ~dir s)
|
|
||||||
>>^ fun () -> []
|
|
||||||
| Glob_files s -> begin
|
|
||||||
let loc = String_with_vars.loc s in
|
|
||||||
let path = expand_vars_path t ~scope ~dir s in
|
|
||||||
match Glob_lexer.parse_string (Path.basename path) with
|
|
||||||
| Ok re ->
|
|
||||||
let dir = Path.parent_exn path in
|
|
||||||
Build.paths_glob ~loc ~dir (Re.compile re)
|
|
||||||
>>^ Path.Set.to_list
|
|
||||||
| Error (_pos, msg) ->
|
|
||||||
Loc.fail (String_with_vars.loc s) "invalid glob: %s" msg
|
|
||||||
end
|
|
||||||
| Source_tree s ->
|
|
||||||
let path = expand_vars_path t ~scope ~dir s in
|
|
||||||
Build.source_tree ~dir:path ~file_tree:t.file_tree
|
|
||||||
>>^ Path.Set.to_list
|
|
||||||
| Package p ->
|
|
||||||
let pkg = Package.Name.of_string (expand_vars_string t ~scope ~dir p) in
|
|
||||||
Alias.dep (Alias.package_install ~context:t.context ~pkg)
|
|
||||||
>>^ fun () -> []
|
|
||||||
| Universe ->
|
|
||||||
Build.path Build_system.universe_file
|
|
||||||
>>^ fun () -> []
|
|
||||||
|
|
||||||
let interpret t ~scope ~dir l =
|
|
||||||
List.map l ~f:(dep t ~scope ~dir)
|
|
||||||
|> Build.all
|
|
||||||
>>^ List.concat
|
|
||||||
|
|
||||||
let interpret_named t ~scope ~dir bindings =
|
|
||||||
List.map bindings ~f:(function
|
|
||||||
| Jbuild.Bindings.Unnamed p ->
|
|
||||||
dep t ~scope ~dir p >>^ fun l ->
|
|
||||||
List.map l ~f:(fun x -> Jbuild.Bindings.Unnamed x)
|
|
||||||
| Named (s, ps) ->
|
|
||||||
Build.all (List.map ps ~f:(dep t ~scope ~dir)) >>^ fun l ->
|
|
||||||
[Jbuild.Bindings.Named (s, List.concat l)])
|
|
||||||
|> Build.all
|
|
||||||
>>^ List.concat
|
|
||||||
end
|
|
||||||
|
|
||||||
module Pkg_version = struct
|
module Pkg_version = struct
|
||||||
open Build.O
|
open Build.O
|
||||||
|
@ -549,24 +183,6 @@ module Pkg_version = struct
|
||||||
Build.vpath spec
|
Build.vpath spec
|
||||||
end
|
end
|
||||||
|
|
||||||
module Scope_key = struct
|
|
||||||
let of_string sctx key =
|
|
||||||
match String.rsplit2 key ~on:'@' with
|
|
||||||
| None ->
|
|
||||||
(key, public_libs sctx)
|
|
||||||
| Some (key, scope) ->
|
|
||||||
( key
|
|
||||||
, Scope.libs (find_scope_by_name sctx (Dune_project.Name.decode scope)))
|
|
||||||
|
|
||||||
let to_string key scope =
|
|
||||||
sprintf "%s@%s" key (Dune_project.Name.encode scope)
|
|
||||||
end
|
|
||||||
|
|
||||||
type targets =
|
|
||||||
| Static of Path.t list
|
|
||||||
| Infer
|
|
||||||
| Alias
|
|
||||||
|
|
||||||
module Expander : sig
|
module Expander : sig
|
||||||
module Resolved_forms : sig
|
module Resolved_forms : sig
|
||||||
type t
|
type t
|
||||||
|
@ -772,6 +388,391 @@ end = struct
|
||||||
)
|
)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
let expand_and_eval_set t ~scope ~dir ?bindings set ~standard =
|
||||||
|
let open Build.O in
|
||||||
|
let parse ~loc:_ s = s in
|
||||||
|
let (syntax, files) =
|
||||||
|
let f = expand_vars_path t ~scope ~dir ?bindings in
|
||||||
|
Ordered_set_lang.Unexpanded.files set ~f in
|
||||||
|
let f = expand_vars t ~mode:Many ~scope ~dir ?bindings in
|
||||||
|
match Path.Set.to_list files with
|
||||||
|
| [] ->
|
||||||
|
let set =
|
||||||
|
Ordered_set_lang.Unexpanded.expand set ~dir
|
||||||
|
~files_contents:Path.Map.empty ~f
|
||||||
|
in
|
||||||
|
standard >>^ fun standard ->
|
||||||
|
Ordered_set_lang.String.eval set ~standard ~parse
|
||||||
|
| paths ->
|
||||||
|
Build.fanout standard (Build.all (List.map paths ~f:(fun f ->
|
||||||
|
Build.read_sexp f syntax)))
|
||||||
|
>>^ fun (standard, sexps) ->
|
||||||
|
let files_contents = List.combine paths sexps |> Path.Map.of_list_exn in
|
||||||
|
let set = Ordered_set_lang.Unexpanded.expand set ~dir ~files_contents ~f in
|
||||||
|
Ordered_set_lang.String.eval set ~standard ~parse
|
||||||
|
|
||||||
|
module Env : sig
|
||||||
|
val ocaml_flags : t -> dir:Path.t -> Ocaml_flags.t
|
||||||
|
val get : t -> dir:Path.t -> Env_node.t
|
||||||
|
end = struct
|
||||||
|
open Env_node
|
||||||
|
|
||||||
|
let rec get t ~dir =
|
||||||
|
match Hashtbl.find t.env dir with
|
||||||
|
| None ->
|
||||||
|
begin match Path.parent dir with
|
||||||
|
| None -> raise_notrace Exit
|
||||||
|
| Some parent ->
|
||||||
|
let node = get t ~dir:parent in
|
||||||
|
Hashtbl.add t.env dir node;
|
||||||
|
node
|
||||||
|
end
|
||||||
|
| Some node -> node
|
||||||
|
|
||||||
|
let get t ~dir =
|
||||||
|
match get t ~dir with
|
||||||
|
| node -> node
|
||||||
|
| exception Exit ->
|
||||||
|
Exn.code_error "Super_context.Env.get called on invalid directory"
|
||||||
|
[ "dir", Path.sexp_of_t dir ]
|
||||||
|
|
||||||
|
let ocaml_flags t ~dir =
|
||||||
|
let rec loop t node =
|
||||||
|
match node.ocaml_flags with
|
||||||
|
| Some x -> x
|
||||||
|
| None ->
|
||||||
|
let default =
|
||||||
|
match node.inherit_from with
|
||||||
|
| None -> Ocaml_flags.default ~profile:(profile t)
|
||||||
|
| Some (lazy node) -> loop t node
|
||||||
|
in
|
||||||
|
let flags =
|
||||||
|
match List.find_map node.config.rules ~f:(fun (pat, cfg) ->
|
||||||
|
match (pat : Env.pattern), profile t with
|
||||||
|
| Any, _ -> Some cfg
|
||||||
|
| Profile a, b -> Option.some_if (a = b) cfg)
|
||||||
|
with
|
||||||
|
| None -> default
|
||||||
|
| Some cfg ->
|
||||||
|
Ocaml_flags.make
|
||||||
|
~flags:cfg.flags
|
||||||
|
~ocamlc_flags:cfg.ocamlc_flags
|
||||||
|
~ocamlopt_flags:cfg.ocamlopt_flags
|
||||||
|
~default
|
||||||
|
~eval:(expand_and_eval_set t ~scope:node.scope ~dir:node.dir
|
||||||
|
?bindings:None)
|
||||||
|
in
|
||||||
|
node.ocaml_flags <- Some flags;
|
||||||
|
flags
|
||||||
|
in
|
||||||
|
loop t (get t ~dir)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
let ocaml_flags t ~dir ~scope (x : Buildable.t) =
|
||||||
|
Ocaml_flags.make
|
||||||
|
~flags:x.flags
|
||||||
|
~ocamlc_flags:x.ocamlc_flags
|
||||||
|
~ocamlopt_flags:x.ocamlopt_flags
|
||||||
|
~default:(Env.ocaml_flags t ~dir)
|
||||||
|
~eval:(expand_and_eval_set t ~scope ~dir ?bindings:None)
|
||||||
|
|
||||||
|
let dump_env t ~dir =
|
||||||
|
Ocaml_flags.dump (Env.ocaml_flags t ~dir)
|
||||||
|
|
||||||
|
let resolve_program t ?hint bin =
|
||||||
|
Artifacts.binary ?hint t.artifacts bin
|
||||||
|
|
||||||
|
let create
|
||||||
|
~(context:Context.t)
|
||||||
|
?host
|
||||||
|
~projects
|
||||||
|
~file_tree
|
||||||
|
~packages
|
||||||
|
~stanzas
|
||||||
|
~external_lib_deps_mode
|
||||||
|
~build_system
|
||||||
|
=
|
||||||
|
let installed_libs =
|
||||||
|
Lib.DB.create_from_findlib context.findlib ~external_lib_deps_mode
|
||||||
|
in
|
||||||
|
let internal_libs =
|
||||||
|
List.concat_map stanzas ~f:(fun { Jbuild_load.Jbuild. dir; stanzas; _ } ->
|
||||||
|
let ctx_dir = Path.append context.build_dir dir in
|
||||||
|
List.filter_map stanzas ~f:(fun stanza ->
|
||||||
|
match (stanza : Stanza.t) with
|
||||||
|
| Library lib -> Some (ctx_dir, lib)
|
||||||
|
| _ -> None))
|
||||||
|
in
|
||||||
|
let scopes, public_libs =
|
||||||
|
Scope.DB.create
|
||||||
|
~projects
|
||||||
|
~context:context.name
|
||||||
|
~installed_libs
|
||||||
|
internal_libs
|
||||||
|
in
|
||||||
|
let stanzas =
|
||||||
|
List.map stanzas
|
||||||
|
~f:(fun { Jbuild_load.Jbuild. dir; project; stanzas; kind } ->
|
||||||
|
let ctx_dir = Path.append context.build_dir dir in
|
||||||
|
{ Dir_with_jbuild.
|
||||||
|
src_dir = dir
|
||||||
|
; ctx_dir
|
||||||
|
; stanzas
|
||||||
|
; scope = Scope.DB.find_by_name scopes project.Dune_project.name
|
||||||
|
; kind
|
||||||
|
})
|
||||||
|
in
|
||||||
|
let stanzas_per_dir =
|
||||||
|
List.map stanzas ~f:(fun stanzas ->
|
||||||
|
(stanzas.Dir_with_jbuild.ctx_dir, stanzas))
|
||||||
|
|> Path.Map.of_list_exn
|
||||||
|
in
|
||||||
|
let stanzas_to_consider_for_install =
|
||||||
|
if not external_lib_deps_mode then
|
||||||
|
List.concat_map stanzas ~f:(fun { ctx_dir; stanzas; scope; kind; _ } ->
|
||||||
|
List.filter_map stanzas ~f:(fun stanza ->
|
||||||
|
let keep =
|
||||||
|
match (stanza : Stanza.t) with
|
||||||
|
| Library lib -> Lib.DB.available (Scope.libs scope) lib.name
|
||||||
|
| Documentation _
|
||||||
|
| Install _ -> true
|
||||||
|
| _ -> false
|
||||||
|
in
|
||||||
|
Option.some_if keep { Installable.
|
||||||
|
dir = ctx_dir
|
||||||
|
; scope
|
||||||
|
; stanza
|
||||||
|
; kind
|
||||||
|
}))
|
||||||
|
else
|
||||||
|
List.concat_map stanzas ~f:(fun { ctx_dir; stanzas; scope; kind; _ } ->
|
||||||
|
List.map stanzas ~f:(fun stanza ->
|
||||||
|
{ Installable.
|
||||||
|
dir = ctx_dir
|
||||||
|
; scope
|
||||||
|
; stanza
|
||||||
|
; kind
|
||||||
|
}))
|
||||||
|
in
|
||||||
|
let artifacts =
|
||||||
|
Artifacts.create context ~public_libs stanzas
|
||||||
|
~f:(fun (d : Dir_with_jbuild.t) -> d.stanzas)
|
||||||
|
in
|
||||||
|
let cxx_flags =
|
||||||
|
List.filter context.ocamlc_cflags
|
||||||
|
~f:(fun s -> not (String.is_prefix s ~prefix:"-std="))
|
||||||
|
in
|
||||||
|
let pforms = Pform.Map.create ~context ~cxx_flags in
|
||||||
|
let ocaml_config =
|
||||||
|
let string s = [Value.String s] in
|
||||||
|
Ocaml_config.to_list context.ocaml_config
|
||||||
|
|> List.map ~f:(fun (k, v) ->
|
||||||
|
( k
|
||||||
|
, match (v : Ocaml_config.Value.t) with
|
||||||
|
| Bool x -> string (string_of_bool x)
|
||||||
|
| Int x -> string (string_of_int x)
|
||||||
|
| String x -> string x
|
||||||
|
| Words x -> Value.L.strings x
|
||||||
|
| Prog_and_args x -> Value.L.strings (x.prog :: x.args)))
|
||||||
|
|> String.Map.of_list_exn
|
||||||
|
in
|
||||||
|
let t =
|
||||||
|
{ context
|
||||||
|
; host
|
||||||
|
; build_system
|
||||||
|
; scopes
|
||||||
|
; public_libs
|
||||||
|
; installed_libs
|
||||||
|
; stanzas
|
||||||
|
; stanzas_per_dir
|
||||||
|
; packages
|
||||||
|
; file_tree
|
||||||
|
; stanzas_to_consider_for_install
|
||||||
|
; artifacts
|
||||||
|
; cxx_flags
|
||||||
|
; pforms
|
||||||
|
; ocaml_config
|
||||||
|
; chdir = Build.arr (fun (action : Action.t) ->
|
||||||
|
match action with
|
||||||
|
| Chdir _ -> action
|
||||||
|
| _ -> Chdir (context.build_dir, action))
|
||||||
|
; libs_by_package =
|
||||||
|
Lib.DB.all public_libs
|
||||||
|
|> Lib.Set.to_list
|
||||||
|
|> List.map ~f:(fun lib ->
|
||||||
|
(Option.value_exn (Lib.package lib), lib))
|
||||||
|
|> Package.Name.Map.of_list_multi
|
||||||
|
|> Package.Name.Map.merge packages ~f:(fun _name pkg libs ->
|
||||||
|
let pkg = Option.value_exn pkg in
|
||||||
|
let libs = Option.value libs ~default:[] in
|
||||||
|
Some (pkg, Lib.Set.of_list libs))
|
||||||
|
; env = Hashtbl.create 128
|
||||||
|
}
|
||||||
|
in
|
||||||
|
List.iter stanzas
|
||||||
|
~f:(fun { Dir_with_jbuild. ctx_dir; scope; stanzas; _ } ->
|
||||||
|
List.iter stanzas ~f:(function
|
||||||
|
| Env config ->
|
||||||
|
let inherit_from =
|
||||||
|
if ctx_dir = Scope.root scope then
|
||||||
|
None
|
||||||
|
else
|
||||||
|
Some (lazy (Env.get t ~dir:(Path.parent_exn ctx_dir)))
|
||||||
|
in
|
||||||
|
Hashtbl.add t.env ctx_dir
|
||||||
|
{ dir = ctx_dir
|
||||||
|
; inherit_from = inherit_from
|
||||||
|
; scope = scope
|
||||||
|
; config = config
|
||||||
|
; ocaml_flags = None
|
||||||
|
}
|
||||||
|
| _ -> ()));
|
||||||
|
if not (Hashtbl.mem t.env context.build_dir) then
|
||||||
|
Hashtbl.add t.env context.build_dir
|
||||||
|
{ Env_node.
|
||||||
|
dir = context.build_dir
|
||||||
|
; inherit_from = None
|
||||||
|
; scope = Scope.DB.find_by_dir scopes context.build_dir
|
||||||
|
; config = { loc = Loc.none; rules = [] }
|
||||||
|
; ocaml_flags = None
|
||||||
|
};
|
||||||
|
t
|
||||||
|
module Libs = struct
|
||||||
|
open Build.O
|
||||||
|
|
||||||
|
let gen_select_rules t ~dir compile_info =
|
||||||
|
List.iter (Lib.Compile.resolved_selects compile_info) ~f:(fun rs ->
|
||||||
|
let { Lib.Compile.Resolved_select.dst_fn; src_fn } = rs in
|
||||||
|
let dst = Path.relative dir dst_fn in
|
||||||
|
add_rule t
|
||||||
|
(match src_fn with
|
||||||
|
| Ok src_fn ->
|
||||||
|
let src = Path.relative dir src_fn in
|
||||||
|
Build.copy_and_add_line_directive ~src ~dst
|
||||||
|
| Error e ->
|
||||||
|
Build.fail ~targets:[dst]
|
||||||
|
{ fail = fun () ->
|
||||||
|
raise (Lib.Error (No_solution_found_for_select e))
|
||||||
|
}))
|
||||||
|
|
||||||
|
let with_lib_deps t compile_info ~dir ~f =
|
||||||
|
let prefix =
|
||||||
|
Build.record_lib_deps (Lib.Compile.user_written_deps compile_info)
|
||||||
|
~kind:(if Lib.Compile.optional compile_info then
|
||||||
|
Optional
|
||||||
|
else
|
||||||
|
Required)
|
||||||
|
in
|
||||||
|
let prefix =
|
||||||
|
if t.context.merlin then
|
||||||
|
Build.path (Path.relative dir ".merlin-exists")
|
||||||
|
>>>
|
||||||
|
prefix
|
||||||
|
else
|
||||||
|
prefix
|
||||||
|
in
|
||||||
|
prefix_rules t prefix ~f
|
||||||
|
|
||||||
|
let lib_files_alias ~dir ~name ~ext =
|
||||||
|
Alias.make (sprintf "lib-%s%s-all" name ext) ~dir
|
||||||
|
|
||||||
|
let setup_file_deps_alias t ~dir ~ext lib files =
|
||||||
|
add_alias_deps t
|
||||||
|
(lib_files_alias ~dir ~name:(Library.best_name lib) ~ext) files
|
||||||
|
|
||||||
|
let setup_file_deps_group_alias t ~dir ~exts lib =
|
||||||
|
setup_file_deps_alias t lib ~dir
|
||||||
|
~ext:(String.concat exts ~sep:"-and-")
|
||||||
|
(List.map exts ~f:(fun ext ->
|
||||||
|
Alias.stamp_file
|
||||||
|
(lib_files_alias ~dir ~name:(Library.best_name lib) ~ext))
|
||||||
|
|> Path.Set.of_list)
|
||||||
|
|
||||||
|
let file_deps t libs ~ext =
|
||||||
|
List.rev_map libs ~f:(fun (lib : Lib.t) ->
|
||||||
|
if Lib.is_local lib then
|
||||||
|
Alias.stamp_file
|
||||||
|
(lib_files_alias ~dir:(Lib.src_dir lib) ~name:(Lib.name lib) ~ext)
|
||||||
|
else
|
||||||
|
Build_system.stamp_file_for_files_of t.build_system
|
||||||
|
~dir:(Lib.obj_dir lib) ~ext)
|
||||||
|
end
|
||||||
|
|
||||||
|
module Deps = struct
|
||||||
|
open Build.O
|
||||||
|
open Dep_conf
|
||||||
|
|
||||||
|
let make_alias t ~scope ~dir s =
|
||||||
|
let loc = String_with_vars.loc s in
|
||||||
|
Alias.of_user_written_path ~loc (expand_vars_path t ~scope ~dir s)
|
||||||
|
|
||||||
|
let dep t ~scope ~dir = function
|
||||||
|
| File s ->
|
||||||
|
let path = expand_vars_path t ~scope ~dir s in
|
||||||
|
Build.path path
|
||||||
|
>>^ fun () -> [path]
|
||||||
|
| Alias s ->
|
||||||
|
Alias.dep (make_alias t ~scope ~dir s)
|
||||||
|
>>^ fun () -> []
|
||||||
|
| Alias_rec s ->
|
||||||
|
Alias.dep_rec ~loc:(String_with_vars.loc s) ~file_tree:t.file_tree
|
||||||
|
(make_alias t ~scope ~dir s)
|
||||||
|
>>^ fun () -> []
|
||||||
|
| Glob_files s -> begin
|
||||||
|
let loc = String_with_vars.loc s in
|
||||||
|
let path = expand_vars_path t ~scope ~dir s in
|
||||||
|
match Glob_lexer.parse_string (Path.basename path) with
|
||||||
|
| Ok re ->
|
||||||
|
let dir = Path.parent_exn path in
|
||||||
|
Build.paths_glob ~loc ~dir (Re.compile re)
|
||||||
|
>>^ Path.Set.to_list
|
||||||
|
| Error (_pos, msg) ->
|
||||||
|
Loc.fail (String_with_vars.loc s) "invalid glob: %s" msg
|
||||||
|
end
|
||||||
|
| Source_tree s ->
|
||||||
|
let path = expand_vars_path t ~scope ~dir s in
|
||||||
|
Build.source_tree ~dir:path ~file_tree:t.file_tree
|
||||||
|
>>^ Path.Set.to_list
|
||||||
|
| Package p ->
|
||||||
|
let pkg = Package.Name.of_string (expand_vars_string t ~scope ~dir p) in
|
||||||
|
Alias.dep (Alias.package_install ~context:t.context ~pkg)
|
||||||
|
>>^ fun () -> []
|
||||||
|
| Universe ->
|
||||||
|
Build.path Build_system.universe_file
|
||||||
|
>>^ fun () -> []
|
||||||
|
|
||||||
|
let interpret t ~scope ~dir l =
|
||||||
|
List.map l ~f:(dep t ~scope ~dir)
|
||||||
|
|> Build.all
|
||||||
|
>>^ List.concat
|
||||||
|
|
||||||
|
let interpret_named t ~scope ~dir bindings =
|
||||||
|
List.map bindings ~f:(function
|
||||||
|
| Jbuild.Bindings.Unnamed p ->
|
||||||
|
dep t ~scope ~dir p >>^ fun l ->
|
||||||
|
List.map l ~f:(fun x -> Jbuild.Bindings.Unnamed x)
|
||||||
|
| Named (s, ps) ->
|
||||||
|
Build.all (List.map ps ~f:(dep t ~scope ~dir)) >>^ fun l ->
|
||||||
|
[Jbuild.Bindings.Named (s, List.concat l)])
|
||||||
|
|> Build.all
|
||||||
|
>>^ List.concat
|
||||||
|
end
|
||||||
|
|
||||||
|
module Scope_key = struct
|
||||||
|
let of_string sctx key =
|
||||||
|
match String.rsplit2 key ~on:'@' with
|
||||||
|
| None ->
|
||||||
|
(key, public_libs sctx)
|
||||||
|
| Some (key, scope) ->
|
||||||
|
( key
|
||||||
|
, Scope.libs (find_scope_by_name sctx (Dune_project.Name.decode scope)))
|
||||||
|
|
||||||
|
let to_string key scope =
|
||||||
|
sprintf "%s@%s" key (Dune_project.Name.encode scope)
|
||||||
|
end
|
||||||
|
|
||||||
module Action = struct
|
module Action = struct
|
||||||
open Build.O
|
open Build.O
|
||||||
module U = Action.Unexpanded
|
module U = Action.Unexpanded
|
||||||
|
|
Loading…
Reference in New Issue