aboutsummaryrefslogtreecommitdiff
path: root/plugins/funind/indfun_common.ml
diff options
context:
space:
mode:
Diffstat (limited to 'plugins/funind/indfun_common.ml')
-rw-r--r--plugins/funind/indfun_common.ml23
1 files changed, 14 insertions, 9 deletions
diff --git a/plugins/funind/indfun_common.ml b/plugins/funind/indfun_common.ml
index e9102e9c82..d6fd2f2a0f 100644
--- a/plugins/funind/indfun_common.ml
+++ b/plugins/funind/indfun_common.ml
@@ -183,12 +183,13 @@ let with_full_print f a =
and old_contextual_implicit_args = Impargs.is_contextual_implicit_args () in
let old_rawprint = !Flags.raw_print in
let old_printuniverses = !Constrextern.print_universes in
+ let old_printallowmatchdefaultclause = !Detyping.print_allow_match_default_clause in
Constrextern.print_universes := true;
+ Detyping.print_allow_match_default_clause := false;
Flags.raw_print := true;
Impargs.make_implicit_args false;
Impargs.make_strict_implicit_args false;
Impargs.make_contextual_implicit_args false;
- Impargs.make_contextual_implicit_args false;
Dumpglob.pause ();
try
let res = f a in
@@ -197,6 +198,7 @@ let with_full_print f a =
Impargs.make_contextual_implicit_args old_contextual_implicit_args;
Flags.raw_print := old_rawprint;
Constrextern.print_universes := old_printuniverses;
+ Detyping.print_allow_match_default_clause := old_printallowmatchdefaultclause;
Dumpglob.continue ();
res
with
@@ -206,6 +208,7 @@ let with_full_print f a =
Impargs.make_contextual_implicit_args old_contextual_implicit_args;
Flags.raw_print := old_rawprint;
Constrextern.print_universes := old_printuniverses;
+ Detyping.print_allow_match_default_clause := old_printallowmatchdefaultclause;
Dumpglob.continue ();
raise reraise
@@ -333,15 +336,17 @@ let discharge_Function (_,finfos) =
}
let pr_ocst c =
- Option.fold_right (fun v acc -> Printer.pr_lconstr (mkConst v)) c (mt ())
+ let sigma, env = Pfedit.get_current_context () in
+ Option.fold_right (fun v acc -> Printer.pr_lconstr_env env sigma (mkConst v)) c (mt ())
let pr_info f_info =
+ let sigma, env = Pfedit.get_current_context () in
str "function_constant := " ++
- Printer.pr_lconstr (mkConst f_info.function_constant)++ fnl () ++
+ Printer.pr_lconstr_env env sigma (mkConst f_info.function_constant)++ fnl () ++
str "function_constant_type := " ++
(try
- Printer.pr_lconstr
- (fst (Global.type_of_global_in_context (Global.env ()) (ConstRef f_info.function_constant)))
+ Printer.pr_lconstr_env env sigma
+ (fst (Global.type_of_global_in_context env (ConstRef f_info.function_constant)))
with e when CErrors.noncritical e -> mt ()) ++ fnl () ++
str "equation_lemma := " ++ pr_ocst f_info.equation_lemma ++ fnl () ++
str "completeness_lemma :=" ++ pr_ocst f_info.completeness_lemma ++ fnl () ++
@@ -349,7 +354,7 @@ let pr_info f_info =
str "rect_lemma := " ++ pr_ocst f_info.rect_lemma ++ fnl () ++
str "rec_lemma := " ++ pr_ocst f_info.rec_lemma ++ fnl () ++
str "prop_lemma := " ++ pr_ocst f_info.prop_lemma ++ fnl () ++
- str "graph_ind := " ++ Printer.pr_lconstr (mkInd f_info.graph_ind) ++ fnl ()
+ str "graph_ind := " ++ Printer.pr_lconstr_env env sigma (mkInd f_info.graph_ind) ++ fnl ()
let pr_table tb =
let l = Cmap_env.fold (fun k v acc -> v::acc) tb [] in
@@ -550,11 +555,11 @@ type tcc_lemma_value =
| Value of constr
| Not_needed
-(* We only "purify" on exceptions *)
+(* We only "purify" on exceptions. XXX: What is this doing here? *)
let funind_purify f x =
- let st = Vernacentries.freeze_interp_state `No in
+ let st = Vernacstate.freeze_interp_state `No in
try f x
with e ->
let e = CErrors.push e in
- Vernacentries.unfreeze_interp_state st;
+ Vernacstate.unfreeze_interp_state st;
Exninfo.iraise e