diff options
| -rw-r--r-- | pretyping/termops.ml | 20 | ||||
| -rw-r--r-- | pretyping/termops.mli | 4 | ||||
| -rw-r--r-- | tactics/tactics.ml | 2 |
3 files changed, 15 insertions, 11 deletions
diff --git a/pretyping/termops.ml b/pretyping/termops.ml index e3b8a166c7..56e4f6ecce 100644 --- a/pretyping/termops.ml +++ b/pretyping/termops.ml @@ -502,12 +502,6 @@ let occur_var_in_decl env hyp (_,c,typ) = occur_var env hyp typ || occur_var env hyp body -(* Tests that t is a subterm of c *) -let occur_term t c = - let eq_constr_fail c = if eq_constr t c then raise Occur - in let rec occur_rec c = eq_constr_fail c; iter_constr occur_rec c - in try occur_rec c; false with Occur -> true - (* returns the list of free debruijn indices in a term *) let free_rels m = @@ -528,10 +522,10 @@ let collect_metas c = in List.rev (collrec [] c) -(* (dependent M N) is true iff M is eq_term with a subterm of N - M is appropriately lifted through abstractions of N *) +(* Tests whether [m] is a subterm of [t]: + [m] is appropriately lifted through abstractions of [t] *) -let dependent m t = +let dependent_main noevar m t = let rec deprec m t = if eq_constr m t then raise Occur @@ -542,10 +536,18 @@ let dependent m t = Array.iter (deprec m) (Array.sub lt (Array.length lm) ((Array.length lt) - (Array.length lm))) + | _, Cast (c,_,_) when noevar & isMeta c -> () + | _, Evar _ when noevar -> () | _ -> iter_constr_with_binders (lift 1) deprec m t in try deprec m t; false with Occur -> true +let dependent = dependent_main false +let dependent_no_evar = dependent_main true + +(* Synonymous *) +let occur_term = dependent + let pop t = lift (-1) t (***************************) diff --git a/pretyping/termops.mli b/pretyping/termops.mli index 79fe908d7a..194fa71327 100644 --- a/pretyping/termops.mli +++ b/pretyping/termops.mli @@ -106,10 +106,12 @@ val occur_var : env -> identifier -> types -> bool val occur_var_in_decl : env -> identifier -> 'a * types option * types -> bool -val occur_term : constr -> constr -> bool val free_rels : constr -> Intset.t val dependent : constr -> constr -> bool +val dependent_no_evar : constr -> constr -> bool val collect_metas : constr -> int list +val occur_term : constr -> constr -> bool (* Synonymous + of dependent *) (* Substitution of metavariables *) type meta_value_map = (metavariable * constr) list val subst_meta : meta_value_map -> constr -> constr diff --git a/tactics/tactics.ml b/tactics/tactics.ml index 83c58ee807..74a7db5721 100644 --- a/tactics/tactics.ml +++ b/tactics/tactics.ml @@ -2535,7 +2535,7 @@ let find_elim_signature isrec elim hyp0 gl = if isrec then lookup_eliminator mind s else let case = - if occur_term (mkVar hyp0) (pf_concl gl) then make_case_dep + if dependent_no_evar (mkVar hyp0) (pf_concl gl) then make_case_dep else make_case_gen in pf_apply case gl mind s in let elimt = pf_type_of gl elimc in |