diff --git a/src/alias.ml b/src/alias.ml index fe5182c1..c391aedd 100644 --- a/src/alias.ml +++ b/src/alias.ml @@ -3,12 +3,14 @@ open! Import (** Fully qualified name *) module Fq_name : sig type t + val pp : Format.formatter -> t -> unit val make : Path.t -> t val path : t -> Path.t end = struct type t = Path.t let make t = t let path t = t + let pp = Path.pp end type t = @@ -16,6 +18,10 @@ type t = ; file : Path.t } +let pp fmt t = + Format.fprintf fmt "@[<2>{ name@ =@ %a@ ;@ file@ =@ %a }@]" + Path.pp (Fq_name.path t.name) Path.pp t.file + let aliases_path = Path.(relative root) "_build/.aliases" let suffix = "-" ^ String.make 32 '0' @@ -113,8 +119,24 @@ module Store = struct { alias : t ; mutable deps : Path.Set.t } + let pp_entry fmt entry = + let pp_deps fmt deps = + Format.pp_print_list Path.pp fmt (Path.Set.elements deps) in + Format.fprintf fmt "@[<2>{@ alias@ =@ %a@ ;@ deps@ = (%a)@ }@]" + pp entry.alias pp_deps entry.deps + type t = (Fq_name.t, entry) Hashtbl.t + let pp fmt (t : t) = + let bindings = Hashtbl.fold ~init:[] ~f:(fun ~key ~data acc -> + (key, data)::acc + ) t in + let pp_bindings fmt b = + Format.pp_print_list (fun fmt (k, v) -> + Format.fprintf fmt "@[<2>(%a@ %a)@]" Fq_name.pp k pp_entry v + ) fmt b in + Format.fprintf fmt "Store.t@ @[@<2>(%a)@]" pp_bindings bindings + let create () = Hashtbl.create 1024 end diff --git a/src/alias.mli b/src/alias.mli index 0bcae570..502432df 100644 --- a/src/alias.mli +++ b/src/alias.mli @@ -1,5 +1,9 @@ +open Import + type t +val pp : t Fmt.t + val make : string -> dir:Path.t -> t val of_path : Path.t -> t @@ -51,6 +55,9 @@ val name_of_file : Path.t -> string option module Store : sig type t + + val pp : t Fmt.t + val create : unit -> t end diff --git a/src/import.ml b/src/import.ml index 279ec789..4c3f84b9 100644 --- a/src/import.ml +++ b/src/import.ml @@ -504,3 +504,7 @@ let open_out_gen = `Use_Io module No_io = struct module Io = struct end end + +module Fmt = struct + type 'a t = Format.formatter -> 'a -> unit +end diff --git a/src/path.ml b/src/path.ml index 9aefa25b..996fd267 100644 --- a/src/path.ml +++ b/src/path.ml @@ -424,3 +424,5 @@ let rm_rf = let change_extension ~ext t = let t = try Filename.chop_extension t with Not_found -> t in t ^ ext + +let pp = Format.pp_print_string diff --git a/src/path.mli b/src/path.mli index 1fc5f699..31d781d2 100644 --- a/src/path.mli +++ b/src/path.mli @@ -111,3 +111,5 @@ val rm_rf : t -> unit (** Changes the extension of the filename (or adds an extension if there was none) *) val change_extension : ext:string -> t -> t + +val pp : t Fmt.t