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
This diff is collapsed.
......@@ -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.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -7,59 +7,71 @@ Context {A : Type} `{∀ x y : A, Decision (x = y)}.
Global Instance listset_elem_of: ElemOf A (listset A) := λ x l, In x (`l).
Global Instance listset_empty: Empty (listset A) := []@NoDup_nil _.
Global Instance listset_singleton: Singleton A (listset A) := λ x, [x]NoDup_singleton x.
Global Instance listset_singleton: Singleton A (listset A) := λ x,
[x]NoDup_singleton x.
Fixpoint listset_diff_raw (l k : list A) :=
Fixpoint listset_difference_raw (l k : list A) :=
match l with
| [] => []
| x :: l => if decide_rel In x k then listset_diff_raw l k else x :: listset_diff_raw l k
| x :: l =>
if decide_rel In x k
then listset_difference_raw l k
else x :: listset_difference_raw l k
end.
Lemma listset_diff_raw_in l k x : In x (listset_diff_raw l k) In x l ¬In x k.
Lemma listset_difference_raw_in l k x : In x (listset_difference_raw l k) In x l ¬In x k.
Proof. split; induction l; simpl; try case_decide; simpl; intuition congruence. Qed.
Lemma listset_diff_raw_nodup l k : NoDup l NoDup (listset_diff_raw l k).
Lemma listset_difference_raw_nodup l k : NoDup l NoDup (listset_difference_raw l k).
Proof.
induction 1; simpl; try case_decide.
constructor.
easy.
constructor. rewrite listset_diff_raw_in; intuition. easy.
* constructor.
* easy.
* constructor. rewrite listset_difference_raw_in; intuition. easy.
Qed.
Global Instance listset_diff: Difference (listset A) := λ l k,
listset_diff_raw (`l) (`k)listset_diff_raw_nodup (`l) (`k) (proj2_sig l).
Global Instance listset_difference: Difference (listset A) := λ l k,
listset_difference_raw (`l) (`k)listset_difference_raw_nodup (`l) (`k) (proj2_sig l).
Definition listset_union_raw (l k : list A) := listset_diff_raw l k ++ k.
Definition listset_union_raw (l k : list A) := listset_difference_raw l k ++ k.
Lemma listset_union_raw_in l k x : In x (listset_union_raw l k) In x l In x k.
Proof.
unfold listset_union_raw. rewrite in_app_iff, listset_diff_raw_in.
unfold listset_union_raw. rewrite in_app_iff, listset_difference_raw_in.
intuition. case (decide (In x k)); intuition.
Qed.
Lemma listset_union_raw_nodup l k : NoDup l NoDup k NoDup (listset_union_raw l k).
Proof.
intros. apply NoDup_app.
now apply listset_diff_raw_nodup.
easy.
intro. rewrite listset_diff_raw_in. intuition.
* now apply listset_difference_raw_nodup.
* easy.
* intro. rewrite listset_difference_raw_in. intuition.
Qed.
Global Instance listset_union: Union (listset A) := λ l k,
listset_union_raw (`l) (`k)listset_union_raw_nodup (`l) (`k) (proj2_sig l) (proj2_sig k).
Fixpoint listset_inter_raw (l k : list A) :=
Fixpoint listset_intersection_raw (l k : list A) :=
match l with
| [] => []
| x :: l => if decide_rel In x k then x :: listset_inter_raw l k else listset_inter_raw l k
| x :: l =>
if decide_rel In x k
then x :: listset_intersection_raw l k
else listset_intersection_raw l k
end.
Lemma listset_inter_raw_in l k x : In x (listset_inter_raw l k) In x l In x k.
Proof. split; induction l; simpl; try case_decide; simpl; intuition congruence. Qed.
Lemma listset_inter_raw_nodup l k : NoDup l NoDup (listset_inter_raw l k).
Lemma listset_intersection_raw_in l k x :
In x (listset_intersection_raw l k) In x l In x k.
Proof.
split; induction l; simpl; try case_decide; simpl; intuition congruence.
Qed.
Lemma listset_intersection_raw_nodup l k :
NoDup l NoDup (listset_intersection_raw l k).
Proof.
induction 1; simpl; try case_decide.
constructor.
constructor. rewrite listset_inter_raw_in; intuition. easy.
easy.
* constructor.
* constructor. rewrite listset_intersection_raw_in; intuition. easy.
* easy.
Qed.
Global Instance listset_inter: Intersection (listset A) := λ l k,
listset_inter_raw (`l) (`k)listset_inter_raw_nodup (`l) (`k) (proj2_sig l).
Global Instance listset_intersection: Intersection (listset A) := λ l k,
listset_intersection_raw (`l) (`k)listset_intersection_raw_nodup (`l) (`k) (proj2_sig l).
Definition listset_add_raw x (l : list A) : list A := if decide_rel In x l then l else x :: l.
Definition listset_add_raw x (l : list A) : list A :=
if decide_rel In x l then l else x :: l.
Lemma listset_add_raw_in x l y : In y (listset_add_raw x l) y = x In y l.
Proof. unfold listset_add_raw. case (decide_rel _); firstorder congruence. Qed.
Lemma listset_add_raw_nodup x l : NoDup l NoDup (listset_add_raw x l).
......@@ -75,9 +87,10 @@ Proof. induction l; simpl. constructor. now apply listset_add_raw_nodup. Qed.
Lemma listset_map_raw_in f l x : In x (listset_map_raw f l) y, x = f y In y l.
Proof.
split.
induction l; simpl. easy. rewrite listset_add_raw_in. firstorder.
intros [?[??]]. subst. induction l; simpl in *. easy.
rewrite listset_add_raw_in. firstorder congruence.
* induction l; simpl; [easy |].
rewrite listset_add_raw_in. firstorder.
* intros [?[??]]. subst. induction l; simpl in *; [easy |].
rewrite listset_add_raw_in. firstorder congruence.
Qed.
Global Instance listset_map: Map A (listset A) := λ f l,
listset_map_raw f (`l)listset_map_raw_nodup f (`l).
......@@ -85,12 +98,12 @@ Global Instance listset_map: Map A (listset A) := λ f l,
Global Instance: Collection A (listset A).
Proof.
split.
easy.
compute. intuition.
intros. apply listset_union_raw_in.
intros. apply listset_inter_raw_in.
intros. apply listset_diff_raw_in.
intros. apply listset_map_raw_in.
* easy.
* compute. intuition.
* intros. apply listset_union_raw_in.
* intros. apply listset_intersection_raw_in.
* intros. apply listset_difference_raw_in.
* intros. apply listset_map_raw_in.
Qed.
Global Instance listset_elems: Elements A (listset A) := @proj1_sig _ _.
......
......@@ -15,5 +15,6 @@ 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.
......@@ -23,7 +23,7 @@ Global Instance Npartial_alter: PartialAlter N Nmap := λ A f i t,
end.
Global Instance Ndom {A} : Dom N (Nmap A) := λ A _ _ _ t,
match t with
| Build_Nmap o t => option_case (λ _, {{ 0 }}) o (Pdom_raw Npos (`t))
| Build_Nmap o t => option_case (λ _, {[ 0 ]}) o (Pdom_raw Npos (`t))
end.
Global Instance Nmerge: Merge Nmap := λ A f t1 t2,
match t1, t2 with
......@@ -37,16 +37,20 @@ Global Instance Nfmap: FMap Nmap := λ A B f t,
Global Instance: FinMap N Nmap.
Proof.
split.
intros ? [??] [??] H. f_equal.
now apply (H 0).
apply finmap_eq. intros i. now apply (H (Npos i)).
now intros ? [|?].
intros ? f [? t] [|i]. easy. now apply (lookup_partial_alter f t i).
intros ? f [? t] [|i] [|j]; try intuition congruence.
intros. apply (lookup_partial_alter_ne f t i j). congruence.
intros ??? [??] []. easy. apply lookup_fmap.
intros ?? ???????? [o t] n; unfold dom, lookup, Ndom, Nlookup; simpl.
rewrite elem_of_union, Plookup_raw_dom.
destruct o, n; esimplify_elem_of (simplify_is_Some; eauto).
intros ? f ? [o1 t1] [o2 t2] [|?]. easy. apply (merge_spec f t1 t2).
* intros ? [??] [??] H. f_equal.
+ now apply (H 0).
+ apply finmap_eq. intros i. now apply (H (Npos i)).
* now intros ? [|?].
* intros ? f [? t] [|i].
+ easy.
+ now apply (lookup_partial_alter f t i).
* intros ? f [? t] [|i] [|j]; try intuition congruence.
intros. apply (lookup_partial_alter_ne f t i j). congruence.
* intros ??? [??] []. easy. apply lookup_fmap.
* intros ?? ???????? [o t] n; unfold dom, lookup, Ndom, Nlookup; simpl.
rewrite elem_of_union, Plookup_raw_dom.
destruct o, n; esimplify_elem_of (simplify_is_Some; eauto).
* intros ? f ? [o1 t1] [o2 t2] [|?].
+ easy.
+ apply (merge_spec f t1 t2).
Qed.
Require Export PArith NArith ZArith.
Require Export base decidable fin_collections.
Infix "≤" := le : nat_scope.
Instance nat_eq_dec: x y : nat, Decision (x = y) := eq_nat_dec.
Instance positive_eq_dec: x y : positive, Decision (x = y) := Pos.eq_dec.
Notation "(~0)" := xO (only parsing) : positive_scope.
......@@ -41,18 +43,19 @@ Lemma Nmax_max `{FinCollection N C} X x : x ∈ X → (x ≤ Nmax X)%N.
Proof.
change ((λ b X, x X (x b)%N) (collection_fold N.max 0%N X) X).
apply collection_fold_ind.
solve_proper.
simplify_elem_of.
simplify_elem_of. apply N.le_max_l. apply N.max_le_iff; auto.
* solve_proper.
* simplify_elem_of.
* simplify_elem_of. apply N.le_max_l. apply N.max_le_iff; auto.
Qed.
Instance Nfresh `{FinCollection N C} : Fresh N C := λ l, (1 + Nmax l)%N.
Instance Nfresh_spec `{FinCollection N C} : FreshSpec N C.
Proof.
split.
intros. unfold fresh, Nfresh.
setoid_replace X with Y; esimplify_elem_of.
intros X E. assert (1 0)%N as []; [| easy].
apply N.add_le_mono_r with (Nmax X).
now apply Nmax_max.
* intros. unfold fresh, Nfresh.
setoid_replace X with Y; [easy |].
now apply elem_of_equiv.
* intros X E. assert (1 0)%N as []; [| easy].
apply N.add_le_mono_r with (Nmax X).
now apply Nmax_max.
Qed.
......@@ -6,7 +6,7 @@ Lemma Some_ne_None `(a : A) : Some a ≠ None.
Proof. congruence. Qed.
Lemma eq_None_ne_Some `(x : option A) a : x = None x Some a.
Proof. congruence. Qed.
Lemma Some_inj {A} (a b : A) : Some a = Some b a = b.
Instance Some_inj {A} : Injective (=) (=) (@Some A).
Proof. congruence. Qed.
Definition option_case {A B} (f : A B) (b : B) (x : option A) :=
......@@ -15,26 +15,33 @@ Definition option_case {A B} (f : A → B) (b : B) (x : option A) :=
| Some a => f a
end.
Definition maybe {A} (a : A) (x : option A) :=
match x with
| None => a
| Some a => a
end.
Lemma option_eq {A} (x y : option A) :
x = y a, x = Some a y = Some a.
Proof.
split.
intros. now subst.
intros E. destruct x, y.
now apply E.
symmetry. now apply E.
now apply E.
easy.
* intros. now subst.
* intros E. destruct x, y.
+ now apply E.
+ symmetry. now apply E.
+ now apply E.
+ easy.
Qed.
Definition is_Some `(x : option A) := a, x = Some a.
Hint Extern 10 (is_Some _) => solve [eexists; eauto].
Ltac simplify_is_Some := repeat intro; repeat (
Ltac simplify_is_Some := repeat intro; repeat
match goal with
| _ => progress simplify_eqs
| H : is_Some _ |- _ => destruct H as [??]
| |- is_Some _ => eauto
end || simplify_eqs).
end.
Lemma Some_is_Some `(a : A) : is_Some (Some a).
Proof. simplify_is_Some. Qed.
......@@ -56,14 +63,15 @@ Lemma make_eq_Some {A} (x : option A) a :
is_Some x ( b, x = Some b b = a) x = Some a.
Proof. intros [??] H. subst. f_equal. auto. Qed.
Instance option_eq_dec `{dec : x y : A, Decision (x = y)} (x y : option A) : Decision (x = y) :=
Instance option_eq_dec `{dec : x y : A, Decision (x = y)} (x y : option A) :
Decision (x = y) :=
match x with
| Some a =>
match y with
| Some b =>
match dec a b with
| left H => left (f_equal _ H)
| right H => right (H Some_inj _ _)
| right H => right (H injective Some _ _)
end
| None => right (Some_ne_None _)
end
......@@ -87,7 +95,8 @@ Ltac option_lift_inv := repeat
Lemma option_lift_inv_Some `(P : A Prop) x : option_lift P (Some x) P x.
Proof. intros. now option_lift_inv. Qed.
Definition option_lift_sig `(P : A Prop) (x : option A) : option_lift P x option (sig P) :=
Definition option_lift_sig `(P : A Prop) (x : option A) :
option_lift P x option (sig P) :=
match x with
| Some a => λ p, Some (exist _ a (option_lift_inv_Some P a p))
| None => λ _, None
......@@ -104,16 +113,16 @@ Lemma option_lift_dsig_Some `(P : A → Prop) `{∀ x : A, Decision (P x)} x y p
option_lift_dsig P x px = Some (ypy) x = Some y.
Proof.
split.
destruct x; simpl; intros; now simplify_eqs.
intros. subst. simpl. f_equal. now apply dsig_eq.
* destruct x; simpl; intros; now simplify_eqs.
* intros. subst. simpl. f_equal. now apply dsig_eq.
Qed.
Lemma option_lift_dsig_is_Some `(P : A Prop) `{ x : A, Decision (P x)} x px :
is_Some (option_lift_dsig P x px) is_Some x.
Proof.
split.
intros [[??] ?]. eapply is_Some_2, option_lift_dsig_Some; eauto.
intros [??]. subst. eapply is_Some_2. reflexivity.
* intros [[??] ?]. eapply is_Some_2, option_lift_dsig_Some; eauto.
* intros [??]. subst. eapply is_Some_2. reflexivity.
Qed.
Instance option_ret: MRet option := @Some.
......@@ -141,9 +150,11 @@ Ltac simplify_options := repeat
simpl
end.
Lemma option_fmap_is_Some {A B} (f : A B) (x : option A) : is_Some x is_Some (f <$> x).
Lemma option_fmap_is_Some {A B} (f : A B) (x : option A) :
is_Some x is_Some (f <$> x).
Proof. destruct x; split; intros [??]; subst; compute; eauto; discriminate. Qed.
Lemma option_fmap_is_None {A B} (f : A B) (x : option A) : x = None f <$> x = None.
Lemma option_fmap_is_None {A B} (f : A B) (x : option A) :
x = None f <$> x = None.
Proof. unfold fmap, option_fmap. destruct x; simpl; split; congruence. Qed.
Instance option_union: UnionWith option := λ A f x y,
......@@ -153,13 +164,19 @@ Instance option_union: UnionWith option := λ A f x y,
| None, Some b => Some b
| None, None => None
end.