aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--kernel/uGraph.ml5
-rw-r--r--kernel/uGraph.mli2
-rw-r--r--vernac/vernacentries.ml11
3 files changed, 10 insertions, 8 deletions
diff --git a/kernel/uGraph.ml b/kernel/uGraph.ml
index ad94362aaf..9083156745 100644
--- a/kernel/uGraph.ml
+++ b/kernel/uGraph.ml
@@ -967,12 +967,11 @@ let pr_universes prl g =
let dump_universes output g =
let dump_arc u = function
| Canonical {univ=u; ltle; _} ->
- let u_str = Level.to_string u in
UMap.iter (fun v strict ->
let typ = if strict then Lt else Le in
- output typ u_str (Level.to_string v)) ltle;
+ output typ u v) ltle;
| Equiv v ->
- output Eq (Level.to_string u) (Level.to_string v)
+ output Eq u v
in
UMap.iter dump_arc g.entries
diff --git a/kernel/uGraph.mli b/kernel/uGraph.mli
index 4336a22b8c..a2cc5b3116 100644
--- a/kernel/uGraph.mli
+++ b/kernel/uGraph.mli
@@ -86,7 +86,7 @@ val check_subtype : AUContext.t check_function
(** {6 Dumping to a file } *)
val dump_universes :
- (constraint_type -> string -> string -> unit) -> t -> unit
+ (constraint_type -> Level.t -> Level.t -> unit) -> t -> unit
(** {6 Debugging} *)
val check_universes_invariants : t -> unit
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index bc554fb4bf..7a76fb9560 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -319,7 +319,7 @@ let print_registered () =
hov 0 (prlist_with_sep fnl pr_lib_ref @@ Coqlib.get_lib_refs ())
-let dump_universes_gen g s =
+let dump_universes_gen prl g s =
let output = open_out s in
let output_constraint, close =
if Filename.check_suffix s ".dot" || Filename.check_suffix s ".gv" then begin
@@ -344,10 +344,12 @@ let dump_universes_gen g s =
| Univ.Lt -> "<"
| Univ.Le -> "<="
| Univ.Eq -> "="
- in Printf.fprintf output "%s %s %s ;\n" left kind right
+ in
+ Printf.fprintf output "%s %s %s ;\n" left kind right
end, (fun () -> close_out output)
end
in
+ let output_constraint k l r = output_constraint k (prl l) (prl r) in
try
UGraph.dump_universes output_constraint g;
close ();
@@ -381,9 +383,10 @@ let print_universes ?loc ~sort ~subgraph dst =
if Global.is_joined_environment () then mt ()
else str"There may remain asynchronous universe constraints"
in
+ let prl = UnivNames.pr_with_global_universes in
begin match dst with
- | None -> UGraph.pr_universes UnivNames.pr_with_global_universes univ ++ pr_remaining
- | Some s -> dump_universes_gen univ s
+ | None -> UGraph.pr_universes prl univ ++ pr_remaining
+ | Some s -> dump_universes_gen (fun u -> Pp.string_of_ppcmds (prl u)) univ s
end
(*********************)