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

Merge pull request #451 from rgrinberg/scope-refactor 

Scope Refactor
This commit is contained in:
Rudi Grinberg 2018-01-30 19:25:53 +08:00 committed by GitHub
parent a3ff5e5f30 672120b3b8
commit f6cefa40cc
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
16 changed files with 444 additions and 334 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/findlib.ml
View File

@ -252,7 +252,7 @@ module External_dep_conflicts_with_local_lib = struct
type t =
{ package : string
; required_by : string
; required_locally_in : Path.t
; required_locally_in : string list
; defined_locally_in : Path.t
}
end

6
src/findlib.mli
View File

@ -26,7 +26,7 @@ module External_dep_conflicts_with_local_lib : sig
type t =
{ package : string
; required_by : string
; required_locally_in : Path.t
; required_locally_in : string list
; defined_locally_in : Path.t
}
end
@ -69,12 +69,12 @@ val root_package_name : string -> string
(** [local_public_libs] is a map from public library names to where they are defined in
the workspace. These must not appear as dependency of a findlib package *)
val closure
: required_by:Path.t
: required_by:string list
-> local_public_libs:Path.t String_map.t
-> package list
-> package list
val closed_ppx_runtime_deps_of
: required_by:Path.t
: required_by:string list
-> local_public_libs:Path.t String_map.t
-> package list
-> package list

21
src/gen_meta.ml
View File

@ -32,7 +32,8 @@ module Pub_name = struct
let to_string t = String.concat ~sep:"." (to_list t)
end
type item = Lib of Path.t * Pub_name.t * Library.t
type item =
Lib of Lib_db.Scope.t Lib_db.with_required_by * Pub_name.t * Library.t
let string_of_deps l =
String.concat (List.sort l ~cmp:String.compare) ~sep:" "
@ -123,14 +124,14 @@ let gen_lib pub_name (lib : Library.t) ~lib_deps ~ppx_runtime_deps:ppx_rt_deps
)
]
let gen ~package ~version ~stanzas ~resolve_lib_dep_names
~all_ppx_runtime_deps_exn =
let gen ~package ~scope ~version ~stanzas =
let items =
List.filter_map stanzas ~f:(fun (dir, stanza) ->
match (stanza : Stanza.t) with
| Library ({ public = Some { name; package = p; _ }; _ } as lib)
when p.name = package ->
Some (Lib (dir, Pub_name.parse name, lib))
let scope = Lib_db.Scope.required_in_jbuild scope ~jbuild_dir:dir in
Some (Lib (scope, Pub_name.parse name, lib))
| _ ->
None)
in
@ -140,18 +141,19 @@ let gen ~package ~version ~stanzas ~resolve_lib_dep_names
| Some s -> [rule "version" [] Set s]
in
let pkgs =
List.map items ~f:(fun (Lib (dir, pub_name, lib)) ->
let lib_deps = resolve_lib_dep_names ~dir lib.buildable.libraries in
List.map items ~f:(fun (Lib (scope, pub_name, lib)) ->
let lib_deps = Lib_db.Scope.best_lib_dep_names_exn scope
lib.buildable.libraries in
let lib_deps =
match Preprocess_map.pps lib.buildable.preprocess with
| [] -> lib_deps
| pps ->
lib_deps @
String_set.elements
(all_ppx_runtime_deps_exn ~dir (List.map pps ~f:Lib_dep.of_pp))
(Lib_db.Scope.all_ppx_runtime_deps_exn scope (List.map pps ~f:Lib_dep.of_pp))
in
let ppx_runtime_deps =
resolve_lib_dep_names ~dir
Lib_db.Scope.best_lib_dep_names_exn scope
(List.map lib.ppx_runtime_libraries ~f:Lib_dep.direct)
in
(* For the deprecated method, we need to put the transitive closure of the ppx
@ -166,8 +168,7 @@ let gen ~package ~version ~stanzas ~resolve_lib_dep_names
let ppx_runtime_deps_for_deprecated_method = lazy (
String_set.union
(String_set.of_list ppx_runtime_deps)
(all_ppx_runtime_deps_exn ~dir
lib.buildable.libraries)
(Lib_db.Scope.all_ppx_runtime_deps_exn scope lib.buildable.libraries)
|> String_set.elements)
in
(pub_name,

4
src/gen_meta.mli
View File

@ -4,9 +4,7 @@ open! Import
val gen
: package:string
-> scope:Lib_db.Scope.t
-> version:string option
-> stanzas:(Path.t * Jbuild.Stanza.t) list
-> resolve_lib_dep_names:(dir:Path.t -> Jbuild.Lib_dep.t list -> string list)
-> all_ppx_runtime_deps_exn:
(dir:Path.t -> Jbuild.Lib_dep.t list -> String_set.t)
-> Meta.t

78
src/gen_rules.ml
View File

@ -52,15 +52,16 @@ module Gen(P : Params) = struct
List.map locks ~f:(fun s ->
Path.relative dir (SC.expand_vars sctx ~dir ~scope s))
let user_rule (rule : Rule.t) ~dir ~scope =
let user_rule (rule : Rule.t) ~dir
~(scope : Lib_db.Scope.t Lib_db.with_required_by) =
let targets : SC.Action.targets =
match rule.targets with
| Infer -> Infer
| Static fns -> Static (List.map fns ~f:(Path.relative dir))
in
SC.add_rule_get_targets sctx ~mode:rule.mode ~loc:rule.loc
~locks:(interpret_locks ~dir ~scope rule.locks)
(SC.Deps.interpret sctx ~scope ~dir rule.deps
~locks:(interpret_locks ~dir ~scope:scope.data rule.locks)
(SC.Deps.interpret sctx ~scope:scope.data ~dir rule.deps
>>>
SC.Action.run
sctx
@ -70,10 +71,11 @@ module Gen(P : Params) = struct
~targets
~scope)
let copy_files_rules (def: Copy_files.t) ~src_dir ~dir ~scope =
let copy_files_rules (def: Copy_files.t) ~src_dir ~dir
~(scope : Lib_db.Scope.t Lib_db.with_required_by) =
let loc = String_with_vars.loc def.glob in
let glob_in_src =
let src_glob = SC.expand_vars sctx ~dir def.glob ~scope in
let src_glob = SC.expand_vars sctx ~dir def.glob ~scope:scope.data in
Path.relative src_dir src_glob ~error_loc:loc
in
(* The following condition is required for merlin to work.
@ -128,7 +130,8 @@ module Gen(P : Params) = struct
| Rule rule ->
List.map (user_rule rule ~dir ~scope) ~f:Path.basename
| Copy_files def ->
List.map (copy_files_rules def ~src_dir ~dir ~scope) ~f:Path.basename
List.map (copy_files_rules def ~src_dir ~dir ~scope)
~f:Path.basename
| Library { buildable; _ } | Executables { buildable; _ } ->
(* Manually add files generated by the (select ...)
dependencies *)
@ -226,7 +229,10 @@ Add it to your jbuild file to remove this warning.
~dir
~dep_kind:Required
~targets:Infer
~scope:Scope.empty);
~scope:(
Lib_db.Scope.required_in_jbuild (SC.Libs.anonymous_scope sctx)
~jbuild_dir:dir
));
{ intf with name = impl_fname } in
String_map.merge impls intfs ~f:(fun name impl intf ->
let impl =
@ -449,9 +455,10 @@ Add it to your jbuild file to remove this warning.
let alias_module_build_sandbox = Scanf.sscanf ctx.version "%u.%u"
(fun a b -> a, b) <= (4, 02)
let library_rules (lib : Library.t) ~dir ~files ~scope =
let library_rules (lib : Library.t) ~dir ~files
~(scope : Lib_db.Scope.t Lib_db.with_required_by) =
let dep_kind = if lib.optional then Build.Optional else Required in
let flags = Ocaml_flags.make lib.buildable sctx ~scope ~dir in
let flags = Ocaml_flags.make lib.buildable sctx ~scope:scope.data ~dir in
let { modules; main_module_name; alias_module } = modules_by_lib ~dir lib in
(* Preprocess before adding the alias module as it doesn't need preprocessing *)
let modules =
@ -488,22 +495,22 @@ Add it to your jbuild file to remove this warning.
>>> Build.write_file_dyn (Path.relative dir m.impl.name)));
let requires, real_requires =
SC.Libs.requires sctx ~dir ~dep_kind ~item:lib.name
SC.Libs.requires sctx ~dir ~scope ~dep_kind ~item:lib.name
~libraries:lib.buildable.libraries
~preprocess:lib.buildable.preprocess
~virtual_deps:lib.virtual_deps
~has_dot_merlin:lib.buildable.gen_dot_merlin
in
SC.Libs.setup_runtime_deps sctx ~dir ~dep_kind ~item:lib.name
SC.Libs.setup_runtime_deps sctx ~dir ~scope ~dep_kind ~item:lib.name
~libraries:lib.buildable.libraries
~ppx_runtime_libraries:lib.ppx_runtime_libraries;
SC.Libs.add_select_rules sctx ~dir lib.buildable.libraries;
SC.Libs.add_select_rules sctx ~dir ~scope lib.buildable.libraries;
let dynlink = lib.dynlink in
let js_of_ocaml = lib.buildable.js_of_ocaml in
Module_compilation.build_modules sctx
~js_of_ocaml ~dynlink ~flags ~scope ~dir ~dep_graph ~modules ~requires ~alias_module;
~js_of_ocaml ~dynlink ~flags ~scope:scope.data ~dir ~dep_graph ~modules ~requires ~alias_module;
Option.iter alias_module ~f:(fun m ->
let flags = Ocaml_flags.default () in
Module_compilation.build_module sctx m
@ -511,7 +518,7 @@ Add it to your jbuild file to remove this warning.
~dynlink
~sandbox:alias_module_build_sandbox
~flags:(Ocaml_flags.append_common flags ["-w"; "-49"])
~scope
~scope:scope.data
~dir
~modules:(String_map.singleton m.name m)
~dep_graph:(Ml_kind.Dict.make_both (Build.return (String_map.singleton m.name [])))
@ -540,15 +547,19 @@ Add it to your jbuild file to remove this warning.
Build.memoize "header files"
(requires >>> SC.Libs.file_deps sctx ~ext:".h")
in
List.map lib.c_names ~f:(build_c_file lib ~scope ~dir ~requires ~h_files) @
List.map lib.cxx_names ~f:(build_cxx_file lib ~scope ~dir ~requires ~h_files)
List.map lib.c_names ~f:(
build_c_file lib ~scope:scope.data ~dir ~requires ~h_files
) @ List.map lib.cxx_names ~f:(
build_cxx_file lib ~scope:scope.data ~dir ~requires ~h_files
)
in
match lib.self_build_stubs_archive with
| Some _ -> ()
| None ->
let ocamlmklib ~sandbox ~custom ~targets =
SC.add_rule sctx ~sandbox
(SC.expand_and_eval_set sctx ~scope ~dir lib.c_library_flags ~standard:[]
(SC.expand_and_eval_set sctx ~scope:scope.data ~dir
lib.c_library_flags ~standard:[]
>>>
Build.run ~context:ctx
~extra_targets:targets
@ -598,11 +609,12 @@ Add it to your jbuild file to remove this warning.
Path.relative dir (header ^ ".h")));
List.iter Mode.all ~f:(fun mode ->
build_lib lib ~scope ~flags ~dir ~mode ~modules ~dep_graph);
build_lib lib ~scope:scope.data ~flags ~dir ~mode ~modules ~dep_graph);
(* Build *.cma.js *)
SC.add_rules sctx (
let src = lib_archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) in
Js_of_ocaml_rules.build_cm sctx ~scope ~dir ~js_of_ocaml:lib.buildable.js_of_ocaml ~src);
Js_of_ocaml_rules.build_cm sctx ~scope:scope.data ~dir
~js_of_ocaml:lib.buildable.js_of_ocaml ~src);
if ctx.natdynlink_supported then
Option.iter ctx.ocamlopt ~f:(fun ocamlopt ->
@ -718,9 +730,10 @@ Add it to your jbuild file to remove this warning.
in
SC.add_rules sctx (List.map rules ~f:(fun r -> libs_and_cm_and_flags >>> r))
let executables_rules (exes : Executables.t) ~dir ~all_modules ~scope =
let executables_rules (exes : Executables.t) ~dir ~all_modules
~(scope : Lib_db.Scope.t Lib_db.with_required_by) =
let dep_kind = Build.Required in
let flags = Ocaml_flags.make exes.buildable sctx ~scope ~dir in
let flags = Ocaml_flags.make exes.buildable sctx ~scope:scope.data ~dir in
let modules =
parse_modules ~dir ~all_modules ~modules_written_by_user:exes.buildable.modules
in
@ -748,25 +761,25 @@ Add it to your jbuild file to remove this warning.
in
let requires, real_requires =
SC.Libs.requires sctx ~dir ~dep_kind ~item
SC.Libs.requires sctx ~dir ~scope ~dep_kind ~item
~libraries:exes.buildable.libraries
~preprocess:exes.buildable.preprocess
~virtual_deps:[]
~has_dot_merlin:exes.buildable.gen_dot_merlin
in
SC.Libs.add_select_rules sctx ~dir exes.buildable.libraries;
SC.Libs.add_select_rules sctx ~dir ~scope exes.buildable.libraries;
(* CR-someday jdimino: this should probably say [~dynlink:false] *)
Module_compilation.build_modules sctx
~js_of_ocaml:exes.buildable.js_of_ocaml
~dynlink:true ~flags ~scope ~dir ~dep_graph ~modules
~dynlink:true ~flags ~scope:scope.data ~dir ~dep_graph ~modules
~requires ~alias_module:None;
List.iter exes.names ~f:(fun name ->
List.iter Mode.all ~f:(fun mode ->
build_exe ~js_of_ocaml:exes.buildable.js_of_ocaml ~flags ~scope ~dir ~requires ~name
~mode ~modules ~dep_graph ~link_flags:exes.link_flags
build_exe ~js_of_ocaml:exes.buildable.js_of_ocaml ~flags ~scope:scope.data
~dir ~requires ~name ~mode ~modules ~dep_graph ~link_flags:exes.link_flags
~force_custom_bytecode:(mode = Native && not exes.modes.native)));
{ Merlin.
requires = real_requires
@ -784,7 +797,8 @@ Add it to your jbuild file to remove this warning.
let alias = Build_system.Alias.make name ~dir in
SC.add_alias_action sctx alias ~locks ~stamp build
let alias_rules (alias_conf : Alias_conf.t) ~dir ~scope =
let alias_rules (alias_conf : Alias_conf.t) ~dir
~(scope : Lib_db.Scope.t Lib_db.with_required_by) =
let stamp =
let module S = Sexp.To_sexp in
Sexp.List
@ -797,8 +811,8 @@ Add it to your jbuild file to remove this warning.
~dir
~name:alias_conf.name
~stamp
~locks:(interpret_locks ~dir ~scope alias_conf.locks)
(SC.Deps.interpret sctx ~scope ~dir alias_conf.deps
~locks:(interpret_locks ~dir ~scope:scope.data alias_conf.locks)
(SC.Deps.interpret sctx ~scope:scope.data ~dir alias_conf.deps
>>>
match alias_conf.action with
| None -> Build.progn []
@ -832,7 +846,7 @@ Add it to your jbuild file to remove this warning.
| Copy_files { glob; _ } ->
let src_dir =
let loc = String_with_vars.loc glob in
let src_glob = SC.expand_vars sctx ~dir glob ~scope in
let src_glob = SC.expand_vars sctx ~dir glob ~scope:scope.data in
Path.parent (Path.relative src_dir src_glob ~error_loc:loc)
in
Some
@ -901,11 +915,11 @@ Add it to your jbuild file to remove this warning.
in
let meta_contents =
version >>^ fun version ->
let scope = Lib_db.find_scope (SC.libs sctx) ~dir:path in
Gen_meta.gen ~package:pkg.name
~scope
~version
~stanzas:(SC.stanzas_to_consider_for_install sctx)
~resolve_lib_dep_names:(SC.Libs.best_lib_dep_names_exn sctx)
~all_ppx_runtime_deps_exn:(SC.Libs.all_ppx_runtime_deps_exn sctx)
in
SC.add_rule sctx
(Build.fanout meta_contents template

3
src/jbuild_load.ml
View File

@ -119,7 +119,8 @@ end
let pkgs =
List.map requires ~f:(Findlib.find_exn context.findlib
~required_by:[Utils.jbuild_name_in ~dir:dir])
|> Findlib.closure ~required_by:dir ~local_public_libs:String_map.empty
|> Findlib.closure ~required_by:[Utils.jbuild_name_in ~dir]
~local_public_libs:String_map.empty
in
let includes =
List.fold_left pkgs ~init:Path.Set.empty ~f:(fun acc pkg ->

2
src/js_of_ocaml_rules.mli
View File

@ -4,7 +4,7 @@ open Jbuild
val build_cm
: Super_context.t
-> scope:Scope.t
-> scope:Lib_db.Scope.t
-> dir:Path.t
-> js_of_ocaml:Js_of_ocaml.t
-> src:Path.t

378
src/lib_db.ml
View File

@ -16,10 +16,9 @@ type t =
dependencies *)
instalable_internal_libs : Lib.Internal.t String_map.t
; local_public_libs : Path.t String_map.t
; anonymous_root : Path.t
}
let local_public_libs t = t.local_public_libs
let rec internal_name_scope t ~dir =
match Hashtbl.find t.by_internal_name dir with
| Some scope -> scope
@ -30,41 +29,210 @@ let rec internal_name_scope t ~dir =
Hashtbl.add t.by_internal_name ~key:dir ~data:scope;
scope
let find_by_internal_name t ~from name =
let scope = internal_name_scope t ~dir:from in
String_map.find name scope.libs
type 'a with_required_by =
{ required_by: string list
; data: 'a
}
let find_exn t ~from name =
match find_by_internal_name t ~from name with
| Some x -> Lib.Internal x
| None ->
Hashtbl.find_or_add t.by_public_name name
~f:(fun name ->
External (Findlib.find_exn t.findlib name
~required_by:[Utils.jbuild_name_in ~dir:from]))
type resolved_select =
{ src_fn : string
; dst_fn : string
}
let find t ~from name =
match find_exn t ~from name with
| exception (Findlib.Findlib _) -> None
| x -> Some x
module Scope = struct
type nonrec t =
{ scope : scope
; lib_db : t
}
let find_internal t ~from name =
match find_by_internal_name t ~from name with
| Some _ as some -> some
| None ->
match Hashtbl.find t.by_public_name name with
| Some (Internal x) -> Some x
| _ -> None
let find_exn (t : t with_required_by) name =
match String_map.find name t.data.scope.libs with
| Some l -> Lib.Internal l
| None ->
Hashtbl.find_or_add t.data.lib_db.by_public_name name
~f:(fun name ->
External (Findlib.find_exn t.data.lib_db.findlib name
~required_by:t.required_by))
let find t name =
match find_exn t name with
| exception (Findlib.Findlib _) -> None
| x -> Some x
let find_internal' t name =
match String_map.find name t.scope.libs with
| Some _ as some -> some
| None ->
match Hashtbl.find t.lib_db.by_public_name name with
| Some (Internal x) -> Some x
| _ -> None
let find_internal t name = find_internal' t.data name
let lib_is_available (t : t with_required_by) name =
match find_internal t name with
| Some (_, lib) -> String_map.mem lib.name t.data.lib_db.instalable_internal_libs
| None -> Findlib.available t.data.lib_db.findlib name ~required_by:t.required_by
let choice_is_possible t { Lib_dep.required; forbidden; _ } =
String_set.for_all required ~f:(fun name -> lib_is_available t name ) &&
String_set.for_all forbidden ~f:(fun name -> not (lib_is_available t name))
let dep_is_available t dep =
match (dep : Lib_dep.t) with
| Direct s -> lib_is_available t s
| Select { choices; _ } -> List.exists choices ~f:(choice_is_possible t)
let interpret_lib_dep (t : t with_required_by) lib_dep =
match lib_dep with
| Lib_dep.Direct name -> begin
match find_exn t name with
| x -> Inl [x]
| exception _ ->
(* Call [find] again to get a proper backtrace *)
Inr { fail = fun () ->
ignore (find_exn t name : Lib.t);
assert false }
end
| Select { choices; loc; _ } ->
match
List.find_map choices ~f:(fun { required; forbidden; _ } ->
if String_set.exists forbidden ~f:(lib_is_available t) then
None
else
match
List.map (String_set.elements required) ~f:(find_exn t)
with
| l -> Some l
| exception (Findlib.Findlib _) -> None)
with
| Some l -> Inl l
| None ->
Inr { fail = fun () ->
Loc.fail loc "No solution found for this select form"
}
let interpret_lib_deps t lib_deps =
let libs, failures =
List.partition_map lib_deps ~f:(interpret_lib_dep t)
in
let internals, externals =
List.partition_map (List.concat libs) ~f:(function
| Internal x -> Inl x
| External x -> Inr x)
in
(internals, externals,
match failures with
| [] -> None
| f :: _ -> Some f)
let best_lib_dep_names_exn t lib_deps =
List.concat_map lib_deps ~f:(fun lib_dep ->
match interpret_lib_dep t lib_dep with
| Inl libs -> List.map libs ~f:Lib.best_name
| Inr fail -> fail.fail ())
let resolve_selects t lib_deps =
List.filter_map lib_deps ~f:(function
| Lib_dep.Direct _ -> None
| Select { result_fn; choices; _ } ->
let src_fn =
match List.find choices ~f:(choice_is_possible t) with
| Some c -> c.file
| None -> "no solution found"
in
Some { dst_fn = result_fn; src_fn })
let root t = t.scope.scope.root
let resolve t =
(* TODO do something with required_by here *)
Jbuild.Scope.resolve t.data.scope.scope
let required_in_jbuild t ~jbuild_dir =
{ required_by = [Utils.jbuild_name_in ~dir:jbuild_dir]
; data = t }
let find_scope t ~dir =
{ lib_db = t
; scope = internal_name_scope t ~dir
}
let find_scope' t ~dir =
let scope = find_scope t ~dir in
required_in_jbuild scope ~jbuild_dir:dir
(* Fold the transitive closure, not necessarily in topological order *)
let fold_transitive_closure scope ~deep_traverse_externals lib_deps ~init ~f =
let seen = ref String_set.empty in
let rec loop scope acc lib_dep =
match interpret_lib_dep scope lib_dep with
| Inr fail -> fail.fail ()
| Inl libs -> List.fold_left libs ~init:acc ~f:process
and process acc (lib : Lib.t) =
let unique_id =
match lib with
| External pkg -> pkg.name
| Internal (dir, lib) ->
match lib.public with
| Some p -> p.name
| None -> Path.to_string dir ^ "\000" ^ lib.name
in
if String_set.mem unique_id !seen then
acc
else begin
seen := String_set.add unique_id !seen;
let acc = f lib acc in
match lib with
| Internal (dir, lib) ->
let scope = find_scope' scope.data.lib_db ~dir in
List.fold_left lib.buildable.libraries ~init:acc ~f:(loop scope)
| External pkg ->
if deep_traverse_externals then
List.fold_left pkg.requires ~init:acc ~f:(fun acc pkg ->
process acc (External pkg))
else begin
seen :=
String_set.union !seen
(String_set.of_list
(List.map pkg.requires ~f:(fun p -> p.Findlib.name)));
acc
end
end
in
List.fold_left lib_deps ~init ~f:(loop scope)
let all_ppx_runtime_deps_exn scope lib_deps =
(* The [ppx_runtime_deps] of [Findlib.package] already holds the transitive closure. *)
let deep_traverse_externals = false in
fold_transitive_closure scope ~deep_traverse_externals lib_deps
~init:String_set.empty ~f:(fun lib acc ->
let rt_deps =
match lib with
| Internal (dir, lib) ->
let scope = lazy (find_scope' scope.data.lib_db ~dir) in
List.map lib.ppx_runtime_libraries ~f:(fun name ->
Lib.best_name (find_exn (Lazy.force scope) name))
| External pkg ->
List.map pkg.ppx_runtime_deps ~f:(fun p -> p.Findlib.name)
in
String_set.union acc (String_set.of_list rt_deps))
end
let find_scope = Scope.find_scope
let find_scope' = Scope.find_scope'
let local_public_libs t = t.local_public_libs
module Local_closure = Top_closure.Make(String)(struct
type graph = t
type t = Lib.Internal.t
let key ((_, lib) : t) = lib.name
let deps ((dir, lib) : Lib.Internal.t) graph =
let scope = find_scope' graph ~dir in
List.concat_map lib.buildable.libraries ~f:(fun dep ->
List.filter_map (Lib_dep.to_lib_names dep) ~f:(find_internal ~from:dir graph)) @
List.filter_map (Lib_dep.to_lib_names dep) ~f:(Scope.find_internal scope)) @
List.filter_map lib.ppx_runtime_libraries ~f:(fun dep ->
find_internal ~from:dir graph dep)
Scope.find_internal scope dep)
end)
let top_sort_internals t ~internal_libraries =
@ -75,26 +243,13 @@ let top_sort_internals t ~internal_libraries =
(List.map cycle ~f:(fun lib -> Lib.describe (Internal lib))
|> String.concat ~sep:"\n-> ")
let lib_is_available t ~from name =
match find_internal t ~from name with
| Some (_, lib) -> String_map.mem lib.name t.instalable_internal_libs
| None -> Findlib.available t.findlib name ~required_by:[Utils.jbuild_name_in ~dir:from]
let choice_is_possible t ~from { Lib_dep.required; forbidden; _ } =
String_set.for_all required ~f:(fun name -> lib_is_available t ~from name ) &&
String_set.for_all forbidden ~f:(fun name -> not (lib_is_available t ~from name))
let dep_is_available t ~from dep =
match (dep : Lib_dep.t) with
| Direct s -> lib_is_available t ~from s
| Select { choices; _ } -> List.exists choices ~f:(choice_is_possible t ~from)
let compute_instalable_internal_libs t ~internal_libraries =
List.fold_left (top_sort_internals t ~internal_libraries) ~init:t
~f:(fun t (dir, lib) ->
let scope = find_scope' t ~dir in
if not lib.Library.optional ||
(List.for_all (Library.all_lib_deps lib) ~f:(dep_is_available t ~from:dir) &&
List.for_all lib.ppx_runtime_libraries ~f:(lib_is_available t ~from:dir))
(List.for_all (Library.all_lib_deps lib) ~f:(Scope.dep_is_available scope) &&
List.for_all lib.ppx_runtime_libraries ~f:(Scope.lib_is_available scope))
then
{ t with
instalable_internal_libs =
@ -104,7 +259,7 @@ let compute_instalable_internal_libs t ~internal_libraries =
else
t)
let create findlib ~scopes internal_libraries =
let create findlib ~scopes ~root internal_libraries =
let local_public_libs =
List.fold_left internal_libraries ~init:String_map.empty ~f:(fun acc (dir, lib) ->
match lib.Library.public with
@ -117,11 +272,12 @@ let create findlib ~scopes internal_libraries =
; by_internal_name = Hashtbl.create 1024
; instalable_internal_libs = String_map.empty
; local_public_libs
; anonymous_root = root
}
in
(* Initializes the scopes, including [Path.root] so that when there are no <pkg>.opam
files in parent directories, the scope is the whole workspace. *)
List.iter scopes ~f:(fun (scope : Scope.t) ->
List.iter scopes ~f:(fun (scope : Jbuild.Scope.t) ->
Hashtbl.add t.by_internal_name ~key:scope.root
~data:{ libs = String_map.empty
; scope
@ -144,125 +300,6 @@ let create findlib ~scopes internal_libraries =
let internal_libs_without_non_installable_optional_ones t =
String_map.values t.instalable_internal_libs
let interpret_lib_dep t ~dir lib_dep =
match lib_dep with
| Lib_dep.Direct name -> begin
match find_exn t ~from:dir name with
| x -> Inl [x]
| exception _ ->
(* Call [find] again to get a proper backtrace *)
Inr { fail = fun () ->
ignore (find_exn t ~from:dir name : Lib.t);
assert false }
end
| Select { choices; loc; _ } ->
match
List.find_map choices ~f:(fun { required; forbidden; _ } ->
if String_set.exists forbidden ~f:(lib_is_available t ~from:dir) then
None
else
match
List.map (String_set.elements required) ~f:(find_exn t ~from:dir)
with
| l -> Some l
| exception (Findlib.Findlib _) -> None)
with
| Some l -> Inl l
| None ->
Inr { fail = fun () ->
Loc.fail loc "No solution found for this select form"
}
let interpret_lib_deps t ~dir lib_deps =
let libs, failures =
List.partition_map lib_deps ~f:(interpret_lib_dep t ~dir)
in
let internals, externals =
List.partition_map (List.concat libs) ~f:(function
| Internal x -> Inl x
| External x -> Inr x)
in
(internals, externals,
match failures with
| [] -> None
| f :: _ -> Some f)
let best_lib_dep_names_exn t ~dir lib_deps =
List.concat_map lib_deps ~f:(fun lib_dep ->
match interpret_lib_dep t ~dir lib_dep with
| Inl libs -> List.map libs ~f:Lib.best_name
| Inr fail -> fail.fail ())
(* Fold the transitive closure, not necessarily in topological order *)
let fold_transitive_closure t ~dir ~deep_traverse_externals lib_deps ~init ~f =
let seen = ref String_set.empty in
let rec loop dir acc lib_dep =
match interpret_lib_dep t ~dir lib_dep with
| Inr fail -> fail.fail ()
| Inl libs -> List.fold_left libs ~init:acc ~f:process
and process acc (lib : Lib.t) =
let unique_id =
match lib with
| External pkg -> pkg.name
| Internal (dir, lib) ->
match lib.public with
| Some p -> p.name
| None -> Path.to_string dir ^ "\000" ^ lib.name
in
if String_set.mem unique_id !seen then
acc
else begin
seen := String_set.add unique_id !seen;
let acc = f lib acc in
match lib with
| Internal (dir, lib) ->
List.fold_left lib.buildable.libraries ~init:acc ~f:(loop dir)
| External pkg ->
if deep_traverse_externals then
List.fold_left pkg.requires ~init:acc ~f:(fun acc pkg ->
process acc (External pkg))
else begin
seen :=
String_set.union !seen
(String_set.of_list
(List.map pkg.requires ~f:(fun p -> p.Findlib.name)));
acc
end
end
in
List.fold_left lib_deps ~init ~f:(loop dir)
let all_ppx_runtime_deps_exn t ~dir lib_deps =
(* The [ppx_runtime_deps] of [Findlib.package] already holds the transitive closure. *)
let deep_traverse_externals = false in
fold_transitive_closure t ~dir ~deep_traverse_externals lib_deps
~init:String_set.empty ~f:(fun lib acc ->
let rt_deps =
match lib with
| Internal (dir, lib) ->
List.map lib.ppx_runtime_libraries ~f:(fun name ->
Lib.best_name (find_exn t ~from:dir name))
| External pkg ->
List.map pkg.ppx_runtime_deps ~f:(fun p -> p.Findlib.name)
in
String_set.union acc (String_set.of_list rt_deps))
type resolved_select =
{ src_fn : string
; dst_fn : string
}
let resolve_selects t ~from lib_deps =
List.filter_map lib_deps ~f:(function
| Lib_dep.Direct _ -> None
| Select { result_fn; choices; _ } ->
let src_fn =
match List.find choices ~f:(choice_is_possible t ~from) with
| Some c -> c.file
| None -> "no solution found"
in
Some { dst_fn = result_fn; src_fn })
let unique_library_name t (lib : Lib.t) =
match lib with
| External pkg -> pkg.name
@ -274,3 +311,18 @@ let unique_library_name t (lib : Lib.t) =
match scope.scope.name with
| None -> lib.name ^ "@"
| Some s -> lib.name ^ "@" ^ s
let external_scope t =
{ Scope.
lib_db = t
; scope =
{ libs = String_map.empty
; scope = Jbuild.Scope.empty
}
}
let anonymous_scope t =
{ Scope.
lib_db = t
; scope = internal_name_scope t ~dir:t.anonymous_root
}

103
src/lib_db.mli
View File

@ -7,52 +7,83 @@ open Import
type t
val create
: Findlib.t
-> scopes:Jbuild.Scope.t list
-> (Path.t * Jbuild.Library.t) list
-> t
val find : t -> from:Path.t -> string -> Lib.t option
val find_exn : t -> from:Path.t -> string -> Lib.t
val internal_libs_without_non_installable_optional_ones : t -> Lib.Internal.t list
val interpret_lib_deps
: t
-> dir:Path.t
-> Jbuild.Lib_dep.t list
-> Lib.Internal.t list * Findlib.package list * fail option
val best_lib_dep_names_exn
: t
-> dir:Path.t
-> Jbuild.Lib_dep.t list
-> string list
(** [all_ppx_runtime_deps_exn t ~dir deps] takes the transitive closure of [deps] and
return the set of all the ppx runtime dependencies of these libraries. *)
val all_ppx_runtime_deps_exn
: t
-> dir:Path.t
-> Jbuild.Lib_dep.t list
-> String_set.t
type 'a with_required_by =
{ required_by: string list
; data: 'a
}
type resolved_select =
{ src_fn : string
; dst_fn : string
}
val resolve_selects
: t
-> from:Path.t
-> Jbuild.Lib_dep.t list
-> resolved_select list
module Scope : sig
(** A scope can be used to resolve library names to libraries as they are
defined in the build - external or internal.
val lib_is_available : t -> from:Path.t -> string -> bool
Every directory in the context's build tree corresponds to a particular
scope which can be found with [find_scope]. The only exception to this is
the external scope.
*)
type t
val find : t with_required_by -> string -> Lib.t option
val find_exn : t with_required_by -> string -> Lib.t
val lib_is_available : t with_required_by -> string -> bool
val root : t -> Path.t
val resolve : t with_required_by -> string -> (Package.t, string) result
val required_in_jbuild : t -> jbuild_dir:Path.t -> t with_required_by
val interpret_lib_deps
: t with_required_by
-> Jbuild.Lib_dep.t list
-> Lib.Internal.t list * Findlib.package list * fail option
val resolve_selects
: t with_required_by
-> Jbuild.Lib_dep.t list
-> resolved_select list
val best_lib_dep_names_exn
: t with_required_by
-> Jbuild.Lib_dep.t list
-> string list
(** [all_ppx_runtime_deps_exn t deps] takes the transitive closure of [deps]
and return the set of all the ppx runtime dependencies of these
libraries. *)
val all_ppx_runtime_deps_exn
: t with_required_by
-> Jbuild.Lib_dep.t list
-> String_set.t
end
val create
: Findlib.t
-> scopes:Jbuild.Scope.t list
-> root:Path.t
-> (Path.t * Jbuild.Library.t) list
-> t
val internal_libs_without_non_installable_optional_ones : t -> Lib.Internal.t list
(** For [Findlib.closure] *)
val local_public_libs : t -> Path.t String_map.t
(** Unique name, even for internal libraries *)
val unique_library_name : t -> Lib.t -> string
val find_scope : t -> dir:Path.t -> Scope.t
val find_scope' : t -> dir:Path.t -> Scope.t with_required_by
(** Includes the private libraries not belonging to any named scope. Corresopnds
to the context's build root path.*)
val anonymous_scope : t -> Scope.t
(** Contains only publicly, and external (findlib) libraries *)
val external_scope : t -> Scope.t

7
src/main.ml
View File

@ -149,13 +149,14 @@ let report_error ?(map_fname=fun x->x) ppf exn ~backtrace =
"@{<error>Error@}: Conflict between internal and external version of library %S:\n\
- it is defined locally in %s\n\
- it is required by external library %S\n\
- external library %S is required in %s\n\
%s\n\
This cannot work.\n"
package
(Utils.jbuild_name_in ~dir:(Path.drop_optional_build_context defined_locally_in))
required_by
required_by
(Utils.jbuild_name_in ~dir:required_locally_in);
(required_locally_in
|> List.map ~f:(sprintf " -> required by %S")
|> String.concat ~sep:"\n");
false
| Code_error msg ->
let bt = Printexc.raw_backtrace_to_string backtrace in

4
src/module_compilation.mli
View File

@ -13,7 +13,7 @@ val build_module
-> js_of_ocaml:Jbuild.Js_of_ocaml.t
-> flags:Ocaml_flags.t
-> Module.t
-> scope:Jbuild.Scope.t
-> scope:Lib_db.Scope.t
-> dir:Path.t
-> dep_graph:Ocamldep.dep_graph
-> modules:Module.t String_map.t
@ -27,7 +27,7 @@ val build_modules
-> dynlink:bool
-> js_of_ocaml:Jbuild.Js_of_ocaml.t
-> flags:Ocaml_flags.t
-> scope:Jbuild.Scope.t
-> scope:Lib_db.Scope.t
-> dir:Path.t
-> dep_graph:Ocamldep.dep_graph
-> modules:Module.t String_map.t

2
src/ocaml_flags.mli
View File

@ -2,7 +2,7 @@
type t
val make : Jbuild.Buildable.t -> Super_context.t -> scope:Jbuild.Scope.t -> dir:Path.t -> t
val make : Jbuild.Buildable.t -> Super_context.t -> scope:Lib_db.Scope.t -> dir:Path.t -> t
val default : unit -> t

3
src/odoc.ml
View File

@ -274,6 +274,7 @@ let gen_rules sctx ~dir rest =
setup_css_rule sctx;
setup_toplevel_index_rule sctx
| lib :: _ ->
match Lib_db.find (SC.libs sctx) ~from:dir lib with
let scope = Lib_db.find_scope' (SC.libs sctx) ~dir in
match Lib_db.Scope.find scope lib with
| None | Some (External _) -> ()
| Some (Internal (dir, _)) -> SC.load_dir sctx ~dir

130
src/super_context.ml
View File

@ -10,7 +10,7 @@ module Dir_with_jbuild = struct
{ src_dir : Path.t
; ctx_dir : Path.t
; stanzas : Stanzas.t
; scope : Scope.t
; scope : Lib_db.Scope.t Lib_db.with_required_by
}
end
@ -44,18 +44,18 @@ let host_sctx t = Option.value t.host ~default:t
let expand_var_no_root t var = String_map.find var t.vars
let expand_vars t ~scope ~dir s =
let expand_vars t ~(scope : Lib_db.Scope.t) ~dir s =
String_with_vars.expand s ~f:(fun _loc -> function
| "ROOT" -> Some (Path.reach ~from:dir t.context.build_dir)
| "SCOPE_ROOT" ->
Some (Path.reach ~from:dir (Path.append t.context.build_dir scope.Scope.root))
| var ->
let open Action.Var_expansion in
expand_var_no_root t var
|> Option.map ~f:(function
| Paths(p,_) -> let p = List.map p ~f:Path.to_string in
String.concat ~sep:" " p
| Strings(s,_) -> String.concat ~sep:" " s))
| "ROOT" -> Some (Path.reach ~from:dir t.context.build_dir)
| "SCOPE_ROOT" ->
Some (Path.reach ~from:dir (Lib_db.Scope.root scope))
| var ->
let open Action.Var_expansion in
expand_var_no_root t var
|> Option.map ~f:(function
| Paths(p,_) -> let p = List.map p ~f:Path.to_string in
String.concat ~sep:" " p
| Strings(s,_) -> String.concat ~sep:" " s))
let resolve_program t ?hint bin =
Artifacts.binary ?hint t.artifacts bin
@ -70,18 +70,9 @@ let create
~filter_out_optional_stanzas_with_missing_deps
~build_system
=
let stanzas =
List.map stanzas
~f:(fun (dir, scope, stanzas) ->
{ Dir_with_jbuild.
src_dir = dir
; ctx_dir = Path.append context.build_dir dir
; stanzas
; scope
})
in
let internal_libraries =
List.concat_map stanzas ~f:(fun { ctx_dir; stanzas; _ } ->
List.concat_map stanzas ~f:(fun (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)
@ -93,7 +84,18 @@ let create
{ scope with Scope.root = Path.append context.build_dir scope.Scope.root })
in
Lib_db.create context.findlib internal_libraries
~scopes
~scopes ~root:context.build_dir
in
let stanzas =
List.map stanzas
~f:(fun (dir, _, stanzas) ->
let ctx_dir = Path.append context.build_dir dir in
{ Dir_with_jbuild.
src_dir = dir
; ctx_dir
; stanzas
; scope = Lib_db.find_scope' libs ~dir:ctx_dir
})
in
let stanzas_to_consider_for_install =
if filter_out_optional_stanzas_with_missing_deps then
@ -118,7 +120,8 @@ let create
(struct
open Sexp.Of_sexp
let t dir sexp =
List.map (list string sexp) ~f:(Lib_db.find_exn libs ~from:dir)
let scope = Lib_db.find_scope' libs ~dir in
List.map (list string sexp) ~f:(Lib_db.Scope.find_exn scope)
end)
in
let artifacts =
@ -225,12 +228,8 @@ module Libs = struct
open Build.O
open Lib_db
let find t ~from name = find t.libs ~from name
let best_lib_dep_names_exn t ~dir deps = best_lib_dep_names_exn t.libs ~dir deps
let all_ppx_runtime_deps_exn t ~dir lib_deps =
all_ppx_runtime_deps_exn t.libs ~dir lib_deps
let anonymous_scope t = Lib_db.anonymous_scope t.libs
let external_scope t = Lib_db.external_scope t.libs
let vrequires t ~dir ~item =
let fn = Path.relative dir (item ^ ".requires.sexp") in
@ -251,8 +250,9 @@ module Libs = struct
| None -> build
| Some f -> Build.fail f >>> build
let closure t ~dir ~dep_kind lib_deps =
let internals, externals, fail = Lib_db.interpret_lib_deps t.libs ~dir lib_deps in
let closure t ~scope ~dep_kind lib_deps =
let internals, externals, fail =
Lib_db.Scope.interpret_lib_deps scope lib_deps in
with_fail ~fail
(Build.record_lib_deps ~kind:dep_kind lib_deps
>>>
@ -262,7 +262,7 @@ module Libs = struct
>>^ (fun internal_deps ->
let externals =
Findlib.closure externals
~required_by:dir
~required_by:scope.required_by
~local_public_libs:(local_public_libs t.libs)
|> List.map ~f:(fun pkg -> Lib.External pkg)
in
@ -270,8 +270,9 @@ module Libs = struct
(List.concat (externals :: internal_deps) @
List.map internals ~f:(fun x -> Lib.Internal x))))
let closed_ppx_runtime_deps_of t ~dir ~dep_kind lib_deps =
let internals, externals, fail = Lib_db.interpret_lib_deps t.libs ~dir lib_deps in
let closed_ppx_runtime_deps_of t ~scope ~dep_kind lib_deps =
let internals, externals, fail =
Lib_db.Scope.interpret_lib_deps scope lib_deps in
with_fail ~fail
(Build.record_lib_deps ~kind:dep_kind lib_deps
>>>
@ -281,16 +282,15 @@ module Libs = struct
>>^ (fun libs ->
let externals =
Findlib.closed_ppx_runtime_deps_of externals
~required_by:dir
~required_by:scope.required_by
~local_public_libs:(local_public_libs t.libs)
|> List.map ~f:(fun pkg -> Lib.External pkg)
in
Lib.remove_dups_preserve_order (List.concat (externals :: libs))))
let lib_is_available t ~from name = lib_is_available t.libs ~from name
let add_select_rules t ~dir lib_deps =
List.iter (Lib_db.resolve_selects t.libs ~from:dir lib_deps) ~f:(fun { dst_fn; src_fn } ->
let add_select_rules t ~dir ~scope lib_deps =
Lib_db.Scope.resolve_selects scope lib_deps
|> List.iter ~f:(fun { dst_fn; src_fn } ->
let src = Path.relative dir src_fn in
let dst = Path.relative dir dst_fn in
add_rule t
@ -299,7 +299,8 @@ module Libs = struct
Build.action ~targets:[dst]
(Copy_and_add_line_directive (src, dst))))
let real_requires t ~dir ~dep_kind ~item ~libraries ~preprocess ~virtual_deps =
let real_requires t ~dir ~scope ~dep_kind ~item ~libraries ~preprocess
~virtual_deps =
let all_pps =
List.map (Preprocess_map.pps preprocess) ~f:Pp.to_string
in
@ -308,8 +309,8 @@ module Libs = struct
(Build.record_lib_deps ~kind:dep_kind (List.map virtual_deps ~f:Lib_dep.direct)
>>>
Build.fanout
(closure t ~dir ~dep_kind libraries)
(closed_ppx_runtime_deps_of t ~dir ~dep_kind
(closure t ~scope ~dep_kind libraries)
(closed_ppx_runtime_deps_of t ~scope ~dep_kind
(List.map all_pps ~f:Lib_dep.direct))
>>>
Build.arr (fun (libs, rt_deps) ->
@ -318,10 +319,10 @@ module Libs = struct
Build.store_vfile vrequires);
Build.vpath vrequires
let requires t ~dir ~dep_kind ~item ~libraries ~preprocess ~virtual_deps
let requires t ~dir ~scope ~dep_kind ~item ~libraries ~preprocess ~virtual_deps
~has_dot_merlin =
let real_requires =
real_requires t ~dir ~dep_kind ~item ~libraries ~preprocess ~virtual_deps
let real_requires = real_requires t ~dir ~scope ~dep_kind ~item ~libraries
~preprocess ~virtual_deps
in
let requires =
if t.context.merlin && has_dot_merlin then
@ -333,12 +334,13 @@ module Libs = struct
in
(requires, real_requires)
let setup_runtime_deps t ~dir ~dep_kind ~item ~libraries ~ppx_runtime_libraries =
let setup_runtime_deps t ~dir ~scope ~dep_kind ~item ~libraries
~ppx_runtime_libraries =
let vruntime_deps = vruntime_deps t ~dir ~item in
add_rule t
(Build.fanout
(closure t ~dir ~dep_kind (List.map ppx_runtime_libraries ~f:Lib_dep.direct))
(closed_ppx_runtime_deps_of t ~dir ~dep_kind libraries)
(closure t ~scope ~dep_kind (List.map ppx_runtime_libraries ~f:Lib_dep.direct))
(closed_ppx_runtime_deps_of t ~scope ~dep_kind libraries)
>>>
Build.arr (fun (rt_deps, rt_deps_of_deps) ->
Lib.remove_dups_preserve_order (rt_deps @ rt_deps_of_deps))
@ -582,9 +584,12 @@ module Action = struct
end
| Some ("lib-available", lib) ->
add_lib_dep acc lib Optional;
Some (str_exp (string_of_bool (Libs.lib_is_available sctx ~from:dir lib)))
Some (str_exp (string_of_bool (
(* XXX should we really be using the required_by of scope here? lib
isn't really required here, but optional *)
Lib_db.Scope.lib_is_available scope lib)))
| Some ("version", s) -> begin
match Scope.resolve scope s with
match Lib_db.Scope.resolve scope s with
| Ok p ->
let x =
Pkg_version.read sctx p >>^ function
@ -622,7 +627,7 @@ module Action = struct
| _ ->
match var with
| "ROOT" -> Some (path_exp sctx.context.build_dir)
| "SCOPE_ROOT" -> Some (path_exp (Path.append sctx.context.build_dir scope.root))
| "SCOPE_ROOT" -> Some (path_exp (Lib_db.Scope.root scope.data))
| "@" -> begin
match targets_written_by_user with
| Infer -> Loc.fail loc "You cannot use ${@} with inferred rules."
@ -771,13 +776,13 @@ module PP = struct
let migrate_driver_main = "ocaml-migrate-parsetree.driver-main"
let build_ppx_driver sctx ~dir ~dep_kind ~target pp_names ~driver =
let build_ppx_driver sctx ~scope ~dep_kind ~target pp_names ~driver =
let ctx = sctx.context in
let mode = Context.best_mode ctx in
let compiler = Option.value_exn (Context.compiler ctx mode) in
let pp_names = pp_names @ [migrate_driver_main] in
let libs =
Libs.closure sctx ~dir ~dep_kind (List.map pp_names ~f:Lib_dep.direct)
Libs.closure sctx ~scope ~dep_kind (List.map pp_names ~f:Lib_dep.direct)
in
let libs =
(* Put the driver back at the end, just before migrate_driver_main *)
@ -812,7 +817,7 @@ module PP = struct
(* Provide a better error for migrate_driver_main given that this is an implicit
dependency *)
let libs =
match Libs.find sctx ~from:dir migrate_driver_main with
match Lib_db.Scope.find scope migrate_driver_main with
| None ->
Build.fail { fail = fun () ->
die "@{<error>Error@}: I couldn't find '%s'.\n\
@ -859,7 +864,13 @@ module PP = struct
| driver :: rest ->
(Some driver, List.sort rest ~cmp:String.compare @ [driver])
in
build_ppx_driver sctx names ~dir:ppx_dir ~dep_kind:Required ~target:exe ~driver
let scope =
{ Lib_db.
data = Lib_db.anonymous_scope sctx.libs
; required_by = [sprintf "required by (pps (%s))"
(String.concat names ~sep:", ")]
} in
build_ppx_driver sctx names ~scope ~dep_kind:Required ~target:exe ~driver
| _ -> ()
let get_ppx_driver sctx pps =
@ -988,10 +999,11 @@ module PP = struct
(* Generate rules to build the .pp files and return a new module map where all filenames
point to the .pp files *)
let pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~lint ~preprocess
~preprocessor_deps ~lib_name ~scope =
~preprocessor_deps ~lib_name
~(scope : Lib_db.Scope.t Lib_db.with_required_by) =
let preprocessor_deps =
Build.memoize "preprocessor deps"
(Deps.interpret sctx ~scope ~dir preprocessor_deps)
(Deps.interpret sctx ~scope:scope.data ~dir preprocessor_deps)
in
let lint_module = lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope in
String_map.map modules ~f:(fun (m : Module.t) ->

33
src/super_context.mli
View File

@ -14,7 +14,7 @@ module Dir_with_jbuild : sig
{ src_dir : Path.t
; ctx_dir : Path.t (** [_build/context-name/src_dir] *)
; stanzas : Stanzas.t
; scope : Scope.t
; scope : Lib_db.Scope.t Lib_db.with_required_by
}
end
@ -40,7 +40,7 @@ val stanzas_to_consider_for_install : t -> (Path.t * Stanza.t) list
val cxx_flags : t -> string list
val libs : t -> Lib_db.t
val expand_vars : t -> scope:Scope.t -> dir:Path.t -> String_with_vars.t -> string
val expand_vars : t -> scope:Lib_db.Scope.t -> dir:Path.t -> String_with_vars.t -> string
val add_rule
: t
@ -100,22 +100,19 @@ val resolve_program
val unique_library_name : t -> Lib.t -> string
module Libs : sig
val find : t -> from:Path.t -> string -> Lib.t option
val best_lib_dep_names_exn : t -> dir:Path.t -> Lib_dep.t list -> string list
val all_ppx_runtime_deps_exn
: t
-> dir:Path.t
-> Jbuild.Lib_dep.t list
-> String_set.t
val anonymous_scope : t -> Lib_db.Scope.t
val external_scope : t -> Lib_db.Scope.t
val load_requires : t -> dir:Path.t -> item:string -> (unit, Lib.t list) Build.t
val load_runtime_deps : t -> dir:Path.t -> item:string -> (unit, Lib.t list) Build.t
val lib_is_available : t -> from:Path.t -> string -> bool
(** Add rules for (select ...) forms *)
val add_select_rules : t -> dir:Path.t -> Lib_deps.t -> unit
val add_select_rules
: t
-> dir:Path.t
-> scope:Lib_db.Scope.t Lib_db.with_required_by
-> Lib_deps.t
-> unit
(** Returns the closed list of dependencies for a dependency list in
a stanza. The second arrow is the same as the first one but with
@ -124,6 +121,7 @@ module Libs : sig
val requires
: t
-> dir:Path.t
-> scope:Lib_db.Scope.t Lib_db.with_required_by
-> dep_kind:Build.lib_dep_kind
-> item:string (* Library name or first exe name *)
-> libraries:Lib_deps.t
@ -136,6 +134,7 @@ module Libs : sig
val setup_runtime_deps
: t
-> dir:Path.t
-> scope:Lib_db.Scope.t Lib_db.with_required_by
-> dep_kind:Build.lib_dep_kind
-> item:string (* Library name or first exe name *)
-> libraries:Lib_deps.t
@ -164,7 +163,7 @@ module Deps : sig
(** Evaluates to the actual list of dependencies, ignoring aliases *)
val interpret
: t
-> scope:Scope.t
-> scope:Lib_db.Scope.t
-> dir:Path.t
-> Dep_conf.t list
-> (unit, Path.t list) Build.t
@ -196,7 +195,7 @@ module Action : sig
-> dir:Path.t
-> dep_kind:Build.lib_dep_kind
-> targets:targets
-> scope:Scope.t
-> scope:Lib_db.Scope.t Lib_db.with_required_by
-> (Path.t list, Action.t) Build.t
end
@ -213,7 +212,7 @@ module PP : sig
-> preprocess:Preprocess_map.t
-> preprocessor_deps:Dep_conf.t list
-> lib_name:string option
-> scope:Scope.t
-> scope:Lib_db.Scope.t Lib_db.with_required_by
-> Module.t String_map.t
(** Get a path to a cached ppx driver *)
@ -228,7 +227,7 @@ end
val expand_and_eval_set
: t
-> scope:Scope.t
-> scope:Lib_db.Scope.t
-> dir:Path.t
-> Ordered_set_lang.Unexpanded.t
-> standard:string list

2
test/blackbox-tests/test-cases/scope-ppx-bug/run.t
View File

@ -1,5 +1,5 @@
$ $JBUILDER build -j1 --root . @install
Error: External library "a_kernel" not found.
-> required by ".ppx/a_kernel/jbuild (context default)"
-> required by "required by (pps (a_kernel))"
Hint: try: jbuilder external-lib-deps --missing --root . @install
[1]