diff options
Diffstat (limited to 'printing/prettyp.ml')
| -rw-r--r-- | printing/prettyp.ml | 39 |
1 files changed, 16 insertions, 23 deletions
diff --git a/printing/prettyp.ml b/printing/prettyp.ml index 827c0e4583..09859157c3 100644 --- a/printing/prettyp.ml +++ b/printing/prettyp.ml @@ -33,17 +33,17 @@ open Context.Rel.Declaration module NamedDecl = Context.Named.Declaration type object_pr = { - print_inductive : mutual_inductive -> std_ppcmds; - print_constant_with_infos : constant -> std_ppcmds; - print_section_variable : variable -> std_ppcmds; - print_syntactic_def : kernel_name -> std_ppcmds; - print_module : bool -> Names.module_path -> std_ppcmds; - print_modtype : module_path -> std_ppcmds; - print_named_decl : Context.Named.Declaration.t -> std_ppcmds; - print_library_entry : bool -> (object_name * Lib.node) -> std_ppcmds option; - print_context : bool -> int option -> Lib.library_segment -> std_ppcmds; - print_typed_value_in_env : Environ.env -> Evd.evar_map -> EConstr.constr * EConstr.types -> Pp.std_ppcmds; - print_eval : Reductionops.reduction_function -> env -> Evd.evar_map -> Constrexpr.constr_expr -> EConstr.unsafe_judgment -> std_ppcmds; + print_inductive : mutual_inductive -> Pp.t; + print_constant_with_infos : constant -> Pp.t; + print_section_variable : variable -> Pp.t; + print_syntactic_def : kernel_name -> Pp.t; + print_module : bool -> Names.module_path -> Pp.t; + print_modtype : module_path -> Pp.t; + print_named_decl : Context.Named.Declaration.t -> Pp.t; + print_library_entry : bool -> (object_name * Lib.node) -> Pp.t option; + print_context : bool -> int option -> Lib.library_segment -> Pp.t; + print_typed_value_in_env : Environ.env -> Evd.evar_map -> EConstr.constr * EConstr.types -> Pp.t; + print_eval : Reductionops.reduction_function -> env -> Evd.evar_map -> Constrexpr.constr_expr -> EConstr.unsafe_judgment -> Pp.t; } let gallina_print_module = print_module @@ -501,9 +501,6 @@ let print_body env evd = function let print_typed_body env evd (val_0,typ) = (print_body env evd val_0 ++ fnl () ++ str " : " ++ pr_ltype_env env evd typ) -let ungeneralized_type_of_constant_type t = - Typeops.type_of_constant_type (Global.env ()) t - let print_instance sigma cb = if Declareops.constant_is_polymorphic cb then let univs = Declareops.constant_polymorphic_context cb in @@ -515,17 +512,13 @@ let print_instance sigma cb = 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 = match cb.const_type with - | RegularArity t as x -> - begin match cb.const_universes with - | Monomorphic_const _ -> x + let typ = + match cb.const_universes with + | Monomorphic_const _ -> cb.const_type | Polymorphic_const univs -> let inst = Univ.AUContext.instance univs in - RegularArity (Vars.subst_instance_constr inst t) - end - | TemplateArity _ as x -> x + Vars.subst_instance_constr inst cb.const_type in - let typ = ungeneralized_type_of_constant_type typ in let univs = let otab = Global.opaque_tables () in match cb.const_body with @@ -698,7 +691,7 @@ let print_full_pure_context () = | "CONSTANT" -> let con = Global.constant_of_delta_kn kn in let cb = Global.lookup_constant con in - let typ = ungeneralized_type_of_constant_type cb.const_type in + let typ = cb.const_type in hov 0 ( match cb.const_body with | Undef _ -> |