From 64a5d7b33c4c66fc82974f255cf40badd0b7bacf Mon Sep 17 00:00:00 2001
From: glondu
Date: Thu, 2 Dec 2010 09:24:33 +0000
Subject: Add tactic has_evar (#2433)

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@13664 85f007b7-540e-0410-9357-904b9bb8a0f7
---
 doc/refman/RefMan-tac.tex | 11 +++++++++++
 tactics/extratactics.ml4  | 25 +++++++++++++++++++++++++
 2 files changed, 36 insertions(+)

diff --git a/doc/refman/RefMan-tac.tex b/doc/refman/RefMan-tac.tex
index 3f9f03c40f..40954f83ed 100644
--- a/doc/refman/RefMan-tac.tex
+++ b/doc/refman/RefMan-tac.tex
@@ -999,6 +999,17 @@ variables generated by e.g. {\tt eapply} (see Section~\ref{apply}).
 
 \ErrMsg \errindex{Not an evar}
 
+\subsection{\tt has\_evar \term
+\tacindex{has\_evar}
+\label{hasevar}}
+
+This tactic applies to any goal. It checks whether its argument has an
+existential variable as a subterm. Unlike {\tt context} patterns
+combined with {\tt is\_evar}, this tactic scans all subterms,
+including those under binders.
+
+\ErrMsg \errindex{No evars}
+
 \subsection{Bindings list
 \index{Binding list}
 \label{Binding-list}}
diff --git a/tactics/extratactics.ml4 b/tactics/extratactics.ml4
index 393934abfa..78a1f51b78 100644
--- a/tactics/extratactics.ml4
+++ b/tactics/extratactics.ml4
@@ -718,3 +718,28 @@ TACTIC EXTEND is_evar
         | _ -> tclFAIL 0 (str "Not an evar")
     ]
 END
+
+let rec has_evar x =
+  match kind_of_term x with
+    | Evar _ -> true
+    | Rel _ | Var _ | Meta _ | Sort _ | Const _ | Ind _ | Construct _ ->
+      false
+    | Cast (t1, _, t2) | Prod (_, t1, t2) | Lambda (_, t1, t2) ->
+      has_evar t1 || has_evar t2
+    | LetIn (_, t1, t2, t3) ->
+      has_evar t1 || has_evar t2 || has_evar t3
+    | App (t1, ts) ->
+      has_evar t1 || has_evar_array ts
+    | Case (_, t1, t2, ts) ->
+      has_evar t1 || has_evar t2 || has_evar_array ts
+    | Fix ((_, tr)) | CoFix ((_, tr)) ->
+      has_evar_prec tr
+and has_evar_array x =
+  array_exists has_evar x
+and has_evar_prec (_, ts1, ts2) =
+  array_exists has_evar ts1 || array_exists has_evar ts2
+
+TACTIC EXTEND has_evar
+| [ "has_evar" constr(x) ] ->
+    [ if has_evar x then tclIDTAC else tclFAIL 0 (str "No evars") ]
+END
-- 
cgit v1.2.3