aboutsummaryrefslogtreecommitdiff
path: root/tactics/tactics.ml
diff options
context:
space:
mode:
Diffstat (limited to 'tactics/tactics.ml')
-rw-r--r--tactics/tactics.ml29
1 files changed, 20 insertions, 9 deletions
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index cbf12ac22f..c24520b371 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -1555,7 +1555,7 @@ let make_projection env sigma params cstr sign elim i n c u =
| Some proj ->
let args = Context.Rel.to_extended_vect mkRel 0 sign in
let proj =
- match Recordops.find_primitive_projection proj with
+ match Structures.PrimitiveProjections.find_opt proj with
| Some proj ->
mkProj (Projection.make proj false, mkApp (c, args))
| None ->
@@ -1585,7 +1585,7 @@ let descend_in_conjunctions avoid tac (err, info) c =
let params = List.map EConstr.of_constr params in
let cstr = (get_constructors env indf).(0) in
let elim =
- try DefinedRecord (Recordops.lookup_projections ind)
+ try DefinedRecord (Structures.Structure.find_projections ind)
with Not_found ->
let u = EInstance.kind sigma u in
let (_, elim) = build_case_analysis_scheme env sigma (ind,u) false sort in
@@ -1886,12 +1886,6 @@ let cut_and_apply c =
(* Exact tactics *)
(********************************************************************)
-(* let convert_leqkey = CProfile.declare_profile "convert_leq";; *)
-(* let convert_leq = CProfile.profile3 convert_leqkey convert_leq *)
-
-(* let refine_no_checkkey = CProfile.declare_profile "refine_no_check";; *)
-(* let refine_no_check = CProfile.profile2 refine_no_checkkey refine_no_check *)
-
let exact_no_check c =
Refine.refine ~typecheck:false (fun h -> (h,c))
@@ -2796,7 +2790,24 @@ let generalize_goal_gen env sigma ids i ((occs,c,b),na) t cl =
let open Context.Rel.Declaration in
let decls,cl = decompose_prod_n_assum sigma i cl in
let dummy_prod = it_mkProd_or_LetIn mkProp decls in
- let newdecls,_ = decompose_prod_n_assum sigma i (subst_term_gen sigma EConstr.eq_constr_nounivs c dummy_prod) in
+ let newdecls,_ =
+ let c = Termops.collapse_appl sigma c in
+ let arity = Array.length (snd (Termops.decompose_app_vect sigma c)) in
+ let cache = ref Int.Map.empty in
+ let eq sigma k t =
+ let c =
+ try Int.Map.find k !cache
+ with Not_found ->
+ let c = EConstr.Vars.lift k c in
+ let () = cache := Int.Map.add k c !cache in
+ c
+ in
+ (* We use a nounivs equality because generalize morally takes a pattern as
+ argument, so we have to ignore freshly generated sorts. *)
+ EConstr.eq_constr_nounivs sigma c t
+ in
+ decompose_prod_n_assum sigma i (replace_term_gen sigma eq arity (mkRel 1) dummy_prod)
+ in
let cl',sigma' = subst_closed_term_occ env sigma (AtOccs occs) c (it_mkProd_or_LetIn cl newdecls) in
let na = generalized_name env sigma c t ids cl' na in
let r = Retyping.relevance_of_type env sigma t in