Commit 18669b92 authored by Robbert Krebbers's avatar Robbert Krebbers

Major revision of the whole development.

The main changes are:

* Function calls in the operational semantics
* Mutually recursive function calls in the axiomatic semantics
* A general definition of the interpretation of the axiomatic semantics  so as
  to improve reusability (useful for function calls, and also for expressions
  in future versions)
* Type classes for stack independent, memory independent, and memory extensible
  assertions, and a lot of instances to automatically derive these properties.
* Many additional lemmas on the memory and more robust tactics to simplify
  goals involving is_free and mem_disjoint
* Proof of preservation of statements in the smallstep semantics

* Some new tactics: feed, feed destruct, feed inversion, etc...
* More robust tactic scripts using bullets and structured scripts
* Truncate most lines at 80 characters
parent a97de42f
......@@ -2,15 +2,14 @@ Global Generalizable All Variables.
Global Set Automatic Coercions Import.
Require Export Morphisms RelationClasses List Bool Utf8 Program Setoid NArith.
Arguments existT {_ _} _ _.
Arguments existT2 {_ _ _} _ _ _.
Arguments id _ _/.
Arguments compose _ _ _ _ _ _ /.
(* Change True and False into notations so we can overload them *)
Notation "'True'" := True : type_scope.
Notation "'False'" := False : type_scope.
Definition proj1_T2 {A} {P Q : A Type} (x : sigT2 P Q) : A :=
match x with existT2 a _ _ => a end.
Definition proj2_T2 {A} {P Q : A Type} (x : sigT2 P Q) : P (proj1_T2 x) :=
match x with existT2 _ p _ => p end.
Definition proj3_T2 {A} {P Q : A Type} (x : sigT2 P Q) : Q (proj1_T2 x) :=
match x with existT2 _ _ q => q end.
Arguments existT {_ _} _ _.
(* Common notations *)
Delimit Scope C_scope with C.
......@@ -28,7 +27,8 @@ Hint Extern 0 (?x = ?x) => reflexivity.
Notation "(→)" := (λ x y, x y) : C_scope.
Notation "( T →)" := (λ y, T y) : C_scope.
Notation "(→ T )" := (λ y, y T) : C_scope.
Notation "t $ r" := (t r) (at level 65, right associativity, only parsing) : C_scope.
Notation "t $ r" := (t r)
(at level 65, right associativity,only parsing) : C_scope.
Infix "∘" := compose : C_scope.
Notation "(∘)" := compose (only parsing) : C_scope.
Notation "( f ∘)" := (compose f) (only parsing) : C_scope.
......@@ -91,8 +91,9 @@ Notation "( ⊈ X )" := (λ Y, Y ⊈ X) (only parsing) : C_scope.
Hint Extern 0 (?x ?x) => reflexivity.
Class Singleton A B := singleton: A B.
Notation "{{ x }}" := (singleton x) : C_scope.
Notation "{{ x ; y ; .. ; z }}" := (union .. (union (singleton x) (singleton y)) .. (singleton z)) : C_scope.
Notation "{[ x ]}" := (singleton x) : C_scope.
Notation "{[ x ; y ; .. ; z ]}" :=
(union .. (union (singleton x) (singleton y)) .. (singleton z)) : C_scope.
Class ElemOf A B := elem_of: A B Prop.
Infix "∈" := elem_of (at level 70) : C_scope.
......@@ -104,16 +105,26 @@ Notation "(∉)" := (λ x X, x ∉ X) (only parsing) : C_scope.
Notation "( x ∉)" := (λ X, x X) (only parsing) : C_scope.
Notation "(∉ X )" := (λ x, x X) (only parsing) : C_scope.
Class UnionWith M := union_with: {A}, (A A A) M A M A M A.
Class IntersectWith M := intersect_with: {A}, (A A A) M A M A M A.
Class UnionWith M :=
union_with: {A}, (A A A) M A M A M A.
Class IntersectionWith M :=
intersection_with: {A}, (A A A) M A M A M A.
Class DifferenceWith M :=
difference_with: {A}, (A A option A) M A M A M A.
(* Common properties *)
Class Injective {A B} R S (f : A B) := injective: x y : A, S (f x) (f y) R x y.
Class Idempotent {A} R (f : A A A) := idempotent: x, R (f x x) x.
Class Commutative {A B} R (f : B B A) := commutative: x y, R (f x y) (f y x).
Class LeftId {A} R (i : A) (f : A A A) := left_id: x, R (f i x) x.
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 Injective {A B} R S (f : A B) :=
injective: x y : A, S (f x) (f y) R x y.
Class Idempotent {A} R (f : A A A) :=
idempotent: x, R (f x x) x.
Class Commutative {A B} R (f : B B A) :=
commutative: x y, R (f x y) (f y x).
Class LeftId {A} R (i : A) (f : A A A) :=
left_id: x, R (f i x) x.
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).
Arguments injective {_ _ _ _} _ {_} _ _ _.
Arguments idempotent {_ _} _ {_} _.
......@@ -123,15 +134,20 @@ Arguments right_id {_ _} _ _ {_} _.
Arguments associative {_ _} _ {_} _ _ _.
(* Using idempotent_eq we can force Coq to not use the setoid mechanism *)
Lemma idempotent_eq {A} (f : A A A) `{!Idempotent (=) f} x : f x x = x.
Lemma idempotent_eq {A} (f : A A A) `{!Idempotent (=) f} x :
f x x = x.
Proof. auto. Qed.
Lemma commutative_eq {A B} (f : B B A) `{!Commutative (=) f} x y : f x y = f y x.
Lemma commutative_eq {A B} (f : B B A) `{!Commutative (=) f} x y :
f x y = f y x.
Proof. auto. Qed.
Lemma left_id_eq {A} (i : A) (f : A A A) `{!LeftId (=) i f} x : f i x = x.
Lemma left_id_eq {A} (i : A) (f : A A A) `{!LeftId (=) i f} x :
f i x = x.
Proof. auto. Qed.
Lemma right_id_eq {A} (i : A) (f : A A A) `{!RightId (=) i f} x : f x i = x.
Lemma right_id_eq {A} (i : A) (f : A A A) `{!RightId (=) i f} x :
f x i = x.
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.
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.
(* Monadic operations *)
......@@ -150,7 +166,8 @@ Arguments mjoin {M MJoin A} _.
Arguments fmap {M FMap A B} _ _.
Notation "m ≫= f" := (mbind f m) (at level 60, right associativity) : C_scope.
Notation "x ← y ; z" := (y = (λ x : _, z)) (at level 65, next at level 35, right associativity) : C_scope.
Notation "x ← y ; z" := (y = (λ x : _, z))
(at level 65, next at level 35, right associativity) : C_scope.
Infix "<$>" := fmap (at level 65, right associativity, only parsing) : C_scope.
(* Ordered structures *)
......@@ -159,7 +176,8 @@ Class BoundedPreOrder A `{Empty A} `{SubsetEq A} := {
subseteq_empty x : x
}.
(* Note: no equality to avoid the need for setoids. We define equality in a generic way. *)
(* Note: no equality to avoid the need for setoids. We define setoid
equality in a generic way. *)
Class BoundedJoinSemiLattice A `{Empty A} `{SubsetEq A} `{Union A} := {
jsl_preorder :>> BoundedPreOrder A;
subseteq_union_l x y : x x y;
......@@ -180,7 +198,7 @@ Class Map A C := map: (A → A) → (C → C).
Class Collection A C `{ElemOf A C} `{Empty C} `{Union C}
`{Intersection C} `{Difference C} `{Singleton A C} `{Map A C} := {
elem_of_empty (x : A) : x ;
elem_of_singleton (x y : A) : x {{ y }} x = y;
elem_of_singleton (x y : A) : x {[ y ]} x = y;
elem_of_union X Y (x : A) : x X Y x X x Y;
elem_of_intersection X Y (x : A) : x X Y x X x Y;
elem_of_difference X Y (x : A) : x X Y x X x Y;
......@@ -208,15 +226,31 @@ Notation "(!!)" := lookup (only parsing) : C_scope.
Notation "( m !!)" := (λ i, lookup i m) (only parsing) : C_scope.
Notation "(!! i )" := (lookup i) (only parsing) : C_scope.
Class PartialAlter K M := partial_alter: {A}, (option A option A) K M A M A.
Class Alter K M := alter: {A}, (A A) K M A M A.
Class Dom K M := dom: C `{Empty C} `{Union C} `{Singleton K C}, M C.
Class Merge M := merge: {A}, (option A option A option A) M A M A M A.
Class Insert K M := insert: {A}, K A M A M A.
Notation "<[ k := a ]>" := (insert k a) (at level 5, right associativity) : C_scope.
Class Delete K M := delete: K M M.
Class PartialAlter K M :=
partial_alter: {A}, (option A option A) K M A M A.
Class Alter K M :=
alter: {A}, (A A) K M A M A.
Class Dom K M :=
dom: C `{Empty C} `{Union C} `{Singleton K C}, M C.
Class Merge M :=
merge: {A}, (option A option A option A) M A M A M A.
Class Insert K M :=
insert: {A}, K A M A M A.
Notation "<[ k := a ]>" := (insert k a)
(at level 5, right associativity, format "<[ k := a ]>") : C_scope.
Class Delete K M :=
delete: K M M.
Definition insert_list `{Insert K M} {A} (l : list (K * A)) (m : M A) : M A :=
fold_right (λ p, <[ fst p := snd p ]>) m l.
Definition delete_list `{Delete K M} (l : list K) (m : M) : M :=
fold_right delete m l.
(* Misc *)
Lemma symmetry_iff `(R : relation A) `{!Symmetric R} (x y : A) :
R x y R y x.
Proof. intuition. Qed.
Instance pointwise_reflexive {A} `{R : relation B} :
Reflexive R Reflexive (pointwise_relation A R) | 9.
Proof. firstorder. Qed.
......@@ -227,20 +261,26 @@ Instance pointwise_transitive {A} `{R : relation B} :
Transitive R Transitive (pointwise_relation A R) | 9.
Proof. firstorder. Qed.
Definition fst_map {A A' B} (f : A A') (p : A * B) : A' * B := (f (fst p), snd p).
Definition snd_map {A B B'} (f : B B') (p : A * B) : A * B' := (fst p, f (snd p)).
Definition prod_relation {A B} (R1 : relation A) (R2 : relation B) : relation (A * B) := λ x y,
R1 (fst x) (fst y) R2 (snd x) (snd y).
Definition fst_map {A A' B} (f : A A') (p : A * B) : A' * B :=
(f (fst p), snd p).
Definition snd_map {A B B'} (f : B B') (p : A * B) : A * B' :=
(fst p, f (snd p)).
Definition prod_relation {A B} (R1 : relation A) (R2 : relation B) :
relation (A * B) := λ x y, R1 (fst x) (fst y) R2 (snd x) (snd y).
Section prod_relation.
Context `{R1 : relation A} `{R2 : relation B}.
Global Instance: Reflexive R1 Reflexive R2 Reflexive (prod_relation R1 R2).
Global Instance:
Reflexive R1 Reflexive R2 Reflexive (prod_relation R1 R2).
Proof. firstorder eauto. Qed.
Global Instance: Symmetric R1 Symmetric R2 Symmetric (prod_relation R1 R2).
Global Instance:
Symmetric R1 Symmetric R2 Symmetric (prod_relation R1 R2).
Proof. firstorder eauto. Qed.
Global Instance: Transitive R1 Transitive R2 Transitive (prod_relation R1 R2).
Global Instance:
Transitive R1 Transitive R2 Transitive (prod_relation R1 R2).
Proof. firstorder eauto. Qed.
Global Instance: Equivalence R1 Equivalence R2 Equivalence (prod_relation R1 R2).
Global Instance:
Equivalence R1 Equivalence R2 Equivalence (prod_relation R1 R2).
Proof. split; apply _. Qed.
Global Instance: Proper (R1 ==> R2 ==> prod_relation R1 R2) pair.
Proof. firstorder eauto. Qed.
......@@ -250,11 +290,13 @@ Section prod_relation.
Proof. firstorder eauto. Qed.
End prod_relation.
Definition lift_relation {A B} (R : relation A) (f : B A) : relation B := λ x y, R (f x) (f y).
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.
Hint Extern 0 (Equivalence (lift_relation _ _)) => eapply @lift_relation_equivalence : typeclass_instances.
Hint Extern 0 (Equivalence (lift_relation _ _)) =>
eapply @lift_relation_equivalence : typeclass_instances.
Instance: A B (x : B), Commutative (=) (λ _ _ : A, x).
Proof. easy. Qed.
......@@ -269,11 +311,14 @@ Proof. easy. Qed.
Instance: A, Idempotent (=) (λ _ x : A, x).
Proof. easy. Qed.
Instance left_id_propholds {A} (R : relation A) i f : LeftId R i f x, PropHolds (R (f i x) x).
Instance left_id_propholds {A} (R : relation A) i f :
LeftId R i f x, PropHolds (R (f i x) x).
Proof. easy. Qed.
Instance right_id_propholds {A} (R : relation A) i f : RightId R i f x, PropHolds (R (f x i) x).
Instance right_id_propholds {A} (R : relation A) i f :
RightId R i f x, PropHolds (R (f x i) x).
Proof. easy. Qed.
Instance idem_propholds {A} (R : relation A) f : Idempotent R f x, PropHolds (R (f x x) x).
Instance idem_propholds {A} (R : relation A) f :
Idempotent R f x, PropHolds (R (f x x) x).
Proof. easy. Qed.
Ltac simplify_eqs := repeat
......@@ -283,7 +328,8 @@ Ltac simplify_eqs := repeat
| H : _ _ |- _ => now destruct H
| H : _ = _ False |- _ => now destruct H
| H : _ = _ |- _ => discriminate H
| H : _ = _ |- ?G => change (id G); injection H; clear H; intros; unfold id at 1
| H : _ = _ |- ?G =>
change (id G); injection H; clear H; intros; unfold id at 1
| H : ?f _ = ?f _ |- _ => apply (injective f) in H
| H : ?f _ ?x = ?f _ ?x |- _ => apply (injective (λ y, f y x)) in H
end.
......@@ -303,3 +349,51 @@ Tactic Notation "remember" constr(t) "as" "(" ident(x) "," ident(E) ")" :=
match goal with
| E' : x = _ |- _ => rename E' into E
end.
Ltac feed tac H :=
let H' := type of H in
match eval hnf in H' with
| ?T1 ?T2 =>
let HT1 := fresh in assert T1 as HT1;
[| feed tac (H HT1); clear HT1 ]
| _ => tac H
end.
Tactic Notation "feed" tactic(tac) constr(H) := feed tac H.
Ltac efeed tac H :=
let H' := type of H in
match eval hnf in H' with
| ?T1 ?T2 =>
let HT1 := fresh in assert T1 as HT1; [| efeed tac (H HT1); clear HT1 ]
| ?T1 _ =>
let e := fresh in evar (e:T1);
let e' := eval unfold e in e in
clear e; efeed tac (H e')
| _ => tac H
end.
Tactic Notation "efeed" tactic(tac) constr(H) := efeed tac H.
Tactic Notation "feed" "pose" "proof" constr(H) "as" ident(H') :=
feed (fun H => pose proof H as H') H.
Tactic Notation "feed" "pose" "proof" constr(H) :=
feed (fun H => pose proof H) H.
Tactic Notation "efeed" "pose" "proof" constr(H) "as" ident(H') :=
efeed (fun H => pose proof H as H') H.
Tactic Notation "efeed" "pose" "proof" constr(H) :=
efeed (fun H => pose proof H) H.
Tactic Notation "feed" "specialize" ident(H) :=
feed (fun H => specialize H) H.
Tactic Notation "efeed" "specialize" ident(H) :=
efeed (fun H => specialize H) H.
Tactic Notation "feed" "inversion" constr(H) :=
feed (fun H => let H':=fresh in pose proof H as H'; inversion H') H.
Tactic Notation "feed" "inversion" constr(H) "as" simple_intropattern(IP) :=
feed (fun H => let H':=fresh in pose proof H as H'; inversion H' as IP) H.
Tactic Notation "feed" "destruct" constr(H) :=
feed (fun H => let H':=fresh in pose proof H as H'; destruct H') H.
Tactic Notation "feed" "destruct" constr(H) "as" simple_intropattern(IP) :=
feed (fun H => let H':=fresh in pose proof H as H'; destruct H' as IP) H.
......@@ -21,28 +21,36 @@ Section collection.
Proof. easy. 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).
Lemma elem_of_equiv_alt X Y :
X Y ( x, x X x Y) ( x, x Y x X).
Proof. firstorder. Qed.
Global Instance: Proper ((=) ==> () ==> iff) ().
Proof. intros ???. subst. firstorder. Qed.
Lemma empty_ne_singleton x : {{ x }}.
Proof. intros [_ E]. destruct (elem_of_empty x). apply E. now apply elem_of_singleton. Qed.
Lemma empty_ne_singleton x : {[ x ]}.
Proof.
intros [_ E]. destruct (elem_of_empty x).
apply E. now apply elem_of_singleton.
Qed.
End collection.
Section cmap.
Context `{Collection A C}.
Lemma elem_of_map_1 (f : A A) (X : C) (x : A) : x X f x map f X.
Lemma elem_of_map_1 (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 : x X y = f x y map f X.
Lemma elem_of_map_1_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.
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 cmap.
Definition fresh_sig `{FreshSpec A C} (X : C) : { x : A | x X } := exist ( X) (fresh X) (is_fresh X).
Definition fresh_sig `{FreshSpec A C} (X : C) : { x : A | x X } :=
exist ( X) (fresh X) (is_fresh X).
Lemma elem_of_fresh_iff `{FreshSpec A C} (X : C) : fresh X X False.
Proof. split. apply is_fresh. easy. Qed.
......@@ -52,7 +60,7 @@ Ltac split_elem_ofs := repeat
| 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_iff in H
| H : context [ _ {{ _ }} ] |- _ => setoid_rewrite elem_of_singleton 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
......@@ -60,7 +68,7 @@ Ltac split_elem_ofs := repeat
| |- context [ _ _ ] => setoid_rewrite elem_of_subseteq
| |- context [ _ _ ] => setoid_rewrite elem_of_equiv_alt
| |- context [ _ ] => setoid_rewrite elem_of_empty_iff
| |- context [ _ {{ _ }} ] => setoid_rewrite elem_of_singleton
| |- context [ _ {[ _ ]} ] => setoid_rewrite elem_of_singleton
| |- context [ _ _ _ ] => setoid_rewrite elem_of_union
| |- context [ _ _ _ ] => setoid_rewrite elem_of_intersection
| |- context [ _ _ _ ] => setoid_rewrite elem_of_difference
......@@ -97,9 +105,12 @@ Ltac naive_firstorder t :=
(* solve *)
| |- _ => solve [t]
(* dirty destructs *)
| H : context [ _, _ ] |- _ => edestruct H; clear H; naive_firstorder t || clear H; naive_firstorder t
| H : context [ _ _ ] |- _ => edestruct H; clear H; naive_firstorder t || clear H; naive_firstorder t
| H : context [ _ _ ] |- _ => edestruct H; clear H; naive_firstorder t || clear H; naive_firstorder t
| H : context [ _, _ ] |- _ =>
edestruct H; clear H;naive_firstorder t || clear H; naive_firstorder t
| H : context [ _ _ ] |- _ =>
destruct H; clear H; naive_firstorder t || clear H; naive_firstorder t
| H : context [ _ _ ] |- _ =>
edestruct H; clear H; naive_firstorder t || clear H; naive_firstorder t
(* dirty constructs *)
| |- x, _ => eexists; naive_firstorder t
| |- _ _ => left; naive_firstorder t || right; naive_firstorder t
......@@ -125,8 +136,8 @@ Section no_dup.
Global Instance: Proper (R ==> () ==> iff) elem_of_upto.
Proof.
intros ?? E1 ?? E2. split; intros [z [??]]; exists z.
rewrite <-E1, <-E2; intuition.
rewrite E1, E2; intuition.
* rewrite <-E1, <-E2; intuition.
* rewrite E1, E2; intuition.
Qed.
Global Instance: Proper (() ==> iff) no_dup.
Proof. firstorder. Qed.
......@@ -135,20 +146,24 @@ Section no_dup.
Proof. unfold elem_of_upto. esimplify_elem_of. Qed.
Lemma elem_of_upto_empty x : ¬elem_of_upto x .
Proof. unfold elem_of_upto. esimplify_elem_of. Qed.
Lemma elem_of_upto_singleton x y : elem_of_upto x {{ y }} R x y.
Lemma elem_of_upto_singleton x y : elem_of_upto x {[ y ]} R x y.
Proof. unfold elem_of_upto. esimplify_elem_of. Qed.
Lemma elem_of_upto_union X Y x : elem_of_upto x (X Y) elem_of_upto x X elem_of_upto x Y.
Lemma elem_of_upto_union X Y x :
elem_of_upto x (X Y) elem_of_upto x X elem_of_upto x Y.
Proof. unfold elem_of_upto. esimplify_elem_of. Qed.
Lemma not_elem_of_upto x X : ¬elem_of_upto x X y, y X ¬R x y.
Proof. unfold elem_of_upto. esimplify_elem_of. Qed.
Lemma no_dup_empty: no_dup .
Proof. unfold no_dup. simplify_elem_of. Qed.
Lemma no_dup_add x X : ¬elem_of_upto x X no_dup X no_dup ({{ x }} X).
Lemma no_dup_add x X : ¬elem_of_upto x X no_dup X no_dup ({[ x ]} X).
Proof. unfold no_dup, elem_of_upto. esimplify_elem_of. Qed.
Lemma no_dup_inv_add x X : x X no_dup ({{ x }} X) ¬elem_of_upto x X.
Proof. intros Hin Hnodup [y [??]]. rewrite (Hnodup x y) in Hin; simplify_elem_of. Qed.
Lemma no_dup_inv_add x X : x X no_dup ({[ x ]} X) ¬elem_of_upto x X.
Proof.
intros Hin Hnodup [y [??]].
rewrite (Hnodup x y) in Hin; simplify_elem_of.
Qed.
Lemma no_dup_inv_union_l X Y : no_dup (X Y) no_dup X.
Proof. unfold no_dup. simplify_elem_of. Qed.
Lemma no_dup_inv_union_r X Y : no_dup (X Y) no_dup Y.
......@@ -163,7 +178,7 @@ Section quantifiers.
Lemma cforall_empty : cforall .
Proof. unfold cforall. simplify_elem_of. Qed.
Lemma cforall_singleton x : cforall {{ x }} P x.
Lemma cforall_singleton x : cforall {[ x ]} P x.
Proof. unfold cforall. simplify_elem_of. Qed.
Lemma cforall_union X Y : cforall X cforall Y cforall (X Y).
Proof. unfold cforall. simplify_elem_of. Qed.
......@@ -174,7 +189,7 @@ Section quantifiers.
Lemma cexists_empty : ¬cexists .
Proof. unfold cexists. esimplify_elem_of. Qed.
Lemma cexists_singleton x : cexists {{ x }} P x.
Lemma cexists_singleton x : cexists {[ x ]} P x.
Proof. unfold cexists. esimplify_elem_of. Qed.
Lemma cexists_union_1 X Y : cexists X cexists (X Y).
Proof. unfold cexists. esimplify_elem_of. Qed.
......@@ -184,9 +199,43 @@ Section quantifiers.
Proof. unfold cexists. esimplify_elem_of. Qed.
End quantifiers.
Lemma cforall_weak `{Collection A B} (P Q : A Prop) (Hweak : x, P x Q x) X :
cforall P X cforall Q X.
Proof. firstorder. Qed.
Lemma cexists_weak `{Collection A B} (P Q : A Prop) (Hweak : x, P x Q x) X :
cexists P X cexists Q X.
Proof. firstorder. Qed.
Section more_quantifiers.
Context `{Collection A B}.
Lemma cforall_weak (P Q : A Prop) (Hweak : x, P x Q x) X :
cforall P X cforall Q X.
Proof. firstorder. Qed.
Lemma cexists_weak (P Q : A Prop) (Hweak : x, P x Q x) X :
cexists P X cexists Q X.
Proof. firstorder. Qed.
End more_quantifiers.
Section fresh.
Context `{Collection A C} `{Fresh A C} `{!FreshSpec A C} .
Fixpoint fresh_list (n : nat) (X : C) : list A :=
match n with
| 0 => []
| S n => let x := fresh X in x :: fresh_list n ({[ x ]} X)
end.
Lemma fresh_list_length n X : length (fresh_list n X) = n.
Proof. revert X. induction n; simpl; auto. Qed.
Lemma fresh_list_is_fresh n X x : In x (fresh_list n X) x X.
Proof.
revert X. induction n; simpl.
* easy.
* intros X [?| Hin]. subst.
+ apply is_fresh.
+ apply IHn in Hin. simplify_elem_of.
Qed.
Lemma fresh_list_nodup n X : NoDup (fresh_list n X).
Proof.
revert X.
induction n; simpl; constructor; auto.
intros Hin. apply fresh_list_is_fresh in Hin.
simplify_elem_of.
Qed.
End fresh.
......@@ -6,9 +6,11 @@ Definition decide_rel {A B} (R : A → B → Prop)
Ltac case_decide :=
match goal with
| H : context [@decide ?P ?dec] |- _ => case (@decide P dec) in *
| H : context [@decide_rel _ _ ?R ?x ?y ?dec] |- _ => case (@decide_rel _ _ R x y dec) in *
| H : context [@decide_rel _ _ ?R ?x ?y ?dec] |- _ =>
case (@decide_rel _ _ R x y dec) in *
| |- context [@decide ?P ?dec] => case (@decide P dec) in *
| |- context [@decide_rel _ _ ?R ?x ?y ?dec] => case (@decide_rel _ _ R x y dec) in *
| |- context [@decide_rel _ _ ?R ?x ?y ?dec] =>
case (@decide_rel _ _ R x y dec) in *
end.
Ltac solve_trivial_decision :=
......@@ -16,25 +18,28 @@ Ltac solve_trivial_decision :=
| [ |- Decision (?P) ] => apply _
| [ |- sumbool ?P (¬?P) ] => change (Decision P); apply _
end.
Ltac solve_decision :=
first [solve_trivial_decision | unfold Decision; decide equality; solve_trivial_decision].
Ltac solve_decision :=
intros; first [ solve_trivial_decision
| unfold Decision; decide equality; solve_trivial_decision ].
Program Instance True_dec: Decision True := left _.
Program Instance False_dec: Decision False := right _.
Program Instance prod_eq_dec `(A_dec : x y : A, Decision (x = y))
`(B_dec : x y : B, Decision (x = y)) : x y : A * B, Decision (x = y) := λ x y,
`(B_dec : x y : B, Decision (x = y)) : x y : A * B, Decision (x = y) := λ x y,
match A_dec (fst x) (fst y) with
| left _ => match B_dec (snd x) (snd y) with left _ => left _ | right _ => right _ end
| right _ => right _
end.
Solve Obligations using (program_simpl; f_equal; firstorder).
Program Instance and_dec `(P_dec : Decision P) `(Q_dec : Decision Q) : Decision (P Q) :=
Program Instance and_dec `(P_dec : Decision P) `(Q_dec : Decision Q) :
Decision (P Q) :=
match P_dec with
| left _ => match Q_dec with left _ => left _ | right _ => right _ end
| right _ => right _
end.
Solve Obligations using (program_simpl; tauto).
Program Instance or_dec `(P_dec : Decision P) `(Q_dec : Decision Q) : Decision (P Q) :=
Program Instance or_dec `(P_dec : Decision P) `(Q_dec : Decision Q) :
Decision (P Q) :=
match P_dec with
| left _ => left _
| right _ => match Q_dec with left _ => left _ | right _ => right _ end
......@@ -48,15 +53,22 @@ Proof. unfold bool_decide. now destruct dec. Qed.
Lemma bool_decide_pack (P : Prop) {dec : Decision P} : P bool_decide P.
Proof. unfold bool_decide. now destruct dec. Qed.
Definition dsig `(P : A Prop) `{ x : A, Decision (P x)} := { x | bool_decide (P x) }.
Definition proj2_dsig `{ x : A, Decision (P x)} (x : dsig P) : P (`x) := bool_decide_unpack _ (proj2_sig x).
Definition dexist `{ x : A, Decision (P x)} (x : A) (p : P x) : dsig P := xbool_decide_pack _ p.
Definition dsig `(P : A Prop) `{ x : A, Decision (P x)} :=
{ x | bool_decide (P x) }.
Definition proj2_dsig `{ x : A, Decision (P x)} (x : dsig P) : P (`x) :=
bool_decide_unpack _ (proj2_sig x).
Definition dexist `{ x : A, Decision (P x)} (x : A) (p : P x) : dsig P :=
xbool_decide_pack _ p.
Lemma proj1_dsig_inj {A} (P : A Prop) x (Px : P x) y (Py : P y) : xPx = yPy x = y.
Lemma proj1_dsig_inj {A} (P : A Prop) x (Px : P x) y (Py : P y) :
xPx = yPy x = y.
Proof. now injection 1. Qed.
Lemma dsig_eq {A} (P : A Prop) {dec : x, Decision (P x)} (x y : { x | bool_decide (P x) }) :
`x = `y x = y.
Lemma dsig_eq {A} (P : A Prop) {dec : x, Decision (P x)}
(x y : { x | bool_decide (P x) }) : `x = `y x = y.
Proof.
intros H1. destruct x as [x Hx], y as [y Hy]. simpl in *. subst.
f_equal. revert Hx Hy. case (bool_decide (P y)). simpl. now intros [] []. easy.
intros H1. destruct x as [x Hx], y as [y Hy].
simpl in *. subst. f_equal.
revert Hx Hy. case (bool_decide (P y)).
* now intros [] [].
* easy.
Qed.
......@@ -11,9 +11,9 @@ Context `{FinCollection A C}.
Global Instance elements_proper: Proper (() ==> Permutation) elements.
Proof.
intros ?? E. apply NoDup_Permutation.
apply elements_nodup.
apply elements_nodup.
intros. now rewrite <-!elements_spec, E.
* apply elements_nodup.
* apply elements_nodup.
* intros. now rewrite <-!elements_spec, E.
Qed.
Global Instance collection_size_proper: Proper (() ==> (=)) size.
Proof. intros ?? E. apply Permutation_length. now rewrite E. Qed.
......@@ -21,8 +21,8 @@ Proof. intros ?? E. apply Permutation_length. now rewrite E. Qed.
Lemma size_empty : size = 0.
Proof.