Honor parsing and printing levels for tactic entry in TACTIC EXTEND and

VERNAC EXTEND.

6 files changed, 87 insertions, 2 deletions

diff --git a/grammar/q_util.ml4 b/grammar/q_util.ml4
index c529260e9..8a876de9b 100644
--- a/grammar/q_util.ml4
+++ b/grammar/q_util.ml4
@@ -79,7 +79,8 @@ let rec type_of_user_symbol = function
   ListArgType (type_of_user_symbol s)
 | Uopt s ->
   OptArgType (type_of_user_symbol s)
-| Uentry e | Uentryl (e, _) -> ExtraArgType e
+| Uentry e -> ExtraArgType e
+| Uentryl (e, n) -> ExtraArgType (e ^ string_of_int n)
 
 let coincide s pat off =
   let len = String.length pat in
diff --git a/interp/constrarg.ml b/interp/constrarg.ml
index 46be0b8a1..9103a5caf 100644
--- a/interp/constrarg.ml
+++ b/interp/constrarg.ml
@@ -28,6 +28,24 @@ let wit_intro_pattern : (Constrexpr.constr_expr intro_pattern_expr located, glob
 let wit_tactic : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type =
   Genarg.make0 "tactic"
 
+let wit_tactic0 : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type =
+  Genarg.make0 "tactic0"
+
+let wit_tactic1 : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type =
+  Genarg.make0 "tactic1"
+
+let wit_tactic2 : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type =
+  Genarg.make0 "tactic2"
+
+let wit_tactic3 : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type =
+  Genarg.make0 "tactic3"
+
+let wit_tactic4 : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type =
+  Genarg.make0 "tactic4"
+
+let wit_tactic5 : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type =
+  Genarg.make0 "tactic5"
+
 let wit_ltac = Genarg.make0 ~dyn:(val_tag (topwit Stdarg.wit_unit)) "ltac"
 
 let wit_ident =
diff --git a/interp/constrarg.mli b/interp/constrarg.mli
index d38b1183c..b4029758a 100644
--- a/interp/constrarg.mli
+++ b/interp/constrarg.mli
@@ -71,6 +71,18 @@ val wit_red_expr :
 
 val wit_tactic : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type
 
+val wit_tactic0 : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type
+
+val wit_tactic1 : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type
+
+val wit_tactic2 : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type
+
+val wit_tactic3 : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type
+
+val wit_tactic4 : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type
+
+val wit_tactic5 : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type
+
 (** [wit_ltac] is subtly different from [wit_tactic]: they only change for their
     toplevel interpretation. The one of [wit_ltac] forces the tactic and
     discards the result. *)
diff --git a/ltac/tacintern.ml b/ltac/tacintern.ml
index 4917c3bb5..17f428bdc 100644
--- a/ltac/tacintern.ml
+++ b/ltac/tacintern.ml
@@ -799,6 +799,12 @@ let () =
   Genintern.register_intern0 wit_ident intern_ident';
   Genintern.register_intern0 wit_var (lift intern_hyp);
   Genintern.register_intern0 wit_tactic (lift intern_tactic_or_tacarg);
+  Genintern.register_intern0 wit_tactic0 (lift intern_tactic_or_tacarg);
+  Genintern.register_intern0 wit_tactic1 (lift intern_tactic_or_tacarg);
+  Genintern.register_intern0 wit_tactic2 (lift intern_tactic_or_tacarg);
+  Genintern.register_intern0 wit_tactic3 (lift intern_tactic_or_tacarg);
+  Genintern.register_intern0 wit_tactic4 (lift intern_tactic_or_tacarg);
+  Genintern.register_intern0 wit_tactic5 (lift intern_tactic_or_tacarg);
   Genintern.register_intern0 wit_ltac (lift intern_tactic_or_tacarg);
   Genintern.register_intern0 wit_sort (fun ist s -> (ist, s));
   Genintern.register_intern0 wit_quant_hyp (lift intern_quantified_hypothesis);
diff --git a/ltac/tacinterp.ml b/ltac/tacinterp.ml
index b875fb26f..e9c30e728 100644
--- a/ltac/tacinterp.ml
+++ b/ltac/tacinterp.ml
@@ -2125,6 +2125,30 @@ let () =
   Geninterp.register_interp0 wit_tactic interp
 
 let () =
+  let interp ist tac = Ftactic.return (Value.of_closure ist tac) in
+  Geninterp.register_interp0 wit_tactic0 interp
+
+let () =
+  let interp ist tac = Ftactic.return (Value.of_closure ist tac) in
+  Geninterp.register_interp0 wit_tactic1 interp
+
+let () =
+  let interp ist tac = Ftactic.return (Value.of_closure ist tac) in
+  Geninterp.register_interp0 wit_tactic2 interp
+
+let () =
+  let interp ist tac = Ftactic.return (Value.of_closure ist tac) in
+  Geninterp.register_interp0 wit_tactic3 interp
+
+let () =
+  let interp ist tac = Ftactic.return (Value.of_closure ist tac) in
+  Geninterp.register_interp0 wit_tactic4 interp
+
+let () =
+  let interp ist tac = Ftactic.return (Value.of_closure ist tac) in
+  Geninterp.register_interp0 wit_tactic5 interp
+
+let () =
   let interp ist tac = interp_tactic ist tac >>= fun () -> Ftactic.return () in
   Geninterp.register_interp0 wit_ltac interp
 
diff --git a/printing/pptactic.ml b/printing/pptactic.ml
index 5dbf9a42a..06bf07741 100644
--- a/printing/pptactic.ml
+++ b/printing/pptactic.ml
@@ -1391,10 +1391,34 @@ let () =
   Genprint.register_print0 Stdarg.wit_string pr_string pr_string pr_string
 
 let () =
-  let printer _ _ prtac = prtac (0, E) in
+  let printer _ _ prtac = prtac (5, E) in
   declare_extra_genarg_pprule wit_tactic printer printer printer
 
 let () =
+  let printer _ _ prtac = prtac (0, E) in
+  declare_extra_genarg_pprule wit_tactic0 printer printer printer
+
+let () =
+  let printer _ _ prtac = prtac (1, E) in
+  declare_extra_genarg_pprule wit_tactic1 printer printer printer
+
+let () =
+  let printer _ _ prtac = prtac (2, E) in
+  declare_extra_genarg_pprule wit_tactic2 printer printer printer
+
+let () =
+  let printer _ _ prtac = prtac (3, E) in
+  declare_extra_genarg_pprule wit_tactic3 printer printer printer
+
+let () =
+  let printer _ _ prtac = prtac (4, E) in
+  declare_extra_genarg_pprule wit_tactic4 printer printer printer
+
+let () =
+  let printer _ _ prtac = prtac (5, E) in
+  declare_extra_genarg_pprule wit_tactic5 printer printer printer
+
+let () =
   let pr_unit _ _ _ () = str "()" in
   let printer _ _ prtac = prtac (0, E) in
   declare_extra_genarg_pprule wit_ltac printer printer pr_unit