diff --git a/src/install_rules.ml b/src/install_rules.ml index 84797e56..247bbb5f 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -45,9 +45,9 @@ module Gen(P : Install_params) = struct let init_meta () = let public_libs = Lib.DB.all (SC.public_libs sctx) in - List.iter public_libs ~f:gen_lib_dune_file; - List.map public_libs ~f:(fun lib -> - (Findlib.root_package_name (Lib.name lib), lib)) + Lib.Set.iter public_libs ~f:gen_lib_dune_file; + Lib.Set.to_list public_libs + |> List.map ~f:(fun lib -> (Findlib.root_package_name (Lib.name lib), lib)) |> String_map.of_list_multi |> String_map.merge (SC.packages sctx) ~f:(fun _name pkg libs -> let pkg = Option.value_exn pkg in diff --git a/src/lib.ml b/src/lib.ml index 3e04aedc..de81d79f 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -319,6 +319,12 @@ let to_id t : Id.t = ; name = t.name } +module Set = Set.Make( +struct + type nonrec t = t + let compare x y = compare x.unique_id y.unique_id +end) + module L = struct type nonrec t = t list @@ -973,13 +979,13 @@ module DB = struct let rec all ?(recursive=false) t = let l = - List.filter_map (Lazy.force t.all) ~f:(fun name -> + List.fold_left (Lazy.force t.all) ~f:(fun libs name -> match find t name with - | Ok x -> Some x - | Error _ -> None) + | Ok x -> Set.add libs x + | Error _ -> libs) ~init:Set.empty in match recursive, t.parent with - | true, Some t -> all ~recursive t @ l + | true, Some t -> Set.union (all ~recursive t) l | _ -> l end diff --git a/src/lib.mli b/src/lib.mli index 0cb112ea..14ad81ac 100644 --- a/src/lib.mli +++ b/src/lib.mli @@ -30,6 +30,8 @@ val jsoo_runtime : t -> Path.t list the process *) val unique_id : t -> int +module Set : Set.S with type elt = t + module Status : sig type t = | Installed @@ -265,7 +267,7 @@ module DB : sig (** Return the list of all libraries in this database. If [recursive] is true, also include libraries in parent databases recursively. *) - val all : ?recursive:bool -> t -> lib list + val all : ?recursive:bool -> t -> Set.t end with type lib := t (** {1 Transitive closure} *)