aboutsummaryrefslogtreecommitdiffhomepage
path: root/tactics
diff options
context:
space:
mode:
Diffstat (limited to 'tactics')
-rw-r--r--tactics/btermdn.ml2
-rw-r--r--tactics/class_tactics.ml8
-rw-r--r--tactics/contradiction.ml2
-rw-r--r--tactics/eauto.ml2
-rw-r--r--tactics/eqdecide.ml2
-rw-r--r--tactics/equality.ml1
-rw-r--r--tactics/hints.ml46
-rw-r--r--tactics/hints.mli29
-rw-r--r--tactics/hipattern.ml2
-rw-r--r--tactics/inv.ml1
-rw-r--r--tactics/leminv.ml2
-rw-r--r--tactics/tacticals.ml2
-rw-r--r--tactics/tactics.ml8
-rw-r--r--tactics/tactics.mli2
-rw-r--r--tactics/term_dnet.ml2
15 files changed, 73 insertions, 38 deletions
diff --git a/tactics/btermdn.ml b/tactics/btermdn.ml
index 8f50b0aa2..aca7f6c65 100644
--- a/tactics/btermdn.ml
+++ b/tactics/btermdn.ml
@@ -9,7 +9,7 @@
(************************************************************************)
open Util
-open Term
+open Constr
open EConstr
open Names
open Pattern
diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml
index 3e08c6d87..998efdd6d 100644
--- a/tactics/class_tactics.ml
+++ b/tactics/class_tactics.ml
@@ -18,6 +18,7 @@ open CErrors
open Util
open Names
open Term
+open Constr
open Termops
open EConstr
open Tacmach
@@ -546,12 +547,7 @@ let make_resolve_hyp env sigma st flags only_classes pri decl =
let hints = build_subclasses ~check:false env sigma (VarRef id) empty_hint_info in
(List.map_append
(fun (path,info,c) ->
- let info =
- { info with hint_pattern =
- Option.map (Constrintern.intern_constr_pattern env sigma)
- info.hint_pattern }
- in
- make_resolves env sigma ~name:(PathHints path)
+ make_resolves env sigma ~name:(PathHints path)
(true,false,not !Flags.quiet) info false
(IsConstr (EConstr.of_constr c,Univ.ContextSet.empty)))
hints)
diff --git a/tactics/contradiction.ml b/tactics/contradiction.ml
index c285f21e7..b92bc75bc 100644
--- a/tactics/contradiction.ml
+++ b/tactics/contradiction.ml
@@ -8,7 +8,7 @@
(* * (see LICENSE file for the text of the license) *)
(************************************************************************)
-open Term
+open Constr
open EConstr
open Hipattern
open Tactics
diff --git a/tactics/eauto.ml b/tactics/eauto.ml
index 3df9e3f82..80d07c5c0 100644
--- a/tactics/eauto.ml
+++ b/tactics/eauto.ml
@@ -12,7 +12,7 @@ open Pp
open CErrors
open Util
open Names
-open Term
+open Constr
open Termops
open EConstr
open Proof_type
diff --git a/tactics/eqdecide.ml b/tactics/eqdecide.ml
index b0deeed17..176701d99 100644
--- a/tactics/eqdecide.ml
+++ b/tactics/eqdecide.ml
@@ -17,7 +17,7 @@
open Util
open Names
open Namegen
-open Term
+open Constr
open EConstr
open Declarations
open Tactics
diff --git a/tactics/equality.ml b/tactics/equality.ml
index 8904cd170..f9e06391a 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -15,6 +15,7 @@ open Util
open Names
open Nameops
open Term
+open Constr
open Termops
open EConstr
open Vars
diff --git a/tactics/hints.ml b/tactics/hints.ml
index 786760122..a86103d57 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -12,7 +12,7 @@ open Pp
open Util
open CErrors
open Names
-open Term
+open Constr
open Evd
open EConstr
open Vars
@@ -23,12 +23,10 @@ open Libobject
open Namegen
open Libnames
open Smartlocate
-open Misctypes
open Termops
open Inductiveops
open Typing
open Decl_kinds
-open Vernacexpr
open Typeclasses
open Pattern
open Patternops
@@ -101,6 +99,8 @@ let empty_hint_info =
(* The Type of Constructions Autotactic Hints *)
(************************************************************************)
+type hint_info_expr = Constrexpr.constr_pattern_expr hint_info_gen
+
type 'a hint_ast =
| Res_pf of 'a (* Hint Apply *)
| ERes_pf of 'a (* Hint EApply *)
@@ -156,6 +156,24 @@ type full_hint = hint with_metadata
type hint_entry = GlobRef.t option *
raw_hint hint_ast with_uid with_metadata
+type reference_or_constr =
+ | HintsReference of reference
+ | HintsConstr of Constrexpr.constr_expr
+
+type hint_mode =
+ | ModeInput (* No evars *)
+ | ModeNoHeadEvar (* No evar at the head *)
+ | ModeOutput (* Anything *)
+
+type hints_expr =
+ | HintsResolve of (hint_info_expr * bool * reference_or_constr) list
+ | HintsImmediate of reference_or_constr list
+ | HintsUnfold of reference list
+ | HintsTransparency of reference list * bool
+ | HintsMode of reference * hint_mode list
+ | HintsConstructors of reference list
+ | HintsExtern of int * Constrexpr.constr_expr option * Genarg.raw_generic_argument
+
type import_level = [ `LAX | `WARN | `STRICT ]
let warn_hint : import_level ref = ref `LAX
@@ -276,15 +294,15 @@ let strip_params env sigma c =
| App (f, args) ->
(match EConstr.kind sigma f with
| Const (p,_) ->
- let cb = lookup_constant p env in
- (match cb.Declarations.const_proj with
- | Some pb ->
- let n = pb.Declarations.proj_npars in
- if Array.length args > n then
- mkApp (mkProj (Projection.make p false, args.(n)),
- Array.sub args (n+1) (Array.length args - (n + 1)))
- else c
- | None -> c)
+ let p = Projection.make p false in
+ (match lookup_projection p env with
+ | pb ->
+ let n = pb.Declarations.proj_npars in
+ if Array.length args > n then
+ mkApp (mkProj (p, args.(n)),
+ Array.sub args (n+1) (Array.length args - (n + 1)))
+ else c
+ | exception Not_found -> c)
| _ -> c)
| _ -> c
@@ -1218,7 +1236,7 @@ let add_trivials env sigma l local dbnames =
type hnf = bool
-type hint_info = (patvar list * constr_pattern) hint_info_gen
+type nonrec hint_info = hint_info
type hints_entry =
| HintsResolveEntry of (hint_info * polymorphic * hnf * hints_path_atom * hint_term) list
@@ -1326,7 +1344,7 @@ let interp_hints poly =
let _, tacexp = Genintern.generic_intern env tacexp in
HintsExternEntry ({ hint_priority = Some pri; hint_pattern = pat }, tacexp)
-let add_hints local dbnames0 h =
+let add_hints ~local dbnames0 h =
if String.List.mem "nocore" dbnames0 then
user_err Pp.(str "The hint database \"nocore\" is meant to stay empty.");
let dbnames = if List.is_empty dbnames0 then ["core"] else dbnames0 in
diff --git a/tactics/hints.mli b/tactics/hints.mli
index c7de10a2a..7ef7f0185 100644
--- a/tactics/hints.mli
+++ b/tactics/hints.mli
@@ -14,11 +14,10 @@ open EConstr
open Environ
open Decl_kinds
open Evd
-open Misctypes
open Tactypes
open Clenv
open Pattern
-open Vernacexpr
+open Typeclasses
(** {6 General functions. } *)
@@ -34,6 +33,8 @@ val empty_hint_info : 'a Typeclasses.hint_info_gen
(** Pre-created hint databases *)
+type hint_info_expr = Constrexpr.constr_pattern_expr hint_info_gen
+
type 'a hint_ast =
| Res_pf of 'a (* Hint Apply *)
| ERes_pf of 'a (* Hint EApply *)
@@ -71,6 +72,24 @@ type search_entry
type hint_entry
+type reference_or_constr =
+ | HintsReference of Libnames.reference
+ | HintsConstr of Constrexpr.constr_expr
+
+type hint_mode =
+ | ModeInput (* No evars *)
+ | ModeNoHeadEvar (* No evar at the head *)
+ | ModeOutput (* Anything *)
+
+type hints_expr =
+ | HintsResolve of (hint_info_expr * bool * reference_or_constr) list
+ | HintsImmediate of reference_or_constr list
+ | HintsUnfold of Libnames.reference list
+ | HintsTransparency of Libnames.reference list * bool
+ | HintsMode of Libnames.reference * hint_mode list
+ | HintsConstructors of Libnames.reference list
+ | HintsExtern of int * Constrexpr.constr_expr option * Genarg.raw_generic_argument
+
type 'a hints_path_gen =
| PathAtom of 'a hints_path_atom_gen
| PathStar of 'a hints_path_gen
@@ -143,8 +162,6 @@ type hint_db = Hint_db.t
type hnf = bool
-type hint_info = (patvar list * constr_pattern) Typeclasses.hint_info_gen
-
type hint_term =
| IsGlobRef of GlobRef.t
| IsConstr of constr * Univ.ContextSet.t
@@ -178,7 +195,7 @@ val current_pure_db : unit -> hint_db list
val interp_hints : polymorphic -> hints_expr -> hints_entry
-val add_hints : locality_flag -> hint_db_name list -> hints_entry -> unit
+val add_hints : local:bool -> hint_db_name list -> hints_entry -> unit
val prepare_hint : bool (* Check no remaining evars *) ->
(bool * bool) (* polymorphic or monomorphic, local or global *) ->
@@ -273,3 +290,5 @@ val pr_hint : env -> evar_map -> hint -> Pp.t
(** Hook for changing the initialization of auto *)
val add_hints_init : (unit -> unit) -> unit
+type nonrec hint_info = hint_info
+[@@ocaml.deprecated "Use [Typeclasses.hint_info]"]
diff --git a/tactics/hipattern.ml b/tactics/hipattern.ml
index b8f1ed720..5d264058a 100644
--- a/tactics/hipattern.ml
+++ b/tactics/hipattern.ml
@@ -12,7 +12,7 @@ open Pp
open CErrors
open Util
open Names
-open Term
+open Constr
open Termops
open EConstr
open Inductiveops
diff --git a/tactics/inv.ml b/tactics/inv.ml
index b346ed223..28cfd57a2 100644
--- a/tactics/inv.ml
+++ b/tactics/inv.ml
@@ -14,6 +14,7 @@ open Util
open Names
open Term
open Termops
+open Constr
open EConstr
open Vars
open Namegen
diff --git a/tactics/leminv.ml b/tactics/leminv.ml
index a4cdc1592..f47e6b2cd 100644
--- a/tactics/leminv.ml
+++ b/tactics/leminv.ml
@@ -12,9 +12,9 @@ open Pp
open CErrors
open Util
open Names
-open Term
open Termops
open Environ
+open Constr
open EConstr
open Vars
open Namegen
diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml
index 6c7db26c7..732d06f8a 100644
--- a/tactics/tacticals.ml
+++ b/tactics/tacticals.ml
@@ -509,7 +509,7 @@ module New = struct
match Evd.evar_body evi with
| Evd.Evar_empty -> Some (evk,evi)
| Evd.Evar_defined c -> match Constr.kind (EConstr.Unsafe.to_constr c) with
- | Term.Evar (evk,l) -> is_undefined_up_to_restriction sigma evk
+ | Evar (evk,l) -> is_undefined_up_to_restriction sigma evk
| _ ->
(* We make the assumption that there is no way to refine an
evar remaining after typing from the initial term given to
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index a42e4b44b..58c62af85 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -128,14 +128,14 @@ let unsafe_intro env store decl b =
(sigma, mkNamedLambda_or_LetIn decl ev)
end
-let introduction ?(check=true) id =
+let introduction id =
Proofview.Goal.enter begin fun gl ->
let concl = Proofview.Goal.concl gl in
let sigma = Tacmach.New.project gl in
let hyps = named_context_val (Proofview.Goal.env gl) in
let store = Proofview.Goal.extra gl in
let env = Proofview.Goal.env gl in
- let () = if check && mem_named_context_val id hyps then
+ let () = if mem_named_context_val id hyps then
user_err ~hdr:"Tactics.introduction"
(str "Variable " ++ Id.print id ++ str " is already declared.")
in
@@ -1910,8 +1910,8 @@ let cast_no_check cast c =
exact_no_check (mkCast (c, cast, concl))
end
-let vm_cast_no_check c = cast_no_check Term.VMcast c
-let native_cast_no_check c = cast_no_check Term.NATIVEcast c
+let vm_cast_no_check c = cast_no_check VMcast c
+let native_cast_no_check c = cast_no_check NATIVEcast c
let exact_proof c =
let open Tacmach.New in
diff --git a/tactics/tactics.mli b/tactics/tactics.mli
index ddf78b1d4..b17330f13 100644
--- a/tactics/tactics.mli
+++ b/tactics/tactics.mli
@@ -34,7 +34,7 @@ val is_quantified_hypothesis : Id.t -> Proofview.Goal.t -> bool
(** {6 Primitive tactics. } *)
-val introduction : ?check:bool -> Id.t -> unit Proofview.tactic
+val introduction : Id.t -> unit Proofview.tactic
val convert_concl : ?check:bool -> types -> cast_kind -> unit Proofview.tactic
val convert_hyp : ?check:bool -> named_declaration -> unit Proofview.tactic
val convert_concl_no_check : types -> cast_kind -> unit Proofview.tactic
diff --git a/tactics/term_dnet.ml b/tactics/term_dnet.ml
index 611799990..8bdcc6321 100644
--- a/tactics/term_dnet.ml
+++ b/tactics/term_dnet.ml
@@ -290,7 +290,7 @@ struct
| Const (c,u) -> Term (DRef (ConstRef c))
| Ind (i,u) -> Term (DRef (IndRef i))
| Construct (c,u)-> Term (DRef (ConstructRef c))
- | Term.Meta _ -> assert false
+ | Meta _ -> assert false
| Evar (i,_) ->
let meta =
try Evar.Map.find i !metas
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-18 08:36:15 +0000