aboutsummaryrefslogtreecommitdiff
path: root/printing
diff options
context:
space:
mode:
Diffstat (limited to 'printing')
-rw-r--r--printing/genprint.ml2
-rw-r--r--printing/genprint.mli2
-rw-r--r--printing/miscprint.ml2
-rw-r--r--printing/miscprint.mli2
-rw-r--r--printing/ppconstr.ml6
-rw-r--r--printing/ppconstr.mli2
-rw-r--r--printing/pputils.ml2
-rw-r--r--printing/pputils.mli2
-rw-r--r--printing/ppvernac.ml24
-rw-r--r--printing/ppvernac.mli2
-rw-r--r--printing/prettyp.ml65
-rw-r--r--printing/prettyp.mli2
-rw-r--r--printing/printer.ml18
-rw-r--r--printing/printer.mli4
-rw-r--r--printing/printmod.ml63
-rw-r--r--printing/printmod.mli2
16 files changed, 141 insertions, 59 deletions
diff --git a/printing/genprint.ml b/printing/genprint.ml
index 6505a8f826..bb9736d731 100644
--- a/printing/genprint.ml
+++ b/printing/genprint.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/printing/genprint.mli b/printing/genprint.mli
index 5381fc5bdb..24779a359d 100644
--- a/printing/genprint.mli
+++ b/printing/genprint.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/printing/miscprint.ml b/printing/miscprint.ml
index a4ecbdf5e5..5d37c8a024 100644
--- a/printing/miscprint.ml
+++ b/printing/miscprint.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/printing/miscprint.mli b/printing/miscprint.mli
index dbbe3dcfd8..21d410c7b0 100644
--- a/printing/miscprint.mli
+++ b/printing/miscprint.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml
index 626464b96f..cf513321fb 100644
--- a/printing/ppconstr.ml
+++ b/printing/ppconstr.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -80,7 +80,7 @@ let tag_var = tag Tag.variable
| Any -> true
let prec_of_prim_token = function
- | Numeral p -> if Bigint.is_pos_or_zero p then lposint else lnegint
+ | Numeral (_,b) -> if b then lposint else lnegint
| String _ -> latom
open Notation
@@ -231,7 +231,7 @@ let tag_var = tag Tag.variable
| ArgVar (loc,s) -> pr_lident (loc,s)
let pr_prim_token = function
- | Numeral n -> str (Bigint.to_string n)
+ | Numeral (n,s) -> str (if s then n else "-"^n)
| String s -> qs s
let pr_evar pr id l =
diff --git a/printing/ppconstr.mli b/printing/ppconstr.mli
index 482c994c25..fd232759ef 100644
--- a/printing/ppconstr.mli
+++ b/printing/ppconstr.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/printing/pputils.ml b/printing/pputils.ml
index 99d07601c4..9ef9162aee 100644
--- a/printing/pputils.ml
+++ b/printing/pputils.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/printing/pputils.mli b/printing/pputils.mli
index b236fed702..0dee11e0bc 100644
--- a/printing/pputils.mli
+++ b/printing/pputils.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/printing/ppvernac.ml b/printing/ppvernac.ml
index 781af47892..a15cadfa0b 100644
--- a/printing/ppvernac.ml
+++ b/printing/ppvernac.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -561,17 +561,13 @@ open Decl_kinds
| GoalUid n -> spc () ++ str n in
let pr_showable = function
| ShowGoal n -> keyword "Show" ++ pr_goal_reference n
- | ShowGoalImplicitly n -> keyword "Show Implicit Arguments" ++ pr_opt int n
| ShowProof -> keyword "Show Proof"
- | ShowNode -> keyword "Show Node"
| ShowScript -> keyword "Show Script"
| ShowExistentials -> keyword "Show Existentials"
| ShowUniverses -> keyword "Show Universes"
- | ShowTree -> keyword "Show Tree"
| ShowProofNames -> keyword "Show Conjectures"
| ShowIntros b -> keyword "Show " ++ (if b then keyword "Intros" else keyword "Intro")
| ShowMatch id -> keyword "Show Match " ++ pr_reference id
- | ShowThesis -> keyword "Show Thesis"
in
return (pr_showable s)
| VernacCheckGuard ->
@@ -702,7 +698,7 @@ open Decl_kinds
| Some cc -> str" :=" ++ spc() ++ cc))
)
- | VernacStartTheoremProof (ki,l,_) ->
+ | VernacStartTheoremProof (ki,l) ->
return (
hov 1 (pr_statement (pr_thm_token ki) (List.hd l) ++
prlist (pr_statement (spc () ++ keyword "with")) (List.tl l))
@@ -731,7 +727,7 @@ open Decl_kinds
let assumptions = prlist_with_sep spc (fun p -> hov 1 (str "(" ++ pr_params p ++ str ")")) l in
return (hov 2 (pr_assumption_token (n > 1) stre ++
pr_non_empty_arg pr_assumption_inline t ++ spc() ++ assumptions))
- | VernacInductive (p,f,l) ->
+ | VernacInductive (cum, p,f,l) ->
let pr_constructor (coe,(id,c)) =
hov 2 (pr_lident id ++ str" " ++
(if coe then str":>" else str":") ++
@@ -758,13 +754,19 @@ open Decl_kinds
in
let key =
let (_,_,_,k,_),_ = List.hd l in
- match k with Record -> "Record" | Structure -> "Structure"
- | Inductive_kw -> "Inductive" | CoInductive -> "CoInductive"
- | Class _ -> "Class" | Variant -> "Variant"
+ let kind =
+ match k with Record -> "Record" | Structure -> "Structure"
+ | Inductive_kw -> "Inductive" | CoInductive -> "CoInductive"
+ | Class _ -> "Class" | Variant -> "Variant"
+ in
+ 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)) ++
- (prlist (fun ind -> fnl() ++ hov 1 (pr_oneind "with" ind)) (List.tl l))
+ (prlist (fun ind -> fnl() ++ hov 1 (pr_oneind "with" ind)) (List.tl l))
)
| VernacFixpoint (local, recs) ->
diff --git a/printing/ppvernac.mli b/printing/ppvernac.mli
index 836b05e0e4..ed5585b309 100644
--- a/printing/ppvernac.mli
+++ b/printing/ppvernac.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/printing/prettyp.ml b/printing/prettyp.ml
index 2b21b3f9e8..827c0e4583 100644
--- a/printing/prettyp.ml
+++ b/printing/prettyp.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -70,7 +70,8 @@ let int_or_no n = if Int.equal n 0 then str "no" else int n
let print_basename sp = pr_global (ConstRef sp)
let print_ref reduce ref =
- let typ = Global.type_of_global_unsafe ref in
+ let typ, ctx = Global.type_of_global_in_context (Global.env ()) ref in
+ let typ = Vars.subst_instance_constr (Univ.AUContext.instance ctx) typ in
let typ = EConstr.of_constr typ in
let typ =
if reduce then
@@ -78,6 +79,8 @@ let print_ref reduce ref =
in EConstr.it_mkProd_or_LetIn ccl ctx
else typ in
let univs = Global.universes_of_global ref in
+ let inst = Univ.AUContext.instance univs in
+ let univs = Univ.UContext.make (inst, Univ.AUContext.instantiate inst univs) in
let env = Global.env () in
let bl = Universes.universe_binders_of_global ref in
let sigma = Evd.from_ctx (Evd.evar_universe_context_of_binders bl) in
@@ -135,7 +138,7 @@ let print_renames_list prefix l =
hv 2 (prlist_with_sep pr_comma (fun x -> x) (List.map Name.print l))]
let need_expansion impl ref =
- let typ = Global.type_of_global_unsafe ref in
+ let typ, _ = Global.type_of_global_in_context (Global.env ()) ref in
let ctx = prod_assum typ in
let nprods = List.count is_local_assum ctx in
not (List.is_empty impl) && List.length impl >= nprods &&
@@ -502,17 +505,48 @@ let ungeneralized_type_of_constant_type t =
Typeops.type_of_constant_type (Global.env ()) t
let print_instance sigma cb =
- if cb.const_polymorphic then
- pr_universe_instance sigma cb.const_universes
+ if Declareops.constant_is_polymorphic cb then
+ let univs = Declareops.constant_polymorphic_context cb in
+ let inst = Univ.AUContext.instance univs in
+ let univs = Univ.UContext.make (inst, Univ.AUContext.instantiate inst univs) in
+ pr_universe_instance sigma univs
else mt()
let print_constant with_values sep sp =
let cb = Global.lookup_constant sp in
let val_0 = Global.body_of_constant_body cb in
- let typ = Declareops.type_of_constant cb in
+ let typ = match cb.const_type with
+ | RegularArity t as x ->
+ begin match cb.const_universes with
+ | Monomorphic_const _ -> x
+ | Polymorphic_const univs ->
+ let inst = Univ.AUContext.instance univs in
+ RegularArity (Vars.subst_instance_constr inst t)
+ end
+ | TemplateArity _ as x -> x
+ in
let typ = ungeneralized_type_of_constant_type typ in
- let univs = Univ.instantiate_univ_context
- (Global.universes_of_constant_body cb)
+ let univs =
+ let otab = Global.opaque_tables () in
+ match cb.const_body with
+ | Undef _ | Def _ ->
+ begin
+ match cb.const_universes with
+ | Monomorphic_const ctx -> ctx
+ | Polymorphic_const ctx ->
+ let inst = Univ.AUContext.instance ctx in
+ Univ.UContext.make (inst, Univ.AUContext.instantiate inst ctx)
+ end
+ | OpaqueDef o ->
+ let body_uctxs = Opaqueproof.force_constraints otab o in
+ match cb.const_universes with
+ | Monomorphic_const ctx ->
+ let uctxs = Univ.ContextSet.of_context ctx in
+ Univ.ContextSet.to_context (Univ.ContextSet.union body_uctxs uctxs)
+ | Polymorphic_const ctx ->
+ assert(Univ.ContextSet.is_empty body_uctxs);
+ let inst = Univ.AUContext.instance ctx in
+ Univ.UContext.make (inst, Univ.AUContext.instantiate inst ctx)
in
let ctx =
Evd.evar_universe_context_of_binders
@@ -520,16 +554,17 @@ let print_constant with_values sep sp =
in
let env = Global.env () and sigma = Evd.from_ctx ctx in
let pr_ltype = pr_ltype_env env sigma in
- hov 0 (pr_polymorphic cb.const_polymorphic ++
+ hov 0 (pr_polymorphic (Declareops.constant_is_polymorphic cb) ++
match val_0 with
| None ->
str"*** [ " ++
print_basename sp ++ print_instance sigma cb ++ str " : " ++ cut () ++ pr_ltype typ ++
str" ]" ++
Printer.pr_universe_ctx sigma univs
- | _ ->
+ | Some (c, ctx) ->
+ let c = Vars.subst_instance_constr (Univ.AUContext.instance ctx) c in
print_basename sp ++ print_instance sigma cb ++ str sep ++ cut () ++
- (if with_values then print_typed_body env sigma (val_0,typ) else pr_ltype typ)++
+ (if with_values then print_typed_body env sigma (Some c,typ) else pr_ltype typ)++
Printer.pr_universe_ctx sigma univs)
let gallina_print_constant_with_infos sp =
@@ -587,8 +622,6 @@ let gallina_print_library_entry with_values ent =
Some (str " >>>>>>> Module " ++ pr_name oname)
| (oname,Lib.ClosedModule _) ->
Some (str " >>>>>>> Closed Module " ++ pr_name oname)
- | (_,Lib.FrozenState _) ->
- None
let gallina_print_context with_values =
let rec prec n = function
@@ -769,9 +802,11 @@ let print_opaque_name qid =
| IndRef (sp,_) ->
print_inductive sp
| ConstructRef cstr as gr ->
- let open EConstr in
- let ty = Universes.unsafe_type_of_global gr in
+ let ty, ctx = Global.type_of_global_in_context env gr in
+ let inst = Univ.AUContext.instance ctx in
+ let ty = Vars.subst_instance_constr inst ty in
let ty = EConstr.of_constr ty in
+ let open EConstr in
print_typed_value (mkConstruct cstr, ty)
| VarRef id ->
env |> lookup_named id |> NamedDecl.set_id id |> print_named_decl
diff --git a/printing/prettyp.mli b/printing/prettyp.mli
index 6841781ccd..4add21fa7b 100644
--- a/printing/prettyp.mli
+++ b/printing/prettyp.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/printing/printer.ml b/printing/printer.ml
index 3c31dd96bf..2a198d4564 100644
--- a/printing/printer.ml
+++ b/printing/printer.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -17,7 +17,6 @@ open Nametab
open Evd
open Proof_type
open Refiner
-open Pfedit
open Constrextern
open Ppconstr
open Declarations
@@ -262,6 +261,14 @@ let pr_universe_ctx sigma c =
else
mt()
+let pr_cumulativity_info sigma cumi =
+ if !Detyping.print_universes
+ && not (Univ.UContext.is_empty (Univ.CumulativityInfo.univ_context cumi)) then
+ fnl()++pr_in_comment (fun uii -> v 0
+ (Univ.pr_cumulativity_info (Termops.pr_evd_level sigma) uii)) cumi
+ else
+ mt()
+
(**********************************************************************)
(* Global references *)
@@ -812,7 +819,7 @@ let pr_open_subgoals ?(proof=Proof_global.give_me_the_proof ()) () =
end
let pr_nth_open_subgoal n =
- let pf = get_pftreestate () in
+ let pf = Proof_global.give_me_the_proof () in
let { it=gls ; sigma=sigma } = Proof.V82.subgoals pf in
pr_subgoal n sigma gls
@@ -992,6 +999,11 @@ let pr_assumptionset env s =
let xor a b =
(a && not b) || (not a && b)
+let pr_cumulative poly cum =
+ if poly then
+ if cum then str "Cumulative " else str "NonCumulative "
+ else mt ()
+
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 3fce065613..f8685b0895 100644
--- a/printing/printer.mli
+++ b/printing/printer.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -95,8 +95,10 @@ 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_cumulativity_info : evar_map -> Univ.cumulativity_info -> std_ppcmds
(** Printing global references using names as short as possible *)
diff --git a/printing/printmod.ml b/printing/printmod.ml
index c4affd4acd..5c7dcdc10f 100644
--- a/printing/printmod.ml
+++ b/printing/printmod.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -88,8 +88,8 @@ let build_ind_type env mip =
Inductive.type_of_inductive env mip
let print_one_inductive env sigma mib ((_,i) as ind) =
- let u = if mib.mind_polymorphic then
- Univ.UContext.instance mib.mind_universes
+ let u = if Declareops.inductive_is_polymorphic mib then
+ Univ.AUContext.instance (Declareops.inductive_polymorphic_context mib)
else Univ.Instance.empty in
let mip = mib.mind_packets.(i) in
let params = Inductive.inductive_paramdecls (mib,u) in
@@ -99,8 +99,10 @@ let print_one_inductive env sigma mib ((_,i) as ind) =
let cstrtypes = Array.map (fun c -> hnf_prod_applist env c args) cstrtypes in
let envpar = push_rel_context params env in
let inst =
- if mib.mind_polymorphic then
- Printer.pr_universe_instance sigma mib.mind_universes
+ if Declareops.inductive_is_polymorphic mib then
+ let ctx = Declareops.inductive_polymorphic_context mib in
+ let ctx = Univ.UContext.make (u, Univ.AUContext.instantiate u ctx) in
+ Printer.pr_universe_instance sigma ctx
else mt ()
in
hov 0 (
@@ -108,6 +110,17 @@ let print_one_inductive env sigma mib ((_,i) as ind) =
str ": " ++ Printer.pr_lconstr_env envpar sigma arity ++ str " :=") ++
brk(0,2) ++ print_constructors envpar sigma mip.mind_consnames cstrtypes
+let instantiate_cumulativity_info cumi =
+ let open Univ in
+ let univs = ACumulativityInfo.univ_context cumi in
+ let subtyp = ACumulativityInfo.subtyp_context cumi in
+ let expose ctx =
+ let inst = AUContext.instance ctx in
+ let cst = AUContext.instantiate inst ctx in
+ UContext.make (inst, cst)
+ in
+ CumulativityInfo.make (expose univs, expose subtyp)
+
let print_mutual_inductive env mind mib =
let inds = List.init (Array.length mib.mind_packets) (fun x -> (mind, x))
in
@@ -120,11 +133,18 @@ let print_mutual_inductive env mind mib =
in
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_ctx sigma (Univ.instantiate_univ_context mib.mind_universes))
+ hov 0 (Printer.pr_polymorphic (Declareops.inductive_is_polymorphic mib) ++
+ Printer.pr_cumulative
+ (Declareops.inductive_is_polymorphic mib)
+ (Declareops.inductive_is_cumulative mib) ++
+ def keyword ++ spc () ++
+ prlist_with_sep (fun () -> fnl () ++ str" with ")
+ (print_one_inductive env sigma mib) inds ++
+ match mib.mind_universes with
+ | Monomorphic_ind _ | Polymorphic_ind _ -> str ""
+ | Cumulative_ind cumi ->
+ Printer.pr_cumulativity_info
+ sigma (instantiate_cumulativity_info cumi))
let get_fields =
let rec prodec_rec l subst c =
@@ -141,8 +161,8 @@ let get_fields =
let print_record env mind mib =
let u =
- if mib.mind_polymorphic then
- Univ.UContext.instance mib.mind_universes
+ if Declareops.inductive_is_polymorphic mib then
+ Univ.AUContext.instance (Declareops.inductive_polymorphic_context mib)
else Univ.Instance.empty
in
let mip = mib.mind_packets.(0) in
@@ -164,7 +184,10 @@ let print_record env mind mib =
in
hov 0 (
hov 0 (
- Printer.pr_polymorphic mib.mind_polymorphic ++
+ Printer.pr_polymorphic (Declareops.inductive_is_polymorphic mib) ++
+ Printer.pr_cumulative
+ (Declareops.inductive_is_polymorphic mib)
+ (Declareops.inductive_is_cumulative mib) ++
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) ++
@@ -175,7 +198,12 @@ let print_record env mind mib =
(fun (id,b,c) ->
pr_id id ++ str (if b then " : " else " := ") ++
Printer.pr_lconstr_env envpar sigma c) fields) ++ str" }" ++
- Printer.pr_universe_ctx sigma (Univ.instantiate_univ_context mib.mind_universes))
+ match mib.mind_universes with
+ | Monomorphic_ind _ | Polymorphic_ind _ -> str ""
+ | Cumulative_ind cumi ->
+ Printer.pr_cumulativity_info
+ sigma (instantiate_cumulativity_info cumi)
+ )
let pr_mutual_inductive_body env mind mib =
if mib.mind_record <> None && not !Flags.raw_print then
@@ -277,10 +305,13 @@ let print_body is_impl env mp (l,body) =
| SFBmodule _ -> keyword "Module" ++ spc () ++ name
| SFBmodtype _ -> keyword "Module Type" ++ spc () ++ name
| SFBconst cb ->
+ let ctx = Declareops.constant_polymorphic_context cb in
let u =
- if cb.const_polymorphic then Univ.UContext.instance cb.const_universes
+ if Declareops.constant_is_polymorphic cb then
+ Univ.AUContext.instance ctx
else Univ.Instance.empty
in
+ let ctx = Univ.UContext.make (u, Univ.AUContext.instantiate u ctx) in
let sigma = Evd.empty in
(match cb.const_body with
| Def _ -> def "Definition" ++ spc ()
@@ -300,7 +331,7 @@ let print_body is_impl env mp (l,body) =
Printer.pr_lconstr_env env sigma
(Vars.subst_instance_constr u (Mod_subst.force_constr l)))
| _ -> mt ()) ++ str "." ++
- Printer.pr_universe_ctx sigma (Univ.instantiate_univ_context cb.const_universes))
+ Printer.pr_universe_ctx sigma ctx)
| SFBmind mib ->
try
let env = Option.get env in
diff --git a/printing/printmod.mli b/printing/printmod.mli
index f3079d5b6b..81b5774537 100644
--- a/printing/printmod.mli
+++ b/printing/printmod.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
generated by cgit v1.2.3 (git 2.25.1) at 2026-04-30 17:47:38 +0000