aboutsummaryrefslogtreecommitdiffhomepage
path: root/plugins/ltac/g_ltac.ml4
diff options
context:
space:
mode:
Diffstat (limited to 'plugins/ltac/g_ltac.ml4')
-rw-r--r--plugins/ltac/g_ltac.ml430
1 files changed, 15 insertions, 15 deletions
diff --git a/plugins/ltac/g_ltac.ml4 b/plugins/ltac/g_ltac.ml4
index ed54320a5..620f14707 100644
--- a/plugins/ltac/g_ltac.ml4
+++ b/plugins/ltac/g_ltac.ml4
@@ -12,9 +12,10 @@ DECLARE PLUGIN "ltac_plugin"
open Util
open Pp
+open Glob_term
open Constrexpr
open Tacexpr
-open Misctypes
+open Namegen
open Genarg
open Genredexpr
open Tok (* necessary for camlp5 *)
@@ -26,7 +27,7 @@ open Pcoq.Constr
open Pvernac.Vernac_
open Pltac
-let fail_default_value = ArgArg 0
+let fail_default_value = Locus.ArgArg 0
let arg_of_expr = function
TacArg (loc,a) -> a
@@ -34,15 +35,16 @@ let arg_of_expr = function
let genarg_of_unit () = in_gen (rawwit Stdarg.wit_unit) ()
let genarg_of_int n = in_gen (rawwit Stdarg.wit_int) n
-let genarg_of_ipattern pat = in_gen (rawwit Stdarg.wit_intro_pattern) pat
+let genarg_of_ipattern pat = in_gen (rawwit Tacarg.wit_intro_pattern) pat
let genarg_of_uconstr c = in_gen (rawwit Stdarg.wit_uconstr) c
let in_tac tac = in_gen (rawwit Tacarg.wit_ltac) tac
-let reference_to_id = CAst.map_with_loc (fun ?loc -> function
- | Libnames.Ident id -> id
- | Libnames.Qualid _ ->
- CErrors.user_err ?loc
- (str "This expression should be a simple identifier."))
+let reference_to_id qid =
+ if Libnames.qualid_is_ident qid then
+ CAst.make ?loc:qid.CAst.loc @@ Libnames.qualid_basename qid
+ else
+ CErrors.user_err ?loc:qid.CAst.loc
+ (str "This expression should be a simple identifier.")
let tactic_mode = Gram.entry_create "vernac:tactic_command"
@@ -197,9 +199,8 @@ GEXTEND Gram
non ambiguous name where dots are replaced by "_"? Probably too
verbose most of the time. *)
fresh_id:
- [ [ s = STRING -> ArgArg s (*| id = ident -> ArgVar (!@loc,id)*)
- | qid = qualid -> let (_pth,id) = Libnames.repr_qualid qid.CAst.v in
- ArgVar (CAst.make ~loc:!@loc id) ] ]
+ [ [ s = STRING -> Locus.ArgArg s (*| id = ident -> Locus.ArgVar (!@loc,id)*)
+ | qid = qualid -> Locus.ArgVar (CAst.make ~loc:!@loc @@ Libnames.qualid_basename qid) ] ]
;
constr_eval:
[ [ IDENT "eval"; rtc = red_expr; "in"; c = Constr.constr ->
@@ -474,7 +475,7 @@ END
VERNAC COMMAND EXTEND VernacPrintLtac CLASSIFIED AS QUERY
| [ "Print" "Ltac" reference(r) ] ->
- [ Feedback.msg_notice (Tacintern.print_ltac (Libnames.qualid_of_reference r).CAst.v) ]
+ [ Feedback.msg_notice (Tacintern.print_ltac r) ]
END
VERNAC COMMAND EXTEND VernacLocateLtac CLASSIFIED AS QUERY
@@ -482,7 +483,7 @@ VERNAC COMMAND EXTEND VernacLocateLtac CLASSIFIED AS QUERY
[ Tacentries.print_located_tactic r ]
END
-let pr_ltac_ref = Libnames.pr_reference
+let pr_ltac_ref = Libnames.pr_qualid
let pr_tacdef_body tacdef_body =
let id, redef, body =
@@ -509,8 +510,7 @@ VERNAC COMMAND FUNCTIONAL EXTEND VernacDeclareTacticDefinition
| [ "Ltac" ne_ltac_tacdef_body_list_sep(l, "with") ] => [
VtSideff (List.map (function
| TacticDefinition ({CAst.v=r},_) -> r
- | TacticRedefinition ({CAst.v=Ident r},_) -> r
- | TacticRedefinition ({CAst.v=Qualid q},_) -> snd(repr_qualid q)) l), VtLater
+ | TacticRedefinition (qid,_) -> qualid_basename qid) l), VtLater
] -> [ fun ~atts ~st -> let open Vernacinterp in
Tacentries.register_ltac (Locality.make_module_locality atts.locality) l;
st