Commit 07d525a0 authored by Robbert Krebbers's avatar Robbert Krebbers

COFE distance is no longer trivial at index 0.

This way we avoid many one-off indexes and no longer need special cases for
index 0 in many definitions. For example, the definition of the distance
relation on option and excl has become much easier. Also, uPreds no longer need
to hold at index 0.

In order to make this change possible, we had to change the notions of
"contractive functions" and "chains" slightly.

Thanks to Aleš Bizjak and Amin Timany for suggesting this change and to help
with the proofs.
parent 7f8d960d
...@@ -5,10 +5,9 @@ Local Hint Extern 10 (_ ≤ _) => omega. ...@@ -5,10 +5,9 @@ Local Hint Extern 10 (_ ≤ _) => omega.
Record agree (A : Type) : Type := Agree { Record agree (A : Type) : Type := Agree {
agree_car :> nat A; agree_car :> nat A;
agree_is_valid : nat Prop; agree_is_valid : nat Prop;
agree_valid_0 : agree_is_valid 0;
agree_valid_S n : agree_is_valid (S n) agree_is_valid n agree_valid_S n : agree_is_valid (S n) agree_is_valid n
}. }.
Arguments Agree {_} _ _ _ _. Arguments Agree {_} _ _ _.
Arguments agree_car {_} _ _. Arguments agree_car {_} _ _.
Arguments agree_is_valid {_} _ _. Arguments agree_is_valid {_} _ _.
...@@ -27,10 +26,9 @@ Instance agree_dist : Dist (agree A) := λ n x y, ...@@ -27,10 +26,9 @@ Instance agree_dist : Dist (agree A) := λ n x y,
( n', n' n agree_is_valid x n' agree_is_valid y n') ( n', n' n agree_is_valid x n' agree_is_valid y n')
( n', n' n agree_is_valid x n' x n' {n'} y n'). ( n', n' n agree_is_valid x n' x n' {n'} y n').
Program Instance agree_compl : Compl (agree A) := λ c, Program Instance agree_compl : Compl (agree A) := λ c,
{| agree_car n := c n n; agree_is_valid n := agree_is_valid (c n) n |}. {| agree_car n := c (S n) n; agree_is_valid n := agree_is_valid (c (S n)) n |}.
Next Obligation. intros; apply agree_valid_0. Qed.
Next Obligation. Next Obligation.
intros c n ?; apply (chain_cauchy c n (S n)), agree_valid_S; auto. intros c n ?. apply (chain_cauchy c n (S (S n))), agree_valid_S; auto.
Qed. Qed.
Definition agree_cofe_mixin : CofeMixin (agree A). Definition agree_cofe_mixin : CofeMixin (agree A).
Proof. Proof.
...@@ -45,9 +43,8 @@ Proof. ...@@ -45,9 +43,8 @@ Proof.
- transitivity (agree_is_valid y n'). by apply Hxy. by apply Hyz. - transitivity (agree_is_valid y n'). by apply Hxy. by apply Hyz.
- transitivity (y n'). by apply Hxy. by apply Hyz, Hxy. - transitivity (y n'). by apply Hxy. by apply Hyz, Hxy.
* intros n x y Hxy; split; intros; apply Hxy; auto. * intros n x y Hxy; split; intros; apply Hxy; auto.
* intros x y; split; intros n'; rewrite Nat.le_0_r; intros ->; [|done]. * intros c n; apply and_wlog_r; intros;
by split; intros; apply agree_valid_0. symmetry; apply (chain_cauchy c); naive_solver.
* by intros c n; split; intros; apply (chain_cauchy c).
Qed. Qed.
Canonical Structure agreeC := CofeT agree_cofe_mixin. Canonical Structure agreeC := CofeT agree_cofe_mixin.
...@@ -59,7 +56,6 @@ Proof. by intros [? Hx]; apply Hx. Qed. ...@@ -59,7 +56,6 @@ Proof. by intros [? Hx]; apply Hx. Qed.
Program Instance agree_op : Op (agree A) := λ x y, Program Instance agree_op : Op (agree A) := λ x y,
{| agree_car := x; {| agree_car := x;
agree_is_valid n := agree_is_valid x n agree_is_valid y n x {n} y |}. agree_is_valid n := agree_is_valid x n agree_is_valid y n x {n} y |}.
Next Obligation. by intros; simpl; split_ands; try apply agree_valid_0. Qed.
Next Obligation. naive_solver eauto using agree_valid_S, dist_S. Qed. Next Obligation. naive_solver eauto using agree_valid_S, dist_S. Qed.
Instance agree_unit : Unit (agree A) := id. Instance agree_unit : Unit (agree A) := id.
Instance agree_minus : Minus (agree A) := λ x y, x. Instance agree_minus : Minus (agree A) := λ x y, x.
...@@ -100,8 +96,6 @@ Definition agree_cmra_mixin : CMRAMixin (agree A). ...@@ -100,8 +96,6 @@ Definition agree_cmra_mixin : CMRAMixin (agree A).
Proof. Proof.
split; try (apply _ || done). split; try (apply _ || done).
* by intros n x1 x2 Hx y1 y2 Hy. * by intros n x1 x2 Hx y1 y2 Hy.
* intros x; split; [apply agree_valid_0|].
by intros n'; rewrite Nat.le_0_r; intros ->.
* intros n x [? Hx]; split; [by apply agree_valid_S|intros n' ?]. * intros n x [? Hx]; split; [by apply agree_valid_S|intros n' ?].
rewrite (Hx n'); last auto. rewrite (Hx n'); last auto.
symmetry; apply dist_le with n; try apply Hx; auto. symmetry; apply dist_le with n; try apply Hx; auto.
...@@ -142,7 +136,7 @@ Arguments agreeRA : clear implicits. ...@@ -142,7 +136,7 @@ Arguments agreeRA : clear implicits.
Program Definition agree_map {A B} (f : A B) (x : agree A) : agree B := Program Definition agree_map {A B} (f : A B) (x : agree A) : agree B :=
{| agree_car n := f (x n); agree_is_valid := agree_is_valid x |}. {| agree_car n := f (x n); agree_is_valid := agree_is_valid x |}.
Solve Obligations with auto using agree_valid_0, agree_valid_S. Solve Obligations with auto using agree_valid_S.
Lemma agree_map_id {A} (x : agree A) : agree_map id x = x. Lemma agree_map_id {A} (x : agree A) : agree_map id x = x.
Proof. by destruct x. Qed. Proof. by destruct x. Qed.
Lemma agree_map_compose {A B C} (f : A B) (g : B C) (x : agree A) : Lemma agree_map_compose {A B C} (f : A B) (g : B C) (x : agree A) :
...@@ -179,4 +173,3 @@ Qed. ...@@ -179,4 +173,3 @@ Qed.
Program Definition agreeF : iFunctor := Program Definition agreeF : iFunctor :=
{| ifunctor_car := agreeRA; ifunctor_map := @agreeC_map |}. {| ifunctor_car := agreeRA; ifunctor_map := @agreeC_map |}.
Solve Obligations with done. Solve Obligations with done.
...@@ -46,7 +46,6 @@ Proof. ...@@ -46,7 +46,6 @@ Proof.
+ by intros ?? [??]; split; symmetry. + by intros ?? [??]; split; symmetry.
+ intros ??? [??] [??]; split; etransitivity; eauto. + intros ??? [??] [??]; split; etransitivity; eauto.
* by intros ? [??] [??] [??]; split; apply dist_S. * by intros ? [??] [??] [??]; split; apply dist_S.
* by split.
* intros c n; split. apply (conv_compl (chain_map authoritative c) n). * intros c n; split. apply (conv_compl (chain_map authoritative c) n).
apply (conv_compl (chain_map own c) n). apply (conv_compl (chain_map own c) n).
Qed. Qed.
...@@ -71,7 +70,7 @@ Instance auth_validN : ValidN (auth A) := λ n x, ...@@ -71,7 +70,7 @@ Instance auth_validN : ValidN (auth A) := λ n x,
match authoritative x with match authoritative x with
| Excl a => own x {n} a {n} a | Excl a => own x {n} a {n} a
| ExclUnit => {n} (own x) | ExclUnit => {n} (own x)
| ExclBot => n = 0 | ExclBot => False
end. end.
Global Arguments auth_validN _ !_ /. Global Arguments auth_validN _ !_ /.
Instance auth_unit : Unit (auth A) := λ x, Instance auth_unit : Unit (auth A) := λ x,
...@@ -103,10 +102,9 @@ Proof. ...@@ -103,10 +102,9 @@ Proof.
* by intros n x y1 y2 [Hy Hy']; split; simpl; rewrite ?Hy ?Hy'. * by intros n x y1 y2 [Hy Hy']; split; simpl; rewrite ?Hy ?Hy'.
* by intros n y1 y2 [Hy Hy']; split; simpl; rewrite ?Hy ?Hy'. * by intros n y1 y2 [Hy Hy']; split; simpl; rewrite ?Hy ?Hy'.
* intros n [x a] [y b] [Hx Ha]; simpl in *; * intros n [x a] [y b] [Hx Ha]; simpl in *;
destruct Hx as [[][]| | |]; intros ?; cofe_subst; auto. destruct Hx; intros ?; cofe_subst; auto.
* by intros n x1 x2 [Hx Hx'] y1 y2 [Hy Hy']; * by intros n x1 x2 [Hx Hx'] y1 y2 [Hy Hy'];
split; simpl; rewrite ?Hy ?Hy' ?Hx ?Hx'. split; simpl; rewrite ?Hy ?Hy' ?Hx ?Hx'.
* by intros [[] ?]; simpl.
* intros n [[] ?] ?; naive_solver eauto using cmra_includedN_S, cmra_validN_S. * intros n [[] ?] ?; naive_solver eauto using cmra_includedN_S, cmra_validN_S.
* by split; simpl; rewrite associative. * by split; simpl; rewrite associative.
* by split; simpl; rewrite commutative. * by split; simpl; rewrite commutative.
...@@ -150,7 +148,7 @@ Lemma auth_both_op a b : Auth (Excl a) b ≡ ● a ⋅ ◯ b. ...@@ -150,7 +148,7 @@ Lemma auth_both_op a b : Auth (Excl a) b ≡ ● a ⋅ ◯ b.
Proof. by rewrite /op /auth_op /= left_id. Qed. Proof. by rewrite /op /auth_op /= left_id. Qed.
Lemma auth_update a a' b b' : Lemma auth_update a a' b b' :
( n af, {S n} a a {S n} a' af b {S n} b' af {S n} b) ( n af, {n} a a {n} a' af b {n} b' af {n} b)
a a' ~~> b b'. a a' ~~> b b'.
Proof. Proof.
move=> Hab [[?| |] bf1] n // =>-[[bf2 Ha] ?]; do 2 red; simpl in *. move=> Hab [[?| |] bf1] n // =>-[[bf2 Ha] ?]; do 2 red; simpl in *.
...@@ -216,4 +214,3 @@ Next Obligation. ...@@ -216,4 +214,3 @@ Next Obligation.
intros Σ A B C f g x. rewrite /= -auth_map_compose. intros Σ A B C f g x. rewrite /= -auth_map_compose.
apply auth_map_ext=>y; apply ifunctor_map_compose. apply auth_map_ext=>y; apply ifunctor_map_compose.
Qed. Qed.
...@@ -40,7 +40,6 @@ Record CMRAMixin A `{Dist A, Equiv A, Unit A, Op A, ValidN A, Minus A} := { ...@@ -40,7 +40,6 @@ Record CMRAMixin A `{Dist A, Equiv A, Unit A, Op A, ValidN A, Minus A} := {
mixin_cmra_validN_ne n : Proper (dist n ==> impl) ({n}); mixin_cmra_validN_ne n : Proper (dist n ==> impl) ({n});
mixin_cmra_minus_ne n : Proper (dist n ==> dist n ==> dist n) minus; mixin_cmra_minus_ne n : Proper (dist n ==> dist n ==> dist n) minus;
(* valid *) (* valid *)
mixin_cmra_validN_0 x : {0} x;
mixin_cmra_validN_S n x : {S n} x {n} x; mixin_cmra_validN_S n x : {S n} x {n} x;
(* monoid *) (* monoid *)
mixin_cmra_associative : Associative () (); mixin_cmra_associative : Associative () ();
...@@ -99,8 +98,6 @@ Section cmra_mixin. ...@@ -99,8 +98,6 @@ Section cmra_mixin.
Global Instance cmra_minus_ne n : Global Instance cmra_minus_ne n :
Proper (dist n ==> dist n ==> dist n) (@minus A _). Proper (dist n ==> dist n ==> dist n) (@minus A _).
Proof. apply (mixin_cmra_minus_ne _ (cmra_mixin A)). Qed. Proof. apply (mixin_cmra_minus_ne _ (cmra_mixin A)). Qed.
Lemma cmra_validN_0 x : {0} x.
Proof. apply (mixin_cmra_validN_0 _ (cmra_mixin A)). Qed.
Lemma cmra_validN_S n x : {S n} x {n} x. Lemma cmra_validN_S n x : {S n} x {n} x.
Proof. apply (mixin_cmra_validN_S _ (cmra_mixin A)). Qed. Proof. apply (mixin_cmra_validN_S _ (cmra_mixin A)). Qed.
Global Instance cmra_associative : Associative () (@op A _). Global Instance cmra_associative : Associative () (@op A _).
...@@ -123,8 +120,6 @@ Section cmra_mixin. ...@@ -123,8 +120,6 @@ Section cmra_mixin.
Proof. apply (cmra_extend_mixin A). Qed. Proof. apply (cmra_extend_mixin A). Qed.
End cmra_mixin. End cmra_mixin.
Hint Extern 0 ({0} _) => apply cmra_validN_0.
(** * CMRAs with a global identity element *) (** * CMRAs with a global identity element *)
(** We use the notation ∅ because for most instances (maps, sets, etc) the (** We use the notation ∅ because for most instances (maps, sets, etc) the
`empty' element is the global identity. *) `empty' element is the global identity. *)
...@@ -142,11 +137,11 @@ Class CMRAMonotone {A B : cmraT} (f : A → B) := { ...@@ -142,11 +137,11 @@ Class CMRAMonotone {A B : cmraT} (f : A → B) := {
(** * Frame preserving updates *) (** * Frame preserving updates *)
Definition cmra_updateP {A : cmraT} (x : A) (P : A Prop) := z n, Definition cmra_updateP {A : cmraT} (x : A) (P : A Prop) := z n,
{S n} (x z) y, P y {S n} (y z). {n} (x z) y, P y {n} (y z).
Instance: Params (@cmra_updateP) 1. Instance: Params (@cmra_updateP) 1.
Infix "~~>:" := cmra_updateP (at level 70). Infix "~~>:" := cmra_updateP (at level 70).
Definition cmra_update {A : cmraT} (x y : A) := z n, Definition cmra_update {A : cmraT} (x y : A) := z n,
{S n} (x z) {S n} (y z). {n} (x z) {n} (y z).
Infix "~~>" := cmra_update (at level 70). Infix "~~>" := cmra_update (at level 70).
Instance: Params (@cmra_update) 1. Instance: Params (@cmra_update) 1.
...@@ -251,8 +246,6 @@ Proof. intros Hyv [z ?]; cofe_subst y; eauto using cmra_validN_op_l. Qed. ...@@ -251,8 +246,6 @@ Proof. intros Hyv [z ?]; cofe_subst y; eauto using cmra_validN_op_l. Qed.
Lemma cmra_validN_included x y n : {n} y x y {n} x. Lemma cmra_validN_included x y n : {n} y x y {n} x.
Proof. rewrite cmra_included_includedN; eauto using cmra_validN_includedN. Qed. Proof. rewrite cmra_included_includedN; eauto using cmra_validN_includedN. Qed.
Lemma cmra_includedN_0 x y : x {0} y.
Proof. by exists (unit x). Qed.
Lemma cmra_includedN_S x y n : x {S n} y x {n} y. Lemma cmra_includedN_S x y n : x {S n} y x {n} y.
Proof. by intros [z Hz]; exists z; apply dist_S. Qed. Proof. by intros [z Hz]; exists z; apply dist_S. Qed.
Lemma cmra_includedN_le x y n n' : x {n} y n' n x {n'} y. Lemma cmra_includedN_le x y n n' : x {n} y n' n x {n'} y.
...@@ -290,19 +283,19 @@ Proof. ...@@ -290,19 +283,19 @@ Proof.
Qed. Qed.
(** ** Timeless *) (** ** Timeless *)
Lemma cmra_timeless_included_l x y : Timeless x {1} y x {1} y x y. Lemma cmra_timeless_included_l x y : Timeless x {0} y x {0} y x y.
Proof. Proof.
intros ?? [x' ?]. intros ?? [x' ?].
destruct (cmra_extend_op 1 y x x') as ([z z']&Hy&Hz&Hz'); auto; simpl in *. destruct (cmra_extend_op 0 y x x') as ([z z']&Hy&Hz&Hz'); auto; simpl in *.
by exists z'; rewrite Hy (timeless x z). by exists z'; rewrite Hy (timeless x z).
Qed. Qed.
Lemma cmra_timeless_included_r n x y : Timeless y x {1} y x {n} y. Lemma cmra_timeless_included_r n x y : Timeless y x {0} y x {n} y.
Proof. intros ? [x' ?]. exists x'. by apply equiv_dist, (timeless y). Qed. Proof. intros ? [x' ?]. exists x'. by apply equiv_dist, (timeless y). Qed.
Lemma cmra_op_timeless x1 x2 : Lemma cmra_op_timeless x1 x2 :
(x1 x2) Timeless x1 Timeless x2 Timeless (x1 x2). (x1 x2) Timeless x1 Timeless x2 Timeless (x1 x2).
Proof. Proof.
intros ??? z Hz. intros ??? z Hz.
destruct (cmra_extend_op 1 z x1 x2) as ([y1 y2]&Hz'&?&?); auto; simpl in *. destruct (cmra_extend_op 0 z x1 x2) as ([y1 y2]&Hz'&?&?); auto; simpl in *.
{ by rewrite -?Hz. } { by rewrite -?Hz. }
by rewrite Hz' (timeless x1 y1) // (timeless x2 y2). by rewrite Hz' (timeless x1 y1) // (timeless x2 y2).
Qed. Qed.
...@@ -370,8 +363,6 @@ Section identity_updates. ...@@ -370,8 +363,6 @@ Section identity_updates.
End identity_updates. End identity_updates.
End cmra. End cmra.
Hint Extern 0 (_ {0} _) => apply cmra_includedN_0.
(** * Properties about monotone functions *) (** * Properties about monotone functions *)
Instance cmra_monotone_id {A : cmraT} : CMRAMonotone (@id A). Instance cmra_monotone_id {A : cmraT} : CMRAMonotone (@id A).
Proof. by split. Qed. Proof. by split. Qed.
...@@ -444,22 +435,16 @@ Section discrete. ...@@ -444,22 +435,16 @@ Section discrete.
Context {A : cofeT} `{ x : A, Timeless x}. Context {A : cofeT} `{ x : A, Timeless x}.
Context `{Unit A, Op A, Valid A, Minus A} (ra : RA A). Context `{Unit A, Op A, Valid A, Minus A} (ra : RA A).
Instance discrete_validN : ValidN A := λ n x, Instance discrete_validN : ValidN A := λ n x, x.
match n with 0 => True | S n => x end.
Definition discrete_cmra_mixin : CMRAMixin A. Definition discrete_cmra_mixin : CMRAMixin A.
Proof. Proof.
destruct ra; split; unfold Proper, respectful, includedN; by destruct ra; split; unfold Proper, respectful, includedN;
repeat match goal with try setoid_rewrite <-(timeless_iff _ _ _ _).
| |- n : nat, _ => intros [|?]
end; try setoid_rewrite <-(timeless_S _ _ _ _); try done.
by intros x y ?; exists x.
Qed. Qed.
Definition discrete_extend_mixin : CMRAExtendMixin A. Definition discrete_extend_mixin : CMRAExtendMixin A.
Proof. Proof.
intros [|n] x y1 y2 ??. intros n x y1 y2 ??; exists (y1,y2); split_ands; auto.
* by exists (unit x, x); rewrite /= ra_unit_l. apply (timeless _), dist_le with n; auto with lia.
* exists (y1,y2); split_ands; auto.
apply (timeless _), dist_le with (S n); auto with lia.
Qed. Qed.
Definition discreteRA : cmraT := Definition discreteRA : cmraT :=
CMRAT (cofe_mixin A) discrete_cmra_mixin discrete_extend_mixin. CMRAT (cofe_mixin A) discrete_cmra_mixin discrete_extend_mixin.
...@@ -512,7 +497,6 @@ Section prod. ...@@ -512,7 +497,6 @@ Section prod.
* by intros n y1 y2 [Hy1 Hy2] [??]; split; rewrite /= -?Hy1 -?Hy2. * by intros n y1 y2 [Hy1 Hy2] [??]; split; rewrite /= -?Hy1 -?Hy2.
* by intros n x1 x2 [Hx1 Hx2] y1 y2 [Hy1 Hy2]; * by intros n x1 x2 [Hx1 Hx2] y1 y2 [Hy1 Hy2];
split; rewrite /= ?Hx1 ?Hx2 ?Hy1 ?Hy2. split; rewrite /= ?Hx1 ?Hx2 ?Hy1 ?Hy2.
* by split.
* by intros n x [??]; split; apply cmra_validN_S. * by intros n x [??]; split; apply cmra_validN_S.
* split; simpl; apply (associative _). * split; simpl; apply (associative _).
* split; simpl; apply (commutative _). * split; simpl; apply (commutative _).
......
...@@ -23,7 +23,7 @@ Tactic Notation "cofe_subst" := ...@@ -23,7 +23,7 @@ Tactic Notation "cofe_subst" :=
Record chain (A : Type) `{Dist A} := { Record chain (A : Type) `{Dist A} := {
chain_car :> nat A; chain_car :> nat A;
chain_cauchy n i : n i chain_car n {n} chain_car i chain_cauchy n i : n < i chain_car i {n} chain_car (S n)
}. }.
Arguments chain_car {_ _} _ _. Arguments chain_car {_ _} _ _.
Arguments chain_cauchy {_ _} _ _ _ _. Arguments chain_cauchy {_ _} _ _ _ _.
...@@ -33,11 +33,10 @@ Record CofeMixin A `{Equiv A, Compl A} := { ...@@ -33,11 +33,10 @@ Record CofeMixin A `{Equiv A, Compl A} := {
mixin_equiv_dist x y : x y n, x {n} y; mixin_equiv_dist x y : x y n, x {n} y;
mixin_dist_equivalence n : Equivalence (dist n); mixin_dist_equivalence n : Equivalence (dist n);
mixin_dist_S n x y : x {S n} y x {n} y; mixin_dist_S n x y : x {S n} y x {n} y;
mixin_dist_0 x y : x {0} y; mixin_conv_compl (c : chain A) n : compl c {n} c (S n)
mixin_conv_compl (c : chain A) n : compl c {n} c n
}. }.
Class Contractive `{Dist A, Dist B} (f : A -> B) := Class Contractive `{Dist A, Dist B} (f : A -> B) :=
contractive n : Proper (dist n ==> dist (S n)) f. contractive n x y : ( i, i < n x {i} y) f x {n} f y.
(** Bundeled version *) (** Bundeled version *)
Structure cofeT := CofeT { Structure cofeT := CofeT {
...@@ -66,14 +65,10 @@ Section cofe_mixin. ...@@ -66,14 +65,10 @@ Section cofe_mixin.
Proof. apply (mixin_dist_equivalence _ (cofe_mixin A)). Qed. Proof. apply (mixin_dist_equivalence _ (cofe_mixin A)). Qed.
Lemma dist_S n x y : x {S n} y x {n} y. Lemma dist_S n x y : x {S n} y x {n} y.
Proof. apply (mixin_dist_S _ (cofe_mixin A)). Qed. Proof. apply (mixin_dist_S _ (cofe_mixin A)). Qed.
Lemma dist_0 x y : x {0} y. Lemma conv_compl (c : chain A) n : compl c {n} c (S n).
Proof. apply (mixin_dist_0 _ (cofe_mixin A)). Qed.
Lemma conv_compl (c : chain A) n : compl c {n} c n.
Proof. apply (mixin_conv_compl _ (cofe_mixin A)). Qed. Proof. apply (mixin_conv_compl _ (cofe_mixin A)). Qed.
End cofe_mixin. End cofe_mixin.
Hint Extern 0 (_ {0} _) => apply dist_0.
(** General properties *) (** General properties *)
Section cofe. Section cofe.
Context {A : cofeT}. Context {A : cofeT}.
...@@ -109,13 +104,12 @@ Section cofe. ...@@ -109,13 +104,12 @@ Section cofe.
unfold Proper, respectful; setoid_rewrite equiv_dist. unfold Proper, respectful; setoid_rewrite equiv_dist.
by intros x1 x2 Hx y1 y2 Hy n; rewrite (Hx n) (Hy n). by intros x1 x2 Hx y1 y2 Hy n; rewrite (Hx n) (Hy n).
Qed. Qed.
Lemma compl_ne (c1 c2: chain A) n : c1 n {n} c2 n compl c1 {n} compl c2. Lemma contractive_S {B : cofeT} {f : A B} `{!Contractive f} n x y :
Proof. intros. by rewrite (conv_compl c1 n) (conv_compl c2 n). Qed. x {n} y f x {S n} f y.
Lemma compl_ext (c1 c2 : chain A) : ( i, c1 i c2 i) compl c1 compl c2. Proof. eauto using contractive, dist_le with omega. Qed.
Proof. setoid_rewrite equiv_dist; naive_solver eauto using compl_ne. Qed.
Global Instance contractive_ne {B : cofeT} (f : A B) `{!Contractive f} n : Global Instance contractive_ne {B : cofeT} (f : A B) `{!Contractive f} n :
Proper (dist n ==> dist n) f | 100. Proper (dist n ==> dist n) f | 100.
Proof. by intros x1 x2 ?; apply dist_S, contractive. Qed. Proof. by intros x y ?; apply dist_S, contractive_S. Qed.
Global Instance contractive_proper {B : cofeT} (f : A B) `{!Contractive f} : Global Instance contractive_proper {B : cofeT} (f : A B) `{!Contractive f} :
Proper (() ==> ()) f | 100 := _. Proper (() ==> ()) f | 100 := _.
End cofe. End cofe.
...@@ -127,20 +121,21 @@ Program Definition chain_map `{Dist A, Dist B} (f : A → B) ...@@ -127,20 +121,21 @@ Program Definition chain_map `{Dist A, Dist B} (f : A → B)
Next Obligation. by intros ? A ? B f Hf c n i ?; apply Hf, chain_cauchy. Qed. Next Obligation. by intros ? A ? B f Hf c n i ?; apply Hf, chain_cauchy. Qed.
(** Timeless elements *) (** Timeless elements *)
Class Timeless {A : cofeT} (x : A) := timeless y : x {1} y x y. Class Timeless {A : cofeT} (x : A) := timeless y : x {0} y x y.
Arguments timeless {_} _ {_} _ _. Arguments timeless {_} _ {_} _ _.
Lemma timeless_S {A : cofeT} (x y : A) n : Timeless x x y x {S n} y. Lemma timeless_iff {A : cofeT} (x y : A) n : Timeless x x y x {n} y.
Proof. Proof.
split; intros; [by apply equiv_dist|]. split; intros; [by apply equiv_dist|].
apply (timeless _), dist_le with (S n); auto with lia. apply (timeless _), dist_le with n; auto with lia.
Qed. Qed.
(** Fixpoint *) (** Fixpoint *)
Program Definition fixpoint_chain {A : cofeT} `{Inhabited A} (f : A A) Program Definition fixpoint_chain {A : cofeT} `{Inhabited A} (f : A A)
`{!Contractive f} : chain A := {| chain_car i := Nat.iter i f inhabitant |}. `{!Contractive f} : chain A := {| chain_car i := Nat.iter (S i) f inhabitant |}.
Next Obligation. Next Obligation.
intros A ? f ? n; induction n as [|n IH]; intros i ?; first done. intros A ? f ? n. induction n as [|n IH]; intros [|i] ?; simpl; try omega.
destruct i as [|i]; simpl; first lia; apply contractive, IH; auto with lia. * apply contractive; auto with omega.
* apply contractive_S, IH; auto with omega.
Qed. Qed.
Program Definition fixpoint {A : cofeT} `{Inhabited A} (f : A A) Program Definition fixpoint {A : cofeT} `{Inhabited A} (f : A A)
`{!Contractive f} : A := compl (fixpoint_chain f). `{!Contractive f} : A := compl (fixpoint_chain f).
...@@ -149,17 +144,16 @@ Section fixpoint. ...@@ -149,17 +144,16 @@ Section fixpoint.
Context {A : cofeT} `{Inhabited A} (f : A A) `{!Contractive f}. Context {A : cofeT} `{Inhabited A} (f : A A) `{!Contractive f}.
Lemma fixpoint_unfold : fixpoint f f (fixpoint f). Lemma fixpoint_unfold : fixpoint f f (fixpoint f).
Proof. Proof.
apply equiv_dist; intros n; unfold fixpoint. apply equiv_dist=>n; rewrite /fixpoint (conv_compl (fixpoint_chain f) n) //.
rewrite (conv_compl (fixpoint_chain f) n). induction n as [|n IH]; simpl; eauto using contractive, dist_le with omega.
by rewrite {1}(chain_cauchy (fixpoint_chain f) n (S n)); last lia.
Qed. Qed.
Lemma fixpoint_ne (g : A A) `{!Contractive g} n : Lemma fixpoint_ne (g : A A) `{!Contractive g} n :
( z, f z {n} g z) fixpoint f {n} fixpoint g. ( z, f z {n} g z) fixpoint f {n} fixpoint g.
Proof. Proof.
intros Hfg; unfold fixpoint. intros Hfg. rewrite /fixpoint
rewrite (conv_compl (fixpoint_chain f) n) (conv_compl (fixpoint_chain g) n). (conv_compl (fixpoint_chain f) n) (conv_compl (fixpoint_chain g) n) /=.
induction n as [|n IH]; simpl in *; first done. induction n as [|n IH]; simpl in *; [by rewrite !Hfg|].
rewrite Hfg; apply contractive, IH; auto using dist_S. rewrite Hfg; apply contractive_S, IH; auto using dist_S.
Qed. Qed.
Lemma fixpoint_proper (g : A A) `{!Contractive g} : Lemma fixpoint_proper (g : A A) `{!Contractive g} :
( x, f x g x) fixpoint f fixpoint g. ( x, f x g x) fixpoint f fixpoint g.
...@@ -188,9 +182,8 @@ Section cofe_mor. ...@@ -188,9 +182,8 @@ Section cofe_mor.
Program Instance cofe_mor_compl : Compl (cofeMor A B) := λ c, Program Instance cofe_mor_compl : Compl (cofeMor A B) := λ c,
{| cofe_mor_car x := compl (fun_chain c x) |}. {| cofe_mor_car x := compl (fun_chain c x) |}.
Next Obligation. Next Obligation.
intros c n x y Hx. intros c n x y Hx. by rewrite (conv_compl (fun_chain c x) n)
rewrite (conv_compl (fun_chain c x) n) (conv_compl (fun_chain c y) n) /= Hx. (conv_compl (fun_chain c y) n) /= Hx.
apply (chain_cauchy c); lia.
Qed. Qed.
Definition cofe_mor_cofe_mixin : CofeMixin (cofeMor A B). Definition cofe_mor_cofe_mixin : CofeMixin (cofeMor A B).
Proof. Proof.
...@@ -202,9 +195,8 @@ Section cofe_mor. ...@@ -202,9 +195,8 @@ Section cofe_mor.
+ by intros f g ? x. + by intros f g ? x.
+ by intros f g h ?? x; transitivity (g x). + by intros f g h ?? x; transitivity (g x).
* by intros n f g ? x; apply dist_S. * by intros n f g ? x; apply dist_S.
* by intros f g x.
* intros c n x; simpl. * intros c n x; simpl.
rewrite (conv_compl (fun_chain c x) n); apply (chain_cauchy c); lia. by rewrite (conv_compl (fun_chain c x) n) /=.
Qed. Qed.
Canonical Structure cofe_mor : cofeT := CofeT cofe_mor_cofe_mixin. Canonical Structure cofe_mor : cofeT :=