diff --git a/src/lib.ml b/src/lib.ml index 01cc5c93f530..f404808ba85e 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -570,7 +570,7 @@ let result_of_resolve_status = function | St_not_found -> Error Error.Library_not_available.Reason.Not_found | St_hidden (_, hidden) -> Error (Hidden hidden) -module Virtual_libs : sig +module Vlib : sig (** Make sure that for every virtual library in the list there is at most one corresponding implementation. @@ -582,7 +582,51 @@ module Virtual_libs : sig -> orig_stack:Dep_stack.t -> linking:bool -> t list Or_exn.t + + module Unimplemented : sig + (** set of unimplemented libraries*) + type t + + val empty : t + + val add : t -> lib -> t Or_exn.t + + val fold + : t + -> init:'acc + -> f:(lib -> 'acc -> 'acc Or_exn.t) + -> 'acc Or_exn.t + end end = struct + module Unimplemented = struct + type status = Implemented | Not_implemented + type t = status Map.t + + let empty = Map.empty + + let add t lib = + match lib.implements, lib.info.virtual_ with + | None, None -> Ok t + | Some _, Some _ -> + assert false (* can't be virtual and implement *) + | None, Some _ -> + Ok (Map.update t lib ~f:(function + | None -> Some Not_implemented + | Some _ as x -> x)) + | Some vlib, None -> + let+ vlib = vlib in + Map.add t vlib Implemented + + let fold = + let rec loop ~f ~acc = function + | [] -> Ok acc + | (_, Implemented) :: libs -> loop ~f ~acc libs + | (lib, Not_implemented) :: libs -> + let* acc = f lib acc in + loop ~f ~acc libs + in + fun t ~init ~f -> loop (Map.to_list t) ~acc:init ~f + end module Table = struct module Partial = struct type vlib_status = @@ -671,13 +715,6 @@ end = struct Ok closure end -module Vlib_status = struct - type nonrec t = - | No_implementation - | Implemented_by of t - | Too_many_impl of t list -end - module Vlib_visit : sig type t @@ -737,29 +774,6 @@ let rec find_implementation_for db lib ~variants = ; conflict })) -(* Update the variant status map according to `lib` which is being added to the - closure. *) -let handle_vlibs lib virtual_status = - match lib.info.virtual_, lib.implements with - | Some _, Some _ -> assert false - | None, None -> Ok virtual_status - | Some _, None -> - (* Virtual library: add it in the map if it doesn't exist yet. *) - Ok ( - match Map.find virtual_status lib with - | None -> Map.add virtual_status lib Vlib_status.No_implementation - | Some _ -> virtual_status) - | None, Some implements -> - (* Implementation: find the corresponding virtual library *) - let+ implements = implements in - Map.update virtual_status implements ~f:(fun status -> - Option.some @@ - match status with - | Some No_implementation - | None -> Vlib_status.Implemented_by lib - | Some (Implemented_by x) -> Too_many_impl [lib; x] - | Some (Too_many_impl lst) -> Too_many_impl (lib :: lst)) - let rec instantiate db name (info : Lib_info.t) ~stack ~hidden = let id, stack = Dep_stack.create_and_push stack name info.src_dir @@ -1096,7 +1110,7 @@ and closure_with_overlap_checks db ts ~stack:orig_stack ~linking ~variants = ~allow_private_deps:true ~loc ~stack:Dep_stack.empty in let visited = ref Map.empty in - let virtual_status = ref Map.empty in + let unimplemented = ref Vlib.Unimplemented.empty in let res = ref [] in let rec loop t ~stack = match Map.find !visited t with @@ -1131,8 +1145,8 @@ and closure_with_overlap_checks db ts ~stack:orig_stack ~linking ~variants = in let* new_stack = Dep_stack.push stack (to_id t) in let* deps = t.requires in - let* virtual_status' = handle_vlibs t !virtual_status in - virtual_status := virtual_status'; + let* unimplemented' = Vlib.Unimplemented.add !unimplemented t in + unimplemented := unimplemented'; let+ () = Result.List.iter deps ~f:(loop ~stack:new_stack) in res := (t, stack) :: !res in @@ -1144,24 +1158,18 @@ and closure_with_overlap_checks db ts ~stack:orig_stack ~linking ~variants = else begin (* Virtual libraries: find implementations according to variants. *) let* (lst, with_default_impl) = - Map.foldi !virtual_status ~init:(Ok ([], [])) - ~f:(fun lib status acc -> - match status with - | Implemented_by _ - | Too_many_impl _ -> acc - | No_implementation -> - let* (lst, def) = acc in - let (lib, _) = Map.find_exn !visited lib in - let* impl = - find_implementation_for (Option.value_exn db) lib ~variants in - match impl, lib.default_implementation with - | None, Some _ -> - Ok (lst, (lib :: def)) - | None, None -> - Ok (lst, def) - | Some (impl_info : Lib_info.t), _ -> - let* impl = name_to_lib impl_info.name impl_info.loc in - Ok (impl :: lst, def)) + !unimplemented + |> Vlib.Unimplemented.fold ~init:([], []) ~f:(fun lib (lst, def) -> + let* impl = + find_implementation_for (Option.value_exn db) lib ~variants in + match impl, lib.default_implementation with + | None, Some _ -> + Ok (lst, (lib :: def)) + | None, None -> + Ok (lst, def) + | Some (impl_info : Lib_info.t), _ -> + let* impl = name_to_lib impl_info.name impl_info.loc in + Ok (impl :: lst, def)) in (* Manage unimplemented libraries that have a default implementation. *) match lst, with_default_impl with @@ -1175,7 +1183,7 @@ and closure_with_overlap_checks db ts ~stack:orig_stack ~linking ~variants = end in let* () = handle ts ~stack:orig_stack in - Virtual_libs.associate (List.rev !res) ~linking ~orig_stack + Vlib.associate (List.rev !res) ~linking ~orig_stack let closure_with_overlap_checks db l ~variants = closure_with_overlap_checks db l ~stack:Dep_stack.empty ~variants