Commit 5b0c6378 authored by Robbert Krebbers's avatar Robbert Krebbers

Introduce cofeT -> cofeT functors, switch to bifunctors.

This cleans up some ad-hoc stuff and prepares for a generalization
of saved propositions.
parent dabe846c
...@@ -50,7 +50,6 @@ algebra/agree.v ...@@ -50,7 +50,6 @@ algebra/agree.v
algebra/dec_agree.v algebra/dec_agree.v
algebra/excl.v algebra/excl.v
algebra/iprod.v algebra/iprod.v
algebra/functor.v
algebra/upred.v algebra/upred.v
algebra/upred_tactics.v algebra/upred_tactics.v
algebra/upred_big_op.v algebra/upred_big_op.v
......
From algebra Require Export cmra. From algebra Require Export cmra.
From algebra Require Import functor upred. From algebra Require Import upred.
Local Hint Extern 10 (_ _) => omega. Local Hint Extern 10 (_ _) => omega.
Record agree (A : Type) : Type := Agree { Record agree (A : Type) : Type := Agree {
...@@ -180,6 +180,18 @@ Proof. ...@@ -180,6 +180,18 @@ Proof.
by apply dist_le with n; try apply Hfg. by apply dist_le with n; try apply Hfg.
Qed. Qed.
Program Definition agreeF : iFunctor := Program Definition agreeRF (F : cFunctor) : rFunctor := {|
{| ifunctor_car := agreeR; ifunctor_map := @agreeC_map |}. rFunctor_car A B := agreeR (cFunctor_car F A B);
Solve Obligations with done. rFunctor_map A1 A2 B1 B2 fg := agreeC_map (cFunctor_map F fg)
|}.
Next Obligation.
intros F A1 A2 B1 B2 n ???; simpl. by apply agreeC_map_ne, cFunctor_ne.
Qed.
Next Obligation.
intros F A B x; simpl. rewrite -{2}(agree_map_id x).
apply agree_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 -agree_map_compose.
apply agree_map_ext=>y; apply cFunctor_compose.
Qed.
From algebra Require Export excl. From algebra Require Export excl.
From algebra Require Import functor upred. From algebra Require Import upred.
Local Arguments valid _ _ !_ /. Local Arguments valid _ _ !_ /.
Local Arguments validN _ _ _ !_ /. Local Arguments validN _ _ _ !_ /.
...@@ -240,17 +240,18 @@ Definition authC_map {A B} (f : A -n> B) : authC A -n> authC B := ...@@ -240,17 +240,18 @@ Definition authC_map {A B} (f : A -n> B) : authC A -n> authC B :=
Lemma authC_map_ne A B n : Proper (dist n ==> dist n) (@authC_map A B). Lemma authC_map_ne A B n : Proper (dist n ==> dist n) (@authC_map A B).
Proof. intros f f' Hf [[a| |] b]; repeat constructor; apply Hf. Qed. Proof. intros f f' Hf [[a| |] b]; repeat constructor; apply Hf. Qed.
Program Definition authF (Σ : iFunctor) : iFunctor := {| Program Definition authRF (F : rFunctor) : rFunctor := {|
ifunctor_car := authR Σ; ifunctor_map A B := authC_map ifunctor_map Σ rFunctor_car A B := authR (rFunctor_car F A B);
rFunctor_map A1 A2 B1 B2 fg := authC_map (rFunctor_map F fg)
|}. |}.
Next Obligation. Next Obligation.
by intros Σ A B n f g Hfg; apply authC_map_ne, ifunctor_map_ne. by intros F A1 A2 B1 B2 n f g Hfg; apply authC_map_ne, rFunctor_ne.
Qed. Qed.
Next Obligation. Next Obligation.
intros Σ A x. rewrite /= -{2}(auth_map_id x). intros F A B x. rewrite /= -{2}(auth_map_id x).
apply auth_map_ext=>y; apply ifunctor_map_id. apply auth_map_ext=>y; apply rFunctor_id.
Qed. Qed.
Next Obligation. Next Obligation.
intros Σ A B C f g x. rewrite /= -auth_map_compose. intros F A1 A2 A3 B1 B2 B3 f g f' g' x. rewrite /= -auth_map_compose.
apply auth_map_ext=>y; apply ifunctor_map_compose. apply auth_map_ext=>y; apply rFunctor_compose.
Qed. Qed.
...@@ -617,3 +617,59 @@ Proof. ...@@ -617,3 +617,59 @@ Proof.
- intros x y; rewrite !prod_included=> -[??] /=. - intros x y; rewrite !prod_included=> -[??] /=.
by split; apply included_preserving. by split; apply included_preserving.
Qed. Qed.
(** Functors *)
Structure rFunctor := RFunctor {
rFunctor_car : cofeT cofeT -> cmraT;
rFunctor_map {A1 A2 B1 B2} :
((A2 -n> A1) * (B1 -n> B2)) rFunctor_car A1 B1 -n> rFunctor_car A2 B2;
rFunctor_ne {A1 A2 B1 B2} n :
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_compose {A1 A2 A3 B1 B2 B3}
(f : A2 -n> A1) (g : A3 -n> A2) (f' : B1 -n> B2) (g' : B2 -n> B3) x :
rFunctor_map (fg, g'f') x rFunctor_map (g,g') (rFunctor_map (f,f') x);
rFunctor_mono {A1 A2 B1 B2} (fg : (A2 -n> A1) * (B1 -n> B2)) :
CMRAMonotone (rFunctor_map fg)
}.
Existing Instances rFunctor_ne rFunctor_mono.
Instance: Params (@rFunctor_map) 5.
Definition rFunctor_diag (F: rFunctor) (A: cofeT) : cmraT := rFunctor_car F A A.
Coercion rFunctor_diag : rFunctor >-> Funclass.
Program Definition constRF (B : cmraT) : rFunctor :=
{| rFunctor_car A1 A2 := B; rFunctor_map A1 A2 B1 B2 f := cid |}.
Solve Obligations with done.
Program Definition prodRF (F1 F2 : rFunctor) : rFunctor := {|
rFunctor_car A B := prodR (rFunctor_car F1 A B) (rFunctor_car F2 A B);
rFunctor_map A1 A2 B1 B2 fg :=
prodC_map (rFunctor_map F1 fg) (rFunctor_map F2 fg)
|}.
Next Obligation.
by intros F1 F2 A1 A2 B1 B2 n ???; apply prodC_map_ne; apply rFunctor_ne.
Qed.
Next Obligation. by intros F1 F2 A B [??]; rewrite /= !rFunctor_id. Qed.
Next Obligation.
intros F1 F2 A1 A2 A3 B1 B2 B3 f g f' g' [??]; simpl.
by rewrite !rFunctor_compose.
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.
...@@ -310,6 +310,47 @@ Instance prodC_map_ne {A A' B B'} n : ...@@ -310,6 +310,47 @@ Instance prodC_map_ne {A A' B B'} n :
Proper (dist n ==> dist n ==> dist n) (@prodC_map A A' B B'). Proper (dist n ==> dist n ==> dist n) (@prodC_map A A' B B').
Proof. intros f f' Hf g g' Hg [??]; split; [apply Hf|apply Hg]. Qed. Proof. intros f f' Hf g g' Hg [??]; split; [apply Hf|apply Hg]. Qed.
(** Functors *)
Structure cFunctor := CFunctor {
cFunctor_car : cofeT cofeT -> cofeT;
cFunctor_map {A1 A2 B1 B2} :
((A2 -n> A1) * (B1 -n> B2)) cFunctor_car A1 B1 -n> cFunctor_car A2 B2;
cFunctor_ne {A1 A2 B1 B2} n :
Proper (dist n ==> dist n) (@cFunctor_map A1 A2 B1 B2);
cFunctor_id {A B : cofeT} (x : cFunctor_car A B) :
cFunctor_map (cid,cid) x x;
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 :
cFunctor_map (fg, g'f') x cFunctor_map (g,g') (cFunctor_map (f,f') x)
}.
Existing Instances cFunctor_ne.
Instance: Params (@cFunctor_map) 5.
Definition cFunctor_diag (F: cFunctor) (A: cofeT) : cofeT := cFunctor_car F A A.
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 :=
{| cFunctor_car A1 A2 := B; cFunctor_map A1 A2 B1 B2 f := cid |}.
Solve Obligations with done.
Program Definition prodCF (F1 F2 : cFunctor) : cFunctor := {|
cFunctor_car A B := prodC (cFunctor_car F1 A B) (cFunctor_car F2 A B);
cFunctor_map A1 A2 B1 B2 fg :=
prodC_map (cFunctor_map F1 fg) (cFunctor_map F2 fg)
|}.
Next Obligation.
by intros F1 F2 A1 A2 B1 B2 n ???; apply prodC_map_ne; apply cFunctor_ne.
Qed.
Next Obligation. by intros F1 F2 A B [??]; rewrite /= !cFunctor_id. Qed.
Next Obligation.
intros F1 F2 A1 A2 A3 B1 B2 B3 f g f' g' [??]; simpl.
by rewrite !cFunctor_compose.
Qed.
(** Discrete cofe *) (** Discrete cofe *)
Section discrete_cofe. Section discrete_cofe.
Context `{Equiv A, @Equivalence A ()}. Context `{Equiv A, @Equivalence A ()}.
...@@ -390,3 +431,13 @@ Definition laterC_map {A B} (f : A -n> B) : laterC A -n> laterC B := ...@@ -390,3 +431,13 @@ Definition laterC_map {A B} (f : A -n> B) : laterC A -n> laterC B :=
CofeMor (later_map f). CofeMor (later_map f).
Instance laterC_map_contractive (A B : cofeT) : Contractive (@laterC_map A B). Instance laterC_map_contractive (A B : cofeT) : Contractive (@laterC_map A B).
Proof. intros [|n] f g Hf n'; [done|]; apply Hf; lia. Qed. Proof. intros [|n] f g Hf n'; [done|]; apply Hf; lia. Qed.
Program Definition laterCF : cFunctor := {|
cFunctor_car A B := laterC B;
cFunctor_map A1 A2 B1 B2 fg := laterC_map (fg.2)
|}.
Next Obligation.
intros F A1 A2 B1 B2 n ? [??]; simpl. by apply (contractive_ne laterC_map).
Qed.
Next Obligation. by intros A B []. Qed.
Next Obligation. by intros A1 A2 A3 B1 B2 B3 f g f' g' []. Qed.
From algebra Require Export cofe. From algebra Require Export cofe.
Record solution (F : cofeT cofeT cofeT) := Solution { Record solution (F : cFunctor) := Solution {
solution_car :> cofeT; solution_car :> cofeT;
solution_unfold : solution_car -n> F solution_car solution_car; solution_unfold : solution_car -n> F solution_car;
solution_fold : F solution_car solution_car -n> solution_car; solution_fold : F solution_car -n> solution_car;
solution_fold_unfold X : solution_fold (solution_unfold X) X; solution_fold_unfold X : solution_fold (solution_unfold X) X;
solution_unfold_fold X : solution_unfold (solution_fold X) X solution_unfold_fold X : solution_unfold (solution_fold X) X
}. }.
...@@ -11,20 +11,13 @@ Arguments solution_unfold {_} _. ...@@ -11,20 +11,13 @@ Arguments solution_unfold {_} _.
Arguments solution_fold {_} _. Arguments solution_fold {_} _.
Module solver. Section solver. Module solver. Section solver.
Context (F : cofeT cofeT cofeT). Context (F : cFunctor) `{Finhab : Inhabited (F unitC)}.
Context `{Finhab : Inhabited (F unitC unitC)}. Context (map_contractive : {A1 A2 B1 B2},
Context (map : {A1 A2 B1 B2 : cofeT}, Contractive (@cFunctor_map F A1 A2 B1 B2)).
((A2 -n> A1) * (B1 -n> B2)) (F A1 B1 -n> F A2 B2)). Notation map := (cFunctor_map F).
Arguments map {_ _ _ _} _.
Instance: Params (@map) 4.
Context (map_id : {A B : cofeT} (x : F A B), map (cid, cid) x x).
Context (map_comp : {A1 A2 A3 B1 B2 B3 : cofeT}
(f : A2 -n> A1) (g : A3 -n> A2) (f' : B1 -n> B2) (g' : B2 -n> B3) x,
map (f g, g' f') x map (g,g') (map (f,f') x)).
Context (map_contractive : {A1 A2 B1 B2}, Contractive (@map A1 A2 B1 B2)).
Fixpoint A (k : nat) : cofeT := Fixpoint A (k : nat) : cofeT :=
match k with 0 => unitC | S k => F (A k) (A k) end. match k with 0 => unitC | S k => F (A k) end.
Fixpoint f (k : nat) : A k -n> A (S k) := Fixpoint f (k : nat) : A k -n> A (S k) :=
match k with 0 => CofeMor (λ _, inhabitant) | S k => map (g k,f k) end match k with 0 => CofeMor (λ _, inhabitant) | S k => map (g k,f k) end
with g (k : nat) : A (S k) -n> A k := with g (k : nat) : A (S k) -n> A k :=
...@@ -38,13 +31,15 @@ Arguments g : simpl never. ...@@ -38,13 +31,15 @@ Arguments g : simpl never.
Lemma gf {k} (x : A k) : g k (f k x) x. Lemma gf {k} (x : A k) : g k (f k x) x.
Proof. Proof.
induction k as [|k IH]; simpl in *; [by destruct x|]. induction k as [|k IH]; simpl in *; [by destruct x|].
rewrite -map_comp -{2}(map_id _ _ x). by apply (contractive_proper map). rewrite -cFunctor_compose -{2}[x]cFunctor_id. by apply (contractive_proper map).
Qed. Qed.
Lemma fg {k} (x : A (S (S k))) : f (S k) (g (S k) x) {k} x. Lemma fg {k} (x : A (S (S k))) : f (S k) (g (S k) x) {k} x.
Proof. Proof.
induction k as [|k IH]; simpl. induction k as [|k IH]; simpl.
- rewrite f_S g_S -{2}(map_id _ _ x) -map_comp. apply (contractive_0 map). - rewrite f_S g_S -{2}[x]cFunctor_id -cFunctor_compose.
- rewrite f_S g_S -{2}(map_id _ _ x) -map_comp. by apply (contractive_S map). apply (contractive_0 map).
- rewrite f_S g_S -{2}[x]cFunctor_id -cFunctor_compose.
by apply (contractive_S map).
Qed. Qed.
Record tower := { Record tower := {
...@@ -174,28 +169,28 @@ Proof. ...@@ -174,28 +169,28 @@ Proof.
- rewrite (ff_tower k (i - S k) X). by destruct (Nat.sub_add _ _ _). - rewrite (ff_tower k (i - S k) X). by destruct (Nat.sub_add _ _ _).
Qed. Qed.
Program Definition unfold_chain (X : T) : chain (F T T) := Program Definition unfold_chain (X : T) : chain (F T) :=
{| chain_car n := map (project n,embed' n) (X (S n)) |}. {| chain_car n := map (project n,embed' n) (X (S n)) |}.
Next Obligation. Next Obligation.
intros X n i Hi. intros X n i Hi.
assert ( k, i = k + n) as [k ?] by (exists (i - n); lia); subst; clear Hi. assert ( k, i = k + n) as [k ?] by (exists (i - n); lia); subst; clear Hi.
induction k as [|k IH]; simpl; first done. induction k as [|k IH]; simpl; first done.
rewrite -IH -(dist_le _ _ _ _ (f_tower (k + n) _)); last lia. rewrite -IH -(dist_le _ _ _ _ (f_tower (k + n) _)); last lia.
rewrite f_S -map_comp. rewrite f_S -cFunctor_compose.
by apply (contractive_ne map); split=> Y /=; rewrite ?g_tower ?embed_f. by apply (contractive_ne map); split=> Y /=; rewrite ?g_tower ?embed_f.
Qed. Qed.
Definition unfold (X : T) : F T T := compl (unfold_chain X). Definition unfold (X : T) : F T := compl (unfold_chain X).
Instance unfold_ne : Proper (dist n ==> dist n) unfold. Instance unfold_ne : Proper (dist n ==> dist n) unfold.
Proof. Proof.
intros n X Y HXY. by rewrite /unfold (conv_compl n (unfold_chain X)) intros n X Y HXY. by rewrite /unfold (conv_compl n (unfold_chain X))
(conv_compl n (unfold_chain Y)) /= (HXY (S n)). (conv_compl n (unfold_chain Y)) /= (HXY (S n)).
Qed. Qed.
Program Definition fold (X : F T T) : T := Program Definition fold (X : F T) : T :=
{| tower_car n := g n (map (embed' n,project n) X) |}. {| tower_car n := g n (map (embed' n,project n) X) |}.
Next Obligation. Next Obligation.
intros X k. apply (_ : Proper (() ==> ()) (g k)). intros X k. apply (_ : Proper (() ==> ()) (g k)).
rewrite g_S -map_comp. rewrite g_S -cFunctor_compose.
apply (contractive_proper map); split=> Y; [apply embed_f|apply g_tower]. apply (contractive_proper map); split=> Y; [apply embed_f|apply g_tower].
Qed. Qed.
Instance fold_ne : Proper (dist n ==> dist n) fold. Instance fold_ne : Proper (dist n ==> dist n) fold.
...@@ -204,14 +199,13 @@ Proof. by intros n X Y HXY k; rewrite /fold /= HXY. Qed. ...@@ -204,14 +199,13 @@ Proof. by intros n X Y HXY k; rewrite /fold /= HXY. Qed.
Theorem result : solution F. Theorem result : solution F.
Proof. Proof.
apply (Solution F T (CofeMor unfold) (CofeMor fold)). apply (Solution F T (CofeMor unfold) (CofeMor fold)).
- move=> X /=. - move=> X /=. rewrite equiv_dist=> n k; rewrite /unfold /fold /=.
rewrite equiv_dist; intros n k; unfold unfold, fold; simpl.
rewrite -g_tower -(gg_tower _ n); apply (_ : Proper (_ ==> _) (g _)). rewrite -g_tower -(gg_tower _ n); apply (_ : Proper (_ ==> _) (g _)).
trans (map (ff n, gg n) (X (S (n + k)))). trans (map (ff n, gg n) (X (S (n + k)))).
{ rewrite /unfold (conv_compl n (unfold_chain X)). { rewrite /unfold (conv_compl n (unfold_chain X)).
rewrite -(chain_cauchy (unfold_chain X) n (S (n + k))) /=; last lia. rewrite -(chain_cauchy (unfold_chain X) n (S (n + k))) /=; last lia.
rewrite -(dist_le _ _ _ _ (f_tower (n + k) _)); last lia. rewrite -(dist_le _ _ _ _ (f_tower (n + k) _)); last lia.
rewrite f_S -!map_comp; apply (contractive_ne map); split=> Y. rewrite f_S -!cFunctor_compose; apply (contractive_ne map); split=> Y.
+ rewrite /embed' /= /embed_coerce. + rewrite /embed' /= /embed_coerce.
destruct (le_lt_dec _ _); simpl; [exfalso; lia|]. destruct (le_lt_dec _ _); simpl; [exfalso; lia|].
by rewrite (ff_ff _ (eq_refl (S n + (0 + k)))) /= gf. by rewrite (ff_ff _ (eq_refl (S n + (0 + k)))) /= gf.
...@@ -221,14 +215,14 @@ Proof. ...@@ -221,14 +215,14 @@ Proof.
assert ( i k (x : A (S i + k)) (H : S i + k = i + S k), assert ( i k (x : A (S i + k)) (H : S i + k = i + S k),
map (ff i, gg i) x gg i (coerce H x)) as map_ff_gg. map (ff i, gg i) x gg i (coerce H x)) as map_ff_gg.
{ intros i; induction i as [|i IH]; intros k' x H; simpl. { intros i; induction i as [|i IH]; intros k' x H; simpl.
{ by rewrite coerce_id map_id. } { by rewrite coerce_id cFunctor_id. }
rewrite map_comp g_coerce; apply IH. } rewrite cFunctor_compose g_coerce; apply IH. }
assert (H: S n + k = n + S k) by lia. assert (H: S n + k = n + S k) by lia.
rewrite (map_ff_gg _ _ _ H). rewrite (map_ff_gg _ _ _ H).
apply (_ : Proper (_ ==> _) (gg _)); by destruct H. apply (_ : Proper (_ ==> _) (gg _)); by destruct H.
- intros X; rewrite equiv_dist=> n /=. - intros X; rewrite equiv_dist=> n /=.
rewrite /unfold /= (conv_compl' n (unfold_chain (fold X))) /=. rewrite /unfold /= (conv_compl' n (unfold_chain (fold X))) /=.
rewrite g_S -!map_comp -{2}(map_id _ _ X). rewrite g_S -!cFunctor_compose -{2}[X]cFunctor_id.
apply (contractive_ne map); split => Y /=. apply (contractive_ne map); split => Y /=.
+ rewrite f_tower. apply dist_S. by rewrite embed_tower. + rewrite f_tower. apply dist_S. by rewrite embed_tower.
+ etrans; [apply embed_ne, equiv_dist, g_tower|apply embed_tower]. + etrans; [apply embed_ne, equiv_dist, g_tower|apply embed_tower].
......
From algebra Require Export cmra. From algebra Require Export cmra.
From algebra Require Import functor upred. From algebra Require Import upred.
Local Arguments validN _ _ _ !_ /. Local Arguments validN _ _ _ !_ /.
Local Arguments valid _ _ !_ /. Local Arguments valid _ _ !_ /.
...@@ -201,7 +201,9 @@ Definition exclC_map {A B} (f : A -n> B) : exclC A -n> exclC B := ...@@ -201,7 +201,9 @@ 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 : iFunctor := Program Definition exclF : rFunctor := {|
{| ifunctor_car := exclR; ifunctor_map := @exclC_map |}. rFunctor_car A B := exclR B; rFunctor_map A1 A2 B1 B2 fg := exclC_map (fg.2)
Next Obligation. by intros A x; rewrite /= excl_map_id. Qed. |}.
Next Obligation. by intros A B C f g x; rewrite /= excl_map_compose. Qed. Next Obligation. intros A1 A2 B1 B2 n x1 x2 [??]. by apply exclC_map_ne. Qed.
Next Obligation. by intros A B x; rewrite /= excl_map_id. Qed.
Next Obligation. by intros A1 A2 A3 B1 B2 B3 *;rewrite /= excl_map_compose. Qed.
From algebra Require Export cmra option. From algebra Require Export cmra option.
From prelude Require Export gmap. From prelude Require Export gmap.
From algebra Require Import functor upred. From algebra Require Import upred.
Section cofe. Section cofe.
Context `{Countable K} {A : cofeT}. Context `{Countable K} {A : cofeT}.
...@@ -352,17 +352,34 @@ Proof. ...@@ -352,17 +352,34 @@ Proof.
destruct (_ !! k) eqn:?; simpl; constructor; apply Hf. destruct (_ !! k) eqn:?; simpl; constructor; apply Hf.
Qed. Qed.
Program Definition mapF K `{Countable K} (Σ : iFunctor) : iFunctor := {| Program Definition mapCF K `{Countable K} (F : cFunctor) : cFunctor := {|
ifunctor_car := mapR K Σ; ifunctor_map A B := mapC_map ifunctor_map Σ cFunctor_car A B := mapC K (cFunctor_car F A B);
cFunctor_map A1 A2 B1 B2 fg := mapC_map (cFunctor_map F fg)
|}. |}.
Next Obligation. Next Obligation.
by intros K ?? Σ A B n f g Hfg; apply mapC_map_ne, ifunctor_map_ne. by intros K ?? F A1 A2 B1 B2 n f g Hfg; apply mapC_map_ne, cFunctor_ne.
Qed. Qed.
Next Obligation. Next Obligation.
intros K ?? Σ A x. rewrite /= -{2}(map_fmap_id x). intros K ?? F A B x. rewrite /= -{2}(map_fmap_id x).
apply map_fmap_setoid_ext=> ? y _; apply ifunctor_map_id. apply map_fmap_setoid_ext=>y ??; apply cFunctor_id.
Qed. Qed.
Next Obligation. Next Obligation.
intros K ?? Σ A B C f g x. rewrite /= -map_fmap_compose. intros K ?? F A1 A2 A3 B1 B2 B3 f g f' g' x. rewrite /= -map_fmap_compose.
apply map_fmap_setoid_ext=> ? y _; apply ifunctor_map_compose. apply map_fmap_setoid_ext=>y ??; apply cFunctor_compose.
Qed.
Program Definition mapRF K `{Countable K} (F : rFunctor) : rFunctor := {|
rFunctor_car A B := mapR K (rFunctor_car F A B);
rFunctor_map A1 A2 B1 B2 fg := mapC_map (rFunctor_map F fg)
|}.
Next Obligation.
by intros K ?? F A1 A2 B1 B2 n f g Hfg; apply mapC_map_ne, rFunctor_ne.
Qed.
Next Obligation.
intros K ?? F A B x. rewrite /= -{2}(map_fmap_id x).
apply map_fmap_setoid_ext=>y ??; apply rFunctor_id.
Qed.
Next Obligation.
intros K ?? F A1 A2 A3 B1 B2 B3 f g f' g' x. rewrite /= -map_fmap_compose.
apply map_fmap_setoid_ext=>y ??; apply rFunctor_compose.
Qed. Qed.
From Coq.QArith Require Import Qcanon. From Coq.QArith Require Import Qcanon.
From algebra Require Export cmra. From algebra Require Export cmra.
From algebra Require Import functor upred. From algebra Require Import upred.
Local Arguments validN _ _ _ !_ /. Local Arguments validN _ _ _ !_ /.
Local Arguments valid _ _ !_ /. Local Arguments valid _ _ !_ /.
Local Arguments div _ _ !_ !_ /. Local Arguments div _ _ !_ !_ /.
...@@ -244,17 +244,18 @@ Proof. ...@@ -244,17 +244,18 @@ Proof.
by exists (Frac q3 b); constructor. by exists (Frac q3 b); constructor.
Qed. Qed.
Program Definition fracF (Σ : iFunctor) : iFunctor := {| Program Definition fracRF (F : rFunctor) : rFunctor := {|
ifunctor_car := fracR Σ; ifunctor_map A B := fracC_map ifunctor_map Σ rFunctor_car A B := fracR (rFunctor_car F A B);
rFunctor_map A1 A2 B1 B2 fg := fracC_map (rFunctor_map F fg)
|}. |}.
Next Obligation. Next Obligation.
by intros Σ A B n f g Hfg; apply fracC_map_ne, ifunctor_map_ne. by intros F A1 A2 B1 B2 n f g Hfg; apply fracC_map_ne, rFunctor_ne.
Qed. Qed.
Next Obligation. Next Obligation.
intros Σ A x. rewrite /= -{2}(frac_map_id x). intros F A B x. rewrite /= -{2}(frac_map_id x).
apply frac_map_ext=>y; apply ifunctor_map_id. apply frac_map_ext=>y; apply rFunctor_id.
Qed. Qed.
Next Obligation. Next Obligation.
intros Σ A B C f g x. rewrite /= -frac_map_compose. intros F A1 A2 A3 B1 B2 B3 f g f' g' x. rewrite /= -frac_map_compose.
apply frac_map_ext=>y; apply ifunctor_map_compose. apply frac_map_ext=>y; apply rFunctor_compose.
Qed. Qed.
From algebra Require Export cmra.