Commit e82cda6c authored by Robbert Krebbers's avatar Robbert Krebbers

Add non-deterministic expressions with side-effects.

The following things have been changed in this revision:

* We now give a small step semantics for expressions. The denotational semantics
  only works for side-effect free expressions.
* Dynamically allocated memory through alloc and free is now supported.
* The following expressions are added: assignment, function call, unary
  operators, conditional, alloc, and free.
* Some customary induction schemes for expressions are proven.
* The axiomatic semantics (and its interpretation) have been changed in order
  to deal with non-deterministic expressions.
* We have added inversion schemes based on small inversions for the operational
  semantics. Inversions using these schemes are much faster.
* We improved the statement preservation proof of the operational semantics.
* We now use a variant of SsReflect's [by] and [done], instead of Coq's [now]
  and [easy]. The [done] tactic is much faster as it does not perform
  inversions.
* Add theory, definitions and notations on vectors.
* Separate theory on contexts.
* Change [Arguments] declarations to ensure better unfolding.
parent 4cda26dd
......@@ -4,6 +4,7 @@
These are particularly useful as we define the operational semantics as a
small step semantics. This file defines a hint database [ars] containing
some theorems on abstract rewriting systems. *)
Require Import Omega Wf_nat.
Require Export tactics base.
(** * Definitions *)
......@@ -62,8 +63,9 @@ Section rtc.
Proof. inversion_clear 1; eauto. Qed.
Lemma rtc_ind_r (P : A A Prop)
(Prefl : x, P x x) (Pstep : x y z, rtc R x y R y z P x y P x z) :
y z, rtc R y z P y z.
(Prefl : x, P x x)
(Pstep : x y z, rtc R x y R y z P x y P x z) :
x z, rtc R x z P x z.
Proof.
cut ( y z, rtc R y z x, rtc R x y P x y P x z).
{ eauto using rtc_refl. }
......@@ -99,7 +101,7 @@ Section rtc.
bsteps R n x y bsteps R (m + n) x y.
Proof. apply bsteps_weaken. auto with arith. Qed.
Lemma bsteps_S n x y : bsteps R n x y bsteps R (S n) x y.
Proof. apply bsteps_weaken. auto with arith. Qed.
Proof. apply bsteps_weaken. omega. Qed.
Lemma bsteps_trans n m x y z :
bsteps R n x y bsteps R m y z bsteps R (n + m) x z.
Proof. induction 1; simpl; eauto using bsteps_plus_l with ars. Qed.
......@@ -108,7 +110,31 @@ Section rtc.
Lemma bsteps_rtc n x y : bsteps R n x y rtc R x y.
Proof. induction 1; eauto with ars. Qed.
Lemma rtc_bsteps x y : rtc R x y n, bsteps R n x y.
Proof. induction 1. exists 0. auto with ars. firstorder eauto with ars. Qed.
Proof.
induction 1.
* exists 0. constructor.
* naive_solver eauto with ars.
Qed.
Lemma bsteps_ind_r (P : nat A Prop) (x : A)
(Prefl : n, P n x)
(Pstep : n y z, bsteps R n x y R y z P n y P (S n) z) :
n z, bsteps R n x z P n z.
Proof.
cut ( m y z, bsteps R m y z n,
bsteps R n x y
( m', n m' m' n + m P m' y)
P (n + m) z).
{ intros help ?. change n with (0 + n). eauto with ars. }
induction 1 as [|m x' y z p2 p3 IH]; [by eauto with arith|].
intros n p1 H. rewrite <-plus_n_Sm.
apply (IH (S n)); [by eauto using bsteps_r |].
intros [|m'] [??]; [omega |].
apply Pstep with x'.
* apply bsteps_weaken with n; intuition omega.
* done.
* apply H; intuition omega.
Qed.
Global Instance tc_trans: Transitive (tc R).
Proof. red; induction 1; eauto with ars. Qed.
......@@ -137,23 +163,26 @@ Section rtc.
Qed.
End rtc.
Hint Resolve rtc_once rtc_r tc_r : ars.
Hint Resolve
rtc_once rtc_r
tc_r
bsteps_once bsteps_r bsteps_refl bsteps_trans : ars.
(** * Theorems on sub relations *)
Section subrel.
Context {A} (R1 R2 : relation A) (Hsub : subrelation R1 R2).
Lemma red_subrel x : red R1 x red R2 x.
Proof. intros [y ?]. exists y. now apply Hsub. Qed.
Proof. intros [y ?]. exists y. by apply Hsub. Qed.
Lemma nf_subrel x : nf R2 x nf R1 x.
Proof. intros H1 H2. destruct H1. now apply red_subrel. Qed.
Proof. intros H1 H2. destruct H1. by apply red_subrel. Qed.
Global Instance rtc_subrel: subrelation (rtc R1) (rtc R2).
Proof. induction 1; [left|eright]; eauto; now apply Hsub. Qed.
Proof. induction 1; [left|eright]; eauto; by apply Hsub. Qed.
Global Instance nsteps_subrel: subrelation (nsteps R1 n) (nsteps R2 n).
Proof. induction 1; [left|eright]; eauto; now apply Hsub. Qed.
Proof. induction 1; [left|eright]; eauto; by apply Hsub. Qed.
Global Instance bsteps_subrel: subrelation (bsteps R1 n) (bsteps R2 n).
Proof. induction 1; [left|eright]; eauto; now apply Hsub. Qed.
Proof. induction 1; [left|eright]; eauto; by apply Hsub. Qed.
Global Instance tc_subrel: subrelation (tc R1) (tc R2).
Proof. induction 1; [left|eright]; eauto; now apply Hsub. Qed.
Proof. induction 1; [left|eright]; eauto; by apply Hsub. Qed.
End subrel.
......@@ -41,8 +41,12 @@ Hint Extern 0 (?x = ?x) => reflexivity.
Notation "(→)" := (λ x y, x y) (only parsing) : C_scope.
Notation "( T →)" := (λ y, T y) (only parsing) : C_scope.
Notation "(→ T )" := (λ y, y T) (only parsing) : C_scope.
Notation "t $ r" := (t r)
(at level 65, right associativity, only parsing) : C_scope.
Notation "($)" := (λ f x, f x) (only parsing) : C_scope.
Notation "($ x )" := (λ f, f x) (only parsing) : C_scope.
Infix "∘" := compose : C_scope.
Notation "(∘)" := compose (only parsing) : C_scope.
Notation "( f ∘)" := (compose f) (only parsing) : C_scope.
......@@ -61,12 +65,12 @@ Class PropHolds (P : Prop) := prop_holds: P.
Hint Extern 0 (PropHolds _) => assumption : typeclass_instances.
Instance: Proper (iff ==> iff) PropHolds.
Proof. now repeat intro. Qed.
Proof. repeat intro; trivial. Qed.
Ltac solve_propholds :=
match goal with
| [ |- PropHolds (?P) ] => apply _
| [ |- ?P ] => change (PropHolds P); apply _
| |- PropHolds (?P) => apply _
| |- ?P => change (PropHolds P); apply _
end.
(** ** Decidable propositions *)
......@@ -99,13 +103,14 @@ Instance: Params (@equiv) 2.
(for types that have an [Equiv] instance) rather than the standard Leibniz
equality. *)
Instance equiv_default_relation `{Equiv A} : DefaultRelation () | 3.
Hint Extern 0 (?x ?x) => reflexivity.
Hint Extern 0 (_ _) => reflexivity.
Hint Extern 0 (_ _) => symmetry; assumption.
(** ** Operations on collections *)
(** We define operational type classes for the standard operations and
(** We define operational type classes for the traditional operations and
relations on collections: the empty collection [∅], the union [(∪)],
intersection [(∩)], difference [(∖)], and the singleton [{[_]}]
operation, and the subset [(⊆)] and element of [(∈)] relation. *)
intersection [(∩)], and difference [(∖)], the singleton [{[_]}], the subset
[(⊆)] and element of [(∈)] relation, and disjointess [(⊥)]. *)
Class Empty A := empty: A.
Notation "∅" := empty : C_scope.
......@@ -116,6 +121,11 @@ Notation "(∪)" := union (only parsing) : C_scope.
Notation "( x ∪)" := (union x) (only parsing) : C_scope.
Notation "(∪ x )" := (λ y, union y x) (only parsing) : C_scope.
Definition union_list `{Empty A}
`{Union A} : list A A := fold_right () .
Arguments union_list _ _ _ !_ /.
Notation "⋃ l" := (union_list l) (at level 20, format "⋃ l") : C_scope.
Class Intersection A := intersection: A A A.
Instance: Params (@intersection) 2.
Infix "∩" := intersection (at level 40) : C_scope.
......@@ -147,7 +157,7 @@ Notation "(⊈)" := (λ X Y, X ⊈ Y) (only parsing) : C_scope.
Notation "( X ⊈ )" := (λ Y, X Y) (only parsing) : C_scope.
Notation "( ⊈ X )" := (λ Y, Y X) (only parsing) : C_scope.
Hint Extern 0 (?x ?x) => reflexivity.
Hint Extern 0 (_ _) => reflexivity.
Class ElemOf A B := elem_of: A B Prop.
Instance: Params (@elem_of) 3.
......@@ -167,6 +177,9 @@ Notation "(⊥)" := disjoint (only parsing) : C_scope.
Notation "( X ⊥)" := (disjoint X) (only parsing) : C_scope.
Notation "(⊥ X )" := (λ Y, disjoint Y X) (only parsing) : C_scope.
Instance generic_disjoint `{ElemOf A B} : Disjoint B | 100 :=
λ X Y, x, x X x Y.
(** ** Operations on maps *)
(** In this section we define operational type classes for the operations
on maps. In the file [fin_maps] we will axiomatize finite maps.
......@@ -179,6 +192,7 @@ Notation "m !! i" := (lookup i m) (at level 20) : C_scope.
Notation "(!!)" := lookup (only parsing) : C_scope.
Notation "( m !!)" := (λ i, lookup i m) (only parsing) : C_scope.
Notation "(!! i )" := (lookup i) (only parsing) : C_scope.
Arguments lookup _ _ _ _ !_ !_ / : simpl nomatch.
(** The function insert [<[k:=a]>m] should update the element at key [k] with
value [a] in [m]. *)
......@@ -187,6 +201,7 @@ Class Insert (K : Type) (M : Type → Type) :=
Instance: Params (@insert) 4.
Notation "<[ k := a ]>" := (insert k a)
(at level 5, right associativity, format "<[ k := a ]>") : C_scope.
Arguments insert _ _ _ _ !_ _ !_ / : simpl nomatch.
(** The function delete [delete k m] should delete the value at key [k] in
[m]. If the key [k] is not a member of [m], the original map should be
......@@ -194,12 +209,14 @@ returned. *)
Class Delete (K : Type) (M : Type Type) :=
delete: {A}, K M A M A.
Instance: Params (@delete) 4.
Arguments delete _ _ _ _ !_ !_ / : simpl nomatch.
(** The function [alter f k m] should update the value at key [k] using the
function [f], which is called with the original value. *)
Class Alter (K : Type) (M : Type Type) :=
alter: {A}, (A A) K M A M A.
Instance: Params (@alter) 4.
Arguments alter _ _ _ _ _ !_ !_ / : simpl nomatch.
(** The function [alter f k m] should update the value at key [k] using the
function [f], which is called with the original value at key [k] or [None]
......@@ -208,12 +225,14 @@ yields [None]. *)
Class PartialAlter (K : Type) (M : Type Type) :=
partial_alter: {A}, (option A option A) K M A M A.
Instance: Params (@partial_alter) 4.
Arguments partial_alter _ _ _ _ _ !_ !_ / : simpl nomatch.
(** The function [dom C m] should yield the domain of [m]. That is a finite
collection of type [C] that contains the keys that are a member of [m]. *)
Class Dom (K : Type) (M : Type Type) :=
dom: {A} C `{Empty C} `{Union C} `{Singleton K C}, M A C.
Instance: Params (@dom) 8.
Arguments dom _ _ _ _ _ _ _ _ !_ / : simpl nomatch.
(** The function [merge f m1 m2] should merge the maps [m1] and [m2] by
constructing a new map whose value at key [k] is [f (m1 !! k) (m2 !! k)]
......@@ -221,6 +240,7 @@ provided that [k] is a member of either [m1] or [m2].*)
Class Merge (M : Type Type) :=
merge: {A}, (option A option A option A) M A M A M A.
Instance: Params (@merge) 3.
Arguments merge _ _ _ _ !_ !_ / : simpl nomatch.
(** We lift the insert and delete operation to lists of elements. *)
Definition insert_list `{Insert K M} {A} (l : list (K * A)) (m : M A) : M A :=
......@@ -261,6 +281,10 @@ Class RightId {A} R (i : A) (f : A → A → A) :=
right_id: x, R (f x i) x.
Class Associative {A} R (f : A A A) :=
associative: x y z, R (f x (f y z)) (f (f x y) z).
Class LeftAbsorb {A} R (i : A) (f : A A A) :=
left_absorb: x, R (f i x) i.
Class RightAbsorb {A} R (i : A) (f : A A A) :=
right_absorb: x, R (f x i) i.
Arguments injective {_ _ _ _} _ {_} _ _ _.
Arguments idempotent {_ _} _ {_} _.
......@@ -268,6 +292,8 @@ Arguments commutative {_ _ _} _ {_} _ _.
Arguments left_id {_ _} _ _ {_} _.
Arguments right_id {_ _} _ _ {_} _.
Arguments associative {_ _} _ {_} _ _ _.
Arguments left_absorb {_ _} _ _ {_} _.
Arguments right_absorb {_ _} _ _ {_} _.
(** The following lemmas are more specific versions of the projections of the
above type classes. These lemmas allow us to enforce Coq not to use the setoid
......@@ -287,28 +313,44 @@ Proof. auto. Qed.
Lemma associative_eq {A} (f : A A A) `{!Associative (=) f} x y z :
f x (f y z) = f (f x y) z.
Proof. auto. Qed.
Lemma left_absorb_eq {A} (i : A) (f : A A A) `{!LeftAbsorb (=) i f} x :
f i x = i.
Proof. auto. Qed.
Lemma right_absorb_eq {A} (i : A) (f : A A A) `{!RightAbsorb (=) i f} x :
f x i = i.
Proof. auto. Qed.
(** ** Monadic operations *)
(** We do use the operation type classes for monads merely for convenient
overloading of notations and do not formalize any theory on monads (we do not
define a class with the monad laws). *)
(** We define operational type classes for the monadic operations bind, join
and fmap. These type classes are defined in a non-standard way by taking the
function as a parameter of the class. For example, we define
<<
Class FMap := fmap: ∀ {A B}, (A → B) → M A → M B.
>>
instead of
<<
Class FMap {A B} (f : A → B) := fmap: M A → M B.
>>
This approach allows us to define [fmap] on lists such that [simpl] unfolds it
in the appropriate way, and so that it can be used for mutual recursion
(the mapped function [f] is not part of the fixpoint) as well.
We use these type classes merely for convenient overloading of notations and do
not formalize any theory on monads (we do not even define a class with the
monad laws). *)
Section monad_ops.
Context (M : Type Type).
Class MRet := mret: {A}, A M A.
Class MBind := mbind: {A B}, (A M B) M A M B.
Class MJoin := mjoin: {A}, M (M A) M A.
Class FMap := fmap: {A B}, (A B) M A M B.
Class MBind {A B} (f : A M B) := mbind: M A M B.
Class MJoin {A} := mjoin: M (M A) M A.
Class FMap {A B} (f : A B) := fmap: M A M B.
End monad_ops.
Instance: Params (@mret) 3.
Arguments mret {M MRet A} _.
Instance: Params (@mbind) 4.
Arguments mbind {M MBind A B} _ _.
Arguments mbind {_ _ _} _ {_} !_ / : simpl nomatch.
Instance: Params (@mjoin) 3.
Arguments mjoin {M MJoin A} _.
Arguments mjoin {_ _ _} !_ / : simpl nomatch.
Instance: Params (@fmap) 4.
Arguments fmap {M FMap A B} _ _.
Arguments fmap {_ _ _} _ {_} !_ / : simpl nomatch.
Notation "m ≫= f" := (mbind f m) (at level 60, right associativity) : C_scope.
Notation "x ← y ; z" := (y = (λ x : _, z))
......@@ -327,7 +369,7 @@ need for proofs that the relations and operations respect setoid equality.
Instead, we will define setoid equality in a generic way as
[λ X Y, X ⊆ Y ∧ Y ⊆ X]. *)
Class BoundedJoinSemiLattice A `{Empty A} `{SubsetEq A} `{Union A} := {
jsl_preorder :>> BoundedPreOrder A;
bjsl_preorder :>> BoundedPreOrder A;
subseteq_union_l x y : x x y;
subseteq_union_r x y : y x y;
union_least x y z : x z y z x y z
......@@ -338,7 +380,11 @@ Class MeetSemiLattice A `{Empty A} `{SubsetEq A} `{Intersection A} := {
subseteq_intersection_r x y : x y y;
intersection_greatest x y z : z x z y z x y
}.
Class LowerBoundedLattice A `{Empty A} `{SubsetEq A}
`{Union A} `{Intersection A} := {
lbl_bjsl :>> BoundedJoinSemiLattice A;
lbl_msl :>> MeetSemiLattice A
}.
(** ** Axiomatization of collections *)
(** The class [Collection A C] axiomatizes a collection of type [C] with
elements of type [A]. Since [C] is not dependent on [A], we use the monomorphic
......@@ -360,8 +406,12 @@ enumerated as a list. These elements, given by the [elements] function, may be
in any order and should not contain duplicates. *)
Class Elements A C := elements: C list A.
Instance: Params (@elements) 3.
Class FinCollection A C `{Empty C} `{Union C} `{Intersection C} `{Difference C}
`{Singleton A C} `{ElemOf A C} `{Map A C} `{Elements A C} := {
(** Decidability of equality of the carrier set is admissible, but we add it
anyway so as to avoid cycles in type class search. *)
Class FinCollection A C `{ElemOf A C} `{Empty C} `{Union C}
`{Intersection C} `{Difference C} `{Singleton A C} `{Map A C}
`{Elements A C} `{ x y : A, Decision (x = y)} := {
fin_collection :>> Collection A C;
elements_spec X x : x X In x (elements X);
elements_nodup X : NoDup (elements X)
......@@ -382,7 +432,7 @@ Class FreshSpec A C `{!Fresh A C} `{!ElemOf A C} := {
(** * Miscellaneous *)
Lemma proj1_sig_inj {A} (P : A Prop) x (Px : P x) y (Py : P y) :
xPx = yPy x = y.
Proof. now injection 1. Qed.
Proof. injection 1; trivial. Qed.
Lemma symmetry_iff `(R : relation A) `{!Symmetric R} (x y : A) :
R x y R y x.
......@@ -436,29 +486,29 @@ Definition lift_relation {A B} (R : relation A)
(f : B A) : relation B := λ x y, R (f x) (f y).
Definition lift_relation_equivalence {A B} (R : relation A) (f : B A) :
Equivalence R Equivalence (lift_relation R f).
Proof. unfold lift_relation. firstorder. Qed.
Proof. unfold lift_relation. firstorder auto. Qed.
Hint Extern 0 (Equivalence (lift_relation _ _)) =>
eapply @lift_relation_equivalence : typeclass_instances.
Instance: A B (x : B), Commutative (=) (λ _ _ : A, x).
Proof. easy. Qed.
Proof. red. trivial. Qed.
Instance: A (x : A), Associative (=) (λ _ _ : A, x).
Proof. easy. Qed.
Proof. red. trivial. Qed.
Instance: A, Associative (=) (λ x _ : A, x).
Proof. easy. Qed.
Proof. red. trivial. Qed.
Instance: A, Associative (=) (λ _ x : A, x).
Proof. easy. Qed.
Proof. red. trivial. Qed.
Instance: A, Idempotent (=) (λ x _ : A, x).
Proof. easy. Qed.
Proof. red. trivial. Qed.
Instance: A, Idempotent (=) (λ _ x : A, x).
Proof. easy. Qed.
Proof. red. trivial. Qed.
Instance left_id_propholds {A} (R : relation A) i f :
LeftId R i f x, PropHolds (R (f i x) x).
Proof. easy. Qed.
Proof. red. trivial. Qed.
Instance right_id_propholds {A} (R : relation A) i f :
RightId R i f x, PropHolds (R (f x i) x).
Proof. easy. Qed.
Proof. red. trivial. Qed.
Instance idem_propholds {A} (R : relation A) f :
Idempotent R f x, PropHolds (R (f x x) x).
Proof. easy. Qed.
Proof. red. trivial. Qed.
......@@ -7,59 +7,108 @@ Require Export base tactics orders.
(** * Theorems *)
Section collection.
Context `{Collection A B}.
Context `{Collection A C}.
Lemma elem_of_empty x : x False.
Proof. split. apply not_elem_of_empty. easy. Qed.
Proof. split. apply not_elem_of_empty. done. Qed.
Lemma elem_of_union_l x X Y : x X x X Y.
Proof. intros. apply elem_of_union. auto. Qed.
Lemma elem_of_union_r x X Y : x Y x X Y.
Proof. intros. apply elem_of_union. auto. Qed.
Lemma not_elem_of_singleton x y : x {[ y ]} x y.
Proof. now rewrite elem_of_singleton. Qed.
Lemma not_elem_of_union x X Y : x X Y x X x Y.
Proof. rewrite elem_of_union. tauto. Qed.
Global Instance collection_subseteq: SubsetEq B := λ X Y,
Global Instance collection_subseteq: SubsetEq C := λ X Y,
x, x X x Y.
Global Instance: BoundedJoinSemiLattice B.
Proof. firstorder. Qed.
Global Instance: MeetSemiLattice B.
Proof. firstorder. Qed.
Global Instance: LowerBoundedLattice C.
Proof. firstorder auto. Qed.
Lemma elem_of_subseteq X Y : X Y x, x X x Y.
Proof. easy. Qed.
Proof. done. Qed.
Lemma elem_of_equiv X Y : X Y x, x X x Y.
Proof. firstorder. Qed.
Lemma elem_of_equiv_alt X Y :
X Y ( x, x X x Y) ( x, x Y x X).
Proof. firstorder. Qed.
Lemma elem_of_subseteq_singleton x X : x X {[ x ]} X.
Proof.
split.
* intros ??. rewrite elem_of_singleton. intro. by subst.
* intros Ex. by apply (Ex x), elem_of_singleton.
Qed.
Global Instance singleton_proper : Proper ((=) ==> ()) singleton.
Proof. repeat intro. now subst. Qed.
Proof. repeat intro. by subst. Qed.
Global Instance elem_of_proper: Proper ((=) ==> () ==> iff) ().
Proof. intros ???. subst. firstorder. Qed.
Lemma empty_ne_singleton x : {[ x ]}.
Lemma elem_of_union_list (x : A) (Xs : list C) :
x Xs X, In X Xs x X.
Proof.
split.
* induction Xs; simpl; intros HXs.
+ by apply elem_of_empty in HXs.
+ apply elem_of_union in HXs. naive_solver.
* intros [X []]. induction Xs; [done | intros [?|?] ?; subst; simpl].
+ by apply elem_of_union_l.
+ apply elem_of_union_r; auto.
Qed.
Lemma non_empty_singleton x : {[ x ]} .
Proof. intros [E _]. by apply (elem_of_empty x), E, elem_of_singleton. Qed.
Lemma intersection_twice x : {[x]} {[x]} {[x]}.
Proof.
intros [_ E]. apply (elem_of_empty x).
apply E. now apply elem_of_singleton.
split; intros y; rewrite elem_of_intersection, !elem_of_singleton; tauto.
Qed.
Lemma not_elem_of_singleton x y : x {[ y ]} x y.
Proof. by rewrite elem_of_singleton. Qed.
Lemma not_elem_of_union x X Y : x X Y x X x Y.
Proof. rewrite elem_of_union. tauto. Qed.
Context `{ (X Y : C), Decision (X Y)}.
Global Instance elem_of_dec_slow (x : A) (X : C) : Decision (x X) | 100.
Proof.
refine (cast_if (decide_rel () {[ x ]} X));
by rewrite elem_of_subseteq_singleton.
Defined.
Lemma not_elem_of_intersection x X Y : x X Y x X x Y.
Proof.
rewrite elem_of_intersection.
destruct (decide (x X)); tauto.
Qed.
Lemma not_elem_of_difference x X Y : x X Y x X x Y.
Proof.
rewrite elem_of_difference.
destruct (decide (x Y)); tauto.
Qed.
Lemma union_difference X Y : X Y X X Y.
Proof.
split; intros x; rewrite !elem_of_union, elem_of_difference.
* tauto.
* destruct (decide (x X)); tauto.
Qed.
End collection.
Ltac decompose_empty := repeat
match goal with
| H : _ _ |- _ => apply empty_union in H; destruct H
| H : _ _ |- _ => apply non_empty_union in H; destruct H
| H : {[ _ ]} |- _ => destruct (non_empty_singleton _ H)
end.
(** * Theorems about map *)
Section map.
Context `{Collection A C}.
Lemma elem_of_map_1 (f : A A) (X : C) (x : A) :
x map f X y, x = f y y X.
Proof. intros. by apply (elem_of_map _). Qed.
Lemma elem_of_map_2 (f : A A) (X : C) (x : A) :
x X f x map f X.
Proof. intros. apply (elem_of_map _). eauto. Qed.
Lemma elem_of_map_1_alt (f : A A) (X : C) (x : A) y :
Lemma elem_of_map_2_alt (f : A A) (X : C) (x : A) y :
x X y = f x y map f X.
Proof. intros. apply (elem_of_map _). eauto. Qed.
Lemma elem_of_map_2 (f : A A) (X : C) (x : A) :
x map f X y, x = f y y X.
Proof. intros. now apply (elem_of_map _). Qed.
End map.
(** * Tactics *)
......@@ -67,16 +116,19 @@ End map.
[(∖)], [map], [∅], [{[_]}], [(≡)], and [(⊆)], by rewriting these into
logically equivalent propositions. For example we rewrite [A → x ∈ X ∪ ∅] into
[A → x ∈ X ∨ False]. *)
Ltac unfold_elem_of := repeat
match goal with
| H : context [ _ _ ] |- _ => setoid_rewrite elem_of_subseteq in H
| H : context [ _ _ ] |- _ => setoid_rewrite elem_of_equiv_alt in H
| H : context [ _ ] |- _ => setoid_rewrite elem_of_empty in H
| H : context [ _ {[ _ ]} ] |- _ => setoid_rewrite elem_of_singleton in H
| H : context [ _ _ _ ] |- _ => setoid_rewrite elem_of_union in H
| H : context [ _ _ _ ] |- _ => setoid_rewrite elem_of_intersection in H
| H : context [ _ _ _ ] |- _ => setoid_rewrite elem_of_difference in H
| H : context [ _ map _ _ ] |- _ => setoid_rewrite elem_of_map in H
Ltac unfold_elem_of :=
repeat_on_hyps (fun H =>
repeat match type of H with
| context [ _ _ ] => setoid_rewrite elem_of_subseteq in H
| context [ _ _ ] => setoid_rewrite elem_of_equiv_alt in H
| context [ _ ] => setoid_rewrite elem_of_empty in H
| context [ _ {[ _ ]} ] => setoid_rewrite elem_of_singleton in H
| context [ _ _ _ ] => setoid_rewrite elem_of_union in H
| context [ _ _ _ ] => setoid_rewrite elem_of_intersection in H
| context [ _ _ _ ] => setoid_rewrite elem_of_difference in H
| context [ _ map _ _ ] => setoid_rewrite elem_of_map in H
end);
repeat match goal with
| |- context [ _ _ ] => setoid_rewrite elem_of_subseteq
| |- context [ _ _ ] => setoid_rewrite elem_of_equiv_alt
| |- context [ _ ] => setoid_rewrite elem_of_empty
......@@ -90,7 +142,7 @@ Ltac unfold_elem_of := repeat
(** The tactic [solve_elem_of tac] composes the above tactic with [intuition].
For goals that do not involve [≡], [⊆], [map], or quantifiers this tactic is
generally powerful enough. This tactic either fails or proves the goal. *)
Tactic Notation "solve_elem_of" tactic(tac) :=
Tactic Notation "solve_elem_of" tactic3(tac) :=
simpl in *;
unfold_elem_of;
solve [intuition (simplify_equality; tac)].
......@@ -101,19 +153,20 @@ Tactic Notation "solve_elem_of" := solve_elem_of auto.
fails or loops on very small goals generated by [solve_elem_of] already. We
use the [naive_solver] tactic as a substitute. This tactic either fails or
proves the goal. *)
Tactic Notation "esolve_elem_of" tactic(tac) :=