diff options
| author | Amin Timany | 2017-05-04 19:12:45 +0200 |
|---|---|---|
| committer | Emilio Jesus Gallego Arias | 2017-06-16 04:51:18 +0200 |
| commit | 0c94de1f8c598c1869f71fee86bdbe4f0000a502 (patch) | |
| tree | 766e45ea9bd38c8978542ce90dad3ba1d96b0f98 | |
| parent | 47ce63d23b8efe35babe0f4429c550400afd6b4f (diff) | |
Add printing of cumulativity in inductive types
| -rw-r--r-- | printing/ppvernac.ml | 6 | ||||
| -rw-r--r-- | printing/printer.ml | 5 | ||||
| -rw-r--r-- | printing/printer.mli | 1 | ||||
| -rw-r--r-- | printing/printmod.ml | 10 |
4 files changed, 16 insertions, 6 deletions
diff --git a/printing/ppvernac.ml b/printing/ppvernac.ml index 6a47c308d3..4a5cfe6301 100644 --- a/printing/ppvernac.ml +++ b/printing/ppvernac.ml @@ -759,8 +759,10 @@ open Decl_kinds | Inductive_kw -> "Inductive" | CoInductive -> "CoInductive" | Class _ -> "Class" | Variant -> "Variant" in - let cm = if cum then "Cumulative" else "NonCumulative" in - cm ^ " " ^ kind + if p then + let cm = if cum then "Cumulative" else "NonCumulative" in + cm ^ " " ^ kind + else kind in return ( hov 1 (pr_oneind key (List.hd l)) ++ diff --git a/printing/printer.ml b/printing/printer.ml index c27a9b009d..1d7b7cff0f 100644 --- a/printing/printer.ml +++ b/printing/printer.ml @@ -998,6 +998,11 @@ let pr_assumptionset env s = let xor a b = (a && not b) || (not a && b) +let pr_cumulative p b = + if p then + if b then str "Cumulative " else str "NonCumulative " + else str "" + let pr_polymorphic b = let print = xor (Flags.is_universe_polymorphism ()) b in if print then diff --git a/printing/printer.mli b/printing/printer.mli index 6531036a1f..9f4ea23b74 100644 --- a/printing/printer.mli +++ b/printing/printer.mli @@ -95,6 +95,7 @@ val pr_sort : evar_map -> sorts -> std_ppcmds (** Universe constraints *) val pr_polymorphic : bool -> std_ppcmds +val pr_cumulative : bool -> bool -> std_ppcmds val pr_universe_instance : evar_map -> Univ.universe_context -> std_ppcmds val pr_universe_ctx : evar_map -> Univ.universe_context -> std_ppcmds val pr_universe_info_ind : evar_map -> Univ.universe_info_ind -> std_ppcmds diff --git a/printing/printmod.ml b/printing/printmod.ml index 7dc47a4a4c..be8940b6ff 100644 --- a/printing/printmod.ml +++ b/printing/printmod.ml @@ -121,10 +121,11 @@ let print_mutual_inductive env mind mib = let bl = Universes.universe_binders_of_global (IndRef (mind, 0)) in let sigma = Evd.from_ctx (Evd.evar_universe_context_of_binders bl) in hov 0 (Printer.pr_polymorphic mib.mind_polymorphic ++ - def keyword ++ spc () ++ - prlist_with_sep (fun () -> fnl () ++ str" with ") - (print_one_inductive env sigma mib) inds ++ - Printer.pr_universe_info_ind sigma (Univ.instantiate_univ_info_ind mib.mind_universes)) + Printer.pr_cumulative mib.mind_polymorphic mib.mind_cumulative ++ + def keyword ++ spc () ++ + prlist_with_sep (fun () -> fnl () ++ str" with ") + (print_one_inductive env sigma mib) inds ++ + Printer.pr_universe_info_ind sigma (Univ.instantiate_univ_info_ind mib.mind_universes)) let get_fields = let rec prodec_rec l subst c = @@ -165,6 +166,7 @@ let print_record env mind mib = hov 0 ( hov 0 ( Printer.pr_polymorphic mib.mind_polymorphic ++ + Printer.pr_cumulative mib.mind_polymorphic mib.mind_cumulative ++ def keyword ++ spc () ++ pr_id mip.mind_typename ++ brk(1,4) ++ print_params env sigma params ++ str ": " ++ Printer.pr_lconstr_env envpar sigma arity ++ brk(1,2) ++ |