diff options
| -rw-r--r-- | kernel/univ.ml | 15 | ||||
| -rw-r--r-- | kernel/univ.mli | 4 | ||||
| -rw-r--r-- | toplevel/vernacentries.ml | 9 |
3 files changed, 14 insertions, 14 deletions
diff --git a/kernel/univ.ml b/kernel/univ.ml index 40bd2a20d..da6f2e179 100644 --- a/kernel/univ.ml +++ b/kernel/univ.ml @@ -600,19 +600,10 @@ let dump_universes output g = let dump_arc _ = function | Canonical {univ=u; lt=lt; le=le} -> let u_str = string_of_univ_level u in - List.iter - (fun v -> - Printf.fprintf output "%s < %s ;\n" u_str - (string_of_univ_level v)) - lt; - List.iter - (fun v -> - Printf.fprintf output "%s <= %s ;\n" u_str - (string_of_univ_level v)) - le + List.iter (fun v -> output `Lt u_str (string_of_univ_level v)) lt; + List.iter (fun v -> output `Le u_str (string_of_univ_level v)) le | Equiv (u,v) -> - Printf.fprintf output "%s = %s ;\n" - (string_of_univ_level u) (string_of_univ_level v) + output `Eq (string_of_univ_level u) (string_of_univ_level v) in UniverseLMap.iter dump_arc g diff --git a/kernel/univ.mli b/kernel/univ.mli index 3d4f97d51..85e227891 100644 --- a/kernel/univ.mli +++ b/kernel/univ.mli @@ -85,6 +85,8 @@ val pr_constraints : constraints -> Pp.std_ppcmds (** {6 Dumping to a file } *) -val dump_universes : out_channel -> universes -> unit +val dump_universes : + ([> `Lt | `Le | `Eq ] -> string -> string -> unit) -> + universes -> unit val hcons1_univ : universe -> universe diff --git a/toplevel/vernacentries.ml b/toplevel/vernacentries.ml index 5962cf14d..1cfc50811 100644 --- a/toplevel/vernacentries.ml +++ b/toplevel/vernacentries.ml @@ -204,8 +204,15 @@ let print_modtype r = let dump_universes s = let output = open_out s in + let output_constraint kind left right = + let kind = match kind with + | `Lt -> "<" + | `Le -> "<=" + | `Eq -> "=" + in Printf.fprintf output "%s %s %s ;\n" left kind right + in try - Univ.dump_universes output (Global.universes ()); + Univ.dump_universes output_constraint (Global.universes ()); close_out output; msgnl (str ("Universes written to file \""^s^"\".")) with |