From b59dab57da66b293cf6328c9f8f9f12a7a3cac63 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= Date: Fri, 16 Mar 2018 11:10:09 +0800 Subject: [PATCH 1/2] Include the package in the public status of libraries --- src/lib.ml | 8 ++++---- src/lib.mli | 2 +- src/odoc.ml | 4 ++-- src/preprocessing.ml | 46 ++++++++++++++++++++++---------------------- 4 files changed, 30 insertions(+), 30 deletions(-) diff --git a/src/lib.ml b/src/lib.ml index 39573dbd..7adf0b37 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -8,20 +8,20 @@ open Result.O module Status = struct type t = | Installed - | Public + | Public of Package.t | Private of Jbuild.Scope_info.Name.t let pp ppf t = Format.pp_print_string ppf (match t with | Installed -> "installed" - | Public -> "public" + | Public _ -> "public" | Private s -> sprintf "private (%s)" (Jbuild.Scope_info.Name.to_string s)) let is_private = function | Private _ -> true - | Installed | Public -> false + | Installed | Public _ -> false end module Info = struct @@ -89,7 +89,7 @@ module Info = struct let status = match conf.public with | None -> Status.Private conf.scope_name - | Some _ -> Public + | Some p -> Public p.package in let foreign_archives = { Mode.Dict. diff --git a/src/lib.mli b/src/lib.mli index d35f55f3..b6a67bbf 100644 --- a/src/lib.mli +++ b/src/lib.mli @@ -35,7 +35,7 @@ module Set : Set.S with type elt = t module Status : sig type t = | Installed - | Public + | Public of Package.t | Private of Jbuild.Scope_info.Name.t val pp : t Fmt.t diff --git a/src/odoc.ml b/src/odoc.ml index c011a24c..6b665833 100644 --- a/src/odoc.ml +++ b/src/odoc.ml @@ -35,7 +35,7 @@ module Doc = struct dir_internal t (match Lib.status lib with | Installed -> assert false - | Public -> Public (Lib.name lib) + | Public _ -> Public (Lib.name lib) | Private s -> Private (Lib.name lib, s)) in Build_system.Alias.stamp_file (alias ~dir) :: acc @@ -220,7 +220,7 @@ let setup_library_rules sctx (lib : Library.t) ~dir ~scope ~modules ~mld_files let name = Lib.name lib in match Lib.status lib with | Installed -> assert false - | Public -> name + | Public _ -> name | Private scope_name -> sprintf "%s@%s" name (Scope_info.Name.to_string scope_name) in diff --git a/src/preprocessing.ml b/src/preprocessing.ml index 24435595..228f6612 100644 --- a/src/preprocessing.ml +++ b/src/preprocessing.ml @@ -126,15 +126,6 @@ let gen_rules sctx components = build_ppx_driver sctx pps ~lib_db ~dep_kind:Required ~target:exe | _ -> () -let most_specific_db (a : Lib.Status.t) (b : Lib.Status.t) = - match a, b with - | Private x, Private y -> assert (x = y); a - | Private _, _ -> a - | _ , Private _ -> b - | Public , _ - | _ , Public -> Public - | Installed, Installed -> Installed - let get_ppx_driver sctx ~scope pps = let driver, names = match List.rev_map pps ~f:(fun (_loc, pp) -> Pp.to_string pp) with @@ -142,25 +133,34 @@ let get_ppx_driver sctx ~scope pps = | driver :: rest -> (Some driver, rest) in let sctx = SC.host sctx in - let name_and_db name = + let name_and_scope_for_key name = match Lib.DB.find (Scope.libs scope) name with | Error _ -> (* XXX unknown but assume it's public *) - (name, Lib.Status.Installed) + (name, None) | Ok lib -> - (Lib.name lib, Lib.status lib) + (Lib.name lib, + match Lib.status lib with + | Private scope_name -> Some scope_name + | Public _ | Installed -> None) in - let driver, driver_db = + let driver, scope_for_key = match driver with - | None -> (None, Lib.Status.Installed) + | None -> (None, None) | Some driver -> - let name, db = name_and_db driver in - (Some name, db) + let name, scope_for_key = name_and_scope_for_key driver in + (Some name, scope_for_key) in - let names, db = - List.fold_left names ~init:([], driver_db) ~f:(fun (names, db) lib -> - let name, db' = name_and_db lib in - (name :: names, most_specific_db db db')) + let names, scope_for_key = + List.fold_left names ~init:([], scope_for_key) + ~f:(fun (names, scope_for_key) lib -> + let name, scope_for_key' = name_and_scope_for_key lib in + (name :: names, + match scope_for_key, scope_for_key' with + | Some a, Some b -> assert (a = b); scope_for_key + | Some _, None -> scope_for_key + | None , Some _ -> scope_for_key' + | None , None -> None)) in let names = List.sort ~compare:String.compare names in let names = @@ -174,9 +174,9 @@ let get_ppx_driver sctx ~scope pps = | _ -> String.concat names ~sep:"+" in let key = - match db with - | Installed | Public -> key - | Private scope_name -> SC.Scope_key.to_string key scope_name + match scope_for_key with + | None -> key + | Some scope_name -> SC.Scope_key.to_string key scope_name in let sctx = SC.host sctx in ppx_exe sctx ~key From 69c5a4a79dfb0da7c0488c8bbdb1de49f266a271 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= Date: Fri, 16 Mar 2018 11:10:22 +0800 Subject: [PATCH 2/2] Implement Lib.package Gets the opam package of a library for a public or installed library --- src/lib.ml | 9 +++++++++ src/lib.mli | 2 ++ 2 files changed, 11 insertions(+) diff --git a/src/lib.ml b/src/lib.ml index 7adf0b37..78a59520 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -353,6 +353,15 @@ let is_local t = Path.is_local t.obj_dir let status t = t.status +let package t = + match t.status with + | Installed -> + Some (Findlib.root_package_name t.name + |> Package.Name.of_string) + | Public p -> Some p.name + | Private _ -> + None + let to_id t : Id.t = { unique_id = t.unique_id ; path = t.src_dir diff --git a/src/lib.mli b/src/lib.mli index b6a67bbf..dee866de 100644 --- a/src/lib.mli +++ b/src/lib.mli @@ -43,6 +43,8 @@ end val status : t -> Status.t +val package : t -> Package.Name.t option + (** Operations on list of libraries *) module L : sig type nonrec t = t list