aboutsummaryrefslogtreecommitdiff
path: root/printing
diff options
context:
space:
mode:
Diffstat (limited to 'printing')
-rw-r--r--printing/ppconstr.ml6
-rw-r--r--printing/ppconstr.mli4
-rw-r--r--printing/ppvernac.ml57
-rw-r--r--printing/prettyp.ml20
-rw-r--r--printing/prettyp.mli11
-rw-r--r--printing/printer.ml63
-rw-r--r--printing/printer.mli16
-rw-r--r--printing/printmod.ml13
-rw-r--r--printing/printmod.mli2
9 files changed, 64 insertions, 128 deletions
diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml
index 412a1cbb41..60268c9de6 100644
--- a/printing/ppconstr.ml
+++ b/printing/ppconstr.ml
@@ -170,13 +170,13 @@ let tag_var = tag Tag.variable
let pr_univ_annot pr x = str "@{" ++ pr x ++ str "}"
- let pr_glob_sort = function
+ let pr_glob_sort = let open Glob_term in function
| GProp -> tag_type (str "Prop")
| GSet -> tag_type (str "Set")
| GType [] -> tag_type (str "Type")
| GType u -> hov 0 (tag_type (str "Type") ++ pr_univ_annot pr_univ u)
- let pr_glob_level = function
+ let pr_glob_level = let open Glob_term in function
| GProp -> tag_type (str "Prop")
| GSet -> tag_type (str "Set")
| GType UUnknown -> tag_type (str "Type")
@@ -199,7 +199,7 @@ let tag_var = tag Tag.variable
let pr_qualid = pr_qualid
let pr_patvar = pr_id
- let pr_glob_sort_instance = function
+ let pr_glob_sort_instance = let open Glob_term in function
| GProp ->
tag_type (str "Prop")
| GSet ->
diff --git a/printing/ppconstr.mli b/printing/ppconstr.mli
index 1f1308b0df..127c4471cd 100644
--- a/printing/ppconstr.mli
+++ b/printing/ppconstr.mli
@@ -41,8 +41,8 @@ val pr_name : Name.t -> Pp.t
val pr_qualid : qualid -> Pp.t
val pr_patvar : patvar -> Pp.t
-val pr_glob_level : glob_level -> Pp.t
-val pr_glob_sort : glob_sort -> Pp.t
+val pr_glob_level : Glob_term.glob_level -> Pp.t
+val pr_glob_sort : Glob_term.glob_sort -> Pp.t
val pr_guard_annot : (constr_expr -> Pp.t) ->
local_binder_expr list ->
lident option * recursion_order_expr ->
diff --git a/printing/ppvernac.ml b/printing/ppvernac.ml
index 7df0a0c94a..7a34e80274 100644
--- a/printing/ppvernac.ml
+++ b/printing/ppvernac.ml
@@ -16,12 +16,13 @@ open Util
open CAst
open Extend
-open Vernacexpr
-open Pputils
open Libnames
+open Decl_kinds
open Constrexpr
open Constrexpr_ops
-open Decl_kinds
+open Vernacexpr
+open Declaremods
+open Pputils
open Ppconstr
@@ -144,7 +145,7 @@ open Decl_kinds
| SearchString (s,sc) -> qs s ++ pr_opt (fun sc -> str "%" ++ str sc) sc
let pr_search a gopt b pr_p =
- pr_opt (fun g -> Proof_bullet.pr_goal_selector g ++ str ":"++ spc()) gopt
+ pr_opt (fun g -> Goal_select.pr_goal_selector g ++ str ":"++ spc()) gopt
++
match a with
| SearchHead c -> keyword "SearchHead" ++ spc() ++ pr_p c ++ pr_in_out_modules b
@@ -155,13 +156,6 @@ open Decl_kinds
let pr_locality local = if local then keyword "Local" else keyword "Global"
- let pr_explanation (e,b,f) =
- let a = match e with
- | ExplByPos (n,_) -> anomaly (Pp.str "No more supported.")
- | ExplByName id -> pr_id id in
- let a = if f then str"!" ++ a else a in
- if b then str "[" ++ a ++ str "]" else a
-
let pr_option_ref_value = function
| QualidRefValue id -> pr_reference id
| StringRefValue s -> qs s
@@ -194,7 +188,7 @@ open Decl_kinds
| ModeNoHeadEvar -> str"!"
| ModeOutput -> str"-"
- let pr_hint_info pr_pat { hint_priority = pri; hint_pattern = pat } =
+ let pr_hint_info pr_pat { Typeclasses.hint_priority = pri; hint_pattern = pat } =
pr_opt (fun x -> str"|" ++ int x) pri ++
pr_opt (fun y -> (if Option.is_empty pri then str"| " else mt()) ++ pr_pat y) pat
@@ -514,7 +508,7 @@ open Decl_kinds
| PrintVisibility s ->
keyword "Print Visibility" ++ pr_opt str s
| PrintAbout (qid,l,gopt) ->
- pr_opt (fun g -> Proof_bullet.pr_goal_selector g ++ str ":"++ spc()) gopt
+ pr_opt (fun g -> Goal_select.pr_goal_selector g ++ str ":"++ spc()) gopt
++ keyword "About" ++ spc() ++ pr_smart_global qid ++ pr_univ_name_list l
| PrintImplicit qid ->
keyword "Print Implicit" ++ spc() ++ pr_smart_global qid
@@ -591,8 +585,6 @@ open Decl_kinds
)
| VernacUndoTo i ->
return (keyword "Undo" ++ spc() ++ keyword "To" ++ pr_intarg i)
- | VernacBacktrack (i,j,k) ->
- return (keyword "Backtrack" ++ spc() ++ prlist_with_sep sep int [i;j;k])
| VernacFocus i ->
return (keyword "Focus" ++ pr_opt int i)
| VernacShow s ->
@@ -653,16 +645,6 @@ open Decl_kinds
keyword "Bind Scope" ++ spc () ++ str sc ++
spc() ++ keyword "with" ++ spc () ++ prlist_with_sep spc pr_class_rawexpr cll
)
- | VernacArgumentsScope (q,scl) ->
- let pr_opt_scope = function
- | None -> str"_"
- | Some sc -> str sc
- in
- return (
- keyword "Arguments Scope"
- ++ spc() ++ pr_smart_global q
- ++ spc() ++ str"[" ++ prlist_with_sep sep pr_opt_scope scl ++ str"]"
- )
| VernacInfix (({v=s},mv),q,sn) -> (* A Verifier *)
return (
hov 0 (hov 0 (keyword "Infix "
@@ -735,6 +717,7 @@ open Decl_kinds
return (keyword "Admitted")
| VernacEndProof (Proved (opac,o)) -> return (
+ let open Proof_global in
match o with
| None -> (match opac with
| Transparent -> keyword "Defined"
@@ -786,8 +769,9 @@ open Decl_kinds
if p then
let cm =
match cum with
- | GlobalCumulativity | LocalCumulativity -> "Cumulative"
- | GlobalNonCumulativity | LocalNonCumulativity -> "NonCumulative"
+ | Some VernacCumulative -> "Cumulative"
+ | Some VernacNonCumulative -> "NonCumulative"
+ | None -> ""
in
cm ^ " " ^ kind
else kind
@@ -1016,18 +1000,6 @@ open Decl_kinds
| Some Flags.Current -> [SetOnlyParsing]
| Some v -> [SetCompatVersion v]))
)
- | VernacDeclareImplicits (q,[]) ->
- return (
- hov 2 (keyword "Implicit Arguments" ++ spc() ++ pr_smart_global q)
- )
- | VernacDeclareImplicits (q,impls) ->
- return (
- hov 1 (keyword "Implicit Arguments" ++ spc () ++
- spc() ++ pr_smart_global q ++ spc() ++
- prlist_with_sep spc (fun imps ->
- str"[" ++ prlist_with_sep sep pr_explanation imps ++ str"]")
- impls)
- )
| VernacArguments (q, args, more_implicits, nargs, mods) ->
return (
hov 2 (
@@ -1151,7 +1123,7 @@ open Decl_kinds
| None -> hov 2 (keyword "Check" ++ spc() ++ pr_lconstr c)
in
let pr_i = match io with None -> mt ()
- | Some i -> Proof_bullet.pr_goal_selector i ++ str ": " in
+ | Some i -> Goal_select.pr_goal_selector i ++ str ": " in
return (pr_i ++ pr_mayeval r c)
| VernacGlobalCheck c ->
return (hov 2 (keyword "Type" ++ pr_constrarg c))
@@ -1205,7 +1177,8 @@ open Decl_kinds
| VernacProofMode s ->
return (keyword "Proof Mode" ++ str s)
| VernacBullet b ->
- return (begin match b with
+ (* XXX: Redundant with Proof_bullet.print *)
+ return (let open Proof_bullet in begin match b with
| Dash n -> str (String.make n '-')
| Star n -> str (String.make n '*')
| Plus n -> str (String.make n '+')
@@ -1213,7 +1186,7 @@ open Decl_kinds
| VernacSubproof None ->
return (str "{")
| VernacSubproof (Some i) ->
- return (Proof_bullet.pr_goal_selector i ++ str ":" ++ spc () ++ str "{")
+ return (Goal_select.pr_goal_selector i ++ str ":" ++ spc () ++ str "{")
| VernacEndSubproof ->
return (str "}")
diff --git a/printing/prettyp.ml b/printing/prettyp.ml
index 1f17d844f7..895181bc51 100644
--- a/printing/prettyp.ml
+++ b/printing/prettyp.ml
@@ -35,8 +35,8 @@ open Context.Rel.Declaration
module NamedDecl = Context.Named.Declaration
type object_pr = {
- print_inductive : MutInd.t -> Universes.univ_name_list option -> Pp.t;
- print_constant_with_infos : Constant.t -> Universes.univ_name_list option -> Pp.t;
+ print_inductive : MutInd.t -> UnivNames.univ_name_list option -> Pp.t;
+ print_constant_with_infos : Constant.t -> UnivNames.univ_name_list option -> Pp.t;
print_section_variable : env -> Evd.evar_map -> variable -> Pp.t;
print_syntactic_def : env -> KerName.t -> Pp.t;
print_module : bool -> ModPath.t -> Pp.t;
@@ -77,7 +77,9 @@ let print_ref reduce ref udecl =
let typ = EConstr.of_constr typ in
let typ =
if reduce then
- let ctx,ccl = Reductionops.splay_prod_assum (Global.env()) Evd.empty typ
+ let env = Global.env () in
+ let sigma = Evd.from_env env in
+ let ctx,ccl = Reductionops.splay_prod_assum env sigma typ
in EConstr.it_mkProd_or_LetIn ccl ctx
else typ in
let univs = Global.universes_of_global ref in
@@ -93,7 +95,7 @@ let print_ref reduce ref udecl =
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_with_opt_names ref
+ let bl = UnivNames.universe_binders_with_opt_names ref
(Array.to_list (Univ.Instance.to_array inst)) udecl in
let sigma = Evd.from_ctx (UState.of_binders bl) in
let inst =
@@ -328,7 +330,7 @@ type 'a locatable_info = {
type locatable = Locatable : 'a locatable_info -> locatable
type logical_name =
- | Term of global_reference
+ | Term of GlobRef.t
| Dir of global_dir_reference
| Syntactic of KerName.t
| ModuleType of ModPath.t
@@ -376,7 +378,6 @@ let pr_located_qualid = function
| DirOpenModtype { obj_dir ; _ } -> "Open Module Type", obj_dir
| DirOpenSection { obj_dir ; _ } -> "Open Section", obj_dir
| DirModule { obj_dir ; _ } -> "Module", obj_dir
- | DirClosedSection dir -> "Closed Section", dir
in
str s ++ spc () ++ DirPath.print dir
| ModuleType mp ->
@@ -595,7 +596,7 @@ let print_constant with_values sep sp udecl =
in
let ctx =
UState.of_binders
- (Universes.universe_binders_with_opt_names (ConstRef sp) ulist udecl)
+ (UnivNames.universe_binders_with_opt_names (ConstRef sp) ulist udecl)
in
let env = Global.env () and sigma = Evd.from_ctx ctx in
let pr_ltype = pr_ltype_env env sigma in
@@ -718,7 +719,10 @@ let print_eval x = !object_pr.print_eval x
(**** Printing declarations and judgments *)
(**** Abstract layer *****)
-let print_typed_value x = print_typed_value_in_env (Global.env ()) Evd.empty x
+let print_typed_value x =
+ let env = Global.env () in
+ let sigma = Evd.from_env env in
+ print_typed_value_in_env env sigma x
let print_judgment env sigma {uj_val=trm;uj_type=typ} =
print_typed_value_in_env env sigma (trm, typ)
diff --git a/printing/prettyp.mli b/printing/prettyp.mli
index 213f0aeeb6..50042d6c5b 100644
--- a/printing/prettyp.mli
+++ b/printing/prettyp.mli
@@ -12,7 +12,6 @@ open Names
open Environ
open Reductionops
open Libnames
-open Globnames
open Misctypes
open Evd
@@ -35,10 +34,10 @@ val print_eval :
Constrexpr.constr_expr -> EConstr.unsafe_judgment -> Pp.t
val print_name : env -> Evd.evar_map -> reference or_by_notation ->
- Universes.univ_name_list option -> Pp.t
+ UnivNames.univ_name_list option -> Pp.t
val print_opaque_name : env -> Evd.evar_map -> reference -> Pp.t
val print_about : env -> Evd.evar_map -> reference or_by_notation ->
- Universes.univ_name_list option -> Pp.t
+ UnivNames.univ_name_list option -> Pp.t
val print_impargs : reference or_by_notation -> Pp.t
(** Pretty-printing functions for classes and coercions *)
@@ -50,7 +49,7 @@ val print_canonical_projections : env -> Evd.evar_map -> Pp.t
(** Pretty-printing functions for type classes and instances *)
val print_typeclasses : unit -> Pp.t
-val print_instances : global_reference -> Pp.t
+val print_instances : GlobRef.t -> Pp.t
val print_all_instances : unit -> Pp.t
val inspect : env -> Evd.evar_map -> int -> Pp.t
@@ -85,8 +84,8 @@ val print_located_module : reference -> Pp.t
val print_located_other : string -> reference -> Pp.t
type object_pr = {
- print_inductive : MutInd.t -> Universes.univ_name_list option -> Pp.t;
- print_constant_with_infos : Constant.t -> Universes.univ_name_list option -> Pp.t;
+ print_inductive : MutInd.t -> UnivNames.univ_name_list option -> Pp.t;
+ print_constant_with_infos : Constant.t -> UnivNames.univ_name_list option -> Pp.t;
print_section_variable : env -> Evd.evar_map -> variable -> Pp.t;
print_syntactic_def : env -> KerName.t -> Pp.t;
print_module : bool -> ModPath.t -> Pp.t;
diff --git a/printing/printer.ml b/printing/printer.ml
index 199aa79c63..72030dc9f6 100644
--- a/printing/printer.ml
+++ b/printing/printer.ml
@@ -93,13 +93,13 @@ let _ = Hook.set Refine.pr_constr pr_constr_env
let pr_lconstr_goal_style_env env sigma c = pr_leconstr_core true env sigma (EConstr.of_constr c)
let pr_constr_goal_style_env env sigma c = pr_econstr_core true env sigma (EConstr.of_constr c)
-let pr_open_lconstr_env env sigma (_,c) = pr_lconstr_env env sigma c
-let pr_open_constr_env env sigma (_,c) = pr_constr_env env sigma c
-
let pr_econstr_n_env env sigma c = pr_econstr_n_core false env sigma c
let pr_leconstr_env env sigma c = pr_leconstr_core false env sigma c
let pr_econstr_env env sigma c = pr_econstr_core false env sigma c
+let pr_open_lconstr_env env sigma (_,c) = pr_leconstr_env env sigma c
+let pr_open_constr_env env sigma (_,c) = pr_econstr_env env sigma c
+
(* NB do not remove the eta-redexes! Global.env() has side-effects... *)
let pr_lconstr t =
let (sigma, env) = Pfedit.get_current_context () in
@@ -108,12 +108,12 @@ let pr_constr t =
let (sigma, env) = Pfedit.get_current_context () in
pr_constr_env env sigma t
-let pr_open_lconstr (_,c) = pr_lconstr c
-let pr_open_constr (_,c) = pr_constr c
-
let pr_leconstr c = pr_lconstr (EConstr.Unsafe.to_constr c)
let pr_econstr c = pr_constr (EConstr.Unsafe.to_constr c)
+let pr_open_lconstr (_,c) = pr_leconstr c
+let pr_open_constr (_,c) = pr_econstr c
+
let pr_constr_under_binders_env_gen pr env sigma (ids,c) =
(* Warning: clashes can occur with variables of same name in env but *)
(* we also need to preserve the actual names of the patterns *)
@@ -293,14 +293,14 @@ let pr_global = pr_global_env Id.Set.empty
let pr_puniverses f env (c,u) =
f env c ++
(if !Constrextern.print_universes then
- str"(*" ++ Univ.Instance.pr Universes.pr_with_global_universes u ++ str"*)"
+ str"(*" ++ Univ.Instance.pr UnivNames.pr_with_global_universes u ++ str"*)"
else mt ())
let pr_constant env cst = pr_global_env (Termops.vars_of_env env) (ConstRef cst)
let pr_existential_key = Termops.pr_existential_key
let pr_existential env sigma ev = pr_lconstr_env env sigma (mkEvar ev)
-let pr_inductive env ind = pr_lconstr_env env Evd.empty (mkInd ind)
-let pr_constructor env cstr = pr_lconstr_env env Evd.empty (mkConstruct cstr)
+let pr_inductive env ind = pr_lconstr_env env (Evd.from_env env) (mkInd ind)
+let pr_constructor env cstr = pr_lconstr_env env (Evd.from_env env) (mkConstruct cstr)
let pr_pconstant = pr_puniverses pr_constant
let pr_pinductive = pr_puniverses pr_inductive
@@ -494,7 +494,7 @@ let pr_transparent_state (ids, csts) =
str"CONSTANTS: " ++ pr_cpred csts ++ fnl ())
(* display complete goal *)
-let default_pr_goal gs =
+let pr_goal gs =
let g = sig_it gs in
let sigma = project gs in
let env = Goal.V82.env sigma g in
@@ -541,12 +541,12 @@ let pr_evgl_sign sigma evi =
if List.is_empty ids then mt () else
(str " (" ++ prlist_with_sep pr_comma pr_id ids ++ str " cannot be used)")
in
- let pc = pr_lconstr_env env sigma evi.evar_concl in
+ let pc = pr_leconstr_env env sigma evi.evar_concl in
let candidates =
match evi.evar_body, evi.evar_candidates with
| Evar_empty, Some l ->
spc () ++ str "= {" ++
- prlist_with_sep (fun () -> str "|") (pr_lconstr_env env sigma) l ++ str "}"
+ prlist_with_sep (fun () -> str "|") (pr_leconstr_env env sigma) l ++ str "}"
| _ ->
mt ()
in
@@ -591,11 +591,11 @@ let pr_ne_evar_set hd tl sigma l =
mt ()
let pr_selected_subgoal name sigma g =
- let pg = default_pr_goal { sigma=sigma ; it=g; } in
+ let pg = pr_goal { sigma=sigma ; it=g; } in
let header = pr_goal_header name sigma g in
v 0 (header ++ str " is:" ++ cut () ++ pg)
-let default_pr_subgoal n sigma =
+let pr_subgoal n sigma =
let rec prrec p = function
| [] -> user_err Pp.(str "No such goal.")
| g::rest ->
@@ -622,8 +622,8 @@ let print_evar_constraints gl sigma =
end
in
let pr_evconstr (pbty,env,t1,t2) =
- let t1 = Evarutil.nf_evar sigma (EConstr.of_constr t1)
- and t2 = Evarutil.nf_evar sigma (EConstr.of_constr t2) in
+ let t1 = Evarutil.nf_evar sigma t1
+ and t2 = Evarutil.nf_evar sigma t2 in
let env =
(** We currently allow evar instances to refer to anonymous de Bruijn
indices, so we protect the error printing code in this case by giving
@@ -695,7 +695,7 @@ let print_dependent_evars gl sigma seeds =
(* spiwack: [seeds] is for printing dependent evars in emacs mode. *)
(* spiwack: [pr_first] is true when the first goal must be singled out
and printed in its entirety. *)
-let default_pr_subgoals ?(pr_first=true)
+let pr_subgoals ?(pr_first=true)
close_cmd sigma ~seeds ~shelf ~stack ~unfocused ~goals =
(** Printing functions for the extra informations. *)
let rec print_stack a = function
@@ -739,7 +739,7 @@ let default_pr_subgoals ?(pr_first=true)
in
let print_multiple_goals g l =
if pr_first then
- default_pr_goal { it = g ; sigma = sigma; }
+ pr_goal { it = g ; sigma = sigma; }
++ (if l=[] then mt () else cut ())
++ pr_rec 2 l
else
@@ -780,33 +780,6 @@ let default_pr_subgoals ?(pr_first=true)
++ print_dependent_evars (Some g1) sigma seeds
)
-(**********************************************************************)
-(* Abstraction layer *)
-
-
-type printer_pr = {
- pr_subgoals : ?pr_first:bool -> Pp.t option -> evar_map -> seeds:goal list -> shelf:goal list -> stack:int list -> unfocused:goal list -> goals:goal list -> Pp.t;
- pr_subgoal : int -> evar_map -> goal list -> Pp.t;
- pr_goal : goal sigma -> Pp.t;
-}
-
-let default_printer_pr = {
- pr_subgoals = default_pr_subgoals;
- pr_subgoal = default_pr_subgoal;
- pr_goal = default_pr_goal;
-}
-
-let printer_pr = ref default_printer_pr
-
-let set_printer_pr = (:=) printer_pr
-
-let pr_subgoals ?pr_first x = !printer_pr.pr_subgoals ?pr_first x
-let pr_subgoal x = !printer_pr.pr_subgoal x
-let pr_goal x = !printer_pr.pr_goal x
-
-(* End abstraction layer *)
-(**********************************************************************)
-
let pr_open_subgoals ~proof =
(* spiwack: it shouldn't be the job of the printer to look up stuff
in the [evar_map], I did stuff that way because it was more
diff --git a/printing/printer.mli b/printing/printer.mli
index 41843680bc..ac0e129792 100644
--- a/printing/printer.mli
+++ b/printing/printer.mli
@@ -9,7 +9,6 @@
(************************************************************************)
open Names
-open Globnames
open Constr
open Environ
open Pattern
@@ -130,8 +129,8 @@ val pr_cumulativity_info : evar_map -> Univ.CumulativityInfo.t -> Pp.t
(** Printing global references using names as short as possible *)
-val pr_global_env : Id.Set.t -> global_reference -> Pp.t
-val pr_global : global_reference -> Pp.t
+val pr_global_env : Id.Set.t -> GlobRef.t -> Pp.t
+val pr_global : GlobRef.t -> Pp.t
val pr_constant : env -> Constant.t -> Pp.t
val pr_existential_key : evar_map -> Evar.t -> Pp.t
@@ -223,14 +222,3 @@ val pr_assumptionset : env -> evar_map -> types ContextObjectMap.t -> Pp.t
val pr_goal_by_id : proof:Proof.t -> Id.t -> Pp.t
-type printer_pr = {
- pr_subgoals : ?pr_first:bool -> Pp.t option -> evar_map -> seeds:goal list -> shelf:goal list -> stack:int list -> unfocused:goal list -> goals:goal list -> Pp.t;
-
- pr_subgoal : int -> evar_map -> goal list -> Pp.t;
- pr_goal : goal sigma -> Pp.t;
-}
-
-val set_printer_pr : printer_pr -> unit
-
-val default_printer_pr : printer_pr
-
diff --git a/printing/printmod.ml b/printing/printmod.ml
index e076c10f3b..be8bc13572 100644
--- a/printing/printmod.ml
+++ b/printing/printmod.ml
@@ -140,7 +140,7 @@ let print_mutual_inductive env mind mib udecl =
(AUContext.instance (Declareops.inductive_polymorphic_context mib)))
else []
in
- let bl = Universes.universe_binders_with_opt_names (IndRef (mind, 0)) univs udecl in
+ let bl = UnivNames.universe_binders_with_opt_names (IndRef (mind, 0)) univs udecl in
let sigma = Evd.from_ctx (UState.of_binders bl) in
hov 0 (Printer.pr_polymorphic (Declareops.inductive_is_polymorphic mib) ++
Printer.pr_cumulative
@@ -183,7 +183,7 @@ let print_record env mind mib udecl =
let cstrtype = hnf_prod_applist_assum env nparamdecls cstrtypes.(0) args in
let fields = get_fields cstrtype in
let envpar = push_rel_context params env in
- let bl = Universes.universe_binders_with_opt_names (IndRef (mind,0))
+ let bl = UnivNames.universe_binders_with_opt_names (IndRef (mind,0))
(Array.to_list (Univ.Instance.to_array u)) udecl in
let sigma = Evd.from_ctx (UState.of_binders bl) in
let keyword =
@@ -323,7 +323,6 @@ let print_body is_impl env mp (l,body) =
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 ()
| OpaqueDef _ when is_impl -> def "Theorem" ++ spc ()
@@ -332,17 +331,17 @@ let print_body is_impl env mp (l,body) =
| None -> mt ()
| Some env ->
str " :" ++ spc () ++
- hov 0 (Printer.pr_ltype_env env sigma
+ hov 0 (Printer.pr_ltype_env env (Evd.from_env env)
(Vars.subst_instance_constr u
cb.const_type)) ++
(match cb.const_body with
| Def l when is_impl ->
spc () ++
hov 2 (str ":= " ++
- Printer.pr_lconstr_env env sigma
+ Printer.pr_lconstr_env env (Evd.from_env env)
(Vars.subst_instance_constr u (Mod_subst.force_constr l)))
| _ -> mt ()) ++ str "." ++
- Printer.pr_universe_ctx sigma ctx)
+ Printer.pr_universe_ctx (Evd.from_env env) ctx)
| SFBmind mib ->
try
let env = Option.get env in
@@ -387,7 +386,7 @@ let rec print_typ_expr env mp locals mty =
let s = String.concat "." (List.map Id.to_string idl) in
(* XXX: What should env and sigma be here? *)
let env = Global.env () in
- let sigma = Evd.empty in
+ let sigma = Evd.from_env env in
hov 2 (print_typ_expr env' mp locals me ++ spc() ++ str "with" ++ spc()
++ def "Definition"++ spc() ++ str s ++ spc() ++ str ":="++ spc()
++ Printer.pr_lconstr_env env sigma c)
diff --git a/printing/printmod.mli b/printing/printmod.mli
index b0b0b0a35e..48ba866cc0 100644
--- a/printing/printmod.mli
+++ b/printing/printmod.mli
@@ -15,6 +15,6 @@ val printable_body : DirPath.t -> bool
val pr_mutual_inductive_body : Environ.env ->
MutInd.t -> Declarations.mutual_inductive_body ->
- Universes.univ_name_list option -> Pp.t
+ UnivNames.univ_name_list option -> Pp.t
val print_module : bool -> ModPath.t -> Pp.t
val print_modtype : ModPath.t -> Pp.t