diff --git a/src/findlib.ml b/src/findlib.ml index 8ea0c0c7..e2fecae1 100644 --- a/src/findlib.ml +++ b/src/findlib.ml @@ -11,6 +11,14 @@ module Rule = struct ; value : string } + let pp fmt { preds_required; preds_forbidden; value } = + Fmt.record fmt + [ "preds_required", Fmt.const Ps.pp preds_required + ; "preds_forbidden", Fmt.const Ps.pp preds_forbidden + ; "value", Fmt.const (fun fmt -> Format.fprintf fmt "%S") value + ] + + let formal_predicates_count t = Ps.cardinal t.preds_required + Ps.cardinal t.preds_forbidden @@ -45,6 +53,12 @@ module Rules = struct ; add_rules : Rule.t list } + let pp fmt { set_rules; add_rules } = + Fmt.record fmt + [ "set_rules", (fun fmt () -> Fmt.ocaml_list Rule.pp fmt set_rules) + ; "add_rules", (fun fmt () -> Fmt.ocaml_list Rule.pp fmt add_rules) + ] + let interpret t ~preds = let rec find_set_rule = function | [] -> None @@ -92,6 +106,15 @@ module Config = struct ; preds : Ps.t } + let pp fmt { vars; preds } = + Fmt.record fmt + [ "vars" + , Fmt.const (Fmt.ocaml_list (Fmt.tuple Format.pp_print_string Rules.pp)) + (String.Map.to_list vars) + ; "preds" + , Fmt.const Ps.pp preds + ] + let load path ~toolchain ~context = let path = Path.extend_basename path ~suffix:".d" in let conf_file = Path.relative path (toolchain ^ ".conf") in diff --git a/src/findlib.mli b/src/findlib.mli index 535332ac..83875550 100644 --- a/src/findlib.mli +++ b/src/findlib.mli @@ -1,6 +1,6 @@ (** Findlib database *) -open Stdune +open Import (** Findlib database *) type t @@ -60,6 +60,9 @@ val dummy_package : t -> name:string -> Package.t module Config : sig type t + + val pp : t Fmt.t + val load : Path.t -> toolchain:string -> context:string -> t val get : t -> string -> string option diff --git a/src/import.ml b/src/import.ml index fd1640f2..ca2d0407 100644 --- a/src/import.ml +++ b/src/import.ml @@ -150,6 +150,9 @@ module Fmt = struct let pp_sep fmt () = Format.fprintf fmt "@,; " in Format.fprintf fmt "@[{ %a@ }@]" (Format.pp_print_list ~pp_sep pp) xs + + let tuple ppfa ppfb fmt (a, b) = + Format.fprintf fmt "@[(%a, %a)@]" ppfa a ppfb b end (* This is ugly *) diff --git a/src/interned.ml b/src/interned.ml index 34111eb5..ac663573 100644 --- a/src/interned.ml +++ b/src/interned.ml @@ -9,6 +9,8 @@ module type S = sig module Set : sig include Set.S with type elt = t val make : string list -> t + + val pp : t Fmt.t end module Map : Map.S with type key = t module Table : sig @@ -72,11 +74,15 @@ module Make() = struct let to_string t = Table.get names t + let pp fmt t = Format.fprintf fmt "%S" (to_string t) + module Set = struct include Int_set let make l = List.fold_left l ~init:empty ~f:(fun acc s -> add acc (make s)) + + let pp fmt (t : t) = Fmt.ocaml_list pp fmt (to_list t) end module Map = Int_map diff --git a/src/interned.mli b/src/interned.mli index 14aee82d..613020bc 100644 --- a/src/interned.mli +++ b/src/interned.mli @@ -17,6 +17,8 @@ module type S = sig include Set.S with type elt = t val make : string list -> t + + val pp : t Fmt.t end module Map : Map.S with type key = t