Commit 0de5b6a9 authored by Filip Sieczkowski's avatar Filip Sieczkowski

Propositions are now uniform predicates over monoid elements (not 0);

definitions pushed through, some lemmas commented out for now.
parent 8688ed6e
This diff is collapsed.
......@@ -143,27 +143,25 @@ Section UPredBI.
Context Res `{pcmRes : PCM Res}.
Local Open Scope pcm_scope.
Local Obligation Tactic := intros; eauto with typeclass_instances.
Local Existing Instance eqT.
Definition oRes := option Res.
(* Standard interpretations of propositional connectives. *)
Global Program Instance top_up : topBI (UPred oRes) := up_cr (const True).
Global Program Instance bot_up : botBI (UPred oRes) := up_cr (const False).
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 oRes) :=
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 oRes) :=
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 oRes) :=
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.
......@@ -172,35 +170,40 @@ Section UPredBI.
Qed.
(* BI connectives. *)
Global Program Instance sc_up : scBI (UPred oRes) :=
Global Program Instance sc_up : scBI (UPred Res) :=
fun P Q =>
mkUPred (fun n r => exists r1 r2, r1 · r2 = r /\ P n r1 /\ Q n r2) _.
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 [rd HEq] [r11 [r12 [HEq' [HP HQ]]]].
rewrite <- HEq', assoc in HEq; setoid_rewrite HLe.
destruct (Some rd · Some r11) as [r11' |] eqn: HEq'';
[| erewrite pcm_op_zero in HEq by apply _; contradiction].
repeat eexists; [eassumption | | assumption].
eapply uni_pred, HP; [| exists rd]; reflexivity.
eapply uni_pred, HP; [reflexivity |].
exists rd; rewrite HEq''; reflexivity.
Qed.
Global Program Instance si_up : siBI (UPred oRes) :=
Global Program Instance si_up : siBI (UPred Res) :=
fun P Q =>
mkUPred (fun n r => forall m r' rr, r · r' = rr -> m <= n -> P m r' -> Q m rr) _.
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.
rewrite comm in HEq; rewrite <- HEq, <- assoc in HEq'.
eapply HSI; [| etransitivity |]; try eassumption; [].
eapply uni_pred, HP; [| exists r12]; reflexivity.
destruct (Some r12 · Some r) as [r' |] eqn: HEq'';
[| erewrite comm, pcm_op_zero in HEq' by apply _; contradiction].
eapply HSI; [eassumption | etransitivity; eassumption |].
eapply uni_pred, HP; [| exists r12; rewrite HEq'']; reflexivity.
Qed.
(* Quantifiers. *)
Global Program Instance all_up : allBI (UPred oRes) :=
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 oRes) :=
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.
......@@ -297,23 +300,23 @@ Section UPredBI.
Existing Instance nonexp_type.
Global Instance all_up_equiv : Proper (equiv (T := V -n> UPred oRes) ==> equiv) all.
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 oRes) n ==> dist n) all.
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 oRes) ==> equiv) xist.
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 oRes)n ==> dist n) xist.
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.
......@@ -321,7 +324,7 @@ Section UPredBI.
End Quantifiers.
Global Program Instance bi_up : ComplBI (UPred oRes).
Global Program Instance bi_up : ComplBI (UPred Res).
Next Obligation.
intros n r _; exact I.
Qed.
......@@ -357,21 +360,27 @@ Section UPredBI.
firstorder.
Qed.
Next Obligation.
intros P Q R n r; simpl; split.
intros P Q R n r; split.
- intros [r1 [rr [EQr [HP [r2 [r3 [EQrr [HQ HR]]]]]]]].
rewrite <- EQrr, assoc in EQr.
exists (r1 · r2) r3; split; [assumption | split; [| assumption] ].
exists r1 r2; tauto.
destruct (Some r1 · Some r2) as [r12 |] eqn: EQr';
[| now erewrite pcm_op_zero in EQr by apply _].
exists r12 r3; split; [assumption | split; [| assumption] ].
exists r1 r2; split; [rewrite EQr'; reflexivity | split; assumption].
- intros [rr [r3 [EQr [[r1 [r2 [EQrr [HP HQ]]]] HR]]]].
rewrite <- EQrr, <- assoc in EQr.
exists r1 (r2 · r3); split; [assumption | split; [assumption |] ].
exists r2 r3; tauto.
rewrite <- EQrr, <- assoc in EQr; clear EQrr.
destruct (Some r2 · Some r3) as [r23 |] eqn: EQ23;
[| now erewrite comm, pcm_op_zero in EQr by apply _].
exists r1 r23; split; [assumption | split; [assumption |] ].
exists r2 r3; split; [rewrite EQ23; reflexivity | split; assumption].
Qed.
Next Obligation.
intros n r; simpl; split.
intros n r; split.
- intros [r1 [r2 [EQr [_ HP]]]].
eapply uni_pred, HP; [| exists r1]; trivial.
- intros HP; exists 1%pcm r; unfold const; intuition eauto using pcm_op_unit.
- intros HP; exists (pcm_unit _) r; split;
[erewrite pcm_op_unit by apply _; reflexivity |].
simpl; unfold const; tauto.
Qed.
Next Obligation.
split; intros HH n r.
......
......@@ -17,10 +17,10 @@ Section Definitions.
Class PCM_op := pcm_op : option T -> option T -> option T.
Class PCM {TU : PCM_unit} {TOP : PCM_op} :=
mkPCM {
pcm_op_assoc :> Associative (eqT := discreteType) pcm_op;
pcm_op_comm :> Commutative (eqT := discreteType) pcm_op;
pcm_op_unit : forall t, pcm_op (Some pcm_unit) t = t;
pcm_op_zero : forall t, pcm_op None t = None
pcm_op_assoc :> Associative pcm_op;
pcm_op_comm :> Commutative pcm_op;
pcm_op_unit t : pcm_op (Some pcm_unit) t = t;
pcm_op_zero t : pcm_op None t = None
}.
End Definitions.
......@@ -31,11 +31,12 @@ Notation "p · q" := (pcm_op _ p q) (at level 40, left associativity) : pcm_scop
Delimit Scope pcm_scope with pcm.
Instance pcm_eq T `{pcmT : PCM T} : Setoid T | 0 := eqT _.
(* PCMs with cartesian products of carriers. *)
Section Products.
Context S T `{pcmS : PCM S, pcmT : PCM T}.
Local Open Scope pcm_scope.
Local Existing Instance eqT.
Global Instance pcm_unit_prod : PCM_unit (S * T) := (pcm_unit S, pcm_unit T).
Global Instance pcm_op_prod : PCM_op (S * T) :=
......@@ -54,29 +55,36 @@ Section Products.
- intros [[s1 t1] |]; [| reflexivity].
intros [[s2 t2] |]; [| reflexivity].
intros [[s3 t3] |];
[unfold pcm_op, pcm_op_prod |
unfold pcm_op at 1 2, pcm_op_prod;
[| unfold pcm_op at 1 2, pcm_op_prod;
destruct (Some (s1, t1) · Some (s2, t2)) as [[s t] |]; simpl; tauto].
assert (HS := assoc (Some s1) (Some s2) (Some s3));
assert (HT := assoc (Some t1) (Some t2) (Some t3)).
unfold pcm_op, pcm_op_prod.
destruct (Some s1 · Some s2) as [s12 |];
destruct (Some s2 · Some s3) as [s23 |]; [.. | reflexivity].
+ destruct (Some t1 · Some t2) as [t12 |];
destruct (Some t2 · Some t3) as [t23 |]; [.. | reflexivity].
* simpl in HS, HT; rewrite HS, HT; reflexivity.
* erewrite comm, pcm_op_zero in HT by eassumption; simpl in HT.
rewrite <- HT; destruct (Some s12 · Some s3); reflexivity.
* erewrite pcm_op_zero in HT by eassumption; simpl in HT.
rewrite HT; destruct (Some s1 · Some s23); reflexivity.
+ erewrite comm, pcm_op_zero in HS by eassumption; simpl in HS.
* destruct (Some s1 · Some s23) as [s |]; destruct (Some s12 · Some s3) as [s' |];
try (reflexivity || contradiction); simpl in HS; subst s'; [].
destruct (Some t1 · Some t23) as [t |]; destruct (Some t12 · Some t3) as [t' |];
try (reflexivity || contradiction); simpl in HT; subst t'; reflexivity.
* erewrite comm, pcm_op_zero in HT by apply _.
destruct (Some t12 · Some t3); [contradiction |].
destruct (Some s12 · Some s3); reflexivity.
* erewrite pcm_op_zero in HT by apply _.
destruct (Some t1 · Some t23); [contradiction |].
destruct (Some s1 · Some s23); reflexivity.
+ erewrite comm, pcm_op_zero in HS by apply _.
destruct (Some t1 · Some t2) as [t12 |]; [| reflexivity].
rewrite <- HS; reflexivity.
+ erewrite pcm_op_zero in HS by eassumption; simpl in HS.
destruct (Some s12 · Some s3) as [s |]; [contradiction | reflexivity].
+ erewrite pcm_op_zero in HS by apply _.
destruct (Some t2 · Some t3) as [t23 |]; [| reflexivity].
rewrite HS; reflexivity.
- intros [[s1 t1] |] [[s2 t2] |]; try reflexivity; []; simpl; unfold pcm_op, pcm_op_prod.
rewrite (comm (Some s1)); assert (HT := comm (Some t1) (Some t2)).
simpl in HT; rewrite HT; reflexivity.
destruct (Some s1 · Some s23); [contradiction | reflexivity].
- intros [[s1 t1] |] [[s2 t2] |]; try reflexivity; []; simpl morph; unfold pcm_op, pcm_op_prod.
assert (HS := comm (Some s1) (Some s2)); assert (HT := comm (Some t1) (Some t2)).
destruct (Some s1 · Some s2); destruct (Some s2 · Some s1); try (contradiction || exact I); [].
destruct (Some t1 · Some t2); destruct (Some t2 · Some t1); try (contradiction || exact I); [].
simpl in HS, HT; subst s0 t0; reflexivity.
- intros [[s t] |]; [| reflexivity]; unfold pcm_op, pcm_op_prod; simpl.
erewrite !pcm_op_unit by eassumption; reflexivity.
- intros st; reflexivity.
......@@ -87,24 +95,59 @@ End Products.
Section Order.
Context T `{pcmT : PCM T}.
Local Open Scope pcm_scope.
Local Existing Instance eqT.
Definition pcm_ord (t1 t2 : option T) :=
exists td, td · t1 = t2.
Global Instance pcm_op_equiv : Proper (equiv ==> equiv ==> equiv) (pcm_op _).
Proof.
intros [s1 |] [s2 |] EQs; try contradiction; [|];
[intros [t1 |] [t2 |] EQt; try contradiction; [| rewrite (comm (Some s1)), (comm (Some s2)) ] | intros t1 t2 _];
try (erewrite !pcm_op_zero by apply _; reflexivity); [].
simpl in EQs, EQt; subst t2 s2; reflexivity.
Qed.
Definition pcm_ord (t1 t2 : T) :=
exists td, Some td · Some t1 == Some t2.
Global Program Instance PCM_preo : preoType T | 0 := mkPOType pcm_ord.
Next Obligation.
split.
- intros x; eexists; erewrite pcm_op_unit by apply _; reflexivity.
- intros z yz xyz [y Hyz] [x Hxyz]; unfold pcm_ord.
rewrite <- Hyz, assoc in Hxyz; setoid_rewrite <- Hxyz.
destruct (Some x · Some y) as [xy |] eqn: Hxy; [eexists; reflexivity |].
erewrite pcm_op_zero in Hxyz by apply _; contradiction.
Qed.
Global Program Instance PCM_preo {pcmT : PCM T} : preoType (option T) | 0 := mkPOType pcm_ord.
Definition opcm_ord (t1 t2 : option T) :=
exists otd, otd · t1 == t2.
Global Program Instance opcm_preo : preoType (option T) :=
mkPOType opcm_ord.
Next Obligation.
split.
- intros x; exists 1; eapply pcm_op_unit; assumption.
- intros r; exists 1; erewrite pcm_op_unit by apply _; reflexivity.
- intros z yz xyz [y Hyz] [x Hxyz]; exists (x · y).
rewrite <- assoc; congruence.
rewrite <- Hxyz, <- Hyz; symmetry; apply assoc.
Qed.
Global Instance equiv_pord_pcm : Proper (equiv ==> equiv ==> equiv) (pord (T := option T)).
Proof.
intros s1 s2 EQs t1 t2 EQt; split; intros [s HS].
- exists s; rewrite <- EQs, <- EQt; assumption.
- exists s; rewrite EQs, EQt; assumption.
Qed.
Global Instance pcm_op_monic : Proper (pord ==> pord ==> pord) (pcm_op _).
Proof.
intros x1 x2 [x EQx] y1 y2 [y EQy]; exists (x · y).
rewrite <- assoc, (comm y), <- assoc, assoc, (comm y1), EQx, EQy; reflexivity.
Qed.
Global Instance prod_ord : Proper (pord ==> pord ==> pord) (pcm_op _).
Lemma ord_res_optRes r s :
(r s) <-> (Some r Some s).
Proof.
intros x1 x2 [xd EQx] y1 y2 [yd EQy].
exists (xd · yd).
rewrite <- assoc, (comm yd), <- assoc, assoc, (comm y1); congruence.
split; intros HR.
- destruct HR as [d EQ]; exists (Some d); assumption.
- destruct HR as [[d |] EQ]; [exists d; assumption |].
erewrite pcm_op_zero in EQ by apply _; contradiction.
Qed.
End Order.
......
......@@ -23,7 +23,7 @@ Module WorldProp (Res : PCM_T).
Local Instance pcm_disc P `{cmetric P} : pcmType P | 2000 := disc_pcm P.
Definition FProp P `{cmP : cmetric P} :=
(nat -f> P) -m> UPred (option res).
(nat -f> P) -m> UPred res.
Context {U V} `{cmU : cmetric U} `{cmV : cmetric V}.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment