Commit 3d69aaa0 by Filip Sieczkowski

### Added a library for solving recursive domain equations.

parents
lib/recdom/BI.v 0 → 100644
 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. Next Obligation. intros t; simpl morph; apply or_injL. Qed. Next Obligation. intros t; simpl morph; apply or_injR. Qed. Next Obligation. intros t; simpl morph; apply or_self. Qed. Next Obligation. intros f1 f2 t; simpl morph; apply comm. Qed. Next Obligation.