Commit 80dd5e37 authored by Robbert Krebbers's avatar Robbert Krebbers

Make cFunctor and rFunctor contractive.

Since functor instances are just used as combinators, there is really
no need for functors that are not contractive.
parent be558596
...@@ -185,7 +185,8 @@ Program Definition agreeRF (F : cFunctor) : rFunctor := {| ...@@ -185,7 +185,8 @@ Program Definition agreeRF (F : cFunctor) : rFunctor := {|
rFunctor_map A1 A2 B1 B2 fg := agreeC_map (cFunctor_map F fg) rFunctor_map A1 A2 B1 B2 fg := agreeC_map (cFunctor_map F fg)
|}. |}.
Next Obligation. Next Obligation.
intros F A1 A2 B1 B2 n ???; simpl. by apply agreeC_map_ne, cFunctor_ne. intros F A1 A2 B1 B2 n ???; simpl.
by apply agreeC_map_ne, cFunctor_contractive.
Qed. Qed.
Next Obligation. Next Obligation.
intros F A B x; simpl. rewrite -{2}(agree_map_id x). intros F A B x; simpl. rewrite -{2}(agree_map_id x).
......
...@@ -245,7 +245,7 @@ Program Definition authRF (F : rFunctor) : rFunctor := {| ...@@ -245,7 +245,7 @@ Program Definition authRF (F : rFunctor) : rFunctor := {|
rFunctor_map A1 A2 B1 B2 fg := authC_map (rFunctor_map F fg) rFunctor_map A1 A2 B1 B2 fg := authC_map (rFunctor_map F fg)
|}. |}.
Next Obligation. Next Obligation.
by intros F A1 A2 B1 B2 n f g Hfg; apply authC_map_ne, rFunctor_ne. by intros F A1 A2 B1 B2 n f g Hfg; apply authC_map_ne, rFunctor_contractive.
Qed. Qed.
Next Obligation. Next Obligation.
intros F A B x. rewrite /= -{2}(auth_map_id x). intros F A B x. rewrite /= -{2}(auth_map_id x).
......
...@@ -623,8 +623,7 @@ Structure rFunctor := RFunctor { ...@@ -623,8 +623,7 @@ Structure rFunctor := RFunctor {
rFunctor_car : cofeT cofeT -> cmraT; rFunctor_car : cofeT cofeT -> cmraT;
rFunctor_map {A1 A2 B1 B2} : rFunctor_map {A1 A2 B1 B2} :
((A2 -n> A1) * (B1 -n> B2)) rFunctor_car A1 B1 -n> rFunctor_car A2 B2; ((A2 -n> A1) * (B1 -n> B2)) rFunctor_car A1 B1 -n> rFunctor_car A2 B2;
rFunctor_ne {A1 A2 B1 B2} n : rFunctor_contractive {A1 A2 B1 B2} : Contractive (@rFunctor_map A1 A2 B1 B2);
Proper (dist n ==> dist n) (@rFunctor_map A1 A2 B1 B2);
rFunctor_id {A B} (x : rFunctor_car A B) : rFunctor_map (cid,cid) x x; rFunctor_id {A B} (x : rFunctor_car A B) : rFunctor_map (cid,cid) x x;
rFunctor_compose {A1 A2 A3 B1 B2 B3} rFunctor_compose {A1 A2 A3 B1 B2 B3}
(f : A2 -n> A1) (g : A3 -n> A2) (f' : B1 -n> B2) (g' : B2 -n> B3) x : (f : A2 -n> A1) (g : A3 -n> A2) (f' : B1 -n> B2) (g' : B2 -n> B3) x :
...@@ -632,7 +631,7 @@ Structure rFunctor := RFunctor { ...@@ -632,7 +631,7 @@ Structure rFunctor := RFunctor {
rFunctor_mono {A1 A2 B1 B2} (fg : (A2 -n> A1) * (B1 -n> B2)) : rFunctor_mono {A1 A2 B1 B2} (fg : (A2 -n> A1) * (B1 -n> B2)) :
CMRAMonotone (rFunctor_map fg) CMRAMonotone (rFunctor_map fg)
}. }.
Existing Instances rFunctor_ne rFunctor_mono. Existing Instances rFunctor_contractive rFunctor_mono.
Instance: Params (@rFunctor_map) 5. Instance: Params (@rFunctor_map) 5.
Definition rFunctor_diag (F: rFunctor) (A: cofeT) : cmraT := rFunctor_car F A A. Definition rFunctor_diag (F: rFunctor) (A: cofeT) : cmraT := rFunctor_car F A A.
...@@ -648,28 +647,11 @@ Program Definition prodRF (F1 F2 : rFunctor) : rFunctor := {| ...@@ -648,28 +647,11 @@ Program Definition prodRF (F1 F2 : rFunctor) : rFunctor := {|
prodC_map (rFunctor_map F1 fg) (rFunctor_map F2 fg) prodC_map (rFunctor_map F1 fg) (rFunctor_map F2 fg)
|}. |}.
Next Obligation. Next Obligation.
by intros F1 F2 A1 A2 B1 B2 n ???; apply prodC_map_ne; apply rFunctor_ne. by intros F1 F2 A1 A2 B1 B2 n ???;
apply prodC_map_ne; apply rFunctor_contractive.
Qed. Qed.
Next Obligation. by intros F1 F2 A B [??]; rewrite /= !rFunctor_id. Qed. Next Obligation. by intros F1 F2 A B [??]; rewrite /= !rFunctor_id. Qed.
Next Obligation. Next Obligation.
intros F1 F2 A1 A2 A3 B1 B2 B3 f g f' g' [??]; simpl. intros F1 F2 A1 A2 A3 B1 B2 B3 f g f' g' [??]; simpl.
by rewrite !rFunctor_compose. by rewrite !rFunctor_compose.
Qed. Qed.
Program Definition laterRF (F : rFunctor) : rFunctor := {|
rFunctor_car A B := rFunctor_car F (laterC A) (laterC B);
rFunctor_map A1 A2 B1 B2 fg :=
rFunctor_map F (prod_map laterC_map laterC_map fg)
|}.
Next Obligation.
intros F A1 A2 B1 B2 n x y [??].
by apply rFunctor_ne; split; apply (contractive_ne laterC_map).
Qed.
Next Obligation.
intros F A B x; simpl. rewrite -{2}[x]rFunctor_id.
apply (ne_proper (rFunctor_map F)); split; by intros [].
Qed.
Next Obligation.
intros F A1 A2 A3 B1 B2 B3 f g f' g' x; simpl in *. rewrite -rFunctor_compose.
apply (ne_proper (rFunctor_map F)); split; by intros [].
Qed.
...@@ -154,6 +154,9 @@ Section cofe. ...@@ -154,6 +154,9 @@ Section cofe.
Qed. Qed.
End cofe. End cofe.
Instance const_contractive {A B : cofeT} (x : A) : Contractive (@const A B x).
Proof. by intros n y1 y2. Qed.
(** Mapping a chain *) (** Mapping a chain *)
Program Definition chain_map `{Dist A, Dist B} (f : A B) Program Definition chain_map `{Dist A, Dist B} (f : A B)
`{! n, Proper (dist n ==> dist n) f} (c : chain A) : chain B := `{! n, Proper (dist n ==> dist n) f} (c : chain A) : chain B :=
...@@ -164,8 +167,8 @@ Next Obligation. by intros ? A ? B f Hf c n i ?; apply Hf, chain_cauchy. Qed. ...@@ -164,8 +167,8 @@ Next Obligation. by intros ? A ? B f Hf c n i ?; apply Hf, chain_cauchy. Qed.
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 (S 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] ?; simpl; intros A ? f ? n.
try reflexivity || omega; [|]. induction n as [|n IH]; intros [|i] ?; simpl in *; try reflexivity || omega.
- apply (contractive_0 f). - apply (contractive_0 f).
- apply (contractive_S f), IH; auto with omega. - apply (contractive_S f), IH; auto with omega.
Qed. Qed.
...@@ -333,24 +336,19 @@ Structure cFunctor := CFunctor { ...@@ -333,24 +336,19 @@ Structure cFunctor := CFunctor {
cFunctor_car : cofeT cofeT -> cofeT; cFunctor_car : cofeT cofeT -> cofeT;
cFunctor_map {A1 A2 B1 B2} : cFunctor_map {A1 A2 B1 B2} :
((A2 -n> A1) * (B1 -n> B2)) cFunctor_car A1 B1 -n> cFunctor_car A2 B2; ((A2 -n> A1) * (B1 -n> B2)) cFunctor_car A1 B1 -n> cFunctor_car A2 B2;
cFunctor_ne {A1 A2 B1 B2} n : cFunctor_contractive {A1 A2 B1 B2} : Contractive (@cFunctor_map A1 A2 B1 B2);
Proper (dist n ==> dist n) (@cFunctor_map A1 A2 B1 B2);
cFunctor_id {A B : cofeT} (x : cFunctor_car A B) : cFunctor_id {A B : cofeT} (x : cFunctor_car A B) :
cFunctor_map (cid,cid) x x; cFunctor_map (cid,cid) x x;
cFunctor_compose {A1 A2 A3 B1 B2 B3} cFunctor_compose {A1 A2 A3 B1 B2 B3}
(f : A2 -n> A1) (g : A3 -n> A2) (f' : B1 -n> B2) (g' : B2 -n> B3) x : (f : A2 -n> A1) (g : A3 -n> A2) (f' : B1 -n> B2) (g' : B2 -n> B3) x :
cFunctor_map (fg, g'f') x cFunctor_map (g,g') (cFunctor_map (f,f') x) cFunctor_map (fg, g'f') x cFunctor_map (g,g') (cFunctor_map (f,f') x)
}. }.
Existing Instances cFunctor_ne. Existing Instances cFunctor_contractive.
Instance: Params (@cFunctor_map) 5. Instance: Params (@cFunctor_map) 5.
Definition cFunctor_diag (F: cFunctor) (A: cofeT) : cofeT := cFunctor_car F A A. Definition cFunctor_diag (F: cFunctor) (A: cofeT) : cofeT := cFunctor_car F A A.
Coercion cFunctor_diag : cFunctor >-> Funclass. Coercion cFunctor_diag : cFunctor >-> Funclass.
Program Definition idCF : cFunctor :=
{| cFunctor_car A1 A2 := A2; cFunctor_map A1 A2 B1 B2 f := f.2 |}.
Solve Obligations with done.
Program Definition constCF (B : cofeT) : cFunctor := Program Definition constCF (B : cofeT) : cFunctor :=
{| cFunctor_car A1 A2 := B; cFunctor_map A1 A2 B1 B2 f := cid |}. {| cFunctor_car A1 A2 := B; cFunctor_map A1 A2 B1 B2 f := cid |}.
Solve Obligations with done. Solve Obligations with done.
...@@ -361,7 +359,8 @@ Program Definition prodCF (F1 F2 : cFunctor) : cFunctor := {| ...@@ -361,7 +359,8 @@ Program Definition prodCF (F1 F2 : cFunctor) : cFunctor := {|
prodC_map (cFunctor_map F1 fg) (cFunctor_map F2 fg) prodC_map (cFunctor_map F1 fg) (cFunctor_map F2 fg)
|}. |}.
Next Obligation. Next Obligation.
by intros F1 F2 A1 A2 B1 B2 n ???; apply prodC_map_ne; apply cFunctor_ne. by intros F1 F2 A1 A2 B1 B2 n ???;
apply prodC_map_ne; apply cFunctor_contractive.
Qed. Qed.
Next Obligation. by intros F1 F2 A B [??]; rewrite /= !cFunctor_id. Qed. Next Obligation. by intros F1 F2 A B [??]; rewrite /= !cFunctor_id. Qed.
Next Obligation. Next Obligation.
...@@ -375,8 +374,8 @@ Program Definition cofe_morCF (F1 F2 : cFunctor) : cFunctor := {| ...@@ -375,8 +374,8 @@ Program Definition cofe_morCF (F1 F2 : cFunctor) : cFunctor := {|
cofe_morC_map (cFunctor_map F1 (fg.2, fg.1)) (cFunctor_map F2 fg) cofe_morC_map (cFunctor_map F1 (fg.2, fg.1)) (cFunctor_map F2 fg)
|}. |}.
Next Obligation. Next Obligation.
intros F1 F2 A1 A2 B1 B2 n [f g] [f' g'] [??]; simpl in *. intros F1 F2 A1 A2 B1 B2 n [f g] [f' g'] Hfg; simpl in *.
apply cofe_morC_map_ne; apply cFunctor_ne; by apply pair_ne. apply cofe_morC_map_ne; apply cFunctor_contractive=>i ?; split; by apply Hfg.
Qed. Qed.
Next Obligation. Next Obligation.
intros F1 F2 A B [f ?] ?; simpl. rewrite /= !cFunctor_id. intros F1 F2 A B [f ?] ?; simpl. rewrite /= !cFunctor_id.
...@@ -476,7 +475,8 @@ Program Definition laterCF : cFunctor := {| ...@@ -476,7 +475,8 @@ Program Definition laterCF : cFunctor := {|
cFunctor_map A1 A2 B1 B2 fg := laterC_map (fg.2) cFunctor_map A1 A2 B1 B2 fg := laterC_map (fg.2)
|}. |}.
Next Obligation. Next Obligation.
intros F A1 A2 B1 B2 n ? [??]; simpl. by apply (contractive_ne laterC_map). intros A1 A2 B1 B2 n fg fg' Hfg.
apply laterC_map_contractive=> i ?; by apply Hfg.
Qed. Qed.
Next Obligation. by intros A B []. Qed. Next Obligation. by intros A B []. Qed.
Next Obligation. by intros A1 A2 A3 B1 B2 B3 f g f' g' []. Qed. Next Obligation. by intros A1 A2 A3 B1 B2 B3 f g f' g' []. Qed.
...@@ -12,8 +12,6 @@ Arguments solution_fold {_} _. ...@@ -12,8 +12,6 @@ Arguments solution_fold {_} _.
Module solver. Section solver. Module solver. Section solver.
Context (F : cFunctor) `{Finhab : Inhabited (F unitC)}. Context (F : cFunctor) `{Finhab : Inhabited (F unitC)}.
Context (map_contractive : {A1 A2 B1 B2},
Contractive (@cFunctor_map F A1 A2 B1 B2)).
Notation map := (cFunctor_map F). Notation map := (cFunctor_map F).
Fixpoint A (k : nat) : cofeT := Fixpoint A (k : nat) : cofeT :=
......
...@@ -201,9 +201,19 @@ Definition exclC_map {A B} (f : A -n> B) : exclC A -n> exclC B := ...@@ -201,9 +201,19 @@ Definition exclC_map {A B} (f : A -n> B) : exclC A -n> exclC B :=
Instance exclC_map_ne A B n : Proper (dist n ==> dist n) (@exclC_map A B). Instance exclC_map_ne A B n : Proper (dist n ==> dist n) (@exclC_map A B).
Proof. by intros f f' Hf []; constructor; apply Hf. Qed. Proof. by intros f f' Hf []; constructor; apply Hf. Qed.
Program Definition exclF : rFunctor := {| Program Definition exclF (F : cFunctor) : rFunctor := {|
rFunctor_car A B := exclR B; rFunctor_map A1 A2 B1 B2 fg := exclC_map (fg.2) rFunctor_car A B := exclR (cFunctor_car F A B);
rFunctor_map A1 A2 B1 B2 fg := exclC_map (cFunctor_map F fg)
|}. |}.
Next Obligation. intros A1 A2 B1 B2 n x1 x2 [??]. by apply exclC_map_ne. Qed. Next Obligation.
Next Obligation. by intros A B x; rewrite /= excl_map_id. Qed. intros A1 A2 B1 B2 n x1 x2 ??.
Next Obligation. by intros A1 A2 A3 B1 B2 B3 *;rewrite /= excl_map_compose. Qed. by apply exclC_map_ne, cFunctor_contractive.
Qed.
Next Obligation.
intros F A B x; simpl. rewrite -{2}(excl_map_id x).
apply excl_map_ext=>y. by rewrite cFunctor_id.
Qed.
Next Obligation.
intros F A1 A2 A3 B1 B2 B3 f g f' g' x; simpl. rewrite -excl_map_compose.
apply excl_map_ext=>y; apply cFunctor_compose.
Qed.
...@@ -357,7 +357,7 @@ Program Definition mapCF K `{Countable K} (F : cFunctor) : cFunctor := {| ...@@ -357,7 +357,7 @@ Program Definition mapCF K `{Countable K} (F : cFunctor) : cFunctor := {|
cFunctor_map A1 A2 B1 B2 fg := mapC_map (cFunctor_map F fg) cFunctor_map A1 A2 B1 B2 fg := mapC_map (cFunctor_map F fg)
|}. |}.
Next Obligation. Next Obligation.
by intros K ?? F A1 A2 B1 B2 n f g Hfg; apply mapC_map_ne, cFunctor_ne. by intros K ?? F A1 A2 B1 B2 n f g ?; apply mapC_map_ne, cFunctor_contractive.
Qed. Qed.
Next Obligation. Next Obligation.
intros K ?? F A B x. rewrite /= -{2}(map_fmap_id x). intros K ?? F A B x. rewrite /= -{2}(map_fmap_id x).
...@@ -373,7 +373,7 @@ Program Definition mapRF K `{Countable K} (F : rFunctor) : rFunctor := {| ...@@ -373,7 +373,7 @@ Program Definition mapRF K `{Countable K} (F : rFunctor) : rFunctor := {|
rFunctor_map A1 A2 B1 B2 fg := mapC_map (rFunctor_map F fg) rFunctor_map A1 A2 B1 B2 fg := mapC_map (rFunctor_map F fg)
|}. |}.
Next Obligation. Next Obligation.
by intros K ?? F A1 A2 B1 B2 n f g Hfg; apply mapC_map_ne, rFunctor_ne. by intros K ?? F A1 A2 B1 B2 n f g ?; apply mapC_map_ne, rFunctor_contractive.
Qed. Qed.
Next Obligation. Next Obligation.
intros K ?? F A B x. rewrite /= -{2}(map_fmap_id x). intros K ?? F A B x. rewrite /= -{2}(map_fmap_id x).
......
...@@ -249,7 +249,7 @@ Program Definition fracRF (F : rFunctor) : rFunctor := {| ...@@ -249,7 +249,7 @@ Program Definition fracRF (F : rFunctor) : rFunctor := {|
rFunctor_map A1 A2 B1 B2 fg := fracC_map (rFunctor_map F fg) rFunctor_map A1 A2 B1 B2 fg := fracC_map (rFunctor_map F fg)
|}. |}.
Next Obligation. Next Obligation.
by intros F A1 A2 B1 B2 n f g Hfg; apply fracC_map_ne, rFunctor_ne. by intros F A1 A2 B1 B2 n f g Hfg; apply fracC_map_ne, rFunctor_contractive.
Qed. Qed.
Next Obligation. Next Obligation.
intros F A B x. rewrite /= -{2}(frac_map_id x). intros F A B x. rewrite /= -{2}(frac_map_id x).
......
...@@ -293,7 +293,8 @@ Program Definition iprodCF {C} (F : C → cFunctor) : cFunctor := {| ...@@ -293,7 +293,8 @@ Program Definition iprodCF {C} (F : C → cFunctor) : cFunctor := {|
cFunctor_map A1 A2 B1 B2 fg := iprodC_map (λ c, cFunctor_map (F c) fg) cFunctor_map A1 A2 B1 B2 fg := iprodC_map (λ c, cFunctor_map (F c) fg)
|}. |}.
Next Obligation. Next Obligation.
by intros C F A1 A2 B1 B2 n ?? g; apply iprodC_map_ne=>c; apply cFunctor_ne. intros C F A1 A2 B1 B2 n ?? g.
by apply iprodC_map_ne=>c; apply cFunctor_contractive.
Qed. Qed.
Next Obligation. Next Obligation.
intros C F A B g; simpl. rewrite -{2}(iprod_map_id g). intros C F A B g; simpl. rewrite -{2}(iprod_map_id g).
...@@ -309,7 +310,8 @@ Program Definition iprodRF {C} (F : C → rFunctor) : rFunctor := {| ...@@ -309,7 +310,8 @@ Program Definition iprodRF {C} (F : C → rFunctor) : rFunctor := {|
rFunctor_map A1 A2 B1 B2 fg := iprodC_map (λ c, rFunctor_map (F c) fg) rFunctor_map A1 A2 B1 B2 fg := iprodC_map (λ c, rFunctor_map (F c) fg)
|}. |}.
Next Obligation. Next Obligation.
by intros C F A1 A2 B1 B2 n ?? g; apply iprodC_map_ne=>c; apply rFunctor_ne. intros C F A1 A2 B1 B2 n ?? g.
by apply iprodC_map_ne=>c; apply rFunctor_contractive.
Qed. Qed.
Next Obligation. Next Obligation.
intros C F A B g; simpl. rewrite -{2}(iprod_map_id g). intros C F A B g; simpl. rewrite -{2}(iprod_map_id g).
......
...@@ -194,7 +194,7 @@ Program Definition optionCF (F : cFunctor) : cFunctor := {| ...@@ -194,7 +194,7 @@ Program Definition optionCF (F : cFunctor) : cFunctor := {|
cFunctor_map A1 A2 B1 B2 fg := optionC_map (cFunctor_map F fg) cFunctor_map A1 A2 B1 B2 fg := optionC_map (cFunctor_map F fg)
|}. |}.
Next Obligation. Next Obligation.
by intros F A1 A2 B1 B2 n f g Hfg; apply optionC_map_ne, cFunctor_ne. by intros F A1 A2 B1 B2 n f g Hfg; apply optionC_map_ne, cFunctor_contractive.
Qed. Qed.
Next Obligation. Next Obligation.
intros F A B x. rewrite /= -{2}(option_fmap_id x). intros F A B x. rewrite /= -{2}(option_fmap_id x).
...@@ -210,7 +210,7 @@ Program Definition optionRF (F : rFunctor) : rFunctor := {| ...@@ -210,7 +210,7 @@ Program Definition optionRF (F : rFunctor) : rFunctor := {|
rFunctor_map A1 A2 B1 B2 fg := optionC_map (rFunctor_map F fg) rFunctor_map A1 A2 B1 B2 fg := optionC_map (rFunctor_map F fg)
|}. |}.
Next Obligation. Next Obligation.
by intros F A1 A2 B1 B2 n f g Hfg; apply optionC_map_ne, rFunctor_ne. by intros F A1 A2 B1 B2 n f g Hfg; apply optionC_map_ne, rFunctor_contractive.
Qed. Qed.
Next Obligation. Next Obligation.
intros F A B x. rewrite /= -{2}(option_fmap_id x). intros F A B x. rewrite /= -{2}(option_fmap_id x).
......
...@@ -102,7 +102,8 @@ Program Definition uPredCF (F : rFunctor) : cFunctor := {| ...@@ -102,7 +102,8 @@ Program Definition uPredCF (F : rFunctor) : cFunctor := {|
cFunctor_map A1 A2 B1 B2 fg := uPredC_map (rFunctor_map F (fg.2, fg.1)) cFunctor_map A1 A2 B1 B2 fg := uPredC_map (rFunctor_map F (fg.2, fg.1))
|}. |}.
Next Obligation. Next Obligation.
intros F A1 A2 B1 B2 n P Q [??]. by apply uPredC_map_ne, rFunctor_ne. intros F A1 A2 B1 B2 n P Q HPQ.
apply uPredC_map_ne, rFunctor_contractive=> i ?; split; by apply HPQ.
Qed. Qed.
Next Obligation. Next Obligation.
intros F A B P; simpl. rewrite -{2}(uPred_map_id P). intros F A B P; simpl. rewrite -{2}(uPred_map_id P).
......
...@@ -10,10 +10,10 @@ Import uPred. ...@@ -10,10 +10,10 @@ Import uPred.
(* Not bundling heapG, as it may be shared with other users. *) (* Not bundling heapG, as it may be shared with other users. *)
Class barrierG Σ := BarrierG { Class barrierG Σ := BarrierG {
barrier_stsG :> stsG heap_lang Σ sts; barrier_stsG :> stsG heap_lang Σ sts;
barrier_savedPropG :> savedPropG heap_lang Σ idCF; barrier_savedPropG :> savedPropG heap_lang Σ laterCF;
}. }.
(** The Functors we need. *) (** The Functors we need. *)
Definition barrierGF : rFunctors := [stsGF sts; agreeRF idCF]. Definition barrierGF : rFunctors := [stsGF sts; agreeRF laterCF].
(* Show and register that they match. *) (* Show and register that they match. *)
Instance inGF_barrierG `{H : inGFs heap_lang Σ barrierGF} : barrierG Σ. Instance inGF_barrierG `{H : inGFs heap_lang Σ barrierGF} : barrierG Σ.
Proof. destruct H as (?&?&?). split; apply _. Qed. Proof. destruct H as (?&?&?). split; apply _. Qed.
...@@ -119,7 +119,7 @@ Proof. ...@@ -119,7 +119,7 @@ Proof.
apply forall_intro=>l. rewrite (forall_elim l). apply wand_intro_l. apply forall_intro=>l. rewrite (forall_elim l). apply wand_intro_l.
rewrite !assoc. apply pvs_wand_r. rewrite !assoc. apply pvs_wand_r.
(* The core of this proof: Allocating the STS and the saved prop. *) (* The core of this proof: Allocating the STS and the saved prop. *)
eapply sep_elim_True_r; first by eapply (saved_prop_alloc (F:=idCF) _ (Next P)). eapply sep_elim_True_r; first by eapply (saved_prop_alloc (F:=laterCF) _ (Next P)).
rewrite pvs_frame_l. apply pvs_strip_pvs. rewrite sep_exist_l. rewrite pvs_frame_l. apply pvs_strip_pvs. rewrite sep_exist_l.
apply exist_elim=>i. apply exist_elim=>i.
trans (pvs (heap_ctx heapN trans (pvs (heap_ctx heapN
......
...@@ -18,7 +18,7 @@ Notation iPropG Λ Σ := (iProp Λ (globalF Σ)). ...@@ -18,7 +18,7 @@ Notation iPropG Λ Σ := (iProp Λ (globalF Σ)).
Class inG (Λ : language) (Σ : rFunctorG) (A : cmraT) := InG { Class inG (Λ : language) (Σ : rFunctorG) (A : cmraT) := InG {
inG_id : gid; inG_id : gid;
inG_prf : A = Σ inG_id (laterC (iPreProp Λ (globalF Σ))) inG_prf : A = Σ inG_id (iPreProp Λ (globalF Σ))
}. }.
Definition to_globalF `{inG Λ Σ A} (γ : gname) (a : A) : iGst Λ (globalF Σ) := Definition to_globalF `{inG Λ Σ A} (γ : gname) (a : A) : iGst Λ (globalF Σ) :=
...@@ -52,9 +52,9 @@ Proof. rewrite /to_globalF; apply _. Qed. ...@@ -52,9 +52,9 @@ Proof. rewrite /to_globalF; apply _. Qed.
(** * Transport empty *) (** * Transport empty *)
Instance inG_empty `{Empty A} : Instance inG_empty `{Empty A} :
Empty (Σ inG_id (laterC (iPreProp Λ (globalF Σ)))) := cmra_transport inG_prf . Empty (Σ inG_id (iPreProp Λ (globalF Σ))) := cmra_transport inG_prf .
Instance inG_empty_spec `{Empty A} : Instance inG_empty_spec `{Empty A} :
CMRAIdentity A CMRAIdentity (Σ inG_id (laterC (iPreProp Λ (globalF Σ)))). CMRAIdentity A CMRAIdentity (Σ inG_id (iPreProp Λ (globalF Σ))).
Proof. Proof.
split. split.
- apply cmra_transport_valid, cmra_empty_valid. - apply cmra_transport_valid, cmra_empty_valid.
......
...@@ -57,7 +57,7 @@ their first argument to avoid loops. For example, the instances [authGF_inGF] ...@@ -57,7 +57,7 @@ their first argument to avoid loops. For example, the instances [authGF_inGF]
and [auth_identity] otherwise create a cycle that pops up arbitrarily. *) and [auth_identity] otherwise create a cycle that pops up arbitrarily. *)
Hint Mode inGF + + - : typeclass_instances. Hint Mode inGF + + - : typeclass_instances.
Lemma inGF_inG `{inGF Λ Σ F} : inG Λ Σ (F (laterC (iPreProp Λ (globalF Σ)))). Lemma inGF_inG `{inGF Λ Σ F} : inG Λ Σ (F (iPreProp Λ (globalF Σ))).
Proof. exists inGF_id. by rewrite -inGF_prf. Qed. Proof. exists inGF_id. by rewrite -inGF_prf. Qed.
Instance inGF_here {Λ Σ} (F: rFunctor) : inGF Λ (rFunctorG.cons F Σ) F. Instance inGF_here {Λ Σ} (F: rFunctor) : inGF Λ (rFunctorG.cons F Σ) F.
Proof. by exists 0. Qed. Proof. by exists 0. Qed.
...@@ -76,4 +76,4 @@ Instance inGFs_nil {Λ Σ} : inGFs Λ Σ []. ...@@ -76,4 +76,4 @@ Instance inGFs_nil {Λ Σ} : inGFs Λ Σ [].
Proof. exact tt. Qed. Proof. exact tt. Qed.
Instance inGFs_cons {Λ Σ} F Fs : Instance inGFs_cons {Λ Σ} F Fs :
inGF Λ Σ F inGFs Λ Σ Fs inGFs Λ Σ (rFunctors.cons F Fs). inGF Λ Σ F inGFs Λ Σ Fs inGFs Λ Σ (rFunctors.cons F Fs).
Proof. split; done. Qed. Proof. by split. Qed.
...@@ -9,8 +9,7 @@ propositions using the agreement CMRA. *) ...@@ -9,8 +9,7 @@ propositions using the agreement CMRA. *)
Module Type iProp_solution_sig. Module Type iProp_solution_sig.
Parameter iPreProp : language rFunctor cofeT. Parameter iPreProp : language rFunctor cofeT.
Definition iGst (Λ : language) (Σ : rFunctor) : cmraT := Definition iGst (Λ : language) (Σ : rFunctor) : cmraT := Σ (iPreProp Λ Σ).
Σ (laterC (iPreProp Λ Σ)).
Definition iRes Λ Σ := res Λ (laterC (iPreProp Λ Σ)) (iGst Λ Σ). Definition iRes Λ Σ := res Λ (laterC (iPreProp Λ Σ)) (iGst Λ Σ).
Definition iResR Λ Σ := resR Λ (laterC (iPreProp Λ Σ)) (iGst Λ Σ). Definition iResR Λ Σ := resR Λ (laterC (iPreProp Λ Σ)) (iGst Λ Σ).
Definition iWld Λ Σ := gmap positive (agree (laterC (iPreProp Λ Σ))). Definition iWld Λ Σ := gmap positive (agree (laterC (iPreProp Λ Σ))).
...@@ -27,19 +26,10 @@ End iProp_solution_sig. ...@@ -27,19 +26,10 @@ End iProp_solution_sig.
Module Export iProp_solution : iProp_solution_sig. Module Export iProp_solution : iProp_solution_sig.
Definition iProp_result (Λ : language) (Σ : rFunctor) : Definition iProp_result (Λ : language) (Σ : rFunctor) :
solution (uPredCF (resRF Λ laterCF (laterRF Σ))). solution (uPredCF (resRF Λ laterCF Σ)) := solver.result _.
Proof.
(* Contractiveness should be derived from general properties about functors *)
apply (solver.result _)=> A1 A2 B1 B2.
intros n fg fg' Hf P; split=> n' -[???].
apply uPredC_map_ne, resC_map_ne; simpl.
- apply laterC_map_contractive=> i ?. by apply Hf.
- apply rFunctor_ne; split; apply laterC_map_contractive=> i ?; by apply Hf.
Qed.
Definition iPreProp (Λ : language) (Σ : rFunctor) : cofeT := iProp_result Λ Σ. Definition iPreProp (Λ : language) (Σ : rFunctor) : cofeT := iProp_result Λ Σ.
Definition iGst (Λ : language) (Σ : rFunctor) : cmraT := Definition iGst (Λ : language) (Σ : rFunctor) : cmraT := Σ (iPreProp Λ Σ).
Σ (laterC (iPreProp Λ Σ)).
Definition iRes Λ Σ := res Λ (laterC (iPreProp Λ Σ)) (iGst Λ Σ). Definition iRes Λ Σ := res Λ (laterC (iPreProp Λ Σ)) (iGst Λ Σ).
Definition iResR Λ Σ := resR Λ (laterC (iPreProp Λ Σ)) (iGst Λ Σ). Definition iResR Λ Σ := resR Λ (laterC (iPreProp Λ Σ)) (iGst Λ Σ).
Definition iWld Λ Σ := gmap positive (agree (laterC (iPreProp Λ Σ))). Definition iWld Λ Σ := gmap positive (agree (laterC (iPreProp Λ Σ))).
......
...@@ -232,8 +232,9 @@ Program Definition resRF (Λ : language) ...@@ -232,8 +232,9 @@ Program Definition resRF (Λ : language)
rFunctor_map A1 A2 B1 B2 fg :=resC_map (cFunctor_map F fg) (rFunctor_map Σ fg) rFunctor_map A1 A2 B1 B2 fg :=resC_map (cFunctor_map F fg) (rFunctor_map Σ fg)
|}. |}.
Next Obligation. Next Obligation.
intros Λ F Σ A1 A2 B1 B2 n f g Hfg. intros Λ F Σ A1 A2 B1 B2 n f g Hfg; apply resC_map_ne.
apply resC_map_ne. by apply cFunctor_ne. by apply rFunctor_ne. - by apply cFunctor_contractive.
- by apply rFunctor_contractive.
Qed. Qed.
Next Obligation. Next Obligation.
intros Λ F Σ A B x. rewrite /= -{2}(res_map_id x). intros Λ F Σ A B x. rewrite /= -{2}(res_map_id x).
......
...@@ -3,21 +3,20 @@ From program_logic Require Export global_functor. ...@@ -3,21 +3,20 @@ From program_logic Require Export global_functor.
Import uPred. Import uPred.
Class savedPropG (Λ : language) (Σ : rFunctorG) (F : cFunctor) := Class savedPropG (Λ : language) (Σ : rFunctorG) (F : cFunctor) :=
saved_prop_inG :> inG Λ Σ (agreeR (F (laterC (iPreProp Λ (globalF Σ))))). saved_prop_inG :> inG Λ Σ (agreeR (F (iPreProp Λ (globalF Σ)))).
Instance inGF_savedPropG `{inGF Λ Σ (agreeRF F)} : savedPropG Λ Σ F. Instance inGF_savedPropG `{inGF Λ Σ (agreeRF F)} : savedPropG Λ Σ F.
Proof. apply: inGF_inG. Qed. Proof. apply: inGF_inG. Qed.
Definition saved_prop_own `{savedPropG Λ Σ F} Definition saved_prop_own `{savedPropG Λ Σ F}
(γ : gname) (x : F (laterC (iPropG Λ Σ))) : iPropG Λ Σ := (γ : gname) (x : F (iPropG Λ Σ)) : iPropG Λ Σ :=
own γ (to_agree own γ (to_agree (cFunctor_map F (iProp_fold, iProp_unfold) x)).
(cFunctor_map F (laterC_map iProp_fold, laterC_map iProp_unfold) x)).
Typeclasses Opaque saved_prop_own. Typeclasses Opaque saved_prop_own.
Instance: Params (@saved_prop_own) 4. Instance: Params (@saved_prop_own) 4.
Section saved_prop. Section saved_prop.
Context `{savedPropG Λ Σ F}. Context `{savedPropG Λ Σ F}.
Implicit Types x y : F (laterC (iPropG Λ Σ)).