Commit 3d69aaa0 authored by Filip Sieczkowski's avatar Filip Sieczkowski

Added a library for solving recursive domain equations.

parents
Require Import PreoMet.
Require Import PCM.
Section CompleteBI.
Context {T : Type}.
Class topBI := top : T.
Class botBI := bot : T.
Class andBI := and : T -> T -> T.
Class orBI := or : T -> T -> T.
Class implBI := impl : T -> T -> T.
Class scBI := sc : T -> T -> T.
Class siBI := si : T -> T -> T.
Class allBI `{cmT : cmetric T} :=
all : forall {U} `{pU : cmetric U}, (U -n> T) -> T.
Class xistBI `{cmT : cmetric T} :=
xist : forall {U} `{pU : cmetric U}, (U -n> T) -> T.
Section Lift.
Context (f : T -> T -> T) `{cmT : cmetric T}
{fequiv : Proper (equiv ==> equiv ==> equiv) f}
{fdist : forall n, Proper (dist n ==> dist n ==> dist n) f}
{U} `{cmU : cmetric U} (P : U -n> T) (Q : U -n> T).
Local Obligation Tactic := intros; resp_set.
Program Definition lift_bin : U -n> T :=
n[(fun u => f (P u) (Q u))].
End Lift.
Class ComplBI `{pcmT : pcmType T, BIT : topBI, BIB : botBI, BIA : andBI,
BIO : orBI, BII : implBI, BISC : scBI, BISI : siBI}
{BIAll : allBI} {BIXist : xistBI} :=
mkCBI {
top_true : forall P, P top;
bot_false : forall P, bot P;
and_self : forall P, P and P P;
and_projL : forall P Q, and P Q P;
and_projR : forall P Q, and P Q Q;
and_equiv :> Proper (equiv ==> equiv ==> equiv) and;
and_dist n :> Proper (dist n ==> dist n ==> dist n) and;
and_pord :> Proper (pord ==> pord ==> pord) and;
and_impl : forall P Q R, and P Q R <-> P impl Q R;
impl_equiv :> Proper (equiv ==> equiv ==> equiv) impl;
impl_dist n :> Proper (dist n ==> dist n ==> dist n) impl;
impl_pord :> Proper (pord --> pord ++> pord) impl;
or_injL : forall P Q, P or P Q;
or_injR : forall P Q, Q or P Q;
or_self : forall P, or P P P;
or_equiv :> Proper (equiv ==> equiv ==> equiv) or;
or_dist n :> Proper (dist n ==> dist n ==> dist n) or;
or_pord :> Proper (pord ==> pord ==> pord) or;
sc_comm :> Commutative sc;
sc_assoc :> Associative sc;
sc_top_unit : forall P, sc top P == P;
sc_equiv :> Proper (equiv ==> equiv ==> equiv) sc;
sc_dist n :> Proper (dist n ==> dist n ==> dist n) sc;
sc_pord :> Proper (pord ==> pord ==> pord) sc;
sc_si : forall P Q R, sc P Q R <-> P si Q R;
si_equiv :> Proper (equiv ==> equiv ==> equiv) si;
si_dist n :> Proper (dist n ==> dist n ==> dist n) si;
si_pord :> Proper (pord --> pord ++> pord) si;
all_R U `{cmU : cmetric U} :
forall P (Q : U -n> T), (forall u, P Q u) <-> P all Q;
all_equiv U `{cmU : cmetric U} :> Proper (equiv ==> equiv) all;
all_dist U `{cmU : cmetric U} n :> Proper (dist n ==> dist n) all;
all_pord U `{cmU : cmetric U} (P Q : U -n> T) :
(forall u, P u Q u) -> all P all Q;
xist_L U `{cmU : cmetric U} :
forall (P : U -n> T) Q, (forall u, P u Q) <-> xist P Q;
xist_sc U `{cmU : cmetric U} :
forall (P : U -n> T) Q, sc (xist P) Q xist (lift_bin sc P (umconst Q));
xist_equiv U `{cmU : cmetric U} :> Proper (equiv ==> equiv) xist;
xist_dist U `{cmU : cmetric U} n :> Proper (dist n ==> dist n) xist;
xist_pord U `{cmU : cmetric U} (P Q : U -n> T) :
(forall u, P u Q u) -> xist P xist Q
}.
End CompleteBI.
Arguments topBI : default implicits.
Arguments botBI : default implicits.
Arguments andBI : default implicits.
Arguments orBI : default implicits.
Arguments implBI : default implicits.
Arguments scBI : default implicits.
Arguments siBI : default implicits.
Arguments allBI T {_ _ _}.
Arguments xistBI T {_ _ _}.
Arguments ComplBI T {_ _ _ _ _ _ _ _ _ _ _ _ _ _}.
Class Valid (T : Type) `{pcmT : pcmType T} :=
{ valid : T -> Prop;
valid_top (t t' : T) (HV : valid t) : t' t
}.
Class Later (T : Type) `{pcmT : pcmType T} {vT : Valid T} :=
{ later : T -m> T;
later_mon (t : T) : t later t;
later_contr : contractive later;
loeb (t : T) (HL : later t t) : valid t
}.
Notation " ▹ p " := (later p) (at level 20) : bi_scope.
Require Import UPred.
Section UPredLater.
Context Res `{preoRes : preoType Res}.
Local Obligation Tactic := intros; resp_set || eauto with typeclass_instances.
Global Program Instance valid_up : Valid (UPred Res) :=
Build_Valid _ _ _ _ _ _ (fun p : UPred Res => forall n r, p n r) _.
Next Obligation.
intros n r _; apply HV.
Qed.
Global Instance later_up_mon : Proper (pord ==> pord) later_up.
Proof.
intros p q Hpq [| n] r; [intros; exact I | simpl; apply Hpq].
Qed.
Global Program Instance later_upred : Later (UPred Res) :=
Build_Later _ _ _ _ _ _ _ m[(later_up)] _ _ _.
Next Obligation.
intros [| n] r Ht; [exact I | simpl].
rewrite Le.le_n_Sn; assumption.
Qed.
Next Obligation.
intros n p q Hpq [| m] r HLt; simpl; [tauto |].
apply Hpq; auto with arith.
Qed.
Next Obligation.
intros n r; induction n.
- apply HL; exact I.
- apply HL, IHn.
Qed.
End UPredLater.
Section UPredBI.
Context Res `{pcmRes : PCM Res}.
Local Open Scope pcm_scope.
Local Obligation Tactic := intros; eauto with typeclass_instances.
Local Instance eqRes : Setoid Res := discreteType.
(* Standard interpretations of propositional connectives. *)
Global Program Instance top_up : topBI (UPred Res) := up_cr (const True).
Global Program Instance bot_up : botBI (UPred Res) := up_cr (const False).
Global Program Instance and_up : andBI (UPred Res) :=
fun P Q =>
mkUPred (fun n r => P n r /\ Q n r) _.
Next Obligation.
intros n m r1 r2 HLe HSub; rewrite HSub, HLe; tauto.
Qed.
Global Program Instance or_up : orBI (UPred Res) :=
fun P Q =>
mkUPred (fun n r => P n r \/ Q n r) _.
Next Obligation.
intros n m r1 r2 HLe HSub; rewrite HSub, HLe; tauto.
Qed.
Global Program Instance impl_up : implBI (UPred Res) :=
fun P Q =>
mkUPred (fun n r => forall m r', m <= n -> r r' -> P m r' -> Q m r') _.
Next Obligation.
intros n m r1 r2 HLe HSub HImp k r3 HLe' HSub' HP.
apply HImp; try (etransitivity; eassumption); assumption.
Qed.
(* BI connectives. *)
Global Program Instance sc_up : scBI (UPred Res) :=
fun P Q =>
mkUPred (fun n r => exists r1 r2, Some r1 · Some r2 = Some r /\ P n r1 /\ Q n r2) _.
Next Obligation.
intros n m r1 r2 HLe [r3 HEq] [r11 [r12 [HEq' [HP HQ]]]].
assert (PA := pcm_op_assoc Res r3 (Some r11) (Some r12)); simpl in PA.
erewrite <- HEq', (assoc (Associative := pcm_op_assoc _)) in HEq.
destruct (r3 · Some r11) as [r311 |] eqn: EQ;
[| erewrite pcm_op_zero in HEq by eassumption; discriminate].
exists r311 r12; rewrite HLe.
split; [assumption |].
assert (HS : r11 r311) by (eexists; eassumption).
rewrite <- HS; tauto.
Qed.
Global Program Instance si_up : siBI (UPred Res) :=
fun P Q =>
mkUPred (fun n r => forall m r' rr, Some r · Some r' = Some rr -> m <= n -> P m r' -> Q m rr) _.
Next Obligation.
intros n m r1 r2 HLe [[r12 |] HEq] HSI k r rr HEq' HSub HP;
[| erewrite pcm_op_zero in HEq by eassumption; discriminate].
rewrite (comm (Commutative := pcm_op_comm _)) in HEq.
rewrite <- HEq, <- (assoc (Associative := pcm_op_assoc _)) in HEq'.
destruct (Some r12 · Some r) as [r12r |] eqn: HEq'';
[| erewrite (comm (Commutative := pcm_op_comm _)), pcm_op_zero in HEq' by eassumption; discriminate].
eapply HSI; [eassumption | etransitivity; eassumption |]; [].
assert (HS : r r12r) by (eexists; eassumption).
rewrite <- HS; assumption.
Qed.
(* Quantifiers. *)
Global Program Instance all_up : allBI (UPred Res) :=
fun T eqT mT cmT R =>
mkUPred (fun n r => forall t, R t n r) _.
Next Obligation.
intros n m r1 r2 HLe HSub HR t; rewrite HLe, <- HSub; apply HR.
Qed.
Global Program Instance xist_up : xistBI (UPred Res) :=
fun T eqT mT cmT R =>
mkUPred (fun n r => exists t, R t n r) _.
Next Obligation.
intros n m r1 r2 HLe HSub [t HR]; exists t; rewrite HLe, <- HSub; apply HR.
Qed.
(* All of the above preserve all the props it should. *)
Global Instance and_up_equiv : Proper (equiv ==> equiv ==> equiv) and_up.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ n r; simpl.
rewrite EQP, EQQ; tauto.
Qed.
Global Instance and_up_dist n : Proper (dist n ==> dist n ==> dist n) and_up.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ m r HLt; simpl.
split; intros; (split; [apply EQP | apply EQQ]; now auto with arith).
Qed.
Global Instance and_up_ord : Proper (pord ==> pord ==> pord) and_up.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ n r; simpl.
rewrite EQP, EQQ; tauto.
Qed.
Global Instance or_up_equiv : Proper (equiv ==> equiv ==> equiv) or_up.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ n r; simpl.
rewrite EQP, EQQ; tauto.
Qed.
Global Instance or_up_dist n : Proper (dist n ==> dist n ==> dist n) or_up.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ m r HLt; simpl.
split; (intros [HP | HQ]; [left; apply EQP | right; apply EQQ]; now auto with arith).
Qed.
Global Instance or_up_ord : Proper (pord ==> pord ==> pord) or_up.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ n r; simpl.
rewrite EQP, EQQ; tauto.
Qed.
Global Instance impl_up_equiv : Proper (equiv ==> equiv ==> equiv) impl_up.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ n r; simpl.
setoid_rewrite EQP; setoid_rewrite EQQ; tauto.
Qed.
Global Instance impl_up_dist n : Proper (dist n ==> dist n ==> dist n) impl_up.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ m r HLt; simpl.
split; intros; apply EQQ, H, EQP; now eauto with arith.
Qed.
Global Instance impl_up_ord : Proper (pord --> pord ++> pord) impl_up.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ n r HP m r'.
rewrite <- EQP, <- EQQ; apply HP.
Qed.
Global Instance sc_up_equiv : Proper (equiv ==> equiv ==> equiv) sc_up.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ n r; simpl.
setoid_rewrite EQP; setoid_rewrite EQQ; tauto.
Qed.
Global Instance sc_up_dist n : Proper (dist n ==> dist n ==> dist n) sc_up.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ m r HLt; simpl.
split; intros [r1 [r2 [EQr [HP HQ]]]]; exists r1; exists r2;
(split; [assumption | split; [apply EQP | apply EQQ]; now auto with arith]).
Qed.
Global Instance sc_up_ord : Proper (pord ==> pord ==> pord) sc_up.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ n r HH; simpl.
setoid_rewrite <- EQP; setoid_rewrite <- EQQ; apply HH.
Qed.
Global Instance si_up_equiv : Proper (equiv ==> equiv ==> equiv) si_up.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ n r; simpl.
setoid_rewrite EQP; setoid_rewrite EQQ; tauto.
Qed.
Global Instance si_up_dist n : Proper (dist n ==> dist n ==> dist n) si_up.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ m r HLt; simpl.
split; intros; eapply EQQ, H, EQP; now eauto with arith.
Qed.
Global Instance si_up_ord : Proper (pord --> pord ++> pord) si_up.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ n r HP m r' rr.
rewrite <- EQP, <- EQQ; apply HP.
Qed.
Section Quantifiers.
Context V `{pU : cmetric V}.
Global Instance all_up_equiv : Proper (equiv (T := V -n> UPred Res) ==> equiv) all.
Proof.
intros R1 R2 EQR n r; simpl.
setoid_rewrite EQR; tauto.
Qed.
Global Instance all_up_dist n : Proper (dist (T := V -n> UPred Res) n ==> dist n) all.
Proof.
intros R1 R2 EQR m r HLt; simpl.
split; intros; apply EQR; now auto.
Qed.
Global Instance xist_up_equiv : Proper (equiv (T := V -n> UPred Res) ==> equiv) xist.
Proof.
intros R1 R2 EQR n r; simpl.
setoid_rewrite EQR; tauto.
Qed.
Global Instance xist_up_dist n : Proper (dist (T := V -n> UPred Res)n ==> dist n) xist.
Proof.
intros R1 R2 EQR m r HLt; simpl.
split; intros [t HR]; exists t; apply EQR; now auto.
Qed.
End Quantifiers.
Global Program Instance bi_up : ComplBI (UPred Res).
Next Obligation.
intros n r _; exact I.
Qed.
Next Obligation.
intros n r HC; contradiction HC.
Qed.
Next Obligation.
intros n r; simpl; tauto.
Qed.
Next Obligation.
intros n r [HP HQ]; assumption.
Qed.
Next Obligation.
intros n r [HP HQ]; assumption.
Qed.
Next Obligation.
split; intros HH n r.
- intros HP m r' HLe HSub HQ; apply HH; split; [rewrite HLe, <- HSub |]; assumption.
- intros [HP HQ]; eapply HH; eassumption || reflexivity.
Qed.
Next Obligation.
intros n r HP; left; assumption.
Qed.
Next Obligation.
intros n r HQ; right; assumption.
Qed.
Next Obligation.
intros n r; simpl; tauto.
Qed.
Next Obligation.
intros P Q n r; simpl.
setoid_rewrite (comm (Commutative := pcm_op_comm _)) at 1.
firstorder.
Qed.
Next Obligation.
intros P Q R n r; simpl; split.
- intros [r1 [rr [EQr [HP [r2 [r3 [EQrr [HQ HR]]]]]]]].
rewrite <- EQrr, (assoc (Associative := pcm_op_assoc _)) in EQr.
destruct (Some r1 · Some r2) as [r12 |] eqn: EQr12;
[| erewrite pcm_op_zero in EQr by eassumption; discriminate].
exists r12 r3; split; [assumption |].
split; [exists r1 r2; split; [assumption |] |]; tauto.
- intros [rr [r3 [EQr [[r1 [r2 [EQrr [HP HQ]]]] HR]]]].
rewrite <- EQrr, <- (assoc (Associative := pcm_op_assoc _)) in EQr.
destruct (Some r2 · Some r3) as [r23 |] eqn: EQr23;
[| erewrite (comm (Commutative := pcm_op_comm _)), pcm_op_zero in EQr by eassumption; discriminate].
exists r1 r23; split; [assumption |].
split; [| exists r2; exists r3; split; [assumption |]]; tauto.
Qed.
Next Obligation.
intros n r; simpl; split.
- intros [r1 [r2 [EQr [_ HP]]]].
assert (HT : r2 r) by (eexists; apply EQr).
rewrite <- HT; assumption.
- intros HP; exists (pcm_unit _) r; unfold const; intuition eauto using pcm_op_unit.
Qed.
Next Obligation.
split; intros HH n r.
- intros HP m r' rr EQrr HLe HQ; apply HH; rewrite <- HLe in HP.
eexists; eexists; split; [eassumption | tauto].
- intros [r1 [r2 [EQr [HP HQ]]]]; eapply HH; eassumption || reflexivity.
Qed.
Next Obligation.
split.
- intros HH n r HP u; apply HH; assumption.
- intros HH u n r HP; apply HH; assumption.
Qed.
Next Obligation.
intros n r HA u; apply H, HA.
Qed.
Next Obligation.
split.
- intros HH n r [u HP]; eapply HH; eassumption.
- intros HH u n r HP; apply HH; exists u; assumption.
Qed.
Next Obligation.
intros n t [t1 [t2 [EQt [[u HP] HQ]]]]; exists u t1 t2; tauto.
Qed.
Next Obligation.
intros n r [u HA]; exists u; apply H, HA.
Qed.
End UPredBI.
(* This class describes a type that can close over "future Us",
thus making a nonexpansive map monotone *)
Class MonotoneClosure T `{pcmT : pcmType T} :=
{ mclose : forall {U} `{pcmU : pcmType U} {eU : extensible U},
(U -n> T) -n> U -m> T;
mclose_cl : forall {U} `{pcmU : pcmType U} {eU : extensible U} (f : U -n> T) u,
mclose f u f u;
mclose_fw : forall {U} `{pcmU : pcmType U} {eU : extensible U} (f : U -n> T) u t
(HFW : forall u' (HS : u u'), t f u'),
t mclose f u
}.
Arguments Build_MonotoneClosure {_ _ _ _ _ _} _ {_ _}.
Section MonotoneExt.
Context B `{BBI : ComplBI B} {MCB : MonotoneClosure B}
T `{pcmT' : pcmType T} {eT : extensible T}.
Local Obligation Tactic := intros; resp_set || mono_resp || eauto with typeclass_instances.
Global Instance top_mm : topBI (T -m> B) := pcmconst top.
Global Instance bot_mm : botBI (T -m> B) := pcmconst bot.
Global Program Instance and_mm : andBI (T -m> B) :=
fun P Q => m[(lift_bin and P Q)].
Global Program Instance or_mm : orBI (T -m> B) :=
fun P Q => m[(lift_bin or P Q)].
Global Instance impl_mm : implBI (T -m> B) :=
fun P Q => mclose (lift_bin impl P Q).
Global Program Instance sc_mm : scBI (T -m> B) :=
fun P Q => m[(lift_bin sc P Q)].
Global Instance si_mm : siBI (T -m> B) :=
fun P Q => mclose (lift_bin si P Q).
Global Program Instance all_mm : allBI (T -m> B) :=
fun U eqU mU cmU R =>
m[(fun t => all n[(fun u => R u t)])].
Next Obligation.
intros t1 t2 EQt; apply all_equiv; intros u; simpl morph.
rewrite EQt; reflexivity.
Qed.
Next Obligation.
intros t1 t2 EQt; apply all_dist; intros u; simpl morph.
rewrite EQt; reflexivity.
Qed.
Next Obligation.
intros t1 t2 Subt; apply all_pord; intros u; simpl morph.
rewrite Subt; reflexivity.
Qed.
Global Program Instance xist_mm : xistBI (T -m> B) :=
fun U eqU mU cmU R =>
m[(fun t => xist n[(fun u => R u t)])].
Next Obligation.
intros t1 t2 EQt; apply xist_equiv; intros u; simpl morph.
rewrite EQt; reflexivity.
Qed.
Next Obligation.
intros t1 t2 EQt; apply xist_dist; intros u; simpl morph.
rewrite EQt; reflexivity.
Qed.
Next Obligation.
intros t1 t2 Subt; apply xist_pord; intros u; simpl morph.
rewrite Subt; reflexivity.
Qed.
(* All of the above preserve all the props it should. *)
Global Instance and_mm_equiv : Proper (equiv ==> equiv ==> equiv) and_mm.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ t; simpl morph.
apply and_equiv; [apply EQP | apply EQQ].
Qed.
Global Instance and_mm_dist n : Proper (dist n ==> dist n ==> dist n) and_mm.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ t; simpl morph.
apply and_dist; [apply EQP | apply EQQ].
Qed.
Global Instance and_mm_ord : Proper (pord ==> pord ==> pord) and_mm.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ t; simpl morph.
apply and_pord; [apply EQP | apply EQQ].
Qed.
Global Instance or_mm_equiv : Proper (equiv ==> equiv ==> equiv) or_mm.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ t; simpl morph.
apply or_equiv; [apply EQP | apply EQQ].
Qed.
Global Instance or_mm_dist n : Proper (dist n ==> dist n ==> dist n) or_mm.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ t; simpl morph.
apply or_dist; [apply EQP | apply EQQ].
Qed.
Global Instance or_mm_ord : Proper (pord ==> pord ==> pord) or_mm.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ t; simpl morph.
apply or_pord; [apply EQP | apply EQQ].
Qed.
Global Instance impl_mm_equiv : Proper (equiv ==> equiv ==> equiv) impl_mm.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ; unfold impl_mm.
apply (morph_resp mclose); intros t; simpl morph.
apply impl_equiv; [apply EQP | apply EQQ].
Qed.
Global Instance impl_mm_dist n : Proper (dist n ==> dist n ==> dist n) impl_mm.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ; apply met_morph_nonexp; intros t; simpl morph.
apply impl_dist; [apply EQP | apply EQQ].
Qed.
Global Instance impl_mm_ord : Proper (pord --> pord ++> pord) impl_mm.
Proof.
intros P1 P2 SubP Q1 Q2 SubQ t; unfold flip in SubP; unfold impl, impl_mm.
apply mclose_fw; intros t' Subt; rewrite Subt; clear t Subt; simpl morph.
rewrite SubP, <- SubQ; apply mclose_cl.
Qed.
Global Instance sc_mm_equiv : Proper (equiv ==> equiv ==> equiv) sc_mm.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ t; simpl morph.
apply sc_equiv; [apply EQP | apply EQQ].
Qed.
Global Instance sc_mm_dist n : Proper (dist n ==> dist n ==> dist n) sc_mm.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ t; simpl morph.
apply sc_dist; [apply EQP | apply EQQ].
Qed.
Global Instance sc_mm_ord : Proper (pord ==> pord ==> pord) sc_mm.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ t; simpl morph.
apply sc_pord; [apply EQP | apply EQQ].
Qed.
Global Instance si_mm_equiv : Proper (equiv ==> equiv ==> equiv) si_mm.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ; apply (morph_resp mclose); intros t; simpl morph.
apply si_equiv; [apply EQP | apply EQQ].
Qed.
Global Instance si_mm_dist n : Proper (dist n ==> dist n ==> dist n) si_mm.
Proof.
intros P1 P2 EQP Q1 Q2 EQQ; apply met_morph_nonexp; intros t; simpl morph.
apply si_dist; [apply EQP | apply EQQ].
Qed.
Global Instance si_mm_ord : Proper (pord --> pord ++> pord) si_mm.
Proof.
intros P1 P2 SubP Q1 Q2 SubQ t; unfold flip in SubP; unfold impl, impl_mm.
apply mclose_fw; intros t' Subt; rewrite Subt; clear t Subt; simpl morph.
rewrite SubP, <- SubQ; apply mclose_cl.
Qed.
Section Quantifiers.
Context V `{cmV : cmetric V}.
Global Instance all_mm_equiv : Proper (equiv (T := V -n> T -m> B) ==> equiv) all.
Proof.
intros R1 R2 EQR t; simpl morph.
apply all_equiv; intros u; simpl morph; apply EQR.
Qed.
Global Instance all_mm_dist n : Proper (dist (T := V -n> T -m> B) n ==> dist n) all.
Proof.
intros R1 R2 EQR t; simpl morph.
apply all_dist; intros u; simpl morph; apply EQR.
Qed.
Global Instance xist_mm_equiv : Proper (equiv (T := V -n> T -m> B) ==> equiv) xist.
Proof.
intros R1 R2 EQR t; simpl.
apply xist_equiv; intros u; simpl; apply EQR.
Qed.
Global Instance xist_mm_dist n : Proper (dist (T := V -n> T -m> B)n ==> dist n) xist.
Proof.
intros R1 R2 EQR t; simpl morph.
apply xist_dist; intros u; simpl morph; apply EQR.
Qed.
End Quantifiers.
Global Program Instance bi_mm : ComplBI (T -m> B).
Next Obligation.
intros t; apply top_true.
Qed.
Next Obligation.
intros t; apply bot_false.
Qed.
Next Obligation.
intros t; simpl morph; apply and_self.
Qed.
Next Obligation.
intros t; simpl morph; apply and_projL.
Qed.
Next Obligation.
intros t; simpl morph; apply and_projR.
Qed.
Next Obligation.
split; intros HH t; simpl morph.
- apply mclose_fw; intros t' Subt; specialize (HH t'); simpl morph in *.
rewrite Subt, <- and_impl; assumption.
- rewrite and_impl, (HH t); apply mclose_cl.
Qed.