Commit 643508b8 authored by Ralf Jung's avatar Ralf Jung

Merge branch 'robbert/functor_cofe' into 'master'

Turn the arguments of functors into COFEs + write some docs

See merge request iris/iris!257
parents 2cfaec5d cb5834a8
...@@ -42,6 +42,8 @@ Changes in and extensions of the theory: ...@@ -42,6 +42,8 @@ Changes in and extensions of the theory:
describes the postcondition of each forked-off thread (instead of it being describes the postcondition of each forked-off thread (instead of it being
`True`). Additionally, there is a stronger variant of the adequacy theorem `True`). Additionally, there is a stronger variant of the adequacy theorem
that allows to make use of the postconditions of the forked-off threads. that allows to make use of the postconditions of the forked-off threads.
* The user-chosen functor used to instantiate the Iris logic now goes from
COFEs to Cameras (it was OFEs to Cameras).
Changes in Coq: Changes in Coq:
......
...@@ -6,16 +6,71 @@ This complements the tactic documentation for the [proof mode](ProofMode.md) and ...@@ -6,16 +6,71 @@ This complements the tactic documentation for the [proof mode](ProofMode.md) and
[HeapLang](HeapLang.md) as well as the documentation of syntactic conventions in [HeapLang](HeapLang.md) as well as the documentation of syntactic conventions in
the [style guide](StyleGuide.md). the [style guide](StyleGuide.md).
## Combinators for functors
In Iris, the type of propositions [iProp] is described by the solution to the
recursive domain equation:
```
iProp ≅ uPred (F (iProp))
```
Here, `F` is a user-chosen locally contractive bifunctor from COFEs to unital
Camaras (a step-indexed generalization of unital resource algebras). To make it
convenient to construct such functors out of smaller pieces, we provide a number
of abstractions:
- [`cFunctor`](theories/algebra/ofe.v): bifunctors from COFEs to OFEs.
- [`rFunctor`](theories/algebra/cmra.v): bifunctors from COFEs to cameras.
- [`urFunctor`](theories/algebra/cmra.v): bifunctors from COFEs to unital
cameras.
Besides, there are the classes `cFunctorContractive`, `rFunctorContractive`, and
`urFunctorContractive` which describe the subset of the above functors that
are contractive.
To compose these functors, we provide a number of combinators, e.g.:
- `constCF (A : ofeT) : cFunctor := λ (B,B⁻), A `
- `idCF : cFunctor := λ (B,B⁻), B`
- `prodCF (F1 F2 : cFunctor) : cFunctor := λ (B,B⁻), F1 (B,B⁻) * F2 (B,B⁻)`
- `ofe_morCF (F1 F2 : cFunctor) : cFunctor := λ (B,B⁻), F1 (B⁻,B) -n> F2 (B,B⁻)`
- `laterCF (F : cFunctor) : cFunctor := λ (B,B⁻), later (F (B,B⁻))`
- `agreeRF (F : cFunctor) : rFunctor := λ (B,B⁻), agree (F (B,B⁻))`
- `gmapURF K (F : rFunctor) : urFunctor := λ (B,B⁻), gmap K (F (B,B⁻))`
Using these combinators, one can easily construct bigger functors in point-free
style, e.g:
```
F := gmapURF K (agreeRF (prodCF (constCF natC) (laterCF idCF)))
```
which effectively defines `F := λ (B,B⁻), gmap K (agree (nat * later B))`.
Furthermore, for functors written using these combinators like the functor `F`
above, Coq can automatically `urFunctorContractive F`.
To make it a little bit more convenient to write down such functors, we make
the constant functors (`constCF`, `constRF`, and `constURF`) a coercion, and
provide the usual notation for products, etc. So the above functor can be
written as follows (which is similar to the effective definition of `F` above):
```
F := gmapURF K (agreeRF (natC * ▶ ∙))
```
## Resource algebra management ## Resource algebra management
When using ghost state in Iris, you have to make sure that the resource algebras When using ghost state in Iris, you have to make sure that the resource algebras
you need are actually available. Every Iris proof is carried out using a you need are actually available. Every Iris proof is carried out using a
universally quantified list `Σ: gFunctors` defining which resource algebras are universally quantified list `Σ: gFunctors` defining which resource algebras are
available. You can think of this as a list of resource algebras, though in available. You can think of this as a list of resource algebras, though in
reality it is a list of functors from OFEs to Cameras (where Cameras are a reality it is a list of locally contractive functors from COFEs to Cameras,
step-indexed generalization of resource algebras). This is the *global* list of which are typically defined using the combinators for functors described above.
resources that the entire proof can use. We keep it universally quantified to The `Σ` is the *global* list of resources that the entire proof can use. We
enable composition of proofs. The formal side of this is described in §7.4 of keep the `Σ` universally quantified to enable composition of proofs. The formal
side of this is described in §7.4 of
[The Iris Documentation](http://plv.mpi-sws.org/iris/appendix-3.1.pdf); here we [The Iris Documentation](http://plv.mpi-sws.org/iris/appendix-3.1.pdf); here we
describe the Coq aspects of this approach. describe the Coq aspects of this approach.
......
...@@ -174,7 +174,7 @@ The purpose of this section is to describe how we solve these issues. ...@@ -174,7 +174,7 @@ The purpose of this section is to describe how we solve these issues.
\paragraph{Picking the resources.} \paragraph{Picking the resources.}
The key ingredient that we will employ on top of the base logic is to give some more fixed structure to the resources. The key ingredient that we will employ on top of the base logic is to give some more fixed structure to the resources.
To instantiate the logic with dynamic higher-order ghost state, the user picks a family of locally contractive bifunctors $(\iFunc_i : \OFEs^\op \times \OFEs \to \CMRAs)_{i \in \mathcal{I}}$. To instantiate the logic with dynamic higher-order ghost state, the user picks a family of locally contractive bifunctors $(\iFunc_i : \COFEs^\op \times \COFEs \to \CMRAs)_{i \in \mathcal{I}}$.
(This is in contrast to the base logic, where the user picks a single, fixed camera that has a unit.) (This is in contrast to the base logic, where the user picks a single, fixed camera that has a unit.)
From this, we construct the bifunctor defining the overall resources as follows: From this, we construct the bifunctor defining the overall resources as follows:
......
...@@ -306,24 +306,24 @@ Proof. ...@@ -306,24 +306,24 @@ Proof.
Qed. Qed.
Program Definition agreeRF (F : cFunctor) : rFunctor := {| Program Definition agreeRF (F : cFunctor) : rFunctor := {|
rFunctor_car A B := agreeR (cFunctor_car F A B); rFunctor_car A _ B _ := agreeR (cFunctor_car F A B);
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 ? A1 A2 B1 B2 n ???; simpl. by apply agreeC_map_ne, cFunctor_ne. intros ? A1 ? A2 ? B1 ? B2 ? n ???; simpl. by apply agreeC_map_ne, cFunctor_ne.
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).
apply (agree_map_ext _)=>y. by rewrite cFunctor_id. apply (agree_map_ext _)=>y. by rewrite cFunctor_id.
Qed. Qed.
Next Obligation. Next Obligation.
intros F A1 A2 A3 B1 B2 B3 f g f' g' x; simpl. rewrite -agree_map_compose. 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. apply (agree_map_ext _)=>y; apply cFunctor_compose.
Qed. Qed.
Instance agreeRF_contractive F : Instance agreeRF_contractive F :
cFunctorContractive F rFunctorContractive (agreeRF F). cFunctorContractive F rFunctorContractive (agreeRF F).
Proof. Proof.
intros ? A1 A2 B1 B2 n ???; simpl. intros ? A1 ? A2 ? B1 ? B2 ? n ???; simpl.
by apply agreeC_map_ne, cFunctor_contractive. by apply agreeC_map_ne, cFunctor_contractive.
Qed. Qed.
...@@ -403,13 +403,13 @@ Proof. destruct x as [[[]|] ]; by rewrite // /auth_map /= agree_map_id. Qed. ...@@ -403,13 +403,13 @@ Proof. destruct x as [[[]|] ]; by rewrite // /auth_map /= agree_map_id. Qed.
Lemma auth_map_compose {A B C} (f : A B) (g : B C) (x : auth A) : Lemma auth_map_compose {A B C} (f : A B) (g : B C) (x : auth A) :
auth_map (g f) x = auth_map g (auth_map f x). auth_map (g f) x = auth_map g (auth_map f x).
Proof. destruct x as [[[]|] ]; by rewrite // /auth_map /= agree_map_compose. Qed. Proof. destruct x as [[[]|] ]; by rewrite // /auth_map /= agree_map_compose. Qed.
Lemma auth_map_ext {A B : ofeT} (f g : A B) `{_ : NonExpansive f} x : Lemma auth_map_ext {A B : ofeT} (f g : A B) `{!NonExpansive f} x :
( x, f x g x) auth_map f x auth_map g x. ( x, f x g x) auth_map f x auth_map g x.
Proof. Proof.
constructor; simpl; auto. constructor; simpl; auto.
apply option_fmap_equiv_ext=> a; by rewrite /prod_map /= agree_map_ext. apply option_fmap_equiv_ext=> a; by rewrite /prod_map /= agree_map_ext.
Qed. Qed.
Instance auth_map_ne {A B : ofeT} (f : A -> B) {Hf : NonExpansive f} : Instance auth_map_ne {A B : ofeT} (f : A -> B) `{Hf : !NonExpansive f} :
NonExpansive (auth_map f). NonExpansive (auth_map f).
Proof. Proof.
intros n [??] [??] [??]; split; simpl in *; [|by apply Hf]. intros n [??] [??] [??]; split; simpl in *; [|by apply Hf].
...@@ -437,45 +437,45 @@ Proof. intros n f f' Hf [[[]|] ]; repeat constructor; try naive_solver; ...@@ -437,45 +437,45 @@ Proof. intros n f f' Hf [[[]|] ]; repeat constructor; try naive_solver;
apply agreeC_map_ne; auto. Qed. apply agreeC_map_ne; auto. Qed.
Program Definition authRF (F : urFunctor) : rFunctor := {| Program Definition authRF (F : urFunctor) : rFunctor := {|
rFunctor_car A B := authR (urFunctor_car F A B); rFunctor_car A _ B _ := authR (urFunctor_car F A B);
rFunctor_map A1 A2 B1 B2 fg := authC_map (urFunctor_map F fg) rFunctor_map A1 _ A2 _ B1 _ B2 _ fg := authC_map (urFunctor_map F fg)
|}. |}.
Next Obligation. Next Obligation.
by intros F A1 A2 B1 B2 n f g Hfg; apply authC_map_ne, urFunctor_ne. by intros F A1 ? A2 ? B1 ? B2 ? n f g Hfg; apply authC_map_ne, urFunctor_ne.
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).
apply auth_map_ext=>y. apply _. apply urFunctor_id. apply (auth_map_ext _ _)=>y; apply urFunctor_id.
Qed. Qed.
Next Obligation. Next Obligation.
intros F A1 A2 A3 B1 B2 B3 f g 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 _. apply urFunctor_compose. apply (auth_map_ext _ _)=>y; apply urFunctor_compose.
Qed. Qed.
Instance authRF_contractive F : Instance authRF_contractive F :
urFunctorContractive F rFunctorContractive (authRF F). urFunctorContractive F rFunctorContractive (authRF F).
Proof. Proof.
by intros ? A1 A2 B1 B2 n f g Hfg; apply authC_map_ne, urFunctor_contractive. by intros ? A1 ? A2 ? B1 ? B2 ? n f g Hfg; apply authC_map_ne, urFunctor_contractive.
Qed. Qed.
Program Definition authURF (F : urFunctor) : urFunctor := {| Program Definition authURF (F : urFunctor) : urFunctor := {|
urFunctor_car A B := authUR (urFunctor_car F A B); urFunctor_car A _ B _ := authUR (urFunctor_car F A B);
urFunctor_map A1 A2 B1 B2 fg := authC_map (urFunctor_map F fg) urFunctor_map A1 _ A2 _ B1 _ B2 _ fg := authC_map (urFunctor_map F fg)
|}. |}.
Next Obligation. Next Obligation.
by intros F A1 A2 B1 B2 n f g Hfg; apply authC_map_ne, urFunctor_ne. by intros F A1 ? A2 ? B1 ? B2 ? n f g Hfg; apply authC_map_ne, urFunctor_ne.
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).
apply auth_map_ext=>y. apply _. apply urFunctor_id. apply (auth_map_ext _ _)=>y; apply urFunctor_id.
Qed. Qed.
Next Obligation. Next Obligation.
intros F A1 A2 A3 B1 B2 B3 f g 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 _. apply urFunctor_compose. apply (auth_map_ext _ _)=>y; apply urFunctor_compose.
Qed. Qed.
Instance authURF_contractive F : Instance authURF_contractive F :
urFunctorContractive F urFunctorContractive (authURF F). urFunctorContractive F urFunctorContractive (authURF F).
Proof. Proof.
by intros ? A1 A2 B1 B2 n f g Hfg; apply authC_map_ne, urFunctor_contractive. by intros ? A1 ? A2 ? B1 ? B2 ? n f g Hfg; apply authC_map_ne, urFunctor_contractive.
Qed. Qed.
...@@ -766,16 +766,18 @@ End cmra_morphism. ...@@ -766,16 +766,18 @@ End cmra_morphism.
(** Functors *) (** Functors *)
Record rFunctor := RFunctor { Record rFunctor := RFunctor {
rFunctor_car : ofeT ofeT cmraT; rFunctor_car : A `{!Cofe A} B `{!Cofe B}, cmraT;
rFunctor_map {A1 A2 B1 B2} : rFunctor_map `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe 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 : rFunctor_ne `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2} :
NonExpansive (@rFunctor_map A1 A2 B1 B2); NonExpansive (@rFunctor_map A1 _ A2 _ B1 _ B2 _);
rFunctor_id {A B} (x : rFunctor_car A B) : rFunctor_map (cid,cid) x x; rFunctor_id `{!Cofe A, !Cofe B} (x : rFunctor_car A B) :
rFunctor_compose {A1 A2 A3 B1 B2 B3} rFunctor_map (cid,cid) x x;
rFunctor_compose `{!Cofe A1, !Cofe A2, !Cofe A3, !Cofe B1, !Cofe B2, !Cofe 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 :
rFunctor_map (fg, g'f') x rFunctor_map (g,g') (rFunctor_map (f,f') x); rFunctor_map (fg, g'f') x rFunctor_map (g,g') (rFunctor_map (f,f') x);
rFunctor_mor {A1 A2 B1 B2} (fg : (A2 -n> A1) * (B1 -n> B2)) : rFunctor_mor `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2}
(fg : (A2 -n> A1) * (B1 -n> B2)) :
CmraMorphism (rFunctor_map fg) CmraMorphism (rFunctor_map fg)
}. }.
Existing Instances rFunctor_ne rFunctor_mor. Existing Instances rFunctor_ne rFunctor_mor.
...@@ -785,13 +787,15 @@ Delimit Scope rFunctor_scope with RF. ...@@ -785,13 +787,15 @@ Delimit Scope rFunctor_scope with RF.
Bind Scope rFunctor_scope with rFunctor. Bind Scope rFunctor_scope with rFunctor.
Class rFunctorContractive (F : rFunctor) := Class rFunctorContractive (F : rFunctor) :=
rFunctor_contractive A1 A2 B1 B2 :> Contractive (@rFunctor_map F A1 A2 B1 B2). rFunctor_contractive `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2} :>
Contractive (@rFunctor_map F A1 _ A2 _ B1 _ B2 _).
Definition rFunctor_diag (F: rFunctor) (A: ofeT) : cmraT := rFunctor_car F A A. Definition rFunctor_diag (F: rFunctor) (A: ofeT) `{!Cofe A} : cmraT :=
rFunctor_car F A A.
Coercion rFunctor_diag : rFunctor >-> Funclass. Coercion rFunctor_diag : rFunctor >-> Funclass.
Program Definition constRF (B : cmraT) : rFunctor := Program Definition constRF (B : cmraT) : rFunctor :=
{| rFunctor_car A1 A2 := B; rFunctor_map A1 A2 B1 B2 f := cid |}. {| rFunctor_car A1 _ A2 _ := B; rFunctor_map A1 _ A2 _ B1 _ B2 _ f := cid |}.
Solve Obligations with done. Solve Obligations with done.
Coercion constRF : cmraT >-> rFunctor. Coercion constRF : cmraT >-> rFunctor.
...@@ -799,16 +803,18 @@ Instance constRF_contractive B : rFunctorContractive (constRF B). ...@@ -799,16 +803,18 @@ Instance constRF_contractive B : rFunctorContractive (constRF B).
Proof. rewrite /rFunctorContractive; apply _. Qed. Proof. rewrite /rFunctorContractive; apply _. Qed.
Record urFunctor := URFunctor { Record urFunctor := URFunctor {
urFunctor_car : ofeT ofeT ucmraT; urFunctor_car : A `{!Cofe A} B `{!Cofe B}, ucmraT;
urFunctor_map {A1 A2 B1 B2} : urFunctor_map `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2} :
((A2 -n> A1) * (B1 -n> B2)) urFunctor_car A1 B1 -n> urFunctor_car A2 B2; ((A2 -n> A1) * (B1 -n> B2)) urFunctor_car A1 B1 -n> urFunctor_car A2 B2;
urFunctor_ne A1 A2 B1 B2 : urFunctor_ne `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2} :
NonExpansive (@urFunctor_map A1 A2 B1 B2); NonExpansive (@urFunctor_map A1 _ A2 _ B1 _ B2 _);
urFunctor_id {A B} (x : urFunctor_car A B) : urFunctor_map (cid,cid) x x; urFunctor_id `{!Cofe A, !Cofe B} (x : urFunctor_car A B) :
urFunctor_compose {A1 A2 A3 B1 B2 B3} urFunctor_map (cid,cid) x x;
urFunctor_compose `{!Cofe A1, !Cofe A2, !Cofe A3, !Cofe B1, !Cofe B2, !Cofe 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 :
urFunctor_map (fg, g'f') x urFunctor_map (g,g') (urFunctor_map (f,f') x); urFunctor_map (fg, g'f') x urFunctor_map (g,g') (urFunctor_map (f,f') x);
urFunctor_mor {A1 A2 B1 B2} (fg : (A2 -n> A1) * (B1 -n> B2)) : urFunctor_mor `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2}
(fg : (A2 -n> A1) * (B1 -n> B2)) :
CmraMorphism (urFunctor_map fg) CmraMorphism (urFunctor_map fg)
}. }.
Existing Instances urFunctor_ne urFunctor_mor. Existing Instances urFunctor_ne urFunctor_mor.
...@@ -818,13 +824,15 @@ Delimit Scope urFunctor_scope with URF. ...@@ -818,13 +824,15 @@ Delimit Scope urFunctor_scope with URF.
Bind Scope urFunctor_scope with urFunctor. Bind Scope urFunctor_scope with urFunctor.
Class urFunctorContractive (F : urFunctor) := Class urFunctorContractive (F : urFunctor) :=
urFunctor_contractive A1 A2 B1 B2 :> Contractive (@urFunctor_map F A1 A2 B1 B2). urFunctor_contractive `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2} :>
Contractive (@urFunctor_map F A1 _ A2 _ B1 _ B2 _).
Definition urFunctor_diag (F: urFunctor) (A: ofeT) : ucmraT := urFunctor_car F A A. Definition urFunctor_diag (F: urFunctor) (A: ofeT) `{!Cofe A} : ucmraT :=
urFunctor_car F A A.
Coercion urFunctor_diag : urFunctor >-> Funclass. Coercion urFunctor_diag : urFunctor >-> Funclass.
Program Definition constURF (B : ucmraT) : urFunctor := Program Definition constURF (B : ucmraT) : urFunctor :=
{| urFunctor_car A1 A2 := B; urFunctor_map A1 A2 B1 B2 f := cid |}. {| urFunctor_car A1 _ A2 _ := B; urFunctor_map A1 _ A2 _ B1 _ B2 _ f := cid |}.
Solve Obligations with done. Solve Obligations with done.
Coercion constURF : ucmraT >-> urFunctor. Coercion constURF : ucmraT >-> urFunctor.
...@@ -1189,16 +1197,16 @@ Proof. ...@@ -1189,16 +1197,16 @@ Proof.
Qed. Qed.
Program Definition prodRF (F1 F2 : rFunctor) : rFunctor := {| Program Definition prodRF (F1 F2 : rFunctor) : rFunctor := {|
rFunctor_car A B := prodR (rFunctor_car F1 A B) (rFunctor_car F2 A B); rFunctor_car A _ B _ := prodR (rFunctor_car F1 A B) (rFunctor_car F2 A B);
rFunctor_map A1 A2 B1 B2 fg := rFunctor_map A1 _ A2 _ B1 _ B2 _ fg :=
prodC_map (rFunctor_map F1 fg) (rFunctor_map F2 fg) prodC_map (rFunctor_map F1 fg) (rFunctor_map F2 fg)
|}. |}.
Next Obligation. Next Obligation.
intros F1 F2 A1 A2 B1 B2 n ???. by apply prodC_map_ne; apply rFunctor_ne. intros F1 F2 A1 ? A2 ? B1 ? B2 ? n ???. by apply prodC_map_ne; apply rFunctor_ne.
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.
Notation "F1 * F2" := (prodRF F1%RF F2%RF) : rFunctor_scope. Notation "F1 * F2" := (prodRF F1%RF F2%RF) : rFunctor_scope.
...@@ -1207,21 +1215,21 @@ Instance prodRF_contractive F1 F2 : ...@@ -1207,21 +1215,21 @@ Instance prodRF_contractive F1 F2 :
rFunctorContractive F1 rFunctorContractive F2 rFunctorContractive F1 rFunctorContractive F2
rFunctorContractive (prodRF F1 F2). rFunctorContractive (prodRF F1 F2).
Proof. Proof.
intros ?? A1 A2 B1 B2 n ???; intros ?? A1 ? A2 ? B1 ? B2 ? n ???;
by apply prodC_map_ne; apply rFunctor_contractive. by apply prodC_map_ne; apply rFunctor_contractive.
Qed. Qed.
Program Definition prodURF (F1 F2 : urFunctor) : urFunctor := {| Program Definition prodURF (F1 F2 : urFunctor) : urFunctor := {|
urFunctor_car A B := prodUR (urFunctor_car F1 A B) (urFunctor_car F2 A B); urFunctor_car A _ B _ := prodUR (urFunctor_car F1 A B) (urFunctor_car F2 A B);
urFunctor_map A1 A2 B1 B2 fg := urFunctor_map A1 _ A2 _ B1 _ B2 _ fg :=
prodC_map (urFunctor_map F1 fg) (urFunctor_map F2 fg) prodC_map (urFunctor_map F1 fg) (urFunctor_map F2 fg)
|}. |}.
Next Obligation. Next Obligation.
intros F1 F2 A1 A2 B1 B2 n ???. by apply prodC_map_ne; apply urFunctor_ne. intros F1 F2 A1 ? A2 ? B1 ? B2 ? n ???. by apply prodC_map_ne; apply urFunctor_ne.
Qed. Qed.
Next Obligation. by intros F1 F2 A B [??]; rewrite /= !urFunctor_id. Qed. Next Obligation. by intros F1 F2 A ? B ? [??]; rewrite /= !urFunctor_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 !urFunctor_compose. by rewrite !urFunctor_compose.
Qed. Qed.
Notation "F1 * F2" := (prodURF F1%URF F2%URF) : urFunctor_scope. Notation "F1 * F2" := (prodURF F1%URF F2%URF) : urFunctor_scope.
...@@ -1230,7 +1238,7 @@ Instance prodURF_contractive F1 F2 : ...@@ -1230,7 +1238,7 @@ Instance prodURF_contractive F1 F2 :
urFunctorContractive F1 urFunctorContractive F2 urFunctorContractive F1 urFunctorContractive F2
urFunctorContractive (prodURF F1 F2). urFunctorContractive (prodURF F1 F2).
Proof. Proof.
intros ?? A1 A2 B1 B2 n ???; intros ?? A1 ? A2 ? B1 ? B2 ? n ???;
by apply prodC_map_ne; apply urFunctor_contractive. by apply prodC_map_ne; apply urFunctor_contractive.
Qed. Qed.
...@@ -1450,47 +1458,47 @@ Proof. ...@@ -1450,47 +1458,47 @@ Proof.
Qed. Qed.
Program Definition optionRF (F : rFunctor) : rFunctor := {| Program Definition optionRF (F : rFunctor) : rFunctor := {|
rFunctor_car A B := optionR (rFunctor_car F A B); rFunctor_car A _ B _ := optionR (rFunctor_car F A B);
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_ne.
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).
apply option_fmap_equiv_ext=>y; apply rFunctor_id. apply option_fmap_equiv_ext=>y; apply rFunctor_id.
Qed. Qed.
Next Obligation. Next Obligation.
intros F A1 A2 A3 B1 B2 B3 f g f' g' x. rewrite /= -option_fmap_compose. intros F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x. rewrite /= -option_fmap_compose.
apply option_fmap_equiv_ext=>y; apply rFunctor_compose. apply option_fmap_equiv_ext=>y; apply rFunctor_compose.
Qed. Qed.
Instance optionRF_contractive F : Instance optionRF_contractive F :
rFunctorContractive F rFunctorContractive (optionRF F). rFunctorContractive F rFunctorContractive (optionRF F).
Proof. Proof.
by intros ? A1 A2 B1 B2 n f g Hfg; apply optionC_map_ne, rFunctor_contractive. by intros ? A1 ? A2 ? B1 ? B2 ? n f g Hfg; apply optionC_map_ne, rFunctor_contractive.
Qed. Qed.
Program Definition optionURF (F : rFunctor) : urFunctor := {| Program Definition optionURF (F : rFunctor) : urFunctor := {|
urFunctor_car A B := optionUR (rFunctor_car F A B); urFunctor_car A _ B _ := optionUR (rFunctor_car F A B);
urFunctor_map A1 A2 B1 B2 fg := optionC_map (rFunctor_map F fg) urFunctor_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_ne.
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).
apply option_fmap_equiv_ext=>y; apply rFunctor_id. apply option_fmap_equiv_ext=>y; apply rFunctor_id.
Qed. Qed.
Next Obligation. Next Obligation.
intros F A1 A2 A3 B1 B2 B3 f g f' g' x. rewrite /= -option_fmap_compose. intros F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x. rewrite /= -option_fmap_compose.
apply option_fmap_equiv_ext=>y; apply rFunctor_compose. apply option_fmap_equiv_ext=>y; apply rFunctor_compose.
Qed. Qed.
Instance optionURF_contractive F : Instance optionURF_contractive F :
rFunctorContractive F urFunctorContractive (optionURF F). rFunctorContractive F urFunctorContractive (optionURF F).
Proof. Proof.
by intros ? A1 A2 B1 B2 n f g Hfg; apply optionC_map_ne, rFunctor_contractive. by intros ? A1 ? A2 ? B1 ? B2 ? n f g Hfg; apply optionC_map_ne, rFunctor_contractive.
Qed. Qed.