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

definitions pushed through, some lemmas commented out for now.

lib/recdom/BI.v

@@ -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.

lib/recdom/PCM.v

@@ -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.

world_prop.v

@@ -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}.