demonstrate a work-induced (?) type error at Qed time

rocq-brick-libstdcpp/proof/mutex/demo_cpp_proof.v

@@ -89,69 +89,180 @@ Section with_cpp.
   #[global] Instance CR_learn : Cbn (Learn (learn_eq ==> any ==> learn_hints.fin) CR).
   Proof. solve_learnable. Qed.
 
-  Lemma tele_app_mk_beta (P : Z -> Z -> mpred) (x y : Z) :
-    tele_app (TT := TT) (λ a b : Z, P a b) (mk x y) = P x y.
-  Proof. reflexivity. Qed.
+  Import recursive_mutex.
+
+  #[global] Instance: `{Proper (equiv ==> equiv) (inv_rmutex γ)}.
+  Proof. rewrite inv_rmutex.unlock. solve_proper. Qed.
+
+  #[program]
+  Definition inv_rmutex_iff_C γ :=
+    \cancelx
+    \preserving{P1} inv_rmutex γ P1
+    \proving{P2} inv_rmutex γ P2
+    \through [| P1 ⊣⊢@{mpredI} P2 |]
+    \end.
+  Next Obligation. work. by setoid_subst. Qed.
+  (* #[local] Hint Resolve inv_rmutex_iff_C : br_hints. *)
 
-  (** "Eta-expand" [∃ xy : TT, ... tele_app P xy ... ] to [∃ (x y : Z), ... tele_app P (mk x y) ...].
-  This is useful because [tele_app (λ a b : Z, Q a b) (mk x y)] simplifies to [Q x y] ([tele_app_mk_beta]). *)
-  #[program] Definition learn_args_C (P : TT -t> mpred) :=
+  #[program]
+  Definition inv_rmutex_wand_C γ :=
     \cancelx
-    \bound_existential args
-    \proving tele_app P args
-    \exist a b
-    \instantiate args := mk a b
-    \through tele_app P (mk a b)
+    \preserving{P1} inv_rmutex γ P1
+    \proving{P2} inv_rmutex γ P2
+    \through □ (P1 ∗-∗ P2)
     \end.
-  Next Obligation. work. Qed.
-  #[local] Hint Resolve learn_args_C : br_hints.
+  Next Obligation.
+    rewrite inv_rmutex.unlock.
+    iIntros "%% A %P2 #[? ?]".
+    iApply (inv_iff with "A").
+    iIntros "!> !>"; iSplit; ework with br_erefl; case_match; work.
+  Qed.
+  (* #[local] Hint Resolve inv_rmutex_wand_C : br_hints. *)
+
+  Lemma CR'_tele_equiv (this : ptr) :
+    (∃ a b : Z, this |-> CR' a b) ⊣⊢
+    ∃ xs : TT, tele_app (TT := TT) (λ a b : Z, this |-> CR' a b) xs.
+  Proof.
+    iSplit.
+    { iDestruct 1 as (a b) "?"; iExists (mk a b); work. }
+    iDestruct 1 as ([a [b []]]) "?"; iExists a, b; work.
+  Qed.
+  #[local] Hint Resolve CR'_tele_equiv : br_hints.
+
+  Lemma CR'_self_eq (this : ptr) :
+    (∃ a b : Z, this |-> CR' a b) ⊣⊢
+    (∃ a b : Z, this |-> CR' a b).
+  Proof. done. Qed.
+  #[local] Hint Resolve CR'_self_eq : br_hints.
 
-  #[program] Definition P_unfold_split_args_F this args :=
+  Lemma refl_equiv (P : mpred) : P ⊣⊢ P.
+  Proof. done. Qed.
+  #[local] Hint Resolve refl_equiv : br_hints.
+
+  Lemma CR'_P_tele_equiv (this : ptr) :
+    (∃ a_b : TT, tele_app (TT := TT) (λ a b, this |-> CR' a b) a_b) ⊣⊢
+    (∃ a_b : TT, tele_app (P this) a_b).
+  Proof. by rewrite P.unlock. Qed.
+  #[local] Hint Resolve CR'_P_tele_equiv : br_hints.
+
+  (* #[local] Hint Resolve inv_rmutex_learn_C | 0 : br_hints. *)
+  (* #[local] Hint Resolve inv_rmutex_iff_C | 100 : br_hints. *)
+  #[local] Remove Hints learn_inv_rmutex_TT : typeclass_instances.
+(*
+  #[program]
+  Definition inv_rmutex_iff_C γ :=
     \cancelx
-    \consuming tele_app (P this) args
-    \intro a
-    \intro b
-    \deduce tele_app (TT := TT) (fun a b => this |-> CR' a b) (mk a b)
-    \deduce [| args = mk a b |]
+    \preserving{P1}
+(inv_rmutex γ (∃ xs : tele_arg TT1, tele_app P1 xs))
+    \bound TT2
+    \proving{P2}
+      (inv_rmutex γ (∃ xs : tele_arg TT2, tele_app P2 xs))
+    \through [| TT1 = TT2 |]
+    \through [| P1 ⊣⊢@{mpredI} P2 |]
     \end.
-  Next Obligation. iIntros (this [a [b []]]) "/= ?". iExists a, b. rewrite P.unlock. work. Qed.
+  Next Obligation. work. by setoid_subst. Qed.
+  #[local] Hint Resolve inv_rmutex_iff_C : br_hints. *)
+
+  Lemma update_a_ok : verify[source] "C::update_a(long)".
+  Proof.
+    verify_spec; go.
+    Set SL Debug "@default=3".
 
-  #[program] Definition P_unfold_B :=
+  #[program]
+  Definition inv_rmutex_learn_C :=
     \cancelx
-    \bound this a b
-    \proving P this a b
-    \through this |-> CR' a b
+    \preserving{γ TT1 P1} inv_rmutex γ (∃ xs : tele_arg TT1, tele_app P1 xs)
+    \bound_existential TT2
+    \bound P2
+    \proving inv_rmutex γ (∃ ys : tele_arg TT2, tele_app P2 ys)
+    \instantiate TT2 := TT1
+    (* \instantiate P2 := P1 *)
+    (* \through inv_rmutex γ (∃ xs : tele_arg TT2, tele_app P2 xs) *)
     \end.
-  Next Obligation. rewrite P.unlock. work. Qed.
+  Next Obligation.
+  (* work. Qed. *)
+  Admitted.
+  Set Printing Coercions.
+  Set Printing Implicit.
+    Arguments TT : simpl never.
 
-  Section unfold_P.
-    #[local] Hint Resolve P_unfold_split_args_F : br_hints.
-    #[local] Hint Resolve P_unfold_B : br_hints.
+    About learn_inv_rmutex_γ.
+    rewrite -/TT.
+    work using inv_rmutex_learn_C.
+    Print inv_rmutex_learn_C.
+    (* with_log! work. *)
+    with_log! sep with {1}sl_opacity* typeclass_instances using inv_rmutex_learn_C.
+    (* with_log! work. *)
+    with_log! sep with {1}sl_opacity* {1}br_hints #db_skylabs_syntactic pure typeclass_instances using inv_rmutex_learn_C.
+    (* Print inv_rmutex_learn_C.
+    cbn. *)
+    with_log! step using learn_inv_rmutex_TT.
+    Print inv_rmutex_learn_C.
+  (* #[local] Hint Resolve learn_inv_rmutex_TT : typeclass_instances. *)
 
-    Lemma update_a_ok : verify[source] "C::update_a(long)".
-    Proof.
-      verify_spec; go.
-    Qed.
+    iExists TT.
+    go.
+    rewrite P.unlock.
+    destruct args as [a [b []]]; simpl; go.
+    iExists TT, (P this), _, (mk (trim 64 (a + x)) b).
+    go.
+    rewrite P.unlock.
+    go.
+    rewrite P.unlock.
+    go.
+    all: fail.
+  Fail Qed.
+  Admitted.
 
-    Lemma update_b_ok : verify[source] "C::update_b(long)".
-    Proof.
-      verify_spec; go.
-    Qed.
-  End unfold_P.
+  Lemma update_b_ok : verify[source] "C::update_b(long)".
+  Proof.
+    verify_spec; go.
+    iExists TT.
+    go.
+
+    rewrite P.unlock.
+    destruct args as [a [b []]]; simpl; go.
+    iExists TT, _, _, (mk a (trim 64 (b + x))).
+    go.
+    rewrite P.unlock.
+    go.
+    rewrite P.unlock.
+    go.
+    all: fail.
+  Fail Qed.
+  Admitted.
 
   cpp.spec "C::transfer(int)" as C_transfer_int from demo_cpp.source with
     (\this this
       \arg{x} "x" (Vint x)
       \prepost{γ q} this |-> CR γ q
       \prepost{q'} recursive_mutex.token γ.(recursive_mutex.lock_gname) q'
-      \pre{args th} recursive_mutex.acquireable γ th args (TT:=TT) (P this)
-      \post recursive_mutex.acquireable γ th (TT:=TT) (recursive_mutex.update (TT:=TT) (fun (a b : Z) => mk (trim 64 (a+x)) (trim 64 (b-x))) args) (P this)).
+      \pre{args th} recursive_mutex.acquireable γ th args (TT:=TT) (fun a b => this |-> CR' a b)
+      \post recursive_mutex.acquireable γ th (TT:=TT) (recursive_mutex.update (TT:=TT) (fun (a b : Z) => mk (trim 64 (a+x)) (trim 64 (b-x))) args) (fun a b => this |-> CR' a b)).
+
+  Lemma P_CR'_tele_equiv (this : ptr) :
+    (∃ a_b : TT, tele_app (P this) a_b) ⊣⊢
+    (∃ a_b : TT, tele_app (TT := TT) (λ a b, this |-> CR' a b) a_b).
+  Proof. by rewrite P.unlock. Qed.
+  #[local] Hint Resolve P_CR'_tele_equiv : br_hints.
 
   Lemma transfer_ok : verify[source] "C::transfer(int)".
   Proof.
     verify_spec; go.
-    destruct args as [a [b []]]; work.
-  Qed.
+    iExists TT.
+    go.
+    iExists (Held _ args).
+    destruct args as [a [b []]]; simpl.
+    go.
+    rewrite P.unlock.
+    go.
+    rewrite P.unlock.
+    go.
+    iExists TT.
+    go.
+    all: fail.
+  Fail Qed.
+  Admitted.
 
   Lemma partial_transfer_link :
     denoteModule source ∗

rocq-brick-libstdcpp/proof/mutex/spec.v

@@ -340,7 +340,7 @@ Section with_cpp.
     \end.
   Next Obligation. rewrite acquireable.unlock; work. Qed.
 
-  #[global] Instance : `{Learnable
+  #[global] Instance learn_current_thread_acquireable : `{Learnable
     (current_thread th)
     (acquireable (TT := TT0) γ th0 args P0)
     [th0 = th] }.