Make Lib.t abstract (#498)
* Make Lib.t abstract This requires removing the external/internal separation in most places in the source code. Briefly, these are: * Special casing of external libs for incremental compilation in jsoo * .merlin generation * stamp file generation * transitive closure having a flag for walking external libs * checking if a lib is a driver (checking various names) These cases are fixed by introducing an src_dir, obj_dir abstractions, and the ability to check if a library is local.
This commit is contained in:
Rudi Grinberg
GitHub
parent
abb4440e28
commit
0d62c34e42
|
|
@ -446,6 +446,13 @@ end
|
|||
module Option = struct
|
||||
type 'a t = 'a option
|
||||
|
||||
module Infix = struct
|
||||
let (>>=) t f =
|
||||
match t with
|
||||
| None -> None
|
||||
| Some a -> f a
|
||||
end
|
||||
|
||||
let map t ~f =
|
||||
match t with
|
||||
| None -> None
|
||||
|
|
@ -480,6 +487,10 @@ module Option = struct
|
|||
match x, y with
|
||||
| Some x, Some y -> Some (x, y)
|
||||
| _ -> None
|
||||
|
||||
let to_list = function
|
||||
| None -> []
|
||||
| Some x -> [x]
|
||||
end
|
||||
|
||||
type ('a, 'b) eq = Eq : ('a, 'a) eq
|
||||
|
|
|
|||
|
|
@ -64,16 +64,17 @@ let link_rule ~sctx ~dir ~runtime ~target =
|
|||
let ctx = SC.context sctx in
|
||||
let get_all ((libs,cm),_) =
|
||||
(* Special case for the stdlib because it is not referenced in the META *)
|
||||
let stdlib = Lib.External (Findlib.stdlib_with_archives ctx.findlib) in
|
||||
let stdlib = Lib.external_ (Findlib.stdlib_with_archives ctx.findlib) in
|
||||
let all_libs =
|
||||
List.concat_map (stdlib :: libs) ~f:(function
|
||||
| Lib.External pkg ->
|
||||
List.map (Findlib.Package.archives pkg Byte) ~f:(fun fn ->
|
||||
in_build_dir ~ctx [ Findlib.Package.name pkg
|
||||
; sprintf "%s.js" (Path.basename fn)
|
||||
])
|
||||
| Lib.Internal (dir, lib) ->
|
||||
[ Path.relative dir (sprintf "%s.cma.js" lib.name) ]
|
||||
List.concat_map (stdlib :: libs) ~f:(fun (lib : Lib.t) ->
|
||||
let jsoo_archives = Lib.jsoo_archives lib in
|
||||
if Lib.is_local lib then (
|
||||
jsoo_archives
|
||||
) else (
|
||||
let lib_name = Option.value_exn (Lib.public_name lib) in
|
||||
List.map ~f:(fun js ->
|
||||
in_build_dir ~ctx [lib_name ; Path.basename js]) jsoo_archives
|
||||
)
|
||||
)
|
||||
in
|
||||
let all_other_modules =
|
||||
|
|
|
|||
121
src/lib.ml
121
src/lib.ml
|
|
@ -11,6 +11,9 @@ module T = struct
|
|||
| Internal of Internal.t
|
||||
| External of FP.t
|
||||
|
||||
let internal i = Internal i
|
||||
let external_ i = External i
|
||||
|
||||
let best_name = function
|
||||
| External pkg -> FP.name pkg
|
||||
| Internal (_, lib) -> Jbuild.Library.best_name lib
|
||||
|
|
@ -24,13 +27,28 @@ module Set = Set.Make(T)
|
|||
let lib_obj_dir dir lib =
|
||||
Path.relative dir ("." ^ lib.Jbuild.Library.name ^ ".objs")
|
||||
|
||||
let dir = function
|
||||
| Internal (dir, _) -> dir
|
||||
| External pkg -> FP.dir pkg
|
||||
let get_internal = function
|
||||
| Internal x -> Some x
|
||||
| External _ -> None
|
||||
|
||||
let to_either = function
|
||||
| Internal x -> Inl x
|
||||
| External x -> Inr x
|
||||
|
||||
let src_dir = function
|
||||
| External _ -> None
|
||||
| Internal (dir, _) -> Some dir
|
||||
|
||||
let obj_dir = function
|
||||
| Internal (dir, lib) -> lib_obj_dir dir lib
|
||||
| External pkg -> FP.dir pkg
|
||||
| Internal (dir, lib) -> lib_obj_dir dir lib
|
||||
|
||||
let src_or_obj_dir t =
|
||||
match src_dir t with
|
||||
| None -> obj_dir t
|
||||
| Some dir -> dir
|
||||
|
||||
let is_local lib = Path.is_local (obj_dir lib)
|
||||
|
||||
let include_paths ts ~stdlib_dir =
|
||||
List.fold_left ts ~init:Path.Set.empty ~f:(fun acc t ->
|
||||
|
|
@ -45,7 +63,7 @@ let include_flags ts ~stdlib_dir =
|
|||
let c_include_flags ts ~stdlib_dir =
|
||||
let dirs =
|
||||
List.fold_left ts ~init:Path.Set.empty ~f:(fun acc t ->
|
||||
Path.Set.add (dir t) acc)
|
||||
Path.Set.add (src_or_obj_dir t) acc)
|
||||
|> Path.Set.remove stdlib_dir
|
||||
in
|
||||
Arg_spec.S (List.concat_map (Path.Set.elements dirs) ~f:(fun dir ->
|
||||
|
|
@ -70,22 +88,35 @@ let link_flags ts ~mode ~stdlib_dir =
|
|||
| Internal (dir, lib) ->
|
||||
Dep (Path.relative dir (lib.name ^ Mode.compiled_lib_ext mode))))
|
||||
|
||||
let stub_archives t ~ext_lib =
|
||||
match t with
|
||||
| External _ -> None
|
||||
| Internal (dir, lib) ->
|
||||
if Jbuild.Library.has_stubs lib then
|
||||
Some (Jbuild.Library.stubs_archive lib ~dir ~ext_lib)
|
||||
else
|
||||
None
|
||||
|
||||
let ml_archives t ~mode ~ext_lib =
|
||||
match t with
|
||||
| External pkg -> FP.archives pkg mode
|
||||
| Internal (dir, lib) ->
|
||||
let l =
|
||||
[Path.relative dir (lib.name ^ Mode.compiled_lib_ext mode)]
|
||||
in
|
||||
match mode, ext_lib with
|
||||
| Byte, _
|
||||
| Native, None -> l
|
||||
| Native, Some ext_lib -> Path.relative dir (lib.name ^ ext_lib) :: l
|
||||
|
||||
let archive_files ts ~mode ~ext_lib =
|
||||
List.concat_map ts ~f:(function
|
||||
| External pkg -> FP.archives pkg mode
|
||||
| Internal (dir, lib) ->
|
||||
let l =
|
||||
[Path.relative dir (lib.name ^ Mode.compiled_lib_ext mode)]
|
||||
in
|
||||
let l =
|
||||
match mode with
|
||||
| Byte -> l
|
||||
| Native -> Path.relative dir (lib.name ^ ext_lib) :: l
|
||||
in
|
||||
if Jbuild.Library.has_stubs lib then
|
||||
Jbuild.Library.stubs_archive lib ~dir ~ext_lib :: l
|
||||
else
|
||||
l)
|
||||
List.concat_map ts ~f:(fun lib ->
|
||||
ml_archives lib ~mode ~ext_lib:(Some ext_lib) @
|
||||
Option.to_list (stub_archives lib ~ext_lib))
|
||||
|
||||
let jsoo_archives t =
|
||||
ml_archives t ~mode:Mode.Byte ~ext_lib:None
|
||||
|> List.map ~f:(Path.extend_basename ~suffix:".js")
|
||||
|
||||
let jsoo_runtime_files ts =
|
||||
List.concat_map ts ~f:(function
|
||||
|
|
@ -93,15 +124,23 @@ let jsoo_runtime_files ts =
|
|||
List.map (FP.jsoo_runtime pkg) ~f:(Path.relative (FP.dir pkg))
|
||||
| Internal (dir, lib) ->
|
||||
List.map lib.buildable.js_of_ocaml.javascript_files ~f:(Path.relative dir))
|
||||
(*
|
||||
let ppx_runtime_libraries ts =
|
||||
List.fold_left ts ~init:String_set.empty ~f:(fun acc t ->
|
||||
|
||||
let ppx_runtime_libraries t =
|
||||
String_set.of_list (
|
||||
match t with
|
||||
| Internal (_, lib) ->
|
||||
String_set.union acc (String_set.of_list lib.ppx_runtime_libraries)
|
||||
| External pkg ->
|
||||
String_set.union acc (String_set.of_list pkg.ppx_runtime_deps))
|
||||
*)
|
||||
| Internal (_, lib) -> lib.ppx_runtime_libraries
|
||||
| External pkg -> List.map ~f:FP.name (FP.ppx_runtime_deps pkg)
|
||||
)
|
||||
|
||||
let requires = function
|
||||
| Internal (_, lib) ->
|
||||
lib.buildable.libraries
|
||||
| External pkg ->
|
||||
List.map ~f:(fun fp -> Jbuild.Lib_dep.direct (FP.name fp)) (FP.requires pkg)
|
||||
|
||||
let scope = function
|
||||
| Internal (dir, _) -> `Dir dir
|
||||
| External _ -> `External
|
||||
|
||||
let remove_dups_preserve_order libs =
|
||||
let rec loop seen libs acc =
|
||||
|
|
@ -120,3 +159,29 @@ let remove_dups_preserve_order libs =
|
|||
let public_name = function
|
||||
| External pkg -> Some (FP.name pkg)
|
||||
| Internal (_, lib) -> Option.map lib.public ~f:(fun p -> p.name)
|
||||
|
||||
let unique_id = function
|
||||
| External pkg -> FP.name pkg
|
||||
| Internal (dir, lib) ->
|
||||
match lib.public with
|
||||
| Some p -> p.name
|
||||
| None -> Path.to_string dir ^ "\000" ^ lib.name
|
||||
|
||||
type local =
|
||||
{ src: Path.t
|
||||
; name: string
|
||||
}
|
||||
|
||||
let local = function
|
||||
| Internal (dir, lib) -> Some { src = dir; name = lib.name }
|
||||
| External _ -> None
|
||||
|
||||
let exists_name t ~f =
|
||||
match t with
|
||||
| External pkg -> f (FP.name pkg)
|
||||
| Internal (_, lib) ->
|
||||
(f lib.name) || (
|
||||
match lib.public with
|
||||
| None -> false
|
||||
| Some p -> f p.name
|
||||
)
|
||||
|
|
|
|||
32
src/lib.mli
32
src/lib.mli
|
|
@ -4,9 +4,18 @@ module Internal : sig
|
|||
type t = Path.t * Jbuild.Library.t
|
||||
end
|
||||
|
||||
type t =
|
||||
| Internal of Internal.t
|
||||
| External of Findlib.Package.t
|
||||
type t
|
||||
|
||||
val internal : Internal.t -> t
|
||||
val external_ : Findlib.Package.t -> t
|
||||
|
||||
val to_either : t -> (Internal.t, Findlib.Package.t) either
|
||||
|
||||
val get_internal : t -> Internal.t option
|
||||
val is_local : t -> bool
|
||||
|
||||
val src_dir : t -> Path.t option
|
||||
val obj_dir : t -> Path.t
|
||||
|
||||
module Set : Set.S with type elt := t
|
||||
|
||||
|
|
@ -26,6 +35,7 @@ val link_flags : t list -> mode:Mode.t -> stdlib_dir:Path.t -> _ Arg_spec.t
|
|||
val archive_files : t list -> mode:Mode.t -> ext_lib:string -> Path.t list
|
||||
|
||||
val jsoo_runtime_files : t list -> Path.t list
|
||||
val jsoo_archives : t -> Path.t list
|
||||
|
||||
(** [public_name] if present, [name] if not *)
|
||||
val best_name : t -> string
|
||||
|
|
@ -34,7 +44,19 @@ val describe : t -> string
|
|||
|
||||
val remove_dups_preserve_order : t list -> t list
|
||||
|
||||
(*val ppx_runtime_libraries : t list -> String_set.t
|
||||
*)
|
||||
val ppx_runtime_libraries : t -> String_set.t
|
||||
val requires : t -> Jbuild.Lib_deps.t
|
||||
val scope : t -> [`Dir of Path.t | `External]
|
||||
|
||||
val public_name : t -> string option
|
||||
|
||||
type local =
|
||||
{ src: Path.t
|
||||
; name: string
|
||||
}
|
||||
|
||||
val local : t -> local option
|
||||
|
||||
val unique_id : t -> string
|
||||
|
||||
val exists_name : t -> f:(string -> bool) -> bool
|
||||
|
|
|
|||
143
src/lib_db.ml
143
src/lib_db.ml
|
|
@ -44,16 +44,15 @@ type resolved_select =
|
|||
}
|
||||
|
||||
let unique_library_name t (lib : Lib.t) =
|
||||
match lib with
|
||||
| External pkg -> FP.name pkg
|
||||
| Internal (dir, lib) ->
|
||||
match lib.public with
|
||||
| Some x -> x.name
|
||||
| None ->
|
||||
let scope = internal_name_scope t ~dir in
|
||||
match scope.scope.name with
|
||||
| None -> lib.name ^ "@"
|
||||
| Some s -> lib.name ^ "@" ^ s
|
||||
match Lib.public_name lib with
|
||||
| Some p -> p
|
||||
| None ->
|
||||
let dir = Option.value_exn (Lib.src_dir lib) in
|
||||
let scope = internal_name_scope t ~dir in
|
||||
let name = Lib.best_name lib in
|
||||
match scope.scope.name with
|
||||
| None -> name ^ "@"
|
||||
| Some s -> name ^ "@" ^ s
|
||||
|
||||
|
||||
module Scope = struct
|
||||
|
|
@ -62,14 +61,22 @@ module Scope = struct
|
|||
; lib_db : t
|
||||
}
|
||||
|
||||
let external_scope t =
|
||||
{ lib_db = t
|
||||
; scope =
|
||||
{ libs = String_map.empty
|
||||
; scope = Jbuild.Scope.empty
|
||||
}
|
||||
}
|
||||
|
||||
let find_exn (t : t With_required_by.t) name =
|
||||
match String_map.find name t.data.scope.libs with
|
||||
| Some l -> Lib.Internal l
|
||||
| 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))
|
||||
Lib.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
|
||||
|
|
@ -80,15 +87,14 @@ module Scope = struct
|
|||
match String_map.find name t.data.scope.libs with
|
||||
| Some _ as some -> some
|
||||
| None ->
|
||||
match Hashtbl.find t.data.lib_db.by_public_name name with
|
||||
| Some (Internal x) -> Some x
|
||||
| _ -> None
|
||||
let open Option.Infix in
|
||||
Hashtbl.find t.data.lib_db.by_public_name name >>= Lib.get_internal
|
||||
|
||||
let lib_is_available (t : t With_required_by.t) name =
|
||||
match find_internal t name with
|
||||
| Some lib ->
|
||||
String_map.mem
|
||||
(unique_library_name t.data.lib_db (Lib.Internal lib))
|
||||
(unique_library_name t.data.lib_db (Lib.internal lib))
|
||||
t.data.lib_db.installable_internal_libs
|
||||
| None ->
|
||||
Findlib.available t.data.lib_db.findlib name ~required_by:t.required_by
|
||||
|
|
@ -131,14 +137,17 @@ module Scope = struct
|
|||
Loc.fail loc "No solution found for this select form"
|
||||
}
|
||||
|
||||
let interpret_lib_dep_exn t lib_dep =
|
||||
match interpret_lib_dep t lib_dep with
|
||||
| Inr fail -> fail.fail ()
|
||||
| Inl r -> r
|
||||
|
||||
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)
|
||||
List.partition_map (List.concat libs) ~f:Lib.to_either
|
||||
in
|
||||
(internals, externals,
|
||||
match failures with
|
||||
|
|
@ -186,41 +195,40 @@ module Scope = struct
|
|||
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 fold_transitive_closure (scope : t With_required_by.t)
|
||||
~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
|
||||
interpret_lib_dep_exn scope lib_dep
|
||||
|> List.fold_left ~init:acc ~f:process
|
||||
and process acc (lib : Lib.t) =
|
||||
let unique_id =
|
||||
match lib with
|
||||
| External pkg -> FP.name pkg
|
||||
| Internal (dir, lib) ->
|
||||
match lib.public with
|
||||
| Some p -> p.name
|
||||
| None -> Path.to_string dir ^ "\000" ^ lib.name
|
||||
in
|
||||
let unique_id = Lib.unique_id lib 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.With_required_by.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 (FP.requires pkg) ~init:acc ~f:(fun acc pkg ->
|
||||
process acc (External pkg))
|
||||
else begin
|
||||
seen :=
|
||||
String_set.union !seen
|
||||
(String_set.of_list
|
||||
(List.map (FP.requires pkg) ~f:FP.name));
|
||||
acc
|
||||
end
|
||||
let requires = Lib.requires lib in
|
||||
let scope =
|
||||
match Lib.scope lib with
|
||||
| `External ->
|
||||
{ With_required_by.
|
||||
data = external_scope scope.data.lib_db
|
||||
; required_by = scope.required_by
|
||||
}
|
||||
| `Dir dir ->
|
||||
find_scope scope.data.lib_db ~dir in
|
||||
if deep_traverse_externals || Lib.is_local lib then (
|
||||
List.fold_left requires ~init:acc ~f:(loop scope)
|
||||
) else (
|
||||
seen := String_set.union !seen (
|
||||
String_set.of_list (List.concat_map ~f:(fun lib_dep ->
|
||||
interpret_lib_dep_exn scope lib_dep
|
||||
|> List.map ~f:Lib.unique_id
|
||||
) requires)
|
||||
);
|
||||
acc
|
||||
)
|
||||
end
|
||||
in
|
||||
List.fold_left lib_deps ~init ~f:(loop scope)
|
||||
|
|
@ -231,15 +239,16 @@ module Scope = struct
|
|||
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 ppx_runtime_libraries = Lib.ppx_runtime_libraries lib in
|
||||
match Lib.src_dir lib with
|
||||
| Some dir ->
|
||||
let scope = lazy (find_scope scope.data.lib_db ~dir) in
|
||||
List.map lib.ppx_runtime_libraries ~f:(fun name ->
|
||||
String_set.map ppx_runtime_libraries ~f:(fun name ->
|
||||
Lib.best_name (find_exn (Lazy.force scope) name))
|
||||
| External pkg ->
|
||||
List.map (FP.ppx_runtime_deps pkg) ~f:FP.name
|
||||
| None ->
|
||||
ppx_runtime_libraries
|
||||
in
|
||||
String_set.union acc (String_set.of_list rt_deps))
|
||||
String_set.union acc rt_deps)
|
||||
end
|
||||
|
||||
let find_scope = Scope.find_scope
|
||||
|
|
@ -269,7 +278,7 @@ let top_sort_internals t ~internal_libraries =
|
|||
| Ok l -> l
|
||||
| Error cycle ->
|
||||
die "dependency cycle between libraries:\n %s"
|
||||
(List.map cycle ~f:(fun lib -> Lib.describe (Internal lib))
|
||||
(List.map cycle ~f:(fun lib -> Lib.describe (Lib.internal lib))
|
||||
|> String.concat ~sep:"\n-> ")
|
||||
|
||||
let compute_instalable_internal_libs t ~internal_libraries =
|
||||
|
|
@ -283,7 +292,8 @@ let compute_instalable_internal_libs t ~internal_libraries =
|
|||
{ t with
|
||||
installable_internal_libs =
|
||||
String_map.add t.installable_internal_libs
|
||||
~key:(unique_library_name t (Internal (dir, lib))) ~data:(dir, lib)
|
||||
~key:(unique_library_name t (Lib.internal (dir, lib)))
|
||||
~data:(dir, lib)
|
||||
}
|
||||
else
|
||||
t)
|
||||
|
|
@ -323,27 +333,22 @@ let create findlib ~scopes ~root internal_libraries =
|
|||
scope.libs <- String_map.add scope.libs ~key:lib.Library.name ~data:internal;
|
||||
Option.iter lib.public ~f:(fun { name; _ } ->
|
||||
match Hashtbl.find t.by_public_name name with
|
||||
| None
|
||||
| Some (External _) ->
|
||||
Hashtbl.add t.by_public_name ~key:name ~data:(Internal internal)
|
||||
| Some (Internal dup) ->
|
||||
let internal_path (path, _) = Path.relative path "jbuild" in
|
||||
| None ->
|
||||
Hashtbl.add t.by_public_name ~key:name ~data:(Lib.internal internal)
|
||||
| Some lib ->
|
||||
(* We only populated this table with internal libraries, who always have
|
||||
source dir *)
|
||||
let dup_path = Option.value_exn (Lib.src_dir lib) in
|
||||
let internal_path d = Path.relative d "jbuild" in
|
||||
die "Libraries with identical public names %s defined in %a and %a."
|
||||
name Path.pp (internal_path internal) Path.pp (internal_path dup)
|
||||
name Path.pp (internal_path dir) Path.pp (internal_path dup_path)
|
||||
));
|
||||
compute_instalable_internal_libs t ~internal_libraries
|
||||
|
||||
let internal_libs_without_non_installable_optional_ones t =
|
||||
String_map.values t.installable_internal_libs
|
||||
|
||||
let external_scope t =
|
||||
{ Scope.
|
||||
lib_db = t
|
||||
; scope =
|
||||
{ libs = String_map.empty
|
||||
; scope = Jbuild.Scope.empty
|
||||
}
|
||||
}
|
||||
let external_scope = Scope.external_scope
|
||||
|
||||
let anonymous_scope t =
|
||||
{ Scope.
|
||||
|
|
|
|||
|
|
@ -49,18 +49,15 @@ let dot_merlin sctx ~dir ~scope ({ requires; flags; _ } as t) =
|
|||
>>^ (fun (libs, flags) ->
|
||||
let ppx_flags = ppx_flags sctx ~dir ~scope ~src_dir:remaindir t in
|
||||
let libs =
|
||||
List.fold_left libs ~init:[] ~f:(fun acc ->
|
||||
let serialize_path = Path.reach ~from:remaindir in
|
||||
function
|
||||
| Lib.Internal (path, lib) ->
|
||||
let spath =
|
||||
serialize_path (Path.drop_optional_build_context path) in
|
||||
let bpath = serialize_path (Lib.lib_obj_dir path lib) in
|
||||
("S " ^ spath) :: ("B " ^ bpath) :: acc
|
||||
| Lib.External pkg ->
|
||||
let external_dir = serialize_path (Findlib.Package.dir pkg) in
|
||||
("S " ^ external_dir) :: ("B " ^ external_dir) :: acc
|
||||
)
|
||||
List.fold_left ~f:(fun acc (lib : Lib.t) ->
|
||||
let nice_path = Path.reach ~from:remaindir in
|
||||
let spath = Option.map (Lib.src_dir lib) ~f:(fun dir ->
|
||||
nice_path (Path.drop_optional_build_context dir)) in
|
||||
let bpath = nice_path (Lib.obj_dir lib) in
|
||||
("B " ^ bpath)
|
||||
:: ("S " ^ (Option.value spath ~default:bpath))
|
||||
:: acc
|
||||
) libs ~init:[]
|
||||
in
|
||||
let source_dirs =
|
||||
Path.Set.fold t.source_dirs ~init:[] ~f:(fun path acc ->
|
||||
|
|
|
|||
|
|
@ -161,7 +161,7 @@ let setup_library_rules sctx (lib : Library.t) ~dir ~modules ~mld_files
|
|||
~requires ~(dep_graphs:Ocamldep.Dep_graph.t Ml_kind.Dict.t) =
|
||||
let doc_dir = SC.Doc.dir sctx (dir, lib) in
|
||||
let obj_dir = Lib.lib_obj_dir dir lib in
|
||||
let lib_unique_name = SC.unique_library_name sctx (Internal (dir, lib)) in
|
||||
let lib_unique_name = SC.unique_library_name sctx (Lib.internal (dir, lib)) in
|
||||
let lib_name = Library.best_name lib in
|
||||
let odoc = get_odoc sctx in
|
||||
let includes =
|
||||
|
|
@ -278,6 +278,6 @@ let gen_rules sctx ~dir:_ rest =
|
|||
data = scope
|
||||
; required_by = [Alias (Path.of_string "doc")]
|
||||
} in
|
||||
match Lib_db.Scope.find scope lib with
|
||||
| None | Some (External _) -> ()
|
||||
| Some (Internal (dir, _)) -> SC.load_dir sctx ~dir
|
||||
let open Option.Infix in
|
||||
Option.iter (Lib_db.Scope.find scope lib >>= Lib.src_dir)
|
||||
~f:(fun dir -> SC.load_dir sctx ~dir)
|
||||
|
|
|
|||
|
|
@ -262,7 +262,7 @@ module Libs = struct
|
|||
findlib_closure externals
|
||||
~required_by:scope.required_by
|
||||
~local_public_libs:(local_public_libs t.libs)
|
||||
|> List.map ~f:(fun pkg -> Lib.External pkg)
|
||||
|> List.map ~f:Lib.external_
|
||||
in
|
||||
(internals, List.concat (externals :: internal_deps)))
|
||||
|
||||
|
|
@ -274,7 +274,7 @@ module Libs = struct
|
|||
~dep_kind
|
||||
>>^ fun (internals, deps) ->
|
||||
Lib.remove_dups_preserve_order
|
||||
(deps @ List.map internals ~f:(fun x -> Lib.Internal x))
|
||||
(deps @ List.map internals ~f:Lib.internal)
|
||||
|
||||
let closed_ppx_runtime_deps_of t ~scope ~dep_kind lib_deps =
|
||||
closure_generic t lib_deps
|
||||
|
|
@ -344,53 +344,59 @@ module Libs = struct
|
|||
>>>
|
||||
Build.store_vfile vruntime_deps)
|
||||
|
||||
let lib_files_alias ((dir, lib) : Lib.Internal.t) ~ext =
|
||||
Alias.make (sprintf "lib-%s%s-all" lib.name ext) ~dir
|
||||
let lib_files_alias ~dir ~name ~ext =
|
||||
Alias.make (sprintf "lib-%s%s-all" name ext) ~dir
|
||||
|
||||
let setup_file_deps_alias t lib ~ext files =
|
||||
add_alias_deps t (lib_files_alias lib ~ext) files
|
||||
let setup_file_deps_alias t ((dir, lib) : Lib.Internal.t) ~ext files =
|
||||
add_alias_deps t (lib_files_alias ~dir ~name:lib.name ~ext) files
|
||||
|
||||
let setup_file_deps_group_alias t lib ~exts =
|
||||
setup_file_deps_alias t lib
|
||||
let setup_file_deps_group_alias t ((dir, lib) : Lib.Internal.t) ~exts =
|
||||
setup_file_deps_alias t (dir, lib)
|
||||
~ext:(String.concat exts ~sep:"-and-")
|
||||
(List.map exts ~f:(fun ext -> Alias.stamp_file (lib_files_alias lib ~ext)))
|
||||
(List.map exts ~f:(fun ext ->
|
||||
Alias.stamp_file (lib_files_alias ~dir ~name:lib.name ~ext)))
|
||||
|
||||
let file_deps t ~ext =
|
||||
Build.dyn_paths (Build.arr (fun libs ->
|
||||
List.fold_left libs ~init:[] ~f:(fun acc (lib : Lib.t) ->
|
||||
match lib with
|
||||
| External pkg ->
|
||||
match Lib.local lib with
|
||||
| None ->
|
||||
Build_system.stamp_file_for_files_of t.build_system
|
||||
~dir:(Findlib.Package.dir pkg) ~ext :: acc
|
||||
| Internal lib ->
|
||||
Alias.stamp_file (lib_files_alias lib ~ext) :: acc)))
|
||||
~dir:(Lib.obj_dir lib) ~ext :: acc
|
||||
| Some { Lib .src ; name } ->
|
||||
Alias.stamp_file (lib_files_alias ~dir:src ~name ~ext) :: acc
|
||||
)))
|
||||
|
||||
let static_file_deps ~ext lib =
|
||||
Alias.dep (lib_files_alias lib ~ext)
|
||||
let static_file_deps ~ext ((dir, lib) : Lib.Internal.t) =
|
||||
Alias.dep (lib_files_alias ~dir ~name:lib.name ~ext)
|
||||
end
|
||||
|
||||
module Doc = struct
|
||||
let root t = Path.relative t.context.Context.build_dir "_doc"
|
||||
|
||||
let dir t lib =
|
||||
let name = unique_library_name t (Lib.Internal lib) in
|
||||
let name = unique_library_name t lib in
|
||||
Path.relative (root t) name
|
||||
|
||||
let alias t ((_, lib) as ilib) =
|
||||
let doc_dir = dir t ilib in
|
||||
Alias.make (sprintf "odoc-%s%s-all" lib.name ".odoc") ~dir:doc_dir
|
||||
let alias = Alias.make ".doc-all"
|
||||
|
||||
let deps t =
|
||||
Build.dyn_paths (Build.arr (
|
||||
List.fold_left ~init:[] ~f:(fun acc (lib : Lib.t) ->
|
||||
match lib with
|
||||
| External _ -> acc
|
||||
| Internal lib -> (Alias.stamp_file (alias t lib)) :: acc
|
||||
if Lib.is_local lib then (
|
||||
Alias.stamp_file (alias ~dir:(dir t lib)) :: acc
|
||||
) else (
|
||||
acc
|
||||
)
|
||||
)))
|
||||
|
||||
let alias t lib = alias ~dir:(dir t (Lib.internal lib))
|
||||
|
||||
let static_deps t lib = Alias.dep (alias t lib)
|
||||
|
||||
let setup_deps t lib files = add_alias_deps t (alias t lib) files
|
||||
|
||||
let dir t lib = dir t (Lib.internal lib)
|
||||
end
|
||||
|
||||
module Deps = struct
|
||||
|
|
@ -788,14 +794,7 @@ module PP = struct
|
|||
let is_driver name = name = driver || name = migrate_driver_main in
|
||||
let libs, drivers =
|
||||
List.partition_map libs ~f:(fun lib ->
|
||||
if (match lib with
|
||||
| External pkg -> is_driver (Findlib.Package.name pkg)
|
||||
| Internal (_, lib) ->
|
||||
is_driver lib.name ||
|
||||
match lib.public with
|
||||
| None -> false
|
||||
| Some { name; _ } -> is_driver name)
|
||||
then
|
||||
if Lib.exists_name lib ~f:is_driver then
|
||||
Inr lib
|
||||
else
|
||||
Inl lib)
|
||||
|
|
|
|||
Loading…
Reference in New Issue