aboutsummaryrefslogtreecommitdiff
path: root/tactics
diff options
context:
space:
mode:
authorMatthieu Sozeau2017-04-25 21:54:31 +0200
committerMaxime Dénès2020-09-07 20:47:42 +0200
commitb6dabf6aa5b96cfa3c11038316399f0797d734ac (patch)
tree0e97b6c66bba554833c47cec50d017820f72afe6 /tactics
parentb972cc5195e941633319c1fa428a9801ac4ef9e2 (diff)
Refine test for unresolved evars: not reachable from initial evars
The test is refined to handle aliases: i.e. undefined evars coming from restrictions and evar-evar unifications with an initial evar are not considered fresh unresolved evars. To check this, we generalize the restricted_evars set to an aliased_evars set in the evar map, registering evars being solved by another evar due to restriction or evar-evar unifications. This implements the proposal of PR #370 for testing the resolution status of evars independently of the evar-evar orientation order. This allows [apply] to refine an evar with a new one if it results from a [clear] request or an evar-evar solution only, otherwise the new evar is considered fresh and an error is raised. Also fixes bugs #4095 and #4413. Co-authored-by: Maxime Dénès <maxime.denes@inria.fr>
Diffstat (limited to 'tactics')
-rw-r--r--tactics/tacticals.ml9
-rw-r--r--tactics/tactics.ml14
2 files changed, 15 insertions, 8 deletions
diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml
index fc099f643d..c0fad0026f 100644
--- a/tactics/tacticals.ml
+++ b/tactics/tacticals.ml
@@ -695,6 +695,8 @@ module New = struct
(* Check that holes in arguments have been resolved *)
let check_evars env sigma extsigma origsigma =
+ let reachable = lazy (Evarutil.reachable_from_evars sigma
+ (Evar.Map.domain (Evd.undefined_map origsigma))) in
let rec is_undefined_up_to_restriction sigma evk =
if Evd.mem origsigma evk then None else
let evi = Evd.find sigma evk in
@@ -710,7 +712,12 @@ module New = struct
let rest =
Evd.fold_undefined (fun evk evi acc ->
match is_undefined_up_to_restriction sigma evk with
- | Some (evk',evi) -> (evk',evi)::acc
+ | Some (evk',evi) ->
+ (* If [evk'] descends from [evk] which descends itself from
+ an originally undefined evar in [origsigma], it is a not
+ a fresh undefined hole from [sigma]. *)
+ if Evar.Set.mem evk (Lazy.force reachable) then acc
+ else (evk',evi)::acc
| _ -> acc)
extsigma []
in
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 5f7e35d205..1dded80d92 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -5184,14 +5184,14 @@ end
(** Tacticals defined directly in term of Proofview *)
module New = struct
- open Genredexpr
- open Locus
-
let reduce_after_refine =
- reduce
- (Lazy {rBeta=true;rMatch=true;rFix=true;rCofix=true;
- rZeta=false;rDelta=false;rConst=[]})
- {onhyps = Some []; concl_occs = AllOccurrences }
+ (* For backward compatibility reasons, we do not contract let-ins, but we unfold them. *)
+ let redfun env t =
+ let open CClosure in
+ let flags = RedFlags.red_add_transparent allnolet TransparentState.empty in
+ clos_norm_flags flags env t
+ in
+ reduct_in_concl ~check:false (redfun,DEFAULTcast)
let refine ~typecheck c =
Refine.refine ~typecheck c <*>