diff --git a/src/findlib.ml b/src/findlib.ml index ca844560..f8b39c96 100644 --- a/src/findlib.ml +++ b/src/findlib.ml @@ -248,6 +248,21 @@ module Pkg_step1 = struct } end +module External_dep_conflicts_with_local_lib = struct + type t = + { package : string + ; required_by : string + ; required_locally_in : Path.t + ; defined_locally_in : Path.t + } +end + +type error = + | Package_not_available of Package_not_available.t + | External_dep_conflicts_with_local_lib of External_dep_conflicts_with_local_lib.t + +exception Findlib of error + let parse_package t ~name ~parent_dir ~vars ~required_by = let pkg_dir = Vars.get vars "directory" [] in let dir = @@ -478,18 +493,16 @@ let load_meta t ~fq_name ~required_by = Hashtbl.add t.packages ~key:pkg.package.name ~data:status ) -exception Package_not_available of Package_not_available.t - let find_exn t ~required_by name = match Hashtbl.find t.packages name with | Some (Present x) -> x - | Some (Not_available na) -> raise (Package_not_available na) + | Some (Not_available na) -> raise (Findlib (Package_not_available na)) | None -> load_meta t ~fq_name:name ~required_by; match Hashtbl.find t.packages name with | Some (Present x) -> x | Some (Not_available pnf) -> - raise (Package_not_available pnf) + raise (Findlib (Package_not_available pnf)) | None -> let na : Package_not_available.t = { package = name @@ -498,40 +511,29 @@ let find_exn t ~required_by name = } in Hashtbl.add t.packages ~key:name ~data:(Not_available na); - raise (Package_not_available na) + raise (Findlib (Package_not_available na)) let find t ~required_by name = match find_exn t ~required_by name with - | exception (Package_not_available _) -> None + | exception (Findlib (Package_not_available _)) -> None | x -> Some x let available t ~required_by name = match find_exn t name ~required_by with | (_ : package) -> true - | exception (Package_not_available _) -> false - -module External_dep_conflicts_with_local_lib = struct - type t = - { package : string - ; required_by : string - ; required_locally_in : Path.t - ; defined_locally_in : Path.t - } -end - -exception External_dep_conflicts_with_local_lib of External_dep_conflicts_with_local_lib.t + | exception (Findlib (Package_not_available _)) -> false let check_deps_consistency ~required_by ~local_public_libs pkg requires = List.iter requires ~f:(fun pkg' -> match String_map.find pkg'.name local_public_libs with | None -> () | Some path -> - raise (External_dep_conflicts_with_local_lib - { package = pkg'.name - ; required_by = pkg.name - ; required_locally_in = required_by - ; defined_locally_in = path - })) + raise (Findlib (External_dep_conflicts_with_local_lib + { package = pkg'.name + ; required_by = pkg.name + ; required_locally_in = required_by + ; defined_locally_in = path + }))) let closure ~required_by ~local_public_libs pkgs = remove_dups_preserve_order diff --git a/src/findlib.mli b/src/findlib.mli index 3c44b9b8..c84bfdcd 100644 --- a/src/findlib.mli +++ b/src/findlib.mli @@ -22,8 +22,6 @@ module Package_not_available : sig val explain : Format.formatter -> reason -> unit end -exception Package_not_available of Package_not_available.t - module External_dep_conflicts_with_local_lib : sig type t = { package : string @@ -33,7 +31,11 @@ module External_dep_conflicts_with_local_lib : sig } end -exception External_dep_conflicts_with_local_lib of External_dep_conflicts_with_local_lib.t +type error = + | Package_not_available of Package_not_available.t + | External_dep_conflicts_with_local_lib of External_dep_conflicts_with_local_lib.t + +exception Findlib of error (** Findlib database *) type t diff --git a/src/lib_db.ml b/src/lib_db.ml index 9988750c..bf60708a 100644 --- a/src/lib_db.ml +++ b/src/lib_db.ml @@ -45,7 +45,7 @@ let find_exn t ~from name = let find t ~from name = match find_exn t ~from name with - | exception _ -> None + | exception (Findlib.Findlib _) -> None | x -> Some x let find_internal t ~from name = @@ -165,7 +165,7 @@ let interpret_lib_dep t ~dir lib_dep = List.map (String_set.elements required) ~f:(find_exn t ~from:dir) with | l -> Some l - | exception _ -> None) + | exception (Findlib.Findlib _) -> None) with | Some l -> Inl l | None -> diff --git a/src/main.ml b/src/main.ml index 53f6ad06..8fe97d1b 100644 --- a/src/main.ml +++ b/src/main.ml @@ -113,7 +113,7 @@ let report_error ?(map_fname=fun x->x) ppf exn ~backtrace = | Fatal_error msg -> Format.fprintf ppf "%s\n" (String.capitalize_ascii msg); false - | Findlib.Package_not_available { package; required_by; reason } -> + | Findlib.Findlib (Findlib.Package_not_available { package; required_by; reason }) -> Format.fprintf ppf "@{Error@}: External library %S %s.\n" package (match reason with @@ -142,8 +142,8 @@ let report_error ?(map_fname=fun x->x) ppf exn ~backtrace = (List.map !Clflags.external_lib_deps_hint ~f:quote_for_shell |> String.concat ~sep:" "); false - | Findlib.External_dep_conflicts_with_local_lib - { package; required_by; required_locally_in; defined_locally_in } -> + | Findlib.Findlib (Findlib.External_dep_conflicts_with_local_lib { + package; required_by; required_locally_in; defined_locally_in }) -> Format.fprintf ppf "@{Error@}: Conflict between internal and external version of library %S:\n\ - it is defined locally in %s\n\