(** The hint database [FSet_decidability] will be given to the [push_neg] tactic from the module [Negation]. *)
Hint Resolve dec_In dec_eq : FSet_decidability.
(** ** Normalizing Propositions About Equality We have to deal with the fact that [E.eq] may be convertible with Coq's equality.  Thus, we will find the following tactics useful to replace one form with the other everywhere. *)
(** The next tactic, [Logic_eq_to_E_eq], mentions the term [E.t]; thus, we must ensure that [E.t] is used in favor of any other convertible but syntactically distinct term. *)
Ltac change_to_E_t :=
repeat (
match goal with
| H : ?T |- _ =>
progress (change T with E.t in H);
repeat (
match goal with
| J : _ |- _ => progress (change T with E.t in J)
| |- _ => progress (change T with E.t)
end )
| H : forall x : ?T, _ |- _ =>
progress (change T with E.t in H);
repeat (
match goal with
| J : _ |- _ => progress (change T with E.t in J)
| |- _ => progress (change T with E.t)
end )
end).
(** These two tactics take us from Coq's built-in equality to [E.eq] (and vice versa) when possible. *)
Ltac Logic_eq_to_E_eq :=
repeat (
match goal with
| H: _ |- _ =>
progress (change (@Logic.eq E.t) with E.eq in H)
| |- _ =>
progress (change (@Logic.eq E.t) with E.eq)
end).
Ltac E_eq_to_Logic_eq :=
repeat (
match goal with
| H: _ |- _ =>
progress (change E.eq with (@Logic.eq E.t) in H)
| |- _ =>
progress (change E.eq with (@Logic.eq E.t))
end).
(** This tactic works like the built-in tactic [subst], but at the level of set element equality (which may not be the convertible with Coq's equality). *)
Ltac substFSet :=
repeat (
match goal with
| H: E.eq ?x ?y |- _ => rewrite H in *; clear H
end).
(** ** Considering Decidability of Base Propositions This tactic adds assertions about the decidability of [E.eq] and [In] to the context.  This is necessary for the completeness of the [fsetdec] tactic.  However, in order to minimize the cost of proof search, we should be careful to not add more than we need.  Once negations have been pushed to the leaves of the propositions, we only need to worry about decidability for those base propositions that appear in a negated form. *)
Ltac assert_decidability :=
(** We actually don't want these rules to fire if the syntactic context in the patterns below is trivially empty, but we'll just do some clean-up at the afterward.  *)
repeat (
match goal with
| H: context [~ E.eq ?x ?y] |- _ =>
assert new (E.eq x y \/ ~ E.eq x y) by (apply dec_eq)
| H: context [~ In ?x ?s] |- _ =>
assert new (In x s \/ ~ In x s) by (apply dec_In)
| |- context [~ E.eq ?x ?y] =>
assert new (E.eq x y \/ ~ E.eq x y) by (apply dec_eq)
| |- context [~ In ?x ?s] =>
assert new (In x s \/ ~ In x s) by (apply dec_In)
end);
(** Now we eliminate the useless facts we added (because they would likely be very harmful to performance). *)
repeat (
match goal with
| _: ~ ?P, H : ?P \/ ~ ?P |- _ => clear H
end).
(** ** Handling [Empty], [Subset], and [Equal] This tactic instantiates universally quantified hypotheses (which arise from the unfolding of [Empty], [Subset], and [Equal]) for each of the set element expressions that is involved in some membership or equality fact.  Then it throws away those hypotheses, which should no longer be needed. *)
Ltac inst_FSet_hypotheses :=
repeat (
match goal with
| H : forall a : E.t, _,
_ : context [ In ?x _ ] |- _ =>
let P := type of (H x) in
assert new P by (exact (H x))
| H : forall a : E.t, _
|- context [ In ?x _ ] =>
let P := type of (H x) in
assert new P by (exact (H x))
| H : forall a : E.t, _,
_ : context [ E.eq ?x _ ] |- _ =>
let P := type of (H x) in
assert new P by (exact (H x))
| H : forall a : E.t, _
|- context [ E.eq ?x _ ] =>
let P := type of (H x) in
assert new P by (exact (H x))
| H : forall a : E.t, _,
_ : context [ E.eq _ ?x ] |- _ =>
let P := type of (H x) in
assert new P by (exact (H x))
| H : forall a : E.t, _
|- context [ E.eq _ ?x ] =>
let P := type of (H x) in
assert new P by (exact (H x))
end);
repeat (
match goal with
| H : forall a : E.t, _ |- _ =>
clear H
end).
(** ** The Core [fsetdec] Auxiliary Tactics *)
(** Here is the crux of the proof search.  Recursion through [intuition]!  (This will terminate if I correctly understand the behavior of [intuition].) *)
Hint Resolve E.eq_refl : FSet_Auto.
(* SCW: to change to MSets, replace with this. Hint Resolve (E.eq_equiv.(@Equivalence_Reflexive _ _)) : FSet_Auto. *)
Ltac fsetdec_rec :=
auto with FSet_Auto;
subst++;
try (match goal with
| H: E.eq ?x ?x -> False |- _ => destruct H
end);
(reflexivity ||
contradiction ||
(progress substFSet; intuition fsetdec_rec)).
(** If we add [unfold Empty, Subset, Equal in *; intros;] to the beginning of this tactic, it will satisfy the same specification as the [fsetdec] tactic; however, it will be much slower than necessary without the pre-processing done by the wrapper tactic [fsetdec]. *)
Ltac fsetdec_body :=
inst_FSet_hypotheses;
autorewrite with set_simpl in *;
push not in * using FSet_decidability;
substFSet;
assert_decidability;
auto with FSet_Auto;
(intuition fsetdec_rec) ||
fail 1
"because the goal is beyond the scope of this tactic".
End FSetDecideAuxiliary.
(** * The [fsetdec] Tactic Here is the top-level tactic (the only one intended for clients of this library).  It's specification is given at the top of the file. *)
Ltac fsetdec :=
(** We first unfold any occurrences of [iff]. *)
unfold iff in *;
(** We fold occurrences of [not] because it is better for [intros] to leave us with a goal of [~ P] than a goal of [False]. *)
fold any not; intros;
(** Now we decompose conjunctions, which will allow the [discard_nonFSet] and [assert_decidability] tactics to do a much better job. *)
decompose records;
discard_nonFSet;
(** We unfold these defined propositions on finite sets.  If our goal was one of them, then have one more item to introduce now. *)
unfold Empty, Subset, Equal in *; intros;
(** SCW: this autorewrite can introduce [=], we need to to it before the next step and not just in the body. *)
autorewrite with set_simpl in *;
(** We now want to get rid of all uses of [=] in favor of [E.eq].  However, the best way to eliminate a [=] is in the context is with [subst], so we will try that first. In fact, we may as well convert uses of [E.eq] into [=] when possible before we do [subst] so that we can even more mileage out of it.  Then we will convert all remaining uses of [=] back to [E.eq] when possible.  We use [change_to_E_t] to ensure that we have a canonical name for set elements, so that [Logic_eq_to_E_eq] will work properly.  *)
change_to_E_t; E_eq_to_Logic_eq; subst++; Logic_eq_to_E_eq;
(** The next optimization is to swap a negated goal with a negated hypothesis when possible.  Any swap will improve performance by eliminating the total number of negations, but we will get the maximum benefit if we swap the goal with a hypotheses mentioning the same set element, so we try that first.  If we reach the fourth branch below, we attempt any swap.  However, to maintain completeness of this tactic, we can only perform such a swap with a decidable proposition; hence, we first test whether the hypothesis is an [FSet_elt_Prop], noting that any [FSet_elt_Prop] is decidable. *)
pull not using FSet_decidability;
unfold not in *;
match goal with
| H: (In ?x ?r) -> False |- (In ?x ?s) -> False =>
contradict H; fsetdec_body
| H: (In ?x ?r) -> False |- (E.eq ?x ?y) -> False =>
contradict H; fsetdec_body
| H: (In ?x ?r) -> False |- (E.eq ?y ?x) -> False =>
contradict H; fsetdec_body
| H: ?P -> False |- ?Q -> False =>
if prop (FSet_elt_Prop P) holds by
(auto 100 with FSet_Prop)
then (contradict H; fsetdec_body)
else fsetdec_body
| |- _ =>
fsetdec_body
end.
(** * Examples *)
Module FSetDecideTestCases.

(* Specifications: *)
Lemma test_eq_trans_1 : forall x y z s,
E.eq x y ->
~ ~ E.eq z y ->
In x s ->
In z s.
Lemma function_test_1 :
forall (f : t -> t),
forall (g : elt -> elt),
forall (s1 s2 : t),
forall (x1 x2 : elt),
Equal s1 (f s2) ->
E.eq x1 (g (g x2)) ->
In x1 s1 ->
In (g (g x2)) (f s2).
Lemma test_baydemir :
forall (f : t -> t),
forall (s : t),
forall (x y : elt),
In x (add y (f s)) ->
~ E.eq x y ->
In x (f s).
Lemma test_baydemir_2 :
forall (x : elt) (s : t),
Subset (inter (singleton x) s) empty ->
~ In x s.