aboutsummaryrefslogtreecommitdiff
path: root/plugins/ltac
diff options
context:
space:
mode:
authorEmilio Jesus Gallego Arias2017-11-19 19:08:35 +0100
committerEmilio Jesus Gallego Arias2017-11-21 18:04:32 +0100
commit0ddf7d9c35eb2dd5f368e7a5735970ef1fd41fc6 (patch)
tree0bc32293ac19ddd63cf764ccbd224b086c7836bc /plugins/ltac
parentb75beb248873db7d9ab8e4a078022b2ed0edcd36 (diff)
[printing] Deprecate all printing functions accessing the global proof.
We'd like to handle proofs functionally we thus recommend not to use printing functions without an explicit context. We also adapt most of the code, making more explicit where the printing environment is coming from. An open task is to refactor some code so we gradually make the `Pfedit.get_current_context ()` disappear.
Diffstat (limited to 'plugins/ltac')
-rw-r--r--plugins/ltac/extraargs.ml44
-rw-r--r--plugins/ltac/g_auto.ml48
-rw-r--r--plugins/ltac/g_rewrite.ml412
-rw-r--r--plugins/ltac/pptactic.ml29
-rw-r--r--plugins/ltac/tacsubst.ml7
-rw-r--r--plugins/ltac/tactic_debug.ml7
6 files changed, 46 insertions, 21 deletions
diff --git a/plugins/ltac/extraargs.ml4 b/plugins/ltac/extraargs.ml4
index 89feea8dcf..bb01aca558 100644
--- a/plugins/ltac/extraargs.ml4
+++ b/plugins/ltac/extraargs.ml4
@@ -133,7 +133,9 @@ let pr_occurrences = pr_occurrences () () ()
let pr_gen prc _prlc _prtac c = prc c
-let pr_globc _prc _prlc _prtac (_,glob) = Printer.pr_glob_constr glob
+let pr_globc _prc _prlc _prtac (_,glob) =
+ let _, env = Pfedit.get_current_context () in
+ Printer.pr_glob_constr_env env glob
let interp_glob ist gl (t,_) = Tacmach.project gl , (ist,t)
diff --git a/plugins/ltac/g_auto.ml4 b/plugins/ltac/g_auto.ml4
index 5baa0d5c1d..84e79d8abd 100644
--- a/plugins/ltac/g_auto.ml4
+++ b/plugins/ltac/g_auto.ml4
@@ -51,8 +51,12 @@ let eval_uconstrs ist cs =
List.map (fun c -> map (Tacinterp.type_uconstr ~flags ist c)) cs
let pr_auto_using_raw _ _ _ = Pptactic.pr_auto_using Ppconstr.pr_constr_expr
-let pr_auto_using_glob _ _ _ = Pptactic.pr_auto_using (fun (c,_) -> Printer.pr_glob_constr c)
-let pr_auto_using _ _ _ = Pptactic.pr_auto_using Printer.pr_closed_glob
+let pr_auto_using_glob _ _ _ = Pptactic.pr_auto_using (fun (c,_) ->
+ let _, env = Pfedit.get_current_context () in
+ Printer.pr_glob_constr_env env c)
+let pr_auto_using _ _ _ = Pptactic.pr_auto_using
+ (let sigma, env = Pfedit.get_current_context () in
+ Printer.pr_closed_glob_env env sigma)
ARGUMENT EXTEND auto_using
TYPED AS uconstr_list
diff --git a/plugins/ltac/g_rewrite.ml4 b/plugins/ltac/g_rewrite.ml4
index b148d962ed..91abe10190 100644
--- a/plugins/ltac/g_rewrite.ml4
+++ b/plugins/ltac/g_rewrite.ml4
@@ -31,8 +31,12 @@ type constr_expr_with_bindings = constr_expr with_bindings
type glob_constr_with_bindings = Tacexpr.glob_constr_and_expr with_bindings
type glob_constr_with_bindings_sign = interp_sign * Tacexpr.glob_constr_and_expr with_bindings
-let pr_glob_constr_with_bindings_sign _ _ _ (ge : glob_constr_with_bindings_sign) = Printer.pr_glob_constr (fst (fst (snd ge)))
-let pr_glob_constr_with_bindings _ _ _ (ge : glob_constr_with_bindings) = Printer.pr_glob_constr (fst (fst ge))
+let pr_glob_constr_with_bindings_sign _ _ _ (ge : glob_constr_with_bindings_sign) =
+ let _, env = Pfedit.get_current_context () in
+ Printer.pr_glob_constr_env env (fst (fst (snd ge)))
+let pr_glob_constr_with_bindings _ _ _ (ge : glob_constr_with_bindings) =
+ let _, env = Pfedit.get_current_context () in
+ Printer.pr_glob_constr_env env (fst (fst ge))
let pr_constr_expr_with_bindings prc _ _ (ge : constr_expr_with_bindings) = prc (fst ge)
let interp_glob_constr_with_bindings ist gl c = Tacmach.project gl , (ist, c)
let glob_glob_constr_with_bindings ist l = Tacintern.intern_constr_with_bindings ist l
@@ -272,5 +276,7 @@ TACTIC EXTEND setoid_transitivity
END
VERNAC COMMAND EXTEND PrintRewriteHintDb CLASSIFIED AS QUERY
- [ "Print" "Rewrite" "HintDb" preident(s) ] -> [ Feedback.msg_notice (Autorewrite.print_rewrite_hintdb s) ]
+ [ "Print" "Rewrite" "HintDb" preident(s) ] ->
+ [ let sigma, env = Pfedit.get_current_context () in
+ Feedback.msg_notice (Autorewrite.print_rewrite_hintdb env sigma s) ]
END
diff --git a/plugins/ltac/pptactic.ml b/plugins/ltac/pptactic.ml
index 3f885f8baa..d707512457 100644
--- a/plugins/ltac/pptactic.ml
+++ b/plugins/ltac/pptactic.ml
@@ -1243,6 +1243,15 @@ let make_constr_printer f c =
let lift f a = Genprint.PrinterBasic (fun () -> f a)
+
+let pr_glob_constr_pptac c =
+ let _, env = Pfedit.get_current_context () in
+ pr_glob_constr_env env c
+
+let pr_lglob_constr_pptac c =
+ let _, env = Pfedit.get_current_context () in
+ pr_lglob_constr_env env c
+
let () =
let pr_bool b = if b then str "true" else str "false" in
let pr_unit _ = str "()" in
@@ -1257,7 +1266,7 @@ let () =
Genprint.register_print0
wit_intro_pattern
(Miscprint.pr_intro_pattern pr_constr_expr)
- (Miscprint.pr_intro_pattern (fun (c,_) -> pr_glob_constr c))
+ (Miscprint.pr_intro_pattern (fun (c, _) -> pr_glob_constr_pptac c))
pr_intro_pattern_env;
Genprint.register_print0
wit_clause_dft_concl
@@ -1267,46 +1276,46 @@ let () =
;
Genprint.register_print0
wit_constr
- Ppconstr.pr_lconstr_expr
- (fun (c, _) -> Printer.pr_lglob_constr c)
+ Ppconstr.pr_constr_expr
+ (fun (c, _) -> pr_glob_constr_pptac c)
(make_constr_printer Printer.pr_econstr_n_env)
;
Genprint.register_print0
wit_uconstr
Ppconstr.pr_constr_expr
- (fun (c,_) -> Printer.pr_glob_constr c)
+ (fun (c, _) -> pr_glob_constr_pptac c)
(make_constr_printer Printer.pr_closed_glob_n_env)
;
Genprint.register_print0
wit_open_constr
Ppconstr.pr_constr_expr
- (fun (c, _) -> Printer.pr_glob_constr c)
+ (fun (c, _) -> pr_glob_constr_pptac c)
(make_constr_printer Printer.pr_econstr_n_env)
;
Genprint.register_print0 wit_red_expr
(pr_red_expr (pr_constr_expr, pr_lconstr_expr, pr_or_by_notation pr_reference, pr_constr_pattern_expr))
- (pr_red_expr (pr_and_constr_expr pr_glob_constr, pr_and_constr_expr pr_lglob_constr, pr_or_var (pr_and_short_name pr_evaluable_reference), pr_pat_and_constr_expr pr_glob_constr))
+ (pr_red_expr (pr_and_constr_expr pr_glob_constr_pptac, pr_and_constr_expr pr_lglob_constr_pptac, pr_or_var (pr_and_short_name pr_evaluable_reference), pr_pat_and_constr_expr pr_glob_constr_pptac))
pr_red_expr_env
;
Genprint.register_print0 wit_quant_hyp pr_quantified_hypothesis pr_quantified_hypothesis (lift pr_quantified_hypothesis);
Genprint.register_print0 wit_bindings
(Miscprint.pr_bindings_no_with pr_constr_expr pr_lconstr_expr)
- (Miscprint.pr_bindings_no_with (pr_and_constr_expr pr_glob_constr) (pr_and_constr_expr pr_lglob_constr))
+ (Miscprint.pr_bindings_no_with (pr_and_constr_expr pr_glob_constr_pptac) (pr_and_constr_expr pr_lglob_constr_pptac))
pr_bindings_env
;
Genprint.register_print0 wit_constr_with_bindings
(pr_with_bindings pr_constr_expr pr_lconstr_expr)
- (pr_with_bindings (pr_and_constr_expr pr_glob_constr) (pr_and_constr_expr pr_lglob_constr))
+ (pr_with_bindings (pr_and_constr_expr pr_glob_constr_pptac) (pr_and_constr_expr pr_lglob_constr_pptac))
pr_with_bindings_env
;
Genprint.register_print0 wit_open_constr_with_bindings
(pr_with_bindings pr_constr_expr pr_lconstr_expr)
- (pr_with_bindings (pr_and_constr_expr pr_glob_constr) (pr_and_constr_expr pr_lglob_constr))
+ (pr_with_bindings (pr_and_constr_expr pr_glob_constr_pptac) (pr_and_constr_expr pr_lglob_constr_pptac))
pr_with_bindings_env
;
Genprint.register_print0 Tacarg.wit_destruction_arg
(pr_destruction_arg pr_constr_expr pr_lconstr_expr)
- (pr_destruction_arg (pr_and_constr_expr pr_glob_constr) (pr_and_constr_expr pr_lglob_constr))
+ (pr_destruction_arg (pr_and_constr_expr pr_glob_constr_pptac) (pr_and_constr_expr pr_lglob_constr_pptac))
pr_destruction_arg_env
;
Genprint.register_print0 Stdarg.wit_int int int (lift int);
diff --git a/plugins/ltac/tacsubst.ml b/plugins/ltac/tacsubst.ml
index 180fb2db40..918d1faebe 100644
--- a/plugins/ltac/tacsubst.ml
+++ b/plugins/ltac/tacsubst.ml
@@ -91,9 +91,10 @@ let subst_global_reference subst =
let subst_global ref =
let ref',t' = subst_global subst ref in
if not (is_global ref' t') then
- Feedback.msg_warning (strbrk "The reference " ++ pr_global ref ++ str " is not " ++
- str " expanded to \"" ++ pr_lconstr t' ++ str "\", but to " ++
- pr_global ref') ;
+ (let sigma, env = Pfedit.get_current_context () in
+ Feedback.msg_warning (strbrk "The reference " ++ pr_global ref ++ str " is not " ++
+ str " expanded to \"" ++ pr_lconstr_env env sigma t' ++ str "\", but to " ++
+ pr_global ref'));
ref'
in
subst_or_var (subst_located subst_global)
diff --git a/plugins/ltac/tactic_debug.ml b/plugins/ltac/tactic_debug.ml
index a669692fc9..2dd7c9a747 100644
--- a/plugins/ltac/tactic_debug.ml
+++ b/plugins/ltac/tactic_debug.ml
@@ -20,7 +20,9 @@ let prmatchpatt env sigma hyp =
Pptactic.pr_match_pattern (Printer.pr_constr_pattern_env env sigma) hyp
let prmatchrl rl =
Pptactic.pr_match_rule false (Pptactic.pr_glob_tactic (Global.env()))
- (fun (_,p) -> Printer.pr_constr_pattern p) rl
+ (fun (_,p) ->
+ let sigma, env = Pfedit.get_current_context () in
+ Printer.pr_constr_pattern_env env sigma p) rl
(* This module intends to be a beginning of debugger for tactic expressions.
Currently, it is quite simple and we can hope to have, in the future, a more
@@ -369,7 +371,8 @@ let explain_ltac_call_trace last trace loc =
strbrk " (with " ++
prlist_with_sep pr_comma
(fun (id,c) ->
- Id.print id ++ str ":=" ++ Printer.pr_lconstr_under_binders c)
+ let sigma, env = Pfedit.get_current_context () in
+ Id.print id ++ str ":=" ++ Printer.pr_lconstr_under_binders_env env sigma c)
(List.rev (Id.Map.bindings vars)) ++ str ")"
else mt())
in