@@ -48,23 +48,39 @@ let deps_of_lib (lib : Lib.t) ~groups =
4848 |> Dep.Set. of_list
4949;;
5050
51+ let deps_of_module (lib : Lib.t ) (m : Module.t ) ~cm_kinds =
52+ let obj_dir = Lib. info lib |> Lib_info. obj_dir in
53+ List. filter_map cm_kinds ~f: (fun kind ->
54+ Obj_dir.Module. cm_file obj_dir m ~kind |> Option. map ~f: (fun p -> Dep. file p))
55+ |> Dep.Set. of_list
56+ ;;
57+
5158let deps libs ~groups = Dep.Set. union_map libs ~f: (deps_of_lib ~groups )
5259
53- let deps_of_entries ~opaque ~(cm_kind : Lib_mode.Cm_kind.t ) ( libs : Lib.t list ) =
54- let groups =
60+ let deps_of_entries ~opaque ~(cm_kind : Lib_mode.Cm_kind.t ) entries =
61+ let groups, cm_kinds =
5562 match cm_kind with
56- | Ocaml Cmi | Ocaml Cmo -> [ Group. Ocaml Cmi ]
57- | Melange Cmi -> [ Group. Melange Cmi ]
58- | Melange Cmj -> [ Group. Melange Cmi ; Melange Cmj ]
59- | Ocaml Cmx -> [ Group. Ocaml Cmi ; Ocaml Cmx ]
63+ | Ocaml Cmi | Ocaml Cmo -> [ Group. Ocaml Cmi ], [ Lib_mode.Cm_kind. Ocaml Cmi ]
64+ | Melange Cmi -> [ Group. Melange Cmi ], [ Melange Cmi ]
65+ | Melange Cmj -> [ Group. Melange Cmi ; Melange Cmj ], [ Melange Cmi ; Melange Cmj ]
66+ | Ocaml Cmx -> [ Group. Ocaml Cmi ; Ocaml Cmx ], [ Ocaml Cmi ; Ocaml Cmx ]
6067 in
61- Dep.Set. union_map libs ~f: (fun lib ->
62- let groups =
68+ List. map entries ~f: (fun (( lib : Lib.t ), mod_opt ) ->
69+ let is_opaque_local =
6370 match cm_kind with
64- | Ocaml Cmx when opaque && Lib. is_local lib -> [ Group. Ocaml Cmi ]
65- | _ -> groups
71+ | Ocaml Cmx -> opaque && Lib. is_local lib
72+ | _ -> false
6673 in
67- deps_of_lib lib ~groups )
74+ match mod_opt with
75+ | Some m ->
76+ let cm_kinds =
77+ if is_opaque_local then [ Lib_mode.Cm_kind. Ocaml Cmi ] else cm_kinds
78+ in
79+ deps_of_module lib m ~cm_kinds
80+ | None ->
81+ let groups = if is_opaque_local then [ Group. Ocaml Cmi ] else groups in
82+ deps_of_lib lib ~groups )
83+ |> List. fold_left ~init: Dep.Set. empty ~f: Dep.Set. union
6884;;
6985
7086type path_specification =
@@ -98,3 +114,92 @@ let eval ~loc ~expander ~paths:path_spec (deps : Dep_conf.t list) =
98114 | Some _ -> raise_disallowed_external_path ~loc lib_name path));
99115 paths
100116;;
117+
118+ module Lib_index = struct
119+ (* * Each entry pairs a library with an optional Module.t: None means use
120+ glob deps (wrapped libs, external unwrapped), Some m means use
121+ per-file deps via Obj_dir.Module.cm_file (local unwrapped). *)
122+ type entry = Lib .t * Module .t option
123+
124+ type t =
125+ { by_module_name : entry list Module_name.Map .t
126+ ; unresolved : Lib .t list
127+ }
128+
129+ let module_names_of_lib sctx (lib : Lib.t ) ~for_
130+ : (Module_name. t * Module. t option ) list option Resolve.Memo. t
131+ =
132+ let open Resolve.Memo.O in
133+ let * main_module = Lib. main_module_name lib in
134+ match main_module with
135+ | Some name -> Resolve.Memo. return (Some [ name, None ])
136+ | None ->
137+ let info = Lib. info lib in
138+ (match Lib_info. entry_modules info ~for_ with
139+ | Lib_info.Source. External (Ok names ) ->
140+ Resolve.Memo. return (Some (List. map names ~f: (fun n -> n, None )))
141+ | Lib_info.Source. External (Error _ ) -> Resolve.Memo. return None
142+ | Lib_info.Source. Local ->
143+ Resolve.Memo. lift_memo
144+ (let open Memo.O in
145+ let + modules_opt = Dir_contents. modules_of_lib sctx lib ~for_ in
146+ match modules_opt with
147+ | None -> None
148+ | Some modules_with_vlib ->
149+ let modules = Modules.With_vlib. drop_vlib modules_with_vlib in
150+ let entry_modules = Modules. entry_modules modules in
151+ Some (List. map entry_modules ~f: (fun m -> Module. name m, Some m))))
152+ ;;
153+
154+ let empty = { by_module_name = Module_name.Map. empty; unresolved = [] }
155+
156+ let create sctx (libs : Lib.t list ) ~for_ : t Resolve.Memo. t =
157+ let open Resolve.Memo.O in
158+ let + entries =
159+ Resolve.Memo.List. map libs ~f: (fun lib ->
160+ let + names_opt = module_names_of_lib sctx lib ~for_ in
161+ lib, names_opt)
162+ in
163+ let by_module_name, unresolved =
164+ List. fold_left
165+ entries
166+ ~init: (Module_name.Map. empty, [] )
167+ ~f: (fun (by_name , unresolved ) (lib , names_opt ) ->
168+ match names_opt with
169+ | None -> by_name, lib :: unresolved
170+ | Some named_modules ->
171+ let by_name =
172+ List. fold_left named_modules ~init: by_name ~f: (fun acc (name , mod_opt ) ->
173+ Module_name.Map. update acc name ~f: (function
174+ | None -> Some [ lib, mod_opt ]
175+ | Some entries -> Some ((lib, mod_opt) :: entries)))
176+ in
177+ by_name, unresolved)
178+ in
179+ { by_module_name; unresolved }
180+ ;;
181+
182+ let filter_libs (index : t ) ~(referenced_modules : Module_name.Set.t ) : entry list =
183+ let from_refs =
184+ Module_name.Set. fold referenced_modules ~init: [] ~f: (fun name acc ->
185+ match Module_name.Map. find index.by_module_name name with
186+ | None -> acc
187+ | Some entries -> List. rev_append entries acc)
188+ in
189+ let unresolved = List. map index.unresolved ~f: (fun lib -> lib, None ) in
190+ (* Entries are unique per (lib, module name). Two modules with the
191+ same name can't appear for the same library since module names are
192+ unique within a library's entry modules. *)
193+ let compare (a_lib , a_mod ) (b_lib , b_mod ) =
194+ match Lib. compare a_lib b_lib with
195+ | (Lt | Gt ) as c -> c
196+ | Eq ->
197+ (match a_mod, b_mod with
198+ | None , None -> Eq
199+ | None , Some _ -> Lt
200+ | Some _ , None -> Gt
201+ | Some a , Some b -> Module_name. compare (Module. name a) (Module. name b))
202+ in
203+ List. rev_append unresolved from_refs |> List. sort_uniq ~compare
204+ ;;
205+ end
0 commit comments