From 83756a2747eeaebacbe551c2c03f82aaf351382f Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Wed, 19 Aug 2026 20:11:42 +0200 Subject: [PATCH 01/51] Copy snapshot of atomic specs --- rocq-brick-libstdcpp/proof/atomic/inc_int.cpp | 2 + rocq-brick-libstdcpp/proof/atomic/pred.v | 54 +++ rocq-brick-libstdcpp/proof/atomic/spec.v | 357 ++++++++++++++++++ rocq-brick-libstdcpp/proof/atomic/test.cpp | 99 +++++ .../proof/atomic/test_cpp_proof.v | 226 +++++++++++ 5 files changed, 738 insertions(+) create mode 100644 rocq-brick-libstdcpp/proof/atomic/inc_int.cpp create mode 100644 rocq-brick-libstdcpp/proof/atomic/pred.v create mode 100644 rocq-brick-libstdcpp/proof/atomic/spec.v create mode 100644 rocq-brick-libstdcpp/proof/atomic/test.cpp create mode 100644 rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v diff --git a/rocq-brick-libstdcpp/proof/atomic/inc_int.cpp b/rocq-brick-libstdcpp/proof/atomic/inc_int.cpp new file mode 100644 index 00000000..fd52b45e --- /dev/null +++ b/rocq-brick-libstdcpp/proof/atomic/inc_int.cpp @@ -0,0 +1,2 @@ +#include +template<> class std::atomic; diff --git a/rocq-brick-libstdcpp/proof/atomic/pred.v b/rocq-brick-libstdcpp/proof/atomic/pred.v new file mode 100644 index 00000000..ddf95972 --- /dev/null +++ b/rocq-brick-libstdcpp/proof/atomic/pred.v @@ -0,0 +1,54 @@ +(** + * Copyright (C) 2025 SkyLabs AI, Inc. + * All rights reserved. + * + * SPDX-License-Identifier: LGPL-2.1 WITH BlueRock Exception for use over network, see repository root for details. + *) +Require Import skylabs.auto.cpp.spec. +Require Import skylabs.cpp.spec.concepts. +Require skylabs.cpp.stdlib.atomic.inc_int_cpp. + +Require Import skylabs.cpp.spec.concepts. + +(** * Interface to Atomic *) +(** +These specifications assume that all memory order parameters (template, +function arguments) are _SEQ_CST. In the C++ code, redefine the other +memory order macros to __ATOMIC_SEQ_CST. +*) + +cpp.enum "std::memory_order" from (inc_int_cpp.source) variant. +#[global] Notation Tmemory_order := {%cpp_type[inc_int_cpp.source] "std::memory_order"} (only parsing). + +Module Type ATOMIC_PREDS. + + (** Type [t] indexing our spec models the type name T in Atomic. *) + + (** The type where the actual methods are implemented *) + #[global] Notation base_name ty := + (Ninst "std::__1::__atomic_base" [Atype ty; Avalue (Eint 0 Tbool)]). + #[global] Notation base_name1 ty := + (Ninst "std::__1::__atomic_base" [Atype ty; Avalue (Eint 1 Tbool)]). + (** The type <>> *) + #[global] Notation class_name ty := (Ninst "std::__1::atomic" [Atype ty]). + #[global] Notation T ty := (Tnamed (class_name ty)). + + (** Abstract predicates *) + + (** Fraction [q] ownership of atomically accessible value [v]. *) + Parameter R : ∀ `{Σ : cpp_logic} {σ : genv} (ty : type) `{PV : @PrimVal ty A} (q : cQp.t) (x : A), Rep. + + Section R_props. + Context `{Σ : cpp_logic} {σ : genv} `{PV : @PrimVal ty A}. + Notation R := (R ty (PV:=PV)). + + #[global] Declare Instance R_frac : CFractional1 R. + #[global] Declare Instance R_timeless : Timeless2 R. + #[global] Declare Instance R_frac_valid : CFracValid1 R. + #[global] Declare Instance R_agree : Cbn (Learn (any ==> learn_eq ==> learn_hints.fin) R). + #[global] Declare Instance R_type : Typed2 (class_name ty) R. + End R_props. + +End ATOMIC_PREDS. + +Declare Module atomic : ATOMIC_PREDS. diff --git a/rocq-brick-libstdcpp/proof/atomic/spec.v b/rocq-brick-libstdcpp/proof/atomic/spec.v new file mode 100644 index 00000000..b7a83714 --- /dev/null +++ b/rocq-brick-libstdcpp/proof/atomic/spec.v @@ -0,0 +1,357 @@ +(** + * Copyright (C) 2025 SkyLabs AI, Inc. + * All rights reserved. + * + * SPDX-License-Identifier: LGPL-2.1 WITH BlueRock Exception for use over network, see repository root for details. + *) +Require Import skylabs.auto.cpp.spec. +Require Import skylabs.cpp.spec.concepts. +Require Import skylabs.cpp.stdlib.atomic.inc_int_cpp. + +Require Import skylabs.cpp.spec.concepts. +Require Export skylabs.cpp.stdlib.atomic.pred. + +Module atomic_specs (Import atomic : ATOMIC_PREDS). + + #[global] Hint Opaque R : sl_opacity. + + Section spec. + Context `{Σ : cpp_logic} {σ : genv}. + Context (ty : type). + Context `{!PrimVal ty A,!DefaultValue ty A}. + Notation s := (class_name ty) (only parsing). (** [Atomic] *) + Notation b0 := (base_name ty) (only parsing). + Notation b1 := (base_name1 ty) (only parsing). + Notation R := (R ty). + Notation bR q v := (_derived b0 b1 ,, _derived b1 s |-> R q%cQp v) (only parsing). + + Definition default_ctor : mpred := + specify.template.ctor s [] $ + \this this + \post this |-> R 1$m (default_val ty). + #[global] Hint Opaque default_ctor : sl_opacity. + #[global] Arguments default_ctor : simpl never. + Definition SpecFor_default_ctor := RegisterSpec default_ctor. + #[global] Existing Instance SpecFor_default_ctor. + + Definition ctor : mpred := + specify.template.ctor s [ty] $ + \this this + \arg{n} "v" (Vinj ty n) + \post this |-> R 1$m n. + #[global] Hint Opaque ctor : sl_opacity. + #[global] Arguments ctor : simpl never. + Definition SpecFor_ctor := RegisterSpec ctor. + #[global] Existing Instance SpecFor_ctor. + + Definition dtor : mpred := + specify.template.dtor s $ + \this this + \pre{n} this |-> R 1$m n + \post emp. + #[global] Hint Opaque dtor : sl_opacity. + #[global] Arguments dtor : simpl never. + Definition SpecFor_dtor := RegisterSpec dtor. + #[global] Existing Instance SpecFor_dtor. + + (** *** <> & <> *) + Definition do_load (this : ptr) (K : A -> mpred) : mpred := + AR1 << ∃∃ n q, this |-> bR q n >> @ top, empty << K n >>. + #[global] Hint Opaque do_load : typeclass_instances sl_opacity. + + Definition load : mpred := + specify.template.method b0 "load" function_qualifiers.N ty [Tmemory_order] $ + \this this + \arg "mo" (memory_order.to_val memory_order.seq_cst) + \pre{K} do_load this K + \post{n}[Vinj ty n] K n. + #[global] Hint Opaque load : sl_opacity. + #[global] Arguments load : simpl never. + Definition SpecFor_load := RegisterSpec load. + #[global] Existing Instance SpecFor_load. + + Definition load_const : mpred := + specify.template.method b0 "load" function_qualifiers.Nc ty [Tmemory_order] $ + \this this + \arg "mo" (memory_order.to_val memory_order.seq_cst) + \pre{K} do_load this K + \post{n}[Vinj ty n] K n. + #[global] Hint Opaque load_const : sl_opacity. + #[global] Arguments load_const : simpl never. + Definition SpecFor_load_const := RegisterSpec load_const. + #[global] Existing Instance SpecFor_load_const. + + Definition do_store (this : ptr) (n : A) (K : mpred) : mpred := + AC1 << ∀ m, this |-> bR 1$m m >> @ top, empty + << this |-> bR 1$m n, COMM K >>. + #[global] Hint Opaque do_store : typeclass_instances sl_opacity. + + Definition store : mpred := + specify.template.method b0 "store" function_qualifiers.N Tvoid [ty; Tmemory_order] $ + \this this + \arg{n} "v" (Vinj ty n) + \arg "mo" (memory_order.to_val memory_order.seq_cst) + \pre{K} do_store this n K + \post K. + #[global] Hint Opaque store : sl_opacity. + #[global] Arguments store : simpl never. + Definition SpecFor_store := RegisterSpec store. + #[global] Existing Instance SpecFor_store. + + (** *** <> *) + Definition assign : mpred := + specify.template.op b0 OOEqual function_qualifiers.N ty [ty] $ + \this this + \arg{n} "v" (Vinj ty n) + \pre{K} do_store this n K + \post[Vinj ty n] K. + #[global] Hint Opaque assign : sl_opacity. + #[global] Arguments assign : simpl never. + Definition SpecFor_assign := RegisterSpec assign. + #[global] Existing Instance SpecFor_assign. + + (** *** <> *) + Definition cast : mpred := + specify.template.conv b0 ty function_qualifiers.Nc $ + \this this + \pre{K} do_load this K + \post{n}[Vinj ty n] K n. + #[global] Hint Opaque cast : sl_opacity. + #[global] Arguments cast : simpl never. + Definition SpecFor_cast := RegisterSpec cast. + #[global] Existing Instance SpecFor_cast. + + (** *** <> *) + Definition do_exchange (this : ptr) (n : A) (K : A -> mpred) : mpred := + AU1 << ∀ m, this |-> bR 1$m m >> @ top, empty + << this |-> bR 1$m n, COMM K m >>. + #[global] Hint Opaque do_exchange : typeclass_instances sl_opacity. + + Definition exchange : mpred := + specify.template.method b0 "exchange" function_qualifiers.N ty + [ty; Tmemory_order] $ + \this this + \arg{desired} "desired" (Vinj ty desired) + \arg "mo" (memory_order.to_val memory_order.seq_cst) + \pre{K} do_exchange this desired K + \post{m}[Vinj ty m] K m. + #[global] Hint Opaque exchange : sl_opacity. + #[global] Arguments exchange : simpl never. + Definition SpecFor_exchange := RegisterSpec exchange. + #[global] Existing Instance SpecFor_exchange. + + (** *** <> & <> *) + Definition do_compare_exchange (weak : bool) (this expected_p : ptr) (expected desired : A) + (K : bool -> mpred) : mpred := + AU1 << ∀ cur, this |-> bR 1$m cur >> @ top, empty + << ∃ success m', + [| if weak then (* lifting the test on [weak] is probably a bit easier to work with *) + (success = true /\ cur = expected /\ m' = desired) \/ + (success = false /\ m' = cur) + else + (success = true /\ cur = expected /\ m' = desired) \/ + (success = false /\ cur <> expected /\ m' = cur) + |] ** + this |-> bR 1$m m', + COMM + expected_p |-> primR ty 1$m (Vinj ty cur) -* + K success + >>. + #[global] Hint Opaque do_compare_exchange : typeclass_instances sl_opacity. + + (** NOTE: the difference between the following two specs is not immediately obvious. *) + Definition compare_exchange_strong : mpred := + specify.template.method b0 "compare_exchange_strong" function_qualifiers.N "bool" + [Tref ty; ty; Tmemory_order; Tmemory_order] $ + \this this + \arg{expected_p} "o" (Vref expected_p) + \arg{desired} "n" (Vinj ty desired) + \arg "mo_success" (memory_order.to_val memory_order.seq_cst) + \arg "mo_failure" (memory_order.to_val memory_order.seq_cst) + \pre{expected} expected_p |-> primR ty 1$m (Vinj ty expected) + \pre{K} do_compare_exchange false this expected_p expected desired K + \post{b}[Vbool b] K b. + #[global] Hint Opaque compare_exchange_strong : sl_opacity. + #[global] Arguments compare_exchange_strong : simpl never. + Definition SpecFor_compare_exchange_strong := RegisterSpec compare_exchange_strong. + #[global] Existing Instance SpecFor_compare_exchange_strong. + + Definition compare_exchange_strong_1 : mpred := + specify.template.method b0 "compare_exchange_strong" function_qualifiers.N "bool" + [Tref ty; ty; Tmemory_order] $ + \this this + \arg{expected_p} "o" (Vref expected_p) + \arg{desired} "n" (Vinj ty desired) + \arg "mo" (memory_order.to_val memory_order.seq_cst) + \pre{expected} expected_p |-> primR ty 1$m (Vinj ty expected) + \pre{K} do_compare_exchange false this expected_p expected desired K + \post{b}[Vbool b] K b. + #[global] Hint Opaque compare_exchange_strong_1 : sl_opacity. + #[global] Arguments compare_exchange_strong_1 : simpl never. + Definition SpecFor_compare_exchange_strong_1 := RegisterSpec compare_exchange_strong_1. + #[global] Existing Instance SpecFor_compare_exchange_strong_1. + + Definition compare_exchange_weak : mpred := + specify.template.method b0 "compare_exchange_weak" function_qualifiers.N "bool" + [Tref ty; ty; Tmemory_order; Tmemory_order] $ + \this this + \arg{expected_p} "o" (Vref expected_p) + \arg{desired} "n" (Vinj ty desired) + \arg "mo_success" (memory_order.to_val memory_order.seq_cst) + \arg "mo_failure" (memory_order.to_val memory_order.seq_cst) + \pre{expected} expected_p |-> primR ty 1$m (Vinj ty expected) + \pre{K} do_compare_exchange true this expected_p expected desired K + \post{b}[Vbool b] K b. + #[global] Hint Opaque compare_exchange_weak : sl_opacity. + #[global] Arguments compare_exchange_weak : simpl never. + Definition SpecFor_compare_exchange_weak := RegisterSpec compare_exchange_weak. + #[global] Existing Instance SpecFor_compare_exchange_weak. + + Definition compare_exchange_weak_1 : mpred := + specify.template.method b0 "compare_exchange_weak" function_qualifiers.N "bool" + [Tref ty; ty; Tmemory_order] $ + \this this + \arg{expected_p} "o" (Vref expected_p) + \arg{desired} "n" (Vinj ty desired) + \arg "mo" (memory_order.to_val memory_order.seq_cst) + \pre{expected} expected_p |-> primR ty 1$m (Vinj ty expected) + \pre{K} do_compare_exchange true this expected_p expected desired K + \post{b}[Vbool b] K b. + #[global] Hint Opaque compare_exchange_weak_1 : sl_opacity. + #[global] Arguments compare_exchange_weak_1 : simpl never. + Definition SpecFor_compare_exchange_weak_1 := RegisterSpec compare_exchange_weak_1. + #[global] Existing Instance SpecFor_compare_exchange_weak_1. + + End spec. + + Section bundled_spec. + Context `{Σ : cpp_logic} {σ : genv}. + Context (ty : type). + Context `{!PrimVal ty A,!DefaultValue ty A}. + + Definition specs := + ctor ty ** + default_ctor ty ** + dtor ty ** + load ty ** + load_const ty ** + store ty ** + assign ty ** + cast ty ** + exchange ty ** + compare_exchange_strong ty ** + compare_exchange_strong_1 ty ** + compare_exchange_weak ty ** + compare_exchange_weak_1 ty. + End bundled_spec. + + Class UnOp (ty : type) (A : Type) (op_name : OverloadableOperator) := + { atomic_un_op : A -> A + }. + + Class BinOp (ty1 ty2 : type) (A B : Type) (op_name : OverloadableOperator) (fun_name : ident) := + { atomic_bin_op : A -> B -> A + }. + + Section with_ty. + Context `{Σ : cpp_logic} {σ : genv}. + Context (ty : type). + Context `{PrimVal ty A}. + + #[local] Notation s := (class_name ty) (only parsing). (** [Atomic] *) + #[local] Notation b1 := (base_name1 ty) (only parsing). + #[local] Notation bR q v := (_derived b1 s |-> R ty q v) (only parsing). + + (** Apply operation [op] to the atomic cell pointed by [this], + and return the old contents to continuation [K]. *) + #[local] Definition do_op (op : A -> A) (this : ptr) (K : A -> mpred) : mpred := + AC1 << ∀ m, this |-> bR 1$m m >> @ top, empty + << this |-> bR 1$m (op m), COMM K m >>. + #[global] Hint Opaque do_op : typeclass_instances sl_opacity. + + Section with_unop. + Context `{!UnOp ty A op_name}. + + (** Triple for unary operators that return the new value *) + Definition unop_fetch : mpred := + specify.template.op b1 op_name function_qualifiers.N ty [] $ + \this this + \pre{K} do_op atomic_un_op this K + \post{m}[Vinj ty (atomic_un_op m)] K m. + + #[global] Hint Opaque unop_fetch : sl_opacity. + #[global] Arguments unop_fetch : simpl never. + Definition SpecFor_unop_fetch := RegisterSpec unop_fetch. + #[global] Existing Instance SpecFor_unop_fetch. + + (** Triple for unary operators that return the old value *) + Definition fetch_unop : mpred := + specify.template.op b1 op_name function_qualifiers.N ty [Tint] $ + \this this + \arg{dummy} "dummy" (Vint dummy) + \pre{K} do_op atomic_un_op this K + \post{m}[Vinj ty m] K m. + + #[global] Hint Opaque fetch_unop : sl_opacity. + #[global] Arguments fetch_unop : simpl never. + Definition SpecFor_fetch_unop := RegisterSpec fetch_unop. + #[global] Existing Instance SpecFor_fetch_unop. + End with_unop. + + Section with_binop. + Context `{!BinOp ty tyM A B op_name fun_name}. + Context `{!PrimVal tyM B}. + + (** Triple for binary operators that return the new value *) + Definition binop_fetch : mpred := + specify.template.op b1 op_name function_qualifiers.N ty [tyM] $ + \this this + \arg{n : B} "v" (Vinj tyM n) + \pre{K} do_op (flip atomic_bin_op n) this K + \post{m}[Vinj ty (atomic_bin_op m n)] K m. + #[global] Hint Opaque binop_fetch : sl_opacity. + #[global] Arguments binop_fetch : simpl never. + Definition SpecFor_binop_fetch := RegisterSpec binop_fetch. + #[global] Existing Instance SpecFor_binop_fetch. + + (** Triple for methods that return the old value *) + Definition fetch_binop : mpred := + specify.template.method b1 fun_name function_qualifiers.N ty [tyM; Tmemory_order] $ + \this this + \arg{n : B} "v" (Vinj tyM n) + \arg "mo" (memory_order.to_val memory_order.seq_cst) + \pre{K} do_op (flip atomic_bin_op n) this K + \post{m}[Vinj ty m] K m. + #[global] Hint Opaque fetch_binop : sl_opacity. + #[global] Arguments fetch_binop : simpl never. + Definition SpecFor_fetch_binop := RegisterSpec fetch_binop. + #[global] Existing Instance SpecFor_fetch_binop. + End with_binop. + End with_ty. + + (** TODO fix overflow handling. *) + Definition add_raw (sz : int_rank.t) (sgn : signed) (a b : Z) : Z := + if sgn is Signed then to_signed (int_rank.bitsize sz) (a + b) + else to_unsigned (int_rank.bitsize sz) (a + b). + + #[global] Instance num_add {sz sgn} : + BinOp (Tnum sz sgn) (Tnum sz sgn) Z Z OOPlusEqual "fetch_add" := + {| atomic_bin_op := add_raw sz sgn |}. + (* TODO character types? *) + + (** TODO fix overflow handling. *) + #[global] Instance num_sub {sz sgn} : + BinOp (Tnum sz sgn) (Tnum sz sgn) Z Z OOMinusEqual "fetch_sub" := + {| atomic_bin_op a b := add_raw sz sgn a (-b) |}. + + #[global] Instance ptr_add {σ : genv} {ty} : + BinOp (Tptr ty) Tptrdiff_t ptr Z OOPlusEqual "fetch_add" := + {| atomic_bin_op (p : ptr) b := p .[ ty ! b ] |}. + + #[global] Instance ptr_sub {σ : genv} {ty} : + BinOp (Tptr ty) Tptrdiff_t ptr Z OOMinusEqual "fetch_sub" := + {| atomic_bin_op (p : ptr) b := p .[ ty ! -b ] |}. + +End atomic_specs. + +Include (atomic_specs atomic). diff --git a/rocq-brick-libstdcpp/proof/atomic/test.cpp b/rocq-brick-libstdcpp/proof/atomic/test.cpp new file mode 100644 index 00000000..8578b703 --- /dev/null +++ b/rocq-brick-libstdcpp/proof/atomic/test.cpp @@ -0,0 +1,99 @@ +/** + * Copyright (C) 2025 BlueRock Security, Inc. + * All rights reserved. + * + * SPDX-License-Identifier: LGPL-2.1 WITH BlueRock Exception for use over network, see repository root for details. + */ +#include +#include + +using namespace std; + +void +test(bool b, const char* msg = nullptr) { + assert(b); +} + +void +TestDefaultConstructor() { + std::atomic atomicInt; + test(atomicInt.load() == 0); +} + +void +TestParameterizedConstructor() { + int initialValue = 10; + std::atomic atomicInt(initialValue); + test(atomicInt.load() == initialValue); +} + +void +TestLoad() { + std::atomic atomicInt(42); + test(42 == atomicInt.load()); + test(42 == atomicInt); +} + +void +TestStore() { + std::atomic atomicInt; + atomicInt.store(25); + test(atomicInt.load() == 25); +} + +void +TestCAS() { + std::atomic atomicInt{57}; + int var = 13; + atomicInt.compare_exchange_strong(var, 25); + test(var == 57); + test(atomicInt.load() == 57); + var = 57; + atomicInt.compare_exchange_strong(var, 25); + test(var == 57); + test(atomicInt.load() == 25); + test(25 == atomicInt.exchange(13)); + test(atomicInt.load() == 13); +} + +void +TestArith() { + std::atomic atomicInt{57}; + assert(60 == (atomicInt += 3)); + assert(60 == atomicInt.load()); +} + +void +TestFetchAdd() { + std::atomic atomicInt{10}; + assert(10 == atomicInt.fetch_add(1)); + assert(11 == atomicInt.load()); + assert(11 == atomicInt.fetch_add(1)); + assert(12 == atomicInt); + assert(12 == atomicInt++); + assert(13 == atomicInt); + assert(14 == ++atomicInt); + assert(19 == (atomicInt += 5)); + + int x[11] = {0}; + std::atomic atomicPtr{x}; + assert(x == atomicPtr.fetch_add(1)); + assert(x+1 == atomicPtr.load()); + assert(x+1 == atomicPtr.fetch_add(1)); + assert(x+2 == atomicPtr); + assert(x+2 == atomicPtr++); + assert(x+3 == atomicPtr); + assert(x+4 == ++atomicPtr); + assert(x+9 == (atomicPtr += 5)); +} + +int +main() { + TestDefaultConstructor(); + TestParameterizedConstructor(); + TestLoad(); + TestStore(); + TestCAS(); + TestArith(); + return 0; +} diff --git a/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v b/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v new file mode 100644 index 00000000..db2006fb --- /dev/null +++ b/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v @@ -0,0 +1,226 @@ +(** + * Copyright (C) 2025 SkyLabs AI, Inc. + * All rights reserved. + * + * SPDX-License-Identifier: LGPL-2.1 WITH BlueRock Exception for use over network, see repository root for details. + *) +Require Import skylabs.auto.cpp.proof. +Require Import skylabs.cpp.stdlib.cassert.spec. +Require Import skylabs.cpp.stdlib.atomic.spec. +Require Import skylabs.cpp.stdlib.test.atomic.test_cpp. + +Section with_cpp. + Context `{Σ : cpp_logic, σ : genv}. + + Notation GLOBALS q := (_global "std::__1::memory_order_seq_cst" |-> primR "enum std::__1::memory_order" q 5). + + Section specs. + Context `{MOD : test_cpp.source ⊧ σ}. + + cpp.spec "test(bool, const char*)" as test_spec with + (\arg "b" (Vbool true) + \arg{p} "" (Vptr p) + \post emp). + + cpp.spec "TestDefaultConstructor()" as test_default_ctor with + (\prepost{q} GLOBALS q + \post emp). + + cpp.spec "TestParameterizedConstructor()" as test_parameterized_ctor with + (\prepost{q} GLOBALS q + \post emp). + + cpp.spec "TestLoad()" as test_load with + (\prepost{q} GLOBALS q + \post emp). + + cpp.spec "TestStore()" as test_store with + (\prepost{q} GLOBALS q + \post emp). + + cpp.spec "TestCAS()" as test_cas with + (\prepost{q} GLOBALS q + \post emp). + + cpp.spec "TestArith()" as test_arith with + (\prepost{q} GLOBALS q + \post emp). + + cpp.spec "TestFetchAdd()" as test_fetch_add with + (\prepost{q} GLOBALS q + \post emp). + + cpp.spec "main()" as main with + (\prepost{q} GLOBALS q + \post[Vint 0] emp). + + Definition specs := + test_default_ctor ** + test_parameterized_ctor ** + test_load ** + test_store ** + test_cas ** + test_arith. + #[global] Hint Opaque specs : sl_opacity. + + End specs. + + #[local] Hint Resolve fractional.UNSAFE_read_prim_cancel : sl_opacity. + + Notation BASE p := (p ,, _base "std::__1::atomic" "std::__1::__atomic_base" ,, _base "std::__1::__atomic_base" "std::__1::__atomic_base"). + + Notation BASE1 p := (p ,, _base "std::__1::atomic" "std::__1::__atomic_base"). + + #[program] + Definition do_load_C (p : ptr) := + \cancelx + \using denoteModule test_cpp.source + \consuming{q (n : Z)} p |-> atomic.R "int" q n + \proving{(K : Z -> mpred) (_ : IsExistential K)} do_load Tint (BASE p) K + \instantiate K := (fun x : Z => p |-> atomic.R "int" q n ** [| x = n |]) + \end@{mpredI}. + Next Obligation. + intros. iIntros "[#M ?]" (?? ->). + iDestruct (observe [| _ ⊧ _ |] with "M") as "%". + rewrite /do_load. + iAcIntro. rewrite /commit_acc. + iDestruct (fupd_mask_subseteq) as ">Y"; [ | iModIntro ]; eauto. + work; normalize_ptrs. + work. iExists q. work. + iMod "Y". iModIntro. + normalize_ptrs. work. + Qed. + #[program] + Definition do_store_C (p : ptr) := + \cancelx + \using denoteModule test_cpp.source + \consuming{(n : Z)} p |-> atomic.R "int" 1$m n + \proving{K (_ : IsExistential K) v} do_store Tint (BASE p) v K + \instantiate K := (p |-> atomic.R "int" 1$m v) + \end@{mpredI}. + Next Obligation. + intros. iIntros "[#M ?]" (??? ->). + iDestruct (observe [| _ ⊧ _ |] with "M") as "%". + rewrite /do_load. + iAcIntro. rewrite /commit_acc. + iDestruct (fupd_mask_subseteq) as ">Y"; [ | iModIntro ]; eauto. + work; normalize_ptrs. + work. + iMod "Y". iModIntro. + normalize_ptrs. work. + Qed. + (* TODO: this is not the most general hint *) + #[program] + Definition do_compare_exchange_C (p p' : ptr) old new := + \cancelx + \using (denoteModule test_cpp.source : mpred) + \consuming{n} p |-> atomic.R "int" 1$m (n : Z) + \proving{K (_ : IsExistential K)} + do_compare_exchange "int" false (BASE p) p' old new K + \instantiate K := (fun res => + if bool_decide (n = old) then + p |-> atomic.R "int" 1$m new ** + p' |-> primR "int" 1$m old ** [| res = true |] + else + p |-> atomic.R "int" 1$m n ** + p' |-> primR "int" 1$m n ** [| res = false |]) + \end@{mpredI}. + Next Obligation. + intros. iIntros "[#M ?]" (?? ->). + iDestruct (observe [| _ ⊧ _ |] with "M") as "%". + rewrite /do_compare_exchange. + iAuIntro1. rewrite /atomic1_acc. + iDestruct (fupd_mask_subseteq) as ">Y"; [ | iModIntro ]; eauto. + work. normalize_ptrs. work. + { iMod "Y". iModIntro. normalize_ptrs. work. } + { iMod "Y"; iModIntro. normalize_ptrs. work. + case_bool_decide. + { subst. lazymatch goal with H : _ \/ _ |- _ => destruct H end. intuition. work. + exfalso; tauto. } + { lazymatch goal with H : _ \/ _ |- _ => destruct H end; try by exfalso; tauto. + intuition; subst. work. } } + Qed. + #[program] + Definition do_exchange_C (p : ptr) new := + \cancelx + \using denoteModule test_cpp.source + \consuming{n} p |-> atomic.R "int" 1$m n + \proving{K (_ : IsExistential K)} + do_exchange "int" (BASE p) new K + \instantiate K := (fun res => [| res = n |] ** + p |-> atomic.R "int" 1$m new) + \end@{mpredI}. + Next Obligation. + intros. iIntros "[#M ?]" (?? ->). + iDestruct (observe [| _ ⊧ _ |] with "M") as "%". + rewrite /do_compare_exchange. + iAuIntro1. rewrite /atomic1_acc. + iDestruct (fupd_mask_subseteq) as ">Y"; [ | iModIntro ]; eauto. + work. normalize_ptrs. work. + { iMod "Y". iModIntro. normalize_ptrs. work. } + { iMod "Y"; iModIntro. normalize_ptrs. work. } + Qed. + + #[program] + Definition do_op_C (p : ptr) (op : Z -> Z) := + \cancelx + \using denoteModule test_cpp.source + \consuming{n} p |-> atomic.R "int" 1$m n + \proving{K (_ : IsExistential K)} + spec.do_op "int" op (BASE1 p) K + \instantiate K := (fun res => [| res = n |] ** + p |-> atomic.R "int" 1$m (op n)) + \end@{mpredI}. + Next Obligation. + intros. iIntros "[#M ?]" (?? ->). + iDestruct (observe [| _ ⊧ _ |] with "M") as "%". + rewrite /spec.do_op. + iAcIntro. rewrite /commit_acc. + iDestruct (fupd_mask_subseteq) as ">Y"; [ | iModIntro ]; eauto. + work. + iMod "Y"; iModIntro; work. + Qed. + + Hint Resolve do_compare_exchange_C do_exchange_C : sl_opacity. + Hint Resolve do_load_C do_store_C : sl_opacity. + Hint Resolve do_op_C : sl_opacity. + + Notation OK spec := + (verify?[test_cpp.source] spec) (only parsing). + + Set Typeclasses Debug. + Goal SpecFor source "std::__1::atomic::fetch_add(long, enum std::__1::memory_order)"%cpp_name. + Fail apply _. + About SpecFor_fetch_binop. + Check (SpecFor_fetch_binop "int*"). + class_apply (SpecFor_fetch_binop "int*"). + Goal SpecFor source "std::__1::__atomic_base::operator++(int)". + apply _. + + Lemma arith_ok : OK test_fetch_add. + Proof. verify_spec. go. + + Qed. + + Lemma cas_ok : OK test_cas. + Proof. verify_spec. go. Qed. + + Lemma default_ctor_ok : OK test_default_ctor. + Proof. verify_spec; go. Qed. + + Lemma param_ctor_ok : OK test_parameterized_ctor. + Proof. verify_spec; go. Qed. + + Lemma load_ok : OK test_load. + Proof. verify_spec; go. Qed. + + Lemma store_ok : OK test_store. + Proof. verify_spec; go. Qed. + + Lemma main_ok : OK main. + Proof. + rewrite /specs. + verify_spec. go. + Qed. + +End with_cpp. From 3e1ce8cc3c903a0c771206175d9bda9277c04f29 Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Wed, 19 Aug 2026 20:16:44 +0200 Subject: [PATCH 02/51] Notation -> Abbreviation --- rocq-brick-libstdcpp/proof/atomic/pred.v | 12 ++++++------ rocq-brick-libstdcpp/proof/atomic/spec.v | 16 ++++++++-------- .../proof/atomic/test_cpp_proof.v | 8 ++++---- 3 files changed, 18 insertions(+), 18 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/atomic/pred.v b/rocq-brick-libstdcpp/proof/atomic/pred.v index ddf95972..0cb14603 100644 --- a/rocq-brick-libstdcpp/proof/atomic/pred.v +++ b/rocq-brick-libstdcpp/proof/atomic/pred.v @@ -18,20 +18,20 @@ memory order macros to __ATOMIC_SEQ_CST. *) cpp.enum "std::memory_order" from (inc_int_cpp.source) variant. -#[global] Notation Tmemory_order := {%cpp_type[inc_int_cpp.source] "std::memory_order"} (only parsing). +#[global] Abbreviation Tmemory_order := {%cpp_type[inc_int_cpp.source] "std::memory_order"} (only parsing). Module Type ATOMIC_PREDS. (** Type [t] indexing our spec models the type name T in Atomic. *) (** The type where the actual methods are implemented *) - #[global] Notation base_name ty := + #[global] Abbreviation base_name ty := (Ninst "std::__1::__atomic_base" [Atype ty; Avalue (Eint 0 Tbool)]). - #[global] Notation base_name1 ty := + #[global] Abbreviation base_name1 ty := (Ninst "std::__1::__atomic_base" [Atype ty; Avalue (Eint 1 Tbool)]). (** The type <>> *) - #[global] Notation class_name ty := (Ninst "std::__1::atomic" [Atype ty]). - #[global] Notation T ty := (Tnamed (class_name ty)). + #[global] Abbreviation class_name ty := (Ninst "std::__1::atomic" [Atype ty]). + #[global] Abbreviation T ty := (Tnamed (class_name ty)). (** Abstract predicates *) @@ -40,7 +40,7 @@ Module Type ATOMIC_PREDS. Section R_props. Context `{Σ : cpp_logic} {σ : genv} `{PV : @PrimVal ty A}. - Notation R := (R ty (PV:=PV)). + Abbreviation R := (R ty (PV:=PV)). #[global] Declare Instance R_frac : CFractional1 R. #[global] Declare Instance R_timeless : Timeless2 R. diff --git a/rocq-brick-libstdcpp/proof/atomic/spec.v b/rocq-brick-libstdcpp/proof/atomic/spec.v index b7a83714..d0e4e633 100644 --- a/rocq-brick-libstdcpp/proof/atomic/spec.v +++ b/rocq-brick-libstdcpp/proof/atomic/spec.v @@ -19,11 +19,11 @@ Module atomic_specs (Import atomic : ATOMIC_PREDS). Context `{Σ : cpp_logic} {σ : genv}. Context (ty : type). Context `{!PrimVal ty A,!DefaultValue ty A}. - Notation s := (class_name ty) (only parsing). (** [Atomic] *) - Notation b0 := (base_name ty) (only parsing). - Notation b1 := (base_name1 ty) (only parsing). - Notation R := (R ty). - Notation bR q v := (_derived b0 b1 ,, _derived b1 s |-> R q%cQp v) (only parsing). + Abbreviation s := (class_name ty) (only parsing). (** [Atomic] *) + Abbreviation b0 := (base_name ty) (only parsing). + Abbreviation b1 := (base_name1 ty) (only parsing). + Abbreviation R := (R ty). + Abbreviation bR q v := (_derived b0 b1 ,, _derived b1 s |-> R q%cQp v) (only parsing). Definition default_ctor : mpred := specify.template.ctor s [] $ @@ -258,9 +258,9 @@ Module atomic_specs (Import atomic : ATOMIC_PREDS). Context (ty : type). Context `{PrimVal ty A}. - #[local] Notation s := (class_name ty) (only parsing). (** [Atomic] *) - #[local] Notation b1 := (base_name1 ty) (only parsing). - #[local] Notation bR q v := (_derived b1 s |-> R ty q v) (only parsing). + #[local] Abbreviation s := (class_name ty) (only parsing). (** [Atomic] *) + #[local] Abbreviation b1 := (base_name1 ty) (only parsing). + #[local] Abbreviation bR q v := (_derived b1 s |-> R ty q v) (only parsing). (** Apply operation [op] to the atomic cell pointed by [this], and return the old contents to continuation [K]. *) diff --git a/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v b/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v index db2006fb..43f048a0 100644 --- a/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v +++ b/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v @@ -12,7 +12,7 @@ Require Import skylabs.cpp.stdlib.test.atomic.test_cpp. Section with_cpp. Context `{Σ : cpp_logic, σ : genv}. - Notation GLOBALS q := (_global "std::__1::memory_order_seq_cst" |-> primR "enum std::__1::memory_order" q 5). + Abbreviation GLOBALS q := (_global "std::__1::memory_order_seq_cst" |-> primR "enum std::__1::memory_order" q 5). Section specs. Context `{MOD : test_cpp.source ⊧ σ}. @@ -67,9 +67,9 @@ Section with_cpp. #[local] Hint Resolve fractional.UNSAFE_read_prim_cancel : sl_opacity. - Notation BASE p := (p ,, _base "std::__1::atomic" "std::__1::__atomic_base" ,, _base "std::__1::__atomic_base" "std::__1::__atomic_base"). + Abbreviation BASE p := (p ,, _base "std::__1::atomic" "std::__1::__atomic_base" ,, _base "std::__1::__atomic_base" "std::__1::__atomic_base"). - Notation BASE1 p := (p ,, _base "std::__1::atomic" "std::__1::__atomic_base"). + Abbreviation BASE1 p := (p ,, _base "std::__1::atomic" "std::__1::__atomic_base"). #[program] Definition do_load_C (p : ptr) := @@ -185,7 +185,7 @@ Section with_cpp. Hint Resolve do_load_C do_store_C : sl_opacity. Hint Resolve do_op_C : sl_opacity. - Notation OK spec := + Abbreviation OK spec := (verify?[test_cpp.source] spec) (only parsing). Set Typeclasses Debug. From 06eeefad23f1b1defc614cca45fa377eba017d75 Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Wed, 19 Aug 2026 22:08:55 +0200 Subject: [PATCH 03/51] Spec: add missing modes --- rocq-brick-libstdcpp/proof/atomic/spec.v | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/atomic/spec.v b/rocq-brick-libstdcpp/proof/atomic/spec.v index d0e4e633..96150800 100644 --- a/rocq-brick-libstdcpp/proof/atomic/spec.v +++ b/rocq-brick-libstdcpp/proof/atomic/spec.v @@ -248,10 +248,13 @@ Module atomic_specs (Import atomic : ATOMIC_PREDS). Class UnOp (ty : type) (A : Type) (op_name : OverloadableOperator) := { atomic_un_op : A -> A }. + #[global] Hint Mode UnOp ! - ! : typeclass_instances. Class BinOp (ty1 ty2 : type) (A B : Type) (op_name : OverloadableOperator) (fun_name : ident) := { atomic_bin_op : A -> B -> A }. + #[global] Hint Mode BinOp ! - ! - ! - : typeclass_instances. + #[global] Hint Mode BinOp ! - ! - - ! : typeclass_instances. Section with_ty. Context `{Σ : cpp_logic} {σ : genv}. @@ -270,14 +273,14 @@ Module atomic_specs (Import atomic : ATOMIC_PREDS). #[global] Hint Opaque do_op : typeclass_instances sl_opacity. Section with_unop. - Context `{!UnOp ty A op_name}. + Context `{UO : !UnOp ty A op_name}. (** Triple for unary operators that return the new value *) Definition unop_fetch : mpred := specify.template.op b1 op_name function_qualifiers.N ty [] $ \this this - \pre{K} do_op atomic_un_op this K - \post{m}[Vinj ty (atomic_un_op m)] K m. + \pre{K} do_op (atomic_un_op (UnOp := UO)) this K + \post{m}[Vinj ty (atomic_un_op (UnOp := UO) m)] K m. #[global] Hint Opaque unop_fetch : sl_opacity. #[global] Arguments unop_fetch : simpl never. @@ -289,7 +292,7 @@ Module atomic_specs (Import atomic : ATOMIC_PREDS). specify.template.op b1 op_name function_qualifiers.N ty [Tint] $ \this this \arg{dummy} "dummy" (Vint dummy) - \pre{K} do_op atomic_un_op this K + \pre{K} do_op (atomic_un_op (UnOp := UO)) this K \post{m}[Vinj ty m] K m. #[global] Hint Opaque fetch_unop : sl_opacity. @@ -299,7 +302,7 @@ Module atomic_specs (Import atomic : ATOMIC_PREDS). End with_unop. Section with_binop. - Context `{!BinOp ty tyM A B op_name fun_name}. + Context `{BO : !BinOp ty tyM A B op_name fun_name}. Context `{!PrimVal tyM B}. (** Triple for binary operators that return the new value *) @@ -307,8 +310,8 @@ Module atomic_specs (Import atomic : ATOMIC_PREDS). specify.template.op b1 op_name function_qualifiers.N ty [tyM] $ \this this \arg{n : B} "v" (Vinj tyM n) - \pre{K} do_op (flip atomic_bin_op n) this K - \post{m}[Vinj ty (atomic_bin_op m n)] K m. + \pre{K} do_op (flip (atomic_bin_op (BinOp := BO)) n) this K + \post{m}[Vinj ty (atomic_bin_op (BinOp := BO) m n)] K m. #[global] Hint Opaque binop_fetch : sl_opacity. #[global] Arguments binop_fetch : simpl never. Definition SpecFor_binop_fetch := RegisterSpec binop_fetch. @@ -320,7 +323,7 @@ Module atomic_specs (Import atomic : ATOMIC_PREDS). \this this \arg{n : B} "v" (Vinj tyM n) \arg "mo" (memory_order.to_val memory_order.seq_cst) - \pre{K} do_op (flip atomic_bin_op n) this K + \pre{K} do_op (flip (atomic_bin_op (BinOp := BO)) n) this K \post{m}[Vinj ty m] K m. #[global] Hint Opaque fetch_binop : sl_opacity. #[global] Arguments fetch_binop : simpl never. From 9fd1809c35d4d457b53c41e7835d10af9aaf988f Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Thu, 20 Aug 2026 11:47:22 +0200 Subject: [PATCH 04/51] Add UnOp instance for num ++ --- rocq-brick-libstdcpp/proof/atomic/spec.v | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/rocq-brick-libstdcpp/proof/atomic/spec.v b/rocq-brick-libstdcpp/proof/atomic/spec.v index 96150800..0d59cb70 100644 --- a/rocq-brick-libstdcpp/proof/atomic/spec.v +++ b/rocq-brick-libstdcpp/proof/atomic/spec.v @@ -337,6 +337,10 @@ Module atomic_specs (Import atomic : ATOMIC_PREDS). if sgn is Signed then to_signed (int_rank.bitsize sz) (a + b) else to_unsigned (int_rank.bitsize sz) (a + b). + #[global] Instance num_plusplus {sz sgn} : + UnOp (Tnum sz sgn) Z OOPlusPlus := + {| atomic_un_op := add_raw sz sgn 1 |}. + #[global] Instance num_add {sz sgn} : BinOp (Tnum sz sgn) (Tnum sz sgn) Z Z OOPlusEqual "fetch_add" := {| atomic_bin_op := add_raw sz sgn |}. From 779b8575a73bbac4687ed0a6534321b0fbdec80a Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Wed, 19 Aug 2026 20:14:21 +0200 Subject: [PATCH 05/51] TMP build rules (to redo) --- rocq-brick-libstdcpp/proof/dune.inc | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/rocq-brick-libstdcpp/proof/dune.inc b/rocq-brick-libstdcpp/proof/dune.inc index 14a82e4b..0abf4551 100644 --- a/rocq-brick-libstdcpp/proof/dune.inc +++ b/rocq-brick-libstdcpp/proof/dune.inc @@ -11,6 +11,30 @@ (with-stderr-to inc_algorithms_cpp.v.stderr (run cpp2v -v %{input} -o inc_algorithms_cpp.v --no-elaborate --templates=inc_algorithms_cpp_templates.v -- -std=c++20 -stdlib=libstdc++ )))) (alias (name srcs) (deps inc_algorithms.cpp)) ) +(subdir atomic + (rule + (targets inc_int_cpp.v.stderr inc_int_cpp.v inc_int_cpp_templates.v) + (alias test_ast) + (deps + (:input inc_int.cpp) + (env_var CPP2V_DOCKER_ENABLED) + (glob_files_rec ../*.hpp)) + (action + (with-stderr-to inc_int_cpp.v.stderr (run cpp2v -v %{input} -o inc_int_cpp.v --no-elaborate --templates=inc_int_cpp_templates.v -- -std=c++20 -stdlib=libstdc++ )))) + (alias (name srcs) (deps inc_int.cpp)) +) +(subdir atomic + (rule + (targets test_cpp.v.stderr test_cpp.v test_cpp_templates.v) + (alias test_ast) + (deps + (:input test.cpp) + (env_var CPP2V_DOCKER_ENABLED) + (glob_files_rec ../*.hpp)) + (action + (with-stderr-to test_cpp.v.stderr (run cpp2v -v %{input} -o test_cpp.v --no-elaborate --templates=test_cpp_templates.v -- -std=c++20 -stdlib=libstdc++ )))) + (alias (name srcs) (deps test.cpp)) +) (subdir cassert (rule (targets inc_cassert_cpp.v.stderr inc_cassert_cpp.v inc_cassert_cpp_templates.v) From 97a793142bda22ab70e85e0a7755889278d9f4c9 Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Wed, 19 Aug 2026 20:14:13 +0200 Subject: [PATCH 06/51] tweak --- rocq-brick-libstdcpp/proof/atomic/pred.v | 2 +- rocq-brick-libstdcpp/proof/atomic/spec.v | 4 ++-- rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v | 6 +++--- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/atomic/pred.v b/rocq-brick-libstdcpp/proof/atomic/pred.v index 0cb14603..7c13c109 100644 --- a/rocq-brick-libstdcpp/proof/atomic/pred.v +++ b/rocq-brick-libstdcpp/proof/atomic/pred.v @@ -6,7 +6,7 @@ *) Require Import skylabs.auto.cpp.spec. Require Import skylabs.cpp.spec.concepts. -Require skylabs.cpp.stdlib.atomic.inc_int_cpp. +Require skylabs.brick.libstdcpp.atomic.inc_int_cpp. Require Import skylabs.cpp.spec.concepts. diff --git a/rocq-brick-libstdcpp/proof/atomic/spec.v b/rocq-brick-libstdcpp/proof/atomic/spec.v index 0d59cb70..34cc407f 100644 --- a/rocq-brick-libstdcpp/proof/atomic/spec.v +++ b/rocq-brick-libstdcpp/proof/atomic/spec.v @@ -6,10 +6,10 @@ *) Require Import skylabs.auto.cpp.spec. Require Import skylabs.cpp.spec.concepts. -Require Import skylabs.cpp.stdlib.atomic.inc_int_cpp. +Require Import skylabs.brick.libstdcpp.atomic.inc_int_cpp. Require Import skylabs.cpp.spec.concepts. -Require Export skylabs.cpp.stdlib.atomic.pred. +Require Export skylabs.brick.libstdcpp.atomic.pred. Module atomic_specs (Import atomic : ATOMIC_PREDS). diff --git a/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v b/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v index 43f048a0..dab345fc 100644 --- a/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v +++ b/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v @@ -5,9 +5,9 @@ * SPDX-License-Identifier: LGPL-2.1 WITH BlueRock Exception for use over network, see repository root for details. *) Require Import skylabs.auto.cpp.proof. -Require Import skylabs.cpp.stdlib.cassert.spec. -Require Import skylabs.cpp.stdlib.atomic.spec. -Require Import skylabs.cpp.stdlib.test.atomic.test_cpp. +Require Import skylabs.brick.libstdcpp.cassert.spec. +Require Import skylabs.brick.libstdcpp.atomic.spec. +Require Import skylabs.brick.libstdcpp.test.atomic.test_cpp. Section with_cpp. Context `{Σ : cpp_logic, σ : genv}. From d086280e1124e53b107753ea5ab8485dd53630ae Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Wed, 19 Aug 2026 20:20:09 +0200 Subject: [PATCH 07/51] Remove __1 --- rocq-brick-libstdcpp/proof/atomic/pred.v | 6 +++--- rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/atomic/pred.v b/rocq-brick-libstdcpp/proof/atomic/pred.v index 7c13c109..0eaffa01 100644 --- a/rocq-brick-libstdcpp/proof/atomic/pred.v +++ b/rocq-brick-libstdcpp/proof/atomic/pred.v @@ -26,11 +26,11 @@ Module Type ATOMIC_PREDS. (** The type where the actual methods are implemented *) #[global] Abbreviation base_name ty := - (Ninst "std::__1::__atomic_base" [Atype ty; Avalue (Eint 0 Tbool)]). + (Ninst "std::__atomic_base" [Atype ty; Avalue (Eint 0 Tbool)]). #[global] Abbreviation base_name1 ty := - (Ninst "std::__1::__atomic_base" [Atype ty; Avalue (Eint 1 Tbool)]). + (Ninst "std::__atomic_base" [Atype ty; Avalue (Eint 1 Tbool)]). (** The type <>> *) - #[global] Abbreviation class_name ty := (Ninst "std::__1::atomic" [Atype ty]). + #[global] Abbreviation class_name ty := (Ninst "std::atomic" [Atype ty]). #[global] Abbreviation T ty := (Tnamed (class_name ty)). (** Abstract predicates *) diff --git a/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v b/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v index dab345fc..c4d508f7 100644 --- a/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v +++ b/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v @@ -12,7 +12,7 @@ Require Import skylabs.brick.libstdcpp.test.atomic.test_cpp. Section with_cpp. Context `{Σ : cpp_logic, σ : genv}. - Abbreviation GLOBALS q := (_global "std::__1::memory_order_seq_cst" |-> primR "enum std::__1::memory_order" q 5). + Abbreviation GLOBALS q := (_global "std::memory_order_seq_cst" |-> primR "enum std::memory_order" q 5). Section specs. Context `{MOD : test_cpp.source ⊧ σ}. @@ -67,9 +67,9 @@ Section with_cpp. #[local] Hint Resolve fractional.UNSAFE_read_prim_cancel : sl_opacity. - Abbreviation BASE p := (p ,, _base "std::__1::atomic" "std::__1::__atomic_base" ,, _base "std::__1::__atomic_base" "std::__1::__atomic_base"). + Abbreviation BASE p := (p ,, _base "std::atomic" "std::__atomic_base" ,, _base "std::__atomic_base" "std::__atomic_base"). - Abbreviation BASE1 p := (p ,, _base "std::__1::atomic" "std::__1::__atomic_base"). + Abbreviation BASE1 p := (p ,, _base "std::atomic" "std::__atomic_base"). #[program] Definition do_load_C (p : ptr) := From 7468a36837dc15b91c3218bffd05b014ee850bf6 Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Wed, 19 Aug 2026 20:17:08 +0200 Subject: [PATCH 08/51] TMP for move from tests --- rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v b/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v index c4d508f7..4b53ba1e 100644 --- a/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v +++ b/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v @@ -7,7 +7,8 @@ Require Import skylabs.auto.cpp.proof. Require Import skylabs.brick.libstdcpp.cassert.spec. Require Import skylabs.brick.libstdcpp.atomic.spec. -Require Import skylabs.brick.libstdcpp.test.atomic.test_cpp. +(* Require Import skylabs.brick.libstdcpp.test.atomic.test_cpp. *) +Require Import skylabs.brick.libstdcpp.atomic.test_cpp. Section with_cpp. Context `{Σ : cpp_logic, σ : genv}. From 0c3d6a0333d97e4ebb11c876766fbd58752eb23b Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Wed, 19 Aug 2026 20:35:38 +0200 Subject: [PATCH 09/51] WIP on merging base classes --- rocq-brick-libstdcpp/proof/atomic/pred.v | 4 +--- rocq-brick-libstdcpp/proof/atomic/spec.v | 21 +++++++++++---------- 2 files changed, 12 insertions(+), 13 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/atomic/pred.v b/rocq-brick-libstdcpp/proof/atomic/pred.v index 0eaffa01..995d3dc0 100644 --- a/rocq-brick-libstdcpp/proof/atomic/pred.v +++ b/rocq-brick-libstdcpp/proof/atomic/pred.v @@ -26,9 +26,7 @@ Module Type ATOMIC_PREDS. (** The type where the actual methods are implemented *) #[global] Abbreviation base_name ty := - (Ninst "std::__atomic_base" [Atype ty; Avalue (Eint 0 Tbool)]). - #[global] Abbreviation base_name1 ty := - (Ninst "std::__atomic_base" [Atype ty; Avalue (Eint 1 Tbool)]). + (Ninst "std::__atomic_base" [Atype ty]). (** The type <>> *) #[global] Abbreviation class_name ty := (Ninst "std::atomic" [Atype ty]). #[global] Abbreviation T ty := (Tnamed (class_name ty)). diff --git a/rocq-brick-libstdcpp/proof/atomic/spec.v b/rocq-brick-libstdcpp/proof/atomic/spec.v index 34cc407f..f958cef0 100644 --- a/rocq-brick-libstdcpp/proof/atomic/spec.v +++ b/rocq-brick-libstdcpp/proof/atomic/spec.v @@ -20,10 +20,11 @@ Module atomic_specs (Import atomic : ATOMIC_PREDS). Context (ty : type). Context `{!PrimVal ty A,!DefaultValue ty A}. Abbreviation s := (class_name ty) (only parsing). (** [Atomic] *) - Abbreviation b0 := (base_name ty) (only parsing). - Abbreviation b1 := (base_name1 ty) (only parsing). + Abbreviation b := (base_name ty) (only parsing). + Abbreviation b0 := b (only parsing). + Abbreviation b1 := b (only parsing). Abbreviation R := (R ty). - Abbreviation bR q v := (_derived b0 b1 ,, _derived b1 s |-> R q%cQp v) (only parsing). + Abbreviation bR q v := (_derived b s |-> R q%cQp v) (only parsing). Definition default_ctor : mpred := specify.template.ctor s [] $ @@ -60,7 +61,7 @@ Module atomic_specs (Import atomic : ATOMIC_PREDS). #[global] Hint Opaque do_load : typeclass_instances sl_opacity. Definition load : mpred := - specify.template.method b0 "load" function_qualifiers.N ty [Tmemory_order] $ + specify.template.method b "load" function_qualifiers.N ty [Tmemory_order] $ \this this \arg "mo" (memory_order.to_val memory_order.seq_cst) \pre{K} do_load this K @@ -262,8 +263,8 @@ Module atomic_specs (Import atomic : ATOMIC_PREDS). Context `{PrimVal ty A}. #[local] Abbreviation s := (class_name ty) (only parsing). (** [Atomic] *) - #[local] Abbreviation b1 := (base_name1 ty) (only parsing). - #[local] Abbreviation bR q v := (_derived b1 s |-> R ty q v) (only parsing). + #[local] Abbreviation b := (base_name ty) (only parsing). + #[local] Abbreviation bR q v := (_derived b s |-> R ty q v) (only parsing). (** Apply operation [op] to the atomic cell pointed by [this], and return the old contents to continuation [K]. *) @@ -277,7 +278,7 @@ Module atomic_specs (Import atomic : ATOMIC_PREDS). (** Triple for unary operators that return the new value *) Definition unop_fetch : mpred := - specify.template.op b1 op_name function_qualifiers.N ty [] $ + specify.template.op b op_name function_qualifiers.N ty [] $ \this this \pre{K} do_op (atomic_un_op (UnOp := UO)) this K \post{m}[Vinj ty (atomic_un_op (UnOp := UO) m)] K m. @@ -289,7 +290,7 @@ Module atomic_specs (Import atomic : ATOMIC_PREDS). (** Triple for unary operators that return the old value *) Definition fetch_unop : mpred := - specify.template.op b1 op_name function_qualifiers.N ty [Tint] $ + specify.template.op b op_name function_qualifiers.N ty [Tint] $ \this this \arg{dummy} "dummy" (Vint dummy) \pre{K} do_op (atomic_un_op (UnOp := UO)) this K @@ -307,7 +308,7 @@ Module atomic_specs (Import atomic : ATOMIC_PREDS). (** Triple for binary operators that return the new value *) Definition binop_fetch : mpred := - specify.template.op b1 op_name function_qualifiers.N ty [tyM] $ + specify.template.op b op_name function_qualifiers.N ty [tyM] $ \this this \arg{n : B} "v" (Vinj tyM n) \pre{K} do_op (flip (atomic_bin_op (BinOp := BO)) n) this K @@ -319,7 +320,7 @@ Module atomic_specs (Import atomic : ATOMIC_PREDS). (** Triple for methods that return the old value *) Definition fetch_binop : mpred := - specify.template.method b1 fun_name function_qualifiers.N ty [tyM; Tmemory_order] $ + specify.template.method b fun_name function_qualifiers.N ty [tyM; Tmemory_order] $ \this this \arg{n : B} "v" (Vinj tyM n) \arg "mo" (memory_order.to_val memory_order.seq_cst) From b07bed7d69e9535dfeec1ab2eb293b8d1688f4f8 Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Wed, 19 Aug 2026 22:09:14 +0200 Subject: [PATCH 10/51] test_cpp_proof: adapt to alternative implementation --- rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v b/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v index 4b53ba1e..40add411 100644 --- a/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v +++ b/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v @@ -68,10 +68,9 @@ Section with_cpp. #[local] Hint Resolve fractional.UNSAFE_read_prim_cancel : sl_opacity. - Abbreviation BASE p := (p ,, _base "std::atomic" "std::__atomic_base" ,, _base "std::__atomic_base" "std::__atomic_base"). - - Abbreviation BASE1 p := (p ,, _base "std::atomic" "std::__atomic_base"). + Abbreviation BASE p := (p ,, _base "std::atomic" "std::__atomic_base"). + Ltac normalize_ptrs := idtac. #[program] Definition do_load_C (p : ptr) := \cancelx @@ -168,7 +167,7 @@ Section with_cpp. \using denoteModule test_cpp.source \consuming{n} p |-> atomic.R "int" 1$m n \proving{K (_ : IsExistential K)} - spec.do_op "int" op (BASE1 p) K + spec.do_op "int" op (BASE p) K \instantiate K := (fun res => [| res = n |] ** p |-> atomic.R "int" 1$m (op n)) \end@{mpredI}. From 60f6bd7046caf1263f54f975b415ec8e123d2425 Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Thu, 20 Aug 2026 12:28:33 +0200 Subject: [PATCH 11/51] Disable pointer tests --- rocq-brick-libstdcpp/proof/atomic/test.cpp | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/atomic/test.cpp b/rocq-brick-libstdcpp/proof/atomic/test.cpp index 8578b703..9f27b3e6 100644 --- a/rocq-brick-libstdcpp/proof/atomic/test.cpp +++ b/rocq-brick-libstdcpp/proof/atomic/test.cpp @@ -75,16 +75,16 @@ TestFetchAdd() { assert(14 == ++atomicInt); assert(19 == (atomicInt += 5)); - int x[11] = {0}; - std::atomic atomicPtr{x}; - assert(x == atomicPtr.fetch_add(1)); - assert(x+1 == atomicPtr.load()); - assert(x+1 == atomicPtr.fetch_add(1)); - assert(x+2 == atomicPtr); - assert(x+2 == atomicPtr++); - assert(x+3 == atomicPtr); - assert(x+4 == ++atomicPtr); - assert(x+9 == (atomicPtr += 5)); + // int x[11] = {0}; + // std::atomic atomicPtr{x}; + // assert(x == atomicPtr.fetch_add(1)); + // assert(x+1 == atomicPtr.load()); + // assert(x+1 == atomicPtr.fetch_add(1)); + // assert(x+2 == atomicPtr); + // assert(x+2 == atomicPtr++); + // assert(x+3 == atomicPtr); + // assert(x+4 == ++atomicPtr); + // assert(x+9 == (atomicPtr += 5)); } int From 2360d14378ca16b674c6cb9f5664f53ac4be37b4 Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Thu, 20 Aug 2026 12:28:27 +0200 Subject: [PATCH 12/51] WIP on thread id --- rocq-brick-libstdcpp/proof/atomic/test.cpp | 15 +++++++++++++++ .../proof/atomic/test_cpp_proof.v | 5 +++++ 2 files changed, 20 insertions(+) diff --git a/rocq-brick-libstdcpp/proof/atomic/test.cpp b/rocq-brick-libstdcpp/proof/atomic/test.cpp index 9f27b3e6..36c7fac5 100644 --- a/rocq-brick-libstdcpp/proof/atomic/test.cpp +++ b/rocq-brick-libstdcpp/proof/atomic/test.cpp @@ -6,6 +6,7 @@ */ #include #include +#include using namespace std; @@ -14,6 +15,20 @@ test(bool b, const char* msg = nullptr) { assert(b); } +void testThreadId(std::thread::id i) { + std::atomic owner{}; + std::atomic owner2{i}; + std::thread::id i2 = owner; + owner = i; +} + +// void testThreadId(std::thread::id id) { +// std::atomic owner{}; +// std::atomic owner2{id}; +// owner; +// owner = id; +// } + void TestDefaultConstructor() { std::atomic atomicInt; diff --git a/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v b/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v index 40add411..fd2ac037 100644 --- a/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v +++ b/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v @@ -55,6 +55,11 @@ Section with_cpp. (\prepost{q} GLOBALS q \post[Vint 0] emp). + cpp.spec "testThreadId(std::thread::id)" as testThreadId with ( + \arg{p} "" (Vptr p) + \prepost{q} GLOBALS q + \post emp). + Definition specs := test_default_ctor ** test_parameterized_ctor ** From e2e5e3421c0f274fdd2600e03e98dac6b9df4aef Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Thu, 20 Aug 2026 20:31:42 +0200 Subject: [PATCH 13/51] atomic: fix namespacing --- rocq-brick-libstdcpp/proof/atomic/spec.v | 2 ++ 1 file changed, 2 insertions(+) diff --git a/rocq-brick-libstdcpp/proof/atomic/spec.v b/rocq-brick-libstdcpp/proof/atomic/spec.v index f958cef0..c3b949e3 100644 --- a/rocq-brick-libstdcpp/proof/atomic/spec.v +++ b/rocq-brick-libstdcpp/proof/atomic/spec.v @@ -362,4 +362,6 @@ Module atomic_specs (Import atomic : ATOMIC_PREDS). End atomic_specs. +NES.Begin std.atomic. Include (atomic_specs atomic). +NES.End std.atomic. From d17add67a4eac7f5f4864e0b74836cb7005fc97c Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Thu, 20 Aug 2026 20:32:09 +0200 Subject: [PATCH 14/51] WIP on thread_id proofs --- .../proof/atomic/test_cpp_proof.v | 169 ++++++++++++++++-- rocq-brick-libstdcpp/proof/thread/pred.v | 6 + rocq-brick-libstdcpp/proof/thread/spec.v | 0 3 files changed, 161 insertions(+), 14 deletions(-) create mode 100644 rocq-brick-libstdcpp/proof/thread/pred.v create mode 100644 rocq-brick-libstdcpp/proof/thread/spec.v diff --git a/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v b/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v index fd2ac037..547b6ee4 100644 --- a/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v +++ b/rocq-brick-libstdcpp/proof/atomic/test_cpp_proof.v @@ -5,11 +5,80 @@ * SPDX-License-Identifier: LGPL-2.1 WITH BlueRock Exception for use over network, see repository root for details. *) Require Import skylabs.auto.cpp.proof. +Require Import skylabs.cpp.spec.argr. +Require Import skylabs.brick.libstdcpp.runtime.pred. Require Import skylabs.brick.libstdcpp.cassert.spec. -Require Import skylabs.brick.libstdcpp.atomic.spec. +(* Require Import skylabs.brick.libstdcpp.atomic.spec. *) (* Require Import skylabs.brick.libstdcpp.test.atomic.test_cpp. *) Require Import skylabs.brick.libstdcpp.atomic.test_cpp. +NES.Begin std.thread.id. + Section with_cpp. + Context `{Σ : cpp_logic, σ : genv}. + + Parameter R : forall (q : cQp.t) (ot : option thread_idT), Rep. + #[only(cfracsplittable, type_ptr="std::thread::id")] derive R. + + cpp.spec (default_ctor "std::thread::id") as ctor_spec from source with ( + \this this + \post this |-> R 1$m None + ). + + cpp.spec (const_copy_ctor "std::thread::id") as const_copy_ctor_spec from source with ( + \this this + \arg{p} "" (Vptr p) + (* TODO p |-> R *) + \post this |-> R 1$m None + ). + + cpp.spec (dtor "std::thread::id") as dtor_spec from source with ( + \this this + \pre this |-> R 1$m None + \post emp + ). + +(* cpp.spec *) +(* "std::thread::id" *) + End with_cpp. +NES.End std.thread.id. + +NES.Begin std.atomic.thread.id. + Section with_cpp. + Context `{Σ : cpp_logic, σ : genv}. + + Parameter R : forall (q : cQp.t) (ot : option thread_idT), Rep. + + cpp.spec (default_ctor "std::atomic") as default_ctor from source with ( + \this this + \post this |-> R 1$m None + ). + + cpp.spec (dtor "std::atomic") as dtor from source with ( + \this this + \pre this |-> R 1$m None + \post emp + ). + + cpp.spec "std::atomic::atomic(std::thread::id)" as atomic_id_ctor from source with ( + \this this + \argR{q m} "" (std.thread.id.R q m) + \post this |-> R 1$m m + ). + + cpp.spec "std::atomic::operator=(std::thread::id)" as atomic_id_op_eq from source with ( + \this this + \argR{q m} "" (std.thread.id.R q m) + \pre this |-> R 1$m None + (* \post{r}[Vref r] this |-> R 1$m m *) + \post{r}[Vref r] this |-> R 1$m m ** r |-> std.thread.id.R 1$m m + ). + + cpp.spec "std::atomic::operator std::thread::id() const" as atomic_read_op from source with ( + ). + + End with_cpp. +NES.End std.atomic.thread.id. + Section with_cpp. Context `{Σ : cpp_logic, σ : genv}. @@ -18,6 +87,41 @@ Section with_cpp. Section specs. Context `{MOD : test_cpp.source ⊧ σ}. + cpp.spec "testThreadId(std::thread::id)" as testThreadId with ( + \arg{p} "" (Vptr p) + \prepost{q} GLOBALS q + \post emp). + + + Goal verify?[source] testThreadId. + Proof. + verify_spec; go. + + (* +Warning: +The following dependencies are missing specifications: +"std::atomic::atomic()"%cpp_name +"std::thread::id::id(const std::thread::id&)"%cpp_name +"std::atomic::atomic(std::thread::id)"%cpp_name +"std::atomic::operator=(std::thread::id)"%cpp_name +"std::atomic::~atomic()"%cpp_name +"std::thread::id::~id()"%cpp_name +[sl-missing-spec-dependencies,sl,default] + + *) + + Definition ctor : mpred := + specify.template.ctor s [ty] $ + \this this + \arg{n} "v" (Vptr ty n) + \post this |-> R 1$m n. + #[global] Hint Opaque ctor : sl_opacity. + #[global] Arguments ctor : simpl never. + Definition SpecFor_ctor := RegisterSpec ctor. + #[global] Existing Instance SpecFor_ctor. *) + + + cpp.spec "test(bool, const char*)" as test_spec with (\arg "b" (Vbool true) \arg{p} "" (Vptr p) @@ -55,11 +159,6 @@ Section with_cpp. (\prepost{q} GLOBALS q \post[Vint 0] emp). - cpp.spec "testThreadId(std::thread::id)" as testThreadId with ( - \arg{p} "" (Vptr p) - \prepost{q} GLOBALS q - \post emp). - Definition specs := test_default_ctor ** test_parameterized_ctor ** @@ -193,17 +292,58 @@ Section with_cpp. Abbreviation OK spec := (verify?[test_cpp.source] spec) (only parsing). - Set Typeclasses Debug. - Goal SpecFor source "std::__1::atomic::fetch_add(long, enum std::__1::memory_order)"%cpp_name. - Fail apply _. - About SpecFor_fetch_binop. - Check (SpecFor_fetch_binop "int*"). +(* + Definition ctor : mpred := + specify.template.ctor s [ty] $ + \this this + \arg{n} "v" (Vinj ty n) + \post this |-> R 1$m n. + #[global] Hint Opaque ctor : sl_opacity. + #[global] Arguments ctor : simpl never. + Definition SpecFor_ctor := RegisterSpec ctor. + #[global] Existing Instance SpecFor_ctor. *) + + + + +(* "std::atomic::atomic()"%cpp_name +"std::thread::id::id(const std::thread::id&)"%cpp_name +"std::atomic::atomic(std::thread::id)"%cpp_name +"std::atomic::operator=(std::thread::id)"%cpp_name +"std::atomic::~atomic()"%cpp_name +"std::thread::id::~id()"%cpp_name *) + + + Goal SpecFor source "std::__atomic_base::fetch_add(int, enum std::memory_order)"%cpp_name. + apply _. + Goal SpecFor source "std::atomic::fetch_add(long, enum std::memory_order)"%cpp_name. + Set Typeclasses Debug. + Fail apply _. + + #[global] Instance num_plusplus {sz sgn} : + UnOp (Tnum sz sgn) Z OOPlusPlus := + {| atomic_un_op := add_raw sz sgn 1 |}. + + (* Goal SpecFor source "std::__atomic_base::operator++()". + apply _. *) + (* Set Typeclasses Debug. *) + + Lemma fetch_add_ok : OK test_fetch_add. + Proof. verify_spec; go. Qed. + + Lemma arith_ok : OK test_arith. + Proof. verify_spec; go. Qed. + + Check (SpecFor_fetch_binop "int"). + About SpecFor_fetch_binop. + class_apply (SpecFor_fetch_binop "int"). + + About SpecFor_fetch_binop. + Check (SpecFor_fetch_binop "int*"). class_apply (SpecFor_fetch_binop "int*"). - Goal SpecFor source "std::__1::__atomic_base::operator++(int)". + Goal SpecFor source "std::__atomic_base::operator++(int)". apply _. - Lemma arith_ok : OK test_fetch_add. - Proof. verify_spec. go. Qed. @@ -228,4 +368,5 @@ Section with_cpp. verify_spec. go. Qed. + End with_cpp. diff --git a/rocq-brick-libstdcpp/proof/thread/pred.v b/rocq-brick-libstdcpp/proof/thread/pred.v new file mode 100644 index 00000000..8f05d106 --- /dev/null +++ b/rocq-brick-libstdcpp/proof/thread/pred.v @@ -0,0 +1,6 @@ +Require Import skylabs.auto.cpp.prelude.pred. +Require Import skylabs.brick.libstdcpp.runtime.pred. + +Section with_cpp. + Context `{Σ : cpp_logic}. +End with_cpp. diff --git a/rocq-brick-libstdcpp/proof/thread/spec.v b/rocq-brick-libstdcpp/proof/thread/spec.v new file mode 100644 index 00000000..e69de29b From c328fe8cbf4efb7fbde68eb63afa26f386c85370 Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Mon, 31 Aug 2026 18:13:50 +0000 Subject: [PATCH 15/51] [mutex.v]: change token to user; comment out with_RepFor section --- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 59 ++++++++++--------- 1 file changed, 31 insertions(+), 28 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index f013828f..c2254964 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -12,8 +12,10 @@ Require Export skylabs.brick.libstdcpp.runtime.pred. Require Import skylabs.brick.libstdcpp.mutex.inc_hpp. Require Import skylabs.brick.libstdcpp.mutex.requirements. +Require Import skylabs.brick.libstdcpp.lib.lock_ghost. Import linearity. +Import lock_ghost. (* TODO UPSTREAM. *) #[global] Instance SplitRecord_prod A B : SplitRecord (@prod A B) := {}. @@ -28,21 +30,14 @@ Section with_cpp. #[global] Declare Instance R_learnable : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv}, Cbn (Learn (learn_eq ==> any ==> learn_eq ==> learn_hints.fin) R). - (** Owning [mutex_token γ 1] proves that the mutex is not locked, and - therefore can be safely destroyed: the standard specifies that calling - [std::mutex::~mutex()] while holding the lock results in undefined behavior. - *) - Parameter token : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv}, gname -> Qp -> mpred. - #[only(fractional,fracvalid,asfractional,timeless)] derive token. - - Section with_RepFor. + (* Section with_RepFor. Import rep.RepFor. Import RepScheme. #[global] Instance repfor `{!HasStdThreads Σ} {σ : genv} : rep.RepFor.C "std::mutex" [ArgType.Constant _; ArgType.CFrac; ArgType.Constant _] - (funI γ q P => R γ q P ∗ pureR (token γ q)) := {}. - End with_RepFor. + (funI γ q P => R γ q P) := {}. + End with_RepFor. *) (** A resource enforcing that the thread calling unlock must be the same thread @@ -65,27 +60,36 @@ Section with_cpp. >> *) Parameter locked : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv}, - gname -> thread_idT -> Qp -> mpred. + gname -> thread_idT -> mpred. #[only(timeless)] derive locked. - (** locked takes a [Qp] but _cannot_ be split. *) #[only(exclusive)] derive locked. + Context `{!lockG Σ}. + + Abbreviation used_threads γ s := + (lock_ghost.used_threads γ s). + + Abbreviation users γ ths := + (lock_ghost.users γ ths). + + Abbreviation user γ th := (users γ {[ th ]}). + Context `{MOD : source ⊧ σ}. Context {HAS_THREADS : HasStdThreads Σ}. - #[global] Instance locked_learn : Cbn (Learn (req_eq ==> learn_eq ==> learn_eq ==> learn_hints.fin) locked). + #[global] Instance locked_learn : Cbn (Learn (req_eq ==> learn_eq ==> learn_hints.fin) locked). Proof. solve_learnable. Qed. cpp.spec "std::mutex::mutex()" as ctor_spec with ( \this this \pre{P} ▷P - \post Exists g, this |-> R g 1$m P ** token g 1). + \post Exists g, this |-> R g 1$m P ** used_threads g ∅). cpp.spec "std::mutex::~mutex()" as dtor_spec with ( \this this - \pre{g P} this |-> R g 1$m P ** token g 1 + \pre{g P} this |-> R g 1$m P ** used_threads g ∅ \post P). (* "Inline" version of these specs. *) @@ -93,41 +97,41 @@ Section with_cpp. \this this \prepost{q P g} this |-> R g q P \persist{thr} current_thread thr - \pre{q'} token g q' - \post P ** locked g thr q'). + \pre user g thr + \post P ** locked g thr). Definition do_lock (lk : gname * mpred) (K: mpred) : mpred := let g := lk.1 in let P := lk.2 in - ∃ q thr, current_thread thr ∗ token g q ∗ + ∃ thr, current_thread thr ∗ user g thr ∗ (* TODO readd *) (* ▷ *) - (locked g thr q ** P -* K). + (locked g thr ** P -* K). #[global] Arguments do_lock /. cpp.spec "std::mutex::unlock()" as unlock_spec_alt with ( \this this \prepost{q P g} this |-> R g q P \persist{thr} current_thread thr - \pre{q'} locked g thr q' + \pre locked g thr \pre ▷P - \post token g q'). + \post user g thr). Definition do_unlock (lk : gname * mpred) (Q : mpred) : mpred := let g := lk.1 in let P := lk.2 in - Exists q thr, current_thread thr ** locked g thr q ** ▷P ** + Exists thr, current_thread thr ** locked g thr ** ▷P ** (* TODO readd *) (* ▷ *) - (token g q -* Q). + (user g thr -* Q). #[global] Arguments do_unlock /. cpp.spec "std::mutex::try_lock()" as try_lock_spec_alt with ( \this this \prepost{q P g} this |-> R g q P \persist{th} current_thread th - \pre{q'} token g q' - \post{b}[Vbool b] if b then P ** locked g th q' else token g q'). + \pre user g th + \post{b}[Vbool b] if b then P ** locked g th else user g th). (* Obtain same specs from (Basic)Lockable. *) (** <> implements [BasicLockable] *) @@ -146,9 +150,9 @@ Section with_cpp. Definition do_try_lock (lk : gname * mpred) (Q : bool -> mpred) : mpred := let g := lk.1 in let P := lk.2 in - ∃ q thr, current_thread thr ∗ token g q ∗ + ∃ thr, current_thread thr ∗ user g thr ∗ ∀ b : bool, - (if b then P ** locked g thr q else token g q) -∗ Q b. + (if b then P ** locked g thr else user g thr) -∗ Q b. #[global] Arguments do_try_lock /. #[global,program] Instance mutex_lockable : Lockable (T:=T) "std::mutex" (λ q γP, R γP.1 q γP.2) := @@ -173,4 +177,3 @@ Section with_cpp. Qed. End with_cpp. End mutex. - From 462cb7548648b32f8519ce6e6f851e67c7d8017f Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Mon, 31 Aug 2026 18:40:05 +0000 Subject: [PATCH 16/51] replace appearance of mutex.token to user --- .../proof/mutex/proof/lock_guard.v | 5 ++--- .../proof/mutex/proof/unique_lock.v | 5 +++-- .../proof/mutex/spec/lock_guard.v | 11 +++++----- .../proof/mutex/spec/scoped_lock.v | 20 ++++++++++--------- 4 files changed, 22 insertions(+), 19 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/mutex/proof/lock_guard.v b/rocq-brick-libstdcpp/proof/mutex/proof/lock_guard.v index 74de4d0d..a828faae 100644 --- a/rocq-brick-libstdcpp/proof/mutex/proof/lock_guard.v +++ b/rocq-brick-libstdcpp/proof/mutex/proof/lock_guard.v @@ -3,12 +3,14 @@ Require Import skylabs.brick.libstdcpp.mutex.spec.mutex. Require Import skylabs.brick.libstdcpp.mutex.spec.lock_guard. Require Import skylabs.brick.libstdcpp.mutex.inc_hpp. +Require Import skylabs.brick.libstdcpp.lib.lock_ghost. Import linearity. Section with_cpp. Context `{Σ : cpp_logic, σ : genv}. Context {HAS_THREADS : HasStdThreads Σ}. + Context `{!lock_ghost.lockG Σ}. Import lock_guard. @@ -17,9 +19,6 @@ Section with_cpp. Cbn (Learn (learn_eq ==> learn_eq ==> learn_eq ==> fin_at) mutex.R). Proof. solve_learnable. Qed. - #[global] Instance UNSAFE_token_learn : Cbn (Learn (req_eq ==> learn_eq ==> learn_hints.fin) mutex.token). - Proof. solve_learnable. Qed. - #[local] Hint Resolve fractional.UNSAFE_read_prim_learn : sl_opacity. Lemma ctor_ok : verify[source] ctor_spec. diff --git a/rocq-brick-libstdcpp/proof/mutex/proof/unique_lock.v b/rocq-brick-libstdcpp/proof/mutex/proof/unique_lock.v index 45ff3244..dc8a20d7 100644 --- a/rocq-brick-libstdcpp/proof/mutex/proof/unique_lock.v +++ b/rocq-brick-libstdcpp/proof/mutex/proof/unique_lock.v @@ -6,11 +6,13 @@ Require Import skylabs.brick.libstdcpp.mutex.spec.prelude. Require Import skylabs.brick.libstdcpp.mutex.spec.unique_lock. Require Import skylabs.brick.libstdcpp.mutex.spec.mutex. Require Import skylabs.brick.libstdcpp.lib.tactics. +Require Import skylabs.brick.libstdcpp.lib.lock_ghost. NES.Begin unique_lock. Section with_cpp. Context `{Σ : cpp_logic} {σ : genv}. Context `{HAS_THREADS : !HasStdThreads Σ}. + Context `{!lock_ghost.lockG Σ}. Import R_unfold. @@ -43,10 +45,9 @@ NES.Begin unique_lock. "std::unique_lock::unique_lock(std::mutex&)". Proof. verify_spec; go. - iExists K. + iExists K, q. (* Time Succeed solve [setoid_rewrite cQp.scale_mut; setoid_rewrite (right_id_L 1%Qp Qp.mul); ego with br_erefl]. *) - iExists _, q. rewrite cQp.scale_mut (right_id_L 1%Qp Qp.mul). go with br_erefl. Qed. diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v b/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v index 392b5445..c95924eb 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v @@ -3,6 +3,7 @@ Require Import skylabs.brick.libstdcpp.mutex.spec.mutex. Require Export skylabs.brick.libstdcpp.runtime.pred. Require Import skylabs.brick.libstdcpp.mutex.inc_hpp. +Require Import skylabs.brick.libstdcpp.lib.lock_ghost. Import linearity. @@ -47,6 +48,7 @@ Module lock_guard. Section with_cpp. Context `{Σ : cpp_logic, σ : genv}. Context {HAS_THREADS : HasStdThreads Σ}. + Context `{!lock_ghost.lockG Σ}. #[global] Instance R_learn : Cbn (Learn (learn_eq ==> any ==> learn_eq ==> learn_hints.fin) lock_guard.R) := @@ -87,20 +89,20 @@ Section with_cpp. \arg{mp} "m" (Vptr mp) \persist{thr} current_thread thr \pre{g q P} mp |-> mutex.R g q$m P - \pre mutex.token g q + \pre lock_ghost.user g thr \post this |-> R (mp, g, q) 1$m P ** - P ** mutex.locked g thr q + P ** mutex.locked g thr ). cpp.spec "std::lock_guard::~lock_guard()" as dtor_spec from source with ( \this this \pre{mp g q P} this |-> R (mp, g, q) 1$m P \persist{thr} current_thread thr - \pre mutex.locked g thr q + \pre mutex.locked g thr \pre ▷P \post - mutex.token g q ** + lock_ghost.user g thr ** mp |-> mutex.R g q$m P ). @@ -124,4 +126,3 @@ Section with_cpp. End with_cpp. End lock_guard. - diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v b/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v index 7a734e9f..b8811f8e 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v @@ -3,6 +3,7 @@ Require Import skylabs.brick.libstdcpp.mutex.inc_hpp. Require Export skylabs.brick.libstdcpp.runtime.pred. Require Import skylabs.brick.libstdcpp.mutex.spec.mutex. +Require Import skylabs.brick.libstdcpp.lib.lock_ghost. Module scoped_lock. Section with_cpp. @@ -17,6 +18,7 @@ Module scoped_lock. Section with_threads. Context {σ : genv}. Context `{HAS_THREADS : !HasStdThreads Σ}. + Context `{!lock_ghost.lockG Σ}. #[global] Instance: LearnEqF1 R := ltac:(solve_learnable). @@ -25,17 +27,17 @@ Module scoped_lock. (* "std::scoped_lock::scoped_lock(std::mutex&, std::mutex&)" *) as ctor_spec from source with ( \this this + \persist{thr} current_thread thr \arg{mp1} "" (Vptr mp1) \pre{g1 q1 P1} mp1 |-> mutex.R g1 q1$m P1 - \pre mutex.token g1 q1 + \pre lock_ghost.user g1 thr \arg{mp2} "" (Vptr mp2) \pre{g2 q2 P2} mp2 |-> mutex.R g2 q2$m P2 - \pre mutex.token g2 q2 - \persist{thr} current_thread thr + \pre lock_ghost.user g2 thr \post this |-> R 1$m [ (mp1, g1, q1, P1); (mp2, g2, q2, P2)] ** - P1 ** mutex.locked g1 thr q1 ** - P2 ** mutex.locked g2 thr q2 + P1 ** mutex.locked g1 thr ** + P2 ** mutex.locked g2 thr ). cpp.spec "std::scoped_lock<...>::~scoped_lock()" @@ -50,11 +52,11 @@ Module scoped_lock. this |-> R 1$m [ (mp1, g1, q1, P1); (mp2, g2, q2, P2)] \pre |> P1 \pre |> P2 - \pre mutex.locked g1 thr q1 - \pre mutex.locked g2 thr q2 + \pre mutex.locked g1 thr + \pre mutex.locked g2 thr \post - mp1 |-> mutex.R g1 q1$m P1 ** mutex.token g1 q1 ** - mp2 |-> mutex.R g2 q2$m P2 ** mutex.token g2 q2 + mp1 |-> mutex.R g1 q1$m P1 ** lock_ghost.user g1 thr ** + mp2 |-> mutex.R g2 q2$m P2 ** lock_ghost.user g2 thr ). End with_threads. End with_cpp. From bcb91f7be3b6077048e81eb764480d841b939600 Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Mon, 31 Aug 2026 23:36:44 +0000 Subject: [PATCH 17/51] check in layout of a custom mutex proof --- .../test/mutex/custom_mutex_hpp_proof.v | 79 +++++++++++++++++++ 1 file changed, 79 insertions(+) create mode 100644 rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v new file mode 100644 index 00000000..70f0b4b1 --- /dev/null +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -0,0 +1,79 @@ +(** Provisional *) + +Require Import skylabs.auto.cpp.proof. +Require Import skylabs.brick.libstdcpp.mutex.spec.mutex. +Require Import skylabs.brick.libstdcpp.test.mutex.custom_mutex_hpp. +Require Import skylabs.brick.libstdcpp.lib.lock_ghost. +Import lock_ghost. +Require Import skylabs.brick.libstdcpp.atomic.spec. + +Module custom_mutex. + + Abbreviation N := "MyMutex"%cpp_name. + + + Parameter atomic_thread_idT : ∀ `{Σ : cpp_logic, σ : genv}, cQp.t -> option thread_idT -> Rep. + + Parameter exclusive_token : ∀ `{Σ : cpp_logic}, iprop.gname -> mpred. + Parameter owner_token_auth : ∀ `{Σ : cpp_logic}, iprop.gname -> option thread_idT -> mpred. + Parameter owner_token_frac : ∀ `{Σ : cpp_logic}, iprop.gname -> option thread_idT -> mpred. + + Record gname : Set := MkGname + { user_gname : iprop.gname + ; cinv_gname : iprop.gname + ; phys_state_gname : iprop.gname + }. + + Definition lock_namespace : namespace := nroot .@@ "MyMutex". + + Definition locked `{Σ : cpp_logic} `{!lockG Σ} (g: gname) (th : thread_idT) : mpred + := owner_token_auth g.(phys_state_gname) (Some th) ** user g.(user_gname) th. + + (* Definition IR `{Σ : cpp_logic, σ : genv, !HasStdThreads Σ, !recursive_mutex.lockedG Σ} (γ : gname) (q : cQp.t) : mpred := + ∃ x, recursive_mutex.owned_count_id_auth γ.(rec_gname) x. *) +(* + Definition rawR `{Σ : cpp_logic, σ : genv} (owner : option thread_idT) (count : nat) : Rep := + structR "std::recursive_mutex" 1$m ** + _field "MyRecursiveMutex::m_count" |-> ulonglongR 1$m count. *) + + Section with_Σ. + Context `{Σ : cpp_logic, σ : genv, !HasStdThreads Σ, !lockG Σ}. + + Definition mutex_content (γ : gname) : Rep := + ∃ o_owner lockedb, + _field "MyMutex::m_lock" |-> atomic.R "bool" 1$m lockedb ** + _field "MyMutex::m_owner" |-> atomic_thread_idT 1$m o_owner. + + Definition mutex_inv (this : ptr) (γ : gname) (P : mpred) : mpred := + ∃ o_owner, this ,, _field "MyMutex::m_owner" |-> atomic_thread_idT 1$m o_owner ** + owner_token_frac γ.(phys_state_gname) o_owner ** + ∃ b : bool, + this ,, _field "MyMutex::m_lock" |-> atomic.R "bool" 1$m b ** + if b then + ∃ owner, [| Some owner = o_owner |] + else + owner_token_auth γ.(phys_state_gname) o_owner ** + P. + + Definition IR (γ : gname) (q : cQp.t) (P : mpred) : Rep := + structR N q$m ** + as_Rep (fun this => + cinv lock_namespace γ.(cinv_gname) (mutex_inv this γ P) ** + cinv_own γ.(cinv_gname) q + ). + + Section proof. + + Context `{MOD : source ⊧ σ}. + Context {HAS_THREADS : HasStdThreads Σ}. + + cpp.spec "MyMutex::MyMutex()" as ctor_spec with ( + \this this + \pre{P} ▷P + \post Exists g, this |-> IR g 1$m P ** used_threads g.(user_gname) ∅). + + End proof. + + End with_Σ. + +End custom_mutex. From af6eb730d92618e89ceda874bca14af4774d2cd6 Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Tue, 1 Sep 2026 04:46:57 +0000 Subject: [PATCH 18/51] [custom_mutex_hpp_proof.v] add do_lock lemma statement --- .../test/mutex/custom_mutex_hpp_proof.v | 60 ++++++++++++++----- 1 file changed, 46 insertions(+), 14 deletions(-) diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index 70f0b4b1..2750bcfc 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -12,7 +12,9 @@ Module custom_mutex. Abbreviation N := "MyMutex"%cpp_name. - Parameter atomic_thread_idT : ∀ `{Σ : cpp_logic, σ : genv}, cQp.t -> option thread_idT -> Rep. + Parameter atomic_thread_idT : ∀ `{Σ : cpp_logic, σ : genv}, cQp.t -> + (* None if value is thread::id(), Some otherwise *) + option thread_idT -> Rep. Parameter exclusive_token : ∀ `{Σ : cpp_logic}, iprop.gname -> mpred. Parameter owner_token_auth : ∀ `{Σ : cpp_logic}, iprop.gname -> option thread_idT -> mpred. @@ -45,15 +47,21 @@ Module custom_mutex. _field "MyMutex::m_owner" |-> atomic_thread_idT 1$m o_owner. Definition mutex_inv (this : ptr) (γ : gname) (P : mpred) : mpred := - ∃ o_owner, this ,, _field "MyMutex::m_owner" |-> atomic_thread_idT 1$m o_owner ** + ∃ o_owner, owner_token_frac γ.(phys_state_gname) o_owner ** ∃ b : bool, this ,, _field "MyMutex::m_lock" |-> atomic.R "bool" 1$m b ** if b then - ∃ owner, [| Some owner = o_owner |] + emp else owner_token_auth γ.(phys_state_gname) o_owner ** - P. + P ** + (** m_owner does not concern do_lock() and do_unlock(), the actual + implementation of mutex, and does not always equal o_owner. + It is just a resource that one can get from the invariant. *) + ∃ m_owner : option thread_idT, + this ,, _field "MyMutex::m_owner" |-> atomic_thread_idT 1$m m_owner + . Definition IR (γ : gname) (q : cQp.t) (P : mpred) : Rep := structR N q$m ** @@ -62,18 +70,42 @@ Module custom_mutex. cinv_own γ.(cinv_gname) q ). - Section proof. - Context `{MOD : source ⊧ σ}. - Context {HAS_THREADS : HasStdThreads Σ}. - cpp.spec "MyMutex::MyMutex()" as ctor_spec with ( - \this this - \pre{P} ▷P - \post Exists g, this |-> IR g 1$m P ** used_threads g.(user_gname) ∅). - - End proof. + Context `{MOD : source ⊧ σ}. + Context {HAS_THREADS : HasStdThreads Σ}. + + cpp.spec "MyMutex::MyMutex()" as ctor_spec with ( + \this this + \pre{P} ▷P + \post Exists g, this |-> IR g 1$m P ** used_threads g.(user_gname) ∅). + + cpp.spec "MyMutex::~MyMutex()" as dtor_spec with ( + \this this + \pre{g P} this |-> IR g 1$m P ** used_threads g.(user_gname) ∅ + \post P). + + cpp.spec "MyMutex::do_lock()" as lock_spec with ( + \this this + \prepost{q P g} this |-> IR g q P + \persist{thr} current_thread thr + \pre user g.(user_gname) thr + \post ▷ P ** locked g thr). + + cpp.spec "MyMutex::do_unlock()" as unlock_spec with ( + \this this + \prepost{q P g} this |-> IR g q P + \persist{thr} current_thread thr + \pre locked g thr + \pre ▷P + \post user g.(user_gname) thr). + + (* Axiom *) + cpp.spec "std::this_thread::yield()" as yield_spec with ( + \post emp). + + Import std.atomic. + Fail Lemma test_do_lock_ok : verify[source] "MyMutex::do_lock()". End with_Σ. - End custom_mutex. From 41318dfe0f244480f67cd1761c277fc7cb048256 Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Tue, 1 Sep 2026 11:58:22 +0200 Subject: [PATCH 19/51] Tweak spec and client proof --- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 6 +++--- rocq-brick-libstdcpp/test/mutex/test_cpp_proof.v | 1 + 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index c2254964..1bea8673 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -13,9 +13,9 @@ Require Export skylabs.brick.libstdcpp.runtime.pred. Require Import skylabs.brick.libstdcpp.mutex.inc_hpp. Require Import skylabs.brick.libstdcpp.mutex.requirements. Require Import skylabs.brick.libstdcpp.lib.lock_ghost. +Export skylabs.brick.libstdcpp.lib.lock_ghost(lockG). Import linearity. -Import lock_ghost. (* TODO UPSTREAM. *) #[global] Instance SplitRecord_prod A B : SplitRecord (@prod A B) := {}. @@ -30,14 +30,14 @@ Section with_cpp. #[global] Declare Instance R_learnable : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv}, Cbn (Learn (learn_eq ==> any ==> learn_eq ==> learn_hints.fin) R). - (* Section with_RepFor. + Section with_RepFor. Import rep.RepFor. Import RepScheme. #[global] Instance repfor `{!HasStdThreads Σ} {σ : genv} : rep.RepFor.C "std::mutex" [ArgType.Constant _; ArgType.CFrac; ArgType.Constant _] (funI γ q P => R γ q P) := {}. - End with_RepFor. *) + End with_RepFor. (** A resource enforcing that the thread calling unlock must be the same thread diff --git a/rocq-brick-libstdcpp/test/mutex/test_cpp_proof.v b/rocq-brick-libstdcpp/test/mutex/test_cpp_proof.v index 7f263bf2..53c73e3e 100644 --- a/rocq-brick-libstdcpp/test/mutex/test_cpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/test_cpp_proof.v @@ -6,6 +6,7 @@ Import linearity. Section with_cpp. Context `{Σ : cpp_logic, σ : genv} {HAS_THREADS : HasStdThreads Σ}. + Context `{!lockG Σ}. cpp.spec "test_mutex()" as test_mutex_spec from source with (\post emp). From 2e24af53780e5ee213d2d0fbc475eb97f91d065e Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Tue, 1 Sep 2026 12:03:16 +0200 Subject: [PATCH 20/51] Drop trailing whitespace --- .../test/mutex/custom_mutex_hpp_proof.v | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index 2750bcfc..6e218639 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -12,8 +12,8 @@ Module custom_mutex. Abbreviation N := "MyMutex"%cpp_name. - Parameter atomic_thread_idT : ∀ `{Σ : cpp_logic, σ : genv}, cQp.t -> - (* None if value is thread::id(), Some otherwise *) + Parameter atomic_thread_idT : ∀ `{Σ : cpp_logic, σ : genv}, cQp.t -> + (* None if value is thread::id(), Some otherwise *) option thread_idT -> Rep. Parameter exclusive_token : ∀ `{Σ : cpp_logic}, iprop.gname -> mpred. @@ -28,7 +28,7 @@ Module custom_mutex. Definition lock_namespace : namespace := nroot .@@ "MyMutex". - Definition locked `{Σ : cpp_logic} `{!lockG Σ} (g: gname) (th : thread_idT) : mpred + Definition locked `{Σ : cpp_logic} `{!lockG Σ} (g: gname) (th : thread_idT) : mpred := owner_token_auth g.(phys_state_gname) (Some th) ** user g.(user_gname) th. (* Definition IR `{Σ : cpp_logic, σ : genv, !HasStdThreads Σ, !recursive_mutex.lockedG Σ} (γ : gname) (q : cQp.t) : mpred := @@ -91,7 +91,7 @@ Module custom_mutex. \persist{thr} current_thread thr \pre user g.(user_gname) thr \post ▷ P ** locked g thr). - + cpp.spec "MyMutex::do_unlock()" as unlock_spec with ( \this this \prepost{q P g} this |-> IR g q P @@ -103,7 +103,7 @@ Module custom_mutex. (* Axiom *) cpp.spec "std::this_thread::yield()" as yield_spec with ( \post emp). - + Import std.atomic. Fail Lemma test_do_lock_ok : verify[source] "MyMutex::do_lock()". From 18d609b3602bdc8cc56588a33d788f847b1148b3 Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Tue, 1 Sep 2026 12:03:25 +0200 Subject: [PATCH 21/51] cleanups --- rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index 6e218639..0b6d7068 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -2,11 +2,11 @@ Require Import skylabs.auto.cpp.proof. Require Import skylabs.brick.libstdcpp.mutex.spec.mutex. -Require Import skylabs.brick.libstdcpp.test.mutex.custom_mutex_hpp. Require Import skylabs.brick.libstdcpp.lib.lock_ghost. -Import lock_ghost. Require Import skylabs.brick.libstdcpp.atomic.spec. +Require Import skylabs.brick.libstdcpp.test.mutex.custom_mutex_hpp. + Module custom_mutex. Abbreviation N := "MyMutex"%cpp_name. From a4e43a3ca815964cf0aba1dcfb0c0a527ed04125 Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Tue, 1 Sep 2026 13:14:24 +0200 Subject: [PATCH 22/51] Fix parentheses in Rep --- .../test/mutex/custom_mutex_hpp_proof.v | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index 0b6d7068..2b06e63b 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -50,17 +50,17 @@ Module custom_mutex. ∃ o_owner, owner_token_frac γ.(phys_state_gname) o_owner ** ∃ b : bool, - this ,, _field "MyMutex::m_lock" |-> atomic.R "bool" 1$m b ** - if b then + this ,, _field "MyMutex::m_lock" |-> atomic.R "int" 1$m (if b then 1 else 0)%Z ** + (if b then emp else owner_token_auth γ.(phys_state_gname) o_owner ** - P ** - (** m_owner does not concern do_lock() and do_unlock(), the actual - implementation of mutex, and does not always equal o_owner. - It is just a resource that one can get from the invariant. *) - ∃ m_owner : option thread_idT, - this ,, _field "MyMutex::m_owner" |-> atomic_thread_idT 1$m m_owner + P) ** + (** m_owner does not concern do_lock() and do_unlock(), the actual + implementation of mutex, and does not always equal o_owner. + It is just a resource that one can get from the invariant. *) + ∃ m_owner : option thread_idT, + this ,, _field "MyMutex::m_owner" |-> atomic_thread_idT 1$m m_owner . Definition IR (γ : gname) (q : cQp.t) (P : mpred) : Rep := From 65013f9401c1cf87f4d53db374a18627e5feb9b0 Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Tue, 1 Sep 2026 12:02:35 +0200 Subject: [PATCH 23/51] custom_mutex: atomic -> atomic --- rocq-brick-libstdcpp/test/mutex/custom_mutex.hpp | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex.hpp b/rocq-brick-libstdcpp/test/mutex/custom_mutex.hpp index c5844ede..b5bcbf60 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex.hpp +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex.hpp @@ -16,13 +16,14 @@ std::mutex protocol: - can't be destroyed while held. */ class MyMutex { - std::atomic m_lock{false}; + // std::atomic m_lock{false}; + std::atomic m_lock{0}; std::thread::id m_owner{}; // "Actual locking" void do_lock() { - while (m_lock.exchange(true)) { + while (m_lock.exchange(1)) { // Yielding helps scheduling, and makes this loop obviously not UB // (under https://eel.is/c++draft/intro.progress#1.2). // Calling exchange might qualify under @@ -32,7 +33,7 @@ class MyMutex { } void do_unlock() { - m_lock = false; + m_lock = 0; } public: @@ -60,7 +61,7 @@ class MyMutex { } ~MyMutex() { - assert(!m_lock); + assert(m_lock == 0); assert(m_owner == std::thread::id()); //unowned } }; From 0e35894cf3e7d803db08bb158d1695a8a0d2d13b Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Tue, 1 Sep 2026 13:15:01 +0200 Subject: [PATCH 24/51] Proof sketch --- .../test/mutex/custom_mutex_hpp_proof.v | 96 ++++++++++++++++++- 1 file changed, 91 insertions(+), 5 deletions(-) diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index 2b06e63b..add64e88 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -15,6 +15,7 @@ Module custom_mutex. Parameter atomic_thread_idT : ∀ `{Σ : cpp_logic, σ : genv}, cQp.t -> (* None if value is thread::id(), Some otherwise *) option thread_idT -> Rep. + #[only(timeless)] derive atomic_thread_idT. Parameter exclusive_token : ∀ `{Σ : cpp_logic}, iprop.gname -> mpred. Parameter owner_token_auth : ∀ `{Σ : cpp_logic}, iprop.gname -> option thread_idT -> mpred. @@ -39,7 +40,7 @@ Module custom_mutex. _field "MyRecursiveMutex::m_count" |-> ulonglongR 1$m count. *) Section with_Σ. - Context `{Σ : cpp_logic, σ : genv, !HasStdThreads Σ, !lockG Σ}. + Context `{Σ : cpp_logic, σ : genv, HAS_THREADS : !HasStdThreads Σ, !lockG Σ}. Definition mutex_content (γ : gname) : Rep := ∃ o_owner lockedb, @@ -69,11 +70,12 @@ Module custom_mutex. cinv lock_namespace γ.(cinv_gname) (mutex_inv this γ P) ** cinv_own γ.(cinv_gname) q ). + Hint Opaque IR : sl_opacity typeclass_instances. + #[only(type_ptr,cfractional,ascfractional,cfracvalid)] derive IR. Context `{MOD : source ⊧ σ}. - Context {HAS_THREADS : HasStdThreads Σ}. cpp.spec "MyMutex::MyMutex()" as ctor_spec with ( \this this @@ -90,6 +92,7 @@ Module custom_mutex. \prepost{q P g} this |-> IR g q P \persist{thr} current_thread thr \pre user g.(user_gname) thr + \prepost{q'} _global "std::memory_order_seq_cst" |-> primR "enum std::memory_order" q' (memory_order.to_val memory_order.seq_cst) \post ▷ P ** locked g thr). cpp.spec "MyMutex::do_unlock()" as unlock_spec with ( @@ -104,8 +107,91 @@ Module custom_mutex. cpp.spec "std::this_thread::yield()" as yield_spec with ( \post emp). - Import std.atomic. - Fail Lemma test_do_lock_ok : verify[source] "MyMutex::do_lock()". - + Abbreviation BASE p := (p ,, _base "std::atomic" "std::__atomic_base"). + + #[only(timeless)] derive exclusive_token. + #[only(timeless)] derive owner_token_auth. + #[only(timeless)] derive owner_token_frac. + + Definition bi_later_exist_F := [FWD] @bi.later_exist. + Definition bi_later_sep_F := [FWD] @bi.later_sep. + Definition bi_later_sep_B := [BWD->] @bi.later_sep. + Hint Resolve bi_later_exist_F bi_later_sep_F : br_hints. + Import linearity. + + #[program] + Definition do_exchange_C (p : ptr) := + \cancelx + \using denoteModule source + \using{thr} current_thread thr + \consuming{g q P} p |-> IR g q P + \proving{K (_ : IsExistential K)} + std.atomic.do_exchange "int" (BASE (p,, o_field σ "MyMutex::m_lock") ) 1%Z K + \instantiate K := (fun res => p |-> IR g q P ** [| res = 0 \/ res = 1 |]%Z ** + if bool_decide (res = 0) then P ** owner_token_auth g.(phys_state_gname) (Some thr) else emp) + \end@{mpredI}. + Next Obligation. + intros. iIntros "[#M ?]" (?? ->). + iDestruct (observe [| _ ⊧ _ |] with "M") as "%". + iAuIntro1. rewrite /atomic1_acc. + rewrite {1}/IR/mutex_inv/=; work. + wname [cinv] "#?". + iInv lock_namespace as "?" "Hc"; work. + iDestruct (fupd_mask_subseteq) as ">Y"; [ | iModIntro ]; first solve_ndisj. + work. + 1: admit. (* can and should be an AC *) + iMod "Y" as "_"; wpose "Hc"; work. + wname [cinv] "CI". + wname [owner_token_frac] "OG". + wname [_ |-> atomic.R _ _ _] "FL". + wname [_ |-> atomic_thread_idT _ _] "FO". + ren_hyp b bool. + destruct b eqn:?; work. { + iSplitL "OG FO FL"; first last. { + iModIntro. rewrite /IR/mutex_inv. work $usenamed=true. + auto. + } + work $usenamed=true with br_erefl. + iExists _, true. + ework $usenamed=true with br_erefl. + } + wname [P] "P". + wname [owner_token_auth] "OA". + iSplitL "FO OG FL"; first last. { + iModIntro. rewrite /IR/mutex_inv. ework $usenamed=true with br_erefl. + auto. + (* perform ghost update, but earlier *) + admit. + } + work $usenamed=true with br_erefl. + iExists _, true. + ework $usenamed=true with br_erefl. + all: fail. + + (* iSplitL "OG FO I FL"; first last. { *) + (* iModIntro. rewrite /IR/mutex_inv. work $usenamed=true. *) + (* wfocus [| _ |] "". { iPureIntro. destruct b; auto. } *) + (* destruct b eqn:?; work. *) + (* } *) + (* destruct b eqn:?. { *) + (* work $usenamed=true with br_erefl. *) + (* iExists _, true. *) + (* ework $usenamed=true with br_erefl. *) + (* } *) + (* work $usenamed=true with br_erefl. *) + (* iExists _, true. *) + (* ework $usenamed=true with br_erefl. *) + (* iApply affine; last iAccu. *) + Admitted. + Hint Resolve do_exchange_C : sl_opacity. + Hint Opaque locked : sl_opacity. + + Lemma test_do_lock_ok : verify[source] "MyMutex::do_lock()". + Proof using MOD HAS_THREADS. + verify_spec; go. + wp_while (fun _ => emp); go; first by ework. + wp_if; go. + rewrite /locked; go. + Qed. End with_Σ. End custom_mutex. From 9b60f5357eb2391df4abb026d3b484ac41b5fde3 Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Tue, 1 Sep 2026 21:35:39 +0000 Subject: [PATCH 25/51] progress on custom mutex proof --- .../test/mutex/custom_mutex_hpp_proof.v | 81 +++++++++++-------- 1 file changed, 47 insertions(+), 34 deletions(-) diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index add64e88..f447712d 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -12,14 +12,15 @@ Module custom_mutex. Abbreviation N := "MyMutex"%cpp_name. - Parameter atomic_thread_idT : ∀ `{Σ : cpp_logic, σ : genv}, cQp.t -> + Parameter thread_idR : ∀ `{Σ : cpp_logic, σ : genv}, cQp.t -> (* None if value is thread::id(), Some otherwise *) option thread_idT -> Rep. - #[only(timeless)] derive atomic_thread_idT. + #[only(timeless)] derive thread_idR. - Parameter exclusive_token : ∀ `{Σ : cpp_logic}, iprop.gname -> mpred. Parameter owner_token_auth : ∀ `{Σ : cpp_logic}, iprop.gname -> option thread_idT -> mpred. Parameter owner_token_frac : ∀ `{Σ : cpp_logic}, iprop.gname -> option thread_idT -> mpred. + #[only(timeless, exclusive)] derive owner_token_auth. + #[only(timeless, exclusive)] derive owner_token_frac. Record gname : Set := MkGname { user_gname : iprop.gname @@ -29,8 +30,10 @@ Module custom_mutex. Definition lock_namespace : namespace := nroot .@@ "MyMutex". - Definition locked `{Σ : cpp_logic} `{!lockG Σ} (g: gname) (th : thread_idT) : mpred - := owner_token_auth g.(phys_state_gname) (Some th) ** user g.(user_gname) th. + Definition locked `{Σ : cpp_logic} `{!lockG Σ} `{σ : genv} + (γ: gname) (o_thr : option thread_idT) : Rep := + _field "MyMutex::m_owner" |-> thread_idR 1$m o_thr ** pureR (owner_token_frac γ.(phys_state_gname) o_thr). + #[only(timeless, exclusive)] derive locked. (* Definition IR `{Σ : cpp_logic, σ : genv, !HasStdThreads Σ, !recursive_mutex.lockedG Σ} (γ : gname) (q : cQp.t) : mpred := ∃ x, recursive_mutex.owned_count_id_auth γ.(rec_gname) x. *) @@ -45,23 +48,23 @@ Module custom_mutex. Definition mutex_content (γ : gname) : Rep := ∃ o_owner lockedb, _field "MyMutex::m_lock" |-> atomic.R "bool" 1$m lockedb ** - _field "MyMutex::m_owner" |-> atomic_thread_idT 1$m o_owner. + _field "MyMutex::m_owner" |-> thread_idR 1$m o_owner. Definition mutex_inv (this : ptr) (γ : gname) (P : mpred) : mpred := - ∃ o_owner, - owner_token_frac γ.(phys_state_gname) o_owner ** ∃ b : bool, this ,, _field "MyMutex::m_lock" |-> atomic.R "int" 1$m (if b then 1 else 0)%Z ** + ∃ o_owner : option thread_idT, + owner_token_auth γ.(phys_state_gname) o_owner ** (if b then - emp + ∃ th, user γ.(user_gname) th ** [| o_owner = Some th |] else - owner_token_auth γ.(phys_state_gname) o_owner ** - P) ** - (** m_owner does not concern do_lock() and do_unlock(), the actual - implementation of mutex, and does not always equal o_owner. - It is just a resource that one can get from the invariant. *) - ∃ m_owner : option thread_idT, - this ,, _field "MyMutex::m_owner" |-> atomic_thread_idT 1$m m_owner + (* owner_token γ.(phys_state_gname) o_owner ** *) + P ** + (** m_owner does not concern do_lock() and do_unlock(), the actual + implementation of mutex, and does not always equal o_owner. + It is just a resource that one can get from the invariant. *) + this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** + owner_token_frac γ.(phys_state_gname) o_owner) . Definition IR (γ : gname) (q : cQp.t) (P : mpred) : Rep := @@ -73,8 +76,6 @@ Module custom_mutex. Hint Opaque IR : sl_opacity typeclass_instances. #[only(type_ptr,cfractional,ascfractional,cfracvalid)] derive IR. - - Context `{MOD : source ⊧ σ}. cpp.spec "MyMutex::MyMutex()" as ctor_spec with ( @@ -93,14 +94,16 @@ Module custom_mutex. \persist{thr} current_thread thr \pre user g.(user_gname) thr \prepost{q'} _global "std::memory_order_seq_cst" |-> primR "enum std::memory_order" q' (memory_order.to_val memory_order.seq_cst) - \post ▷ P ** locked g thr). + \post (▷ P ** + this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None) ** + owner_token_frac g.(phys_state_gname) (Some thr)). cpp.spec "MyMutex::do_unlock()" as unlock_spec with ( \this this \prepost{q P g} this |-> IR g q P \persist{thr} current_thread thr - \pre locked g thr \pre ▷P + \pre this |-> locked g (Some thr) \post user g.(user_gname) thr). (* Axiom *) @@ -109,10 +112,6 @@ Module custom_mutex. Abbreviation BASE p := (p ,, _base "std::atomic" "std::__atomic_base"). - #[only(timeless)] derive exclusive_token. - #[only(timeless)] derive owner_token_auth. - #[only(timeless)] derive owner_token_frac. - Definition bi_later_exist_F := [FWD] @bi.later_exist. Definition bi_later_sep_F := [FWD] @bi.later_sep. Definition bi_later_sep_B := [BWD->] @bi.later_sep. @@ -125,10 +124,13 @@ Module custom_mutex. \using denoteModule source \using{thr} current_thread thr \consuming{g q P} p |-> IR g q P + \consuming user g.(user_gname) thr \proving{K (_ : IsExistential K)} std.atomic.do_exchange "int" (BASE (p,, o_field σ "MyMutex::m_lock") ) 1%Z K \instantiate K := (fun res => p |-> IR g q P ** [| res = 0 \/ res = 1 |]%Z ** - if bool_decide (res = 0) then P ** owner_token_auth g.(phys_state_gname) (Some thr) else emp) + if bool_decide (res = 0) then P ** owner_token_frac g.(phys_state_gname) (Some thr) ** + p ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None + else user g.(user_gname) thr) \end@{mpredI}. Next Obligation. intros. iIntros "[#M ?]" (?? ->). @@ -142,30 +144,32 @@ Module custom_mutex. 1: admit. (* can and should be an AC *) iMod "Y" as "_"; wpose "Hc"; work. wname [cinv] "CI". - wname [owner_token_frac] "OG". + wname [owner_token_auth] "OA". wname [_ |-> atomic.R _ _ _] "FL". - wname [_ |-> atomic_thread_idT _ _] "FO". + wname [_ |-> thread_idR _ _] "PF". + wname [user _ _] "U". ren_hyp b bool. destruct b eqn:?; work. { - iSplitL "OG FO FL"; first last. { + iSplitL "OA FL PF"; first last. { iModIntro. rewrite /IR/mutex_inv. work $usenamed=true. auto. } work $usenamed=true with br_erefl. - iExists _, true. + iExists true, _. ework $usenamed=true with br_erefl. } - wname [P] "P". - wname [owner_token_auth] "OA". - iSplitL "FO OG FL"; first last. { + iDestruct "PF" as "(P & ? & OF)". + iSplitL "FL OA U"; first last. { iModIntro. rewrite /IR/mutex_inv. ework $usenamed=true with br_erefl. auto. (* perform ghost update, but earlier *) admit. } work $usenamed=true with br_erefl. - iExists _, true. + iExists true, _. ework $usenamed=true with br_erefl. + (* should be proved by the previously mentioned ghost update *) + admit. all: fail. (* iSplitL "OG FO I FL"; first last. { *) @@ -191,7 +195,16 @@ Module custom_mutex. verify_spec; go. wp_while (fun _ => emp); go; first by ework. wp_if; go. - rewrite /locked; go. Qed. + + Lemma test_do_unlock_ok : verify[source] "MyMutex::do_unlock()". + Proof using MOD HAS_THREADS. + verify_spec; go. + iExists (user g.(user_gname) thr). + rewrite /locked. + work. + Admitted. + + End with_Σ. End custom_mutex. From ff74e69d7a50d54e9eac154df01402b012814cb3 Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Wed, 2 Sep 2026 07:36:34 +0000 Subject: [PATCH 26/51] custom mutex proof mostly done Fix invariant. Add specs for all functions in MyMutex. Not sure if we need do_store_C or do_load_C. --- rocq-brick-libstdcpp/proof/atomic/pred.v | 3 + .../test/mutex/custom_mutex.hpp | 2 + .../test/mutex/custom_mutex_hpp_proof.v | 415 +++++++++++++++--- 3 files changed, 363 insertions(+), 57 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/atomic/pred.v b/rocq-brick-libstdcpp/proof/atomic/pred.v index 995d3dc0..435de841 100644 --- a/rocq-brick-libstdcpp/proof/atomic/pred.v +++ b/rocq-brick-libstdcpp/proof/atomic/pred.v @@ -5,6 +5,7 @@ * SPDX-License-Identifier: LGPL-2.1 WITH BlueRock Exception for use over network, see repository root for details. *) Require Import skylabs.auto.cpp.spec. +Require Import skylabs.bi.weakly_objective. Require Import skylabs.cpp.spec.concepts. Require skylabs.brick.libstdcpp.atomic.inc_int_cpp. @@ -45,6 +46,8 @@ Module Type ATOMIC_PREDS. #[global] Declare Instance R_frac_valid : CFracValid1 R. #[global] Declare Instance R_agree : Cbn (Learn (any ==> learn_eq ==> learn_hints.fin) R). #[global] Declare Instance R_type : Typed2 (class_name ty) R. + #[global] Declare Instance R_weakly_objective q x p : + WeaklyObjective (R q x p). End R_props. End ATOMIC_PREDS. diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex.hpp b/rocq-brick-libstdcpp/test/mutex/custom_mutex.hpp index b5bcbf60..54865952 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex.hpp +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex.hpp @@ -37,6 +37,8 @@ class MyMutex { } public: + MyMutex() {} + void lock() { std::thread::id this_id{std::this_thread::get_id()}; diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index f447712d..4e62bd24 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -1,27 +1,122 @@ (** Provisional *) +Require Import iris.algebra.lib.excl_auth. +Require Import iris.algebra.gset. + Require Import skylabs.auto.cpp.proof. +Require Import skylabs.auto.cpp.hints.base_derived. Require Import skylabs.brick.libstdcpp.mutex.spec.mutex. +Require Import skylabs.brick.libstdcpp.mutex.requirements. Require Import skylabs.brick.libstdcpp.lib.lock_ghost. Require Import skylabs.brick.libstdcpp.atomic.spec. +Require Import skylabs.brick.libstdcpp.cassert.spec. Require Import skylabs.brick.libstdcpp.test.mutex.custom_mutex_hpp. Module custom_mutex. - Abbreviation N := "MyMutex"%cpp_name. + #[local] Existing Instance lock_ghost.has_lock. + #[local] Existing Instance lock_ghost.has_lock_upd. + #[local] Existing Instance lock_ghost.has_lock_valid. + Abbreviation N := "MyMutex"%cpp_name. + (* FIXME maybe don't need to split it? *) Parameter thread_idR : ∀ `{Σ : cpp_logic, σ : genv}, cQp.t -> (* None if value is thread::id(), Some otherwise *) option thread_idT -> Rep. - #[only(timeless)] derive thread_idR. + #[only(cfracsplittable, type_ptr="std::thread::id")] derive thread_idR. + #[global] Axiom thread_idR_WeaklyObjective : + ∀ `{Σ : cpp_logic, σ : genv} (q : cQp.t) + (o : option thread_idT) (p : ptr), + WeaklyObjective (thread_idR q o p). + #[global] Existing Instance thread_idR_WeaklyObjective. + + #[local] Instance at_WeaklyObjective `{Σ : cpp_logic} + (p : ptr) (R : Rep) `{!WeaklyObjective (R p)} : + WeaklyObjective (p |-> R). + Proof. rewrite INTERNAL._at_eq. apply _. Qed. + + Canonical Structure owner_stateO := optionO thread_idTO. + Canonical Structure owner_tokenR := excl_authR owner_stateO. - Parameter owner_token_auth : ∀ `{Σ : cpp_logic}, iprop.gname -> option thread_idT -> mpred. - Parameter owner_token_frac : ∀ `{Σ : cpp_logic}, iprop.gname -> option thread_idT -> mpred. + Class ownerG `{Σ : cpp_logic} := { + #[local] has_owner_token :: HasOwn (iPropI _Σ) owner_tokenR; + #[local] has_owner_token_upd :: HasOwnUpd (iPropI _Σ) owner_tokenR; + #[local] has_owner_token_valid :: HasOwnValid (iPropI _Σ) owner_tokenR; + }. + #[global] Arguments ownerG {_ _} Σ : assert. + + sl.lock + Definition owner_token_auth `{Σ : cpp_logic, !ownerG Σ} + (γ : iprop.gname) (o_thr : option thread_idT) : mpred := + own γ (●E o_thr). + sl.lock + Definition owner_token_frac `{Σ : cpp_logic, !ownerG Σ} + (γ : iprop.gname) (o_thr : option thread_idT) : mpred := + own γ (◯E o_thr). #[only(timeless, exclusive)] derive owner_token_auth. #[only(timeless, exclusive)] derive owner_token_frac. + #[global] Instance owner_token_auth_WeaklyObjective + `{Σ : cpp_logic, !ownerG Σ} γ o_thr : + WeaklyObjective (PROP := iPropI _) (owner_token_auth γ o_thr). + Proof. rewrite owner_token_auth.unlock. apply _. Qed. + + #[global] Instance owner_token_frac_WeaklyObjective + `{Σ : cpp_logic, !ownerG Σ} γ o_thr : + WeaklyObjective (PROP := iPropI _) (owner_token_frac γ o_thr). + Proof. rewrite owner_token_frac.unlock. apply _. Qed. + + Lemma owner_token_agree `{Σ : cpp_logic, !ownerG Σ} + γ (o1 o2 : option thread_idT) : + owner_token_auth γ o1 ** owner_token_frac γ o2 |-- [| o1 = o2 |]. + Proof. + rewrite owner_token_auth.unlock owner_token_frac.unlock. + iIntros "[A F]". + iDestruct (own_valid_2 with "A F") as %HV. + iPureIntro. + apply leibniz_equiv, excl_auth_agree, HV. + Qed. + + #[global] Instance owner_token_agree_observe + `{Σ : cpp_logic, !ownerG Σ} γ (o1 o2 : option thread_idT) : + Observe2 [| o1 = o2 |] + (owner_token_auth γ o1) (owner_token_frac γ o2). + Proof. + apply observe_2_intro_only_provable. + rewrite owner_token_auth.unlock owner_token_frac.unlock. + iIntros "A F". + iDestruct (own_valid_2 with "A F") as %HV. + iPureIntro. + apply leibniz_equiv, excl_auth_agree, HV. + Qed. + + #[global] Instance owner_token_agree_observe_sep + `{Σ : cpp_logic, !ownerG Σ} γ (o1 o2 : option thread_idT) : + Observe [| o1 = o2 |] + (owner_token_auth γ o1 ** owner_token_frac γ o2). + Proof. + apply observe_intro_only_provable. + rewrite owner_token_auth.unlock owner_token_frac.unlock. + iIntros "[A F]". + iDestruct (own_valid_2 with "A F") as %HV. + iPureIntro. + apply leibniz_equiv, excl_auth_agree, HV. + Qed. + + Lemma owner_token_update `{Σ : cpp_logic, !ownerG Σ} + γ (oa ofrag o' : option thread_idT) : + owner_token_auth γ oa ** owner_token_frac γ ofrag |-- + (|==> owner_token_auth γ o' ** owner_token_frac γ o'). + Proof. + rewrite owner_token_auth.unlock owner_token_frac.unlock. + iIntros "[A F]". + iMod (own_update_2 with "A F") as "[$ $]"; + first apply (excl_auth_update _ _ o'). + done. + Qed. + Record gname : Set := MkGname { user_gname : iprop.gname ; cinv_gname : iprop.gname @@ -30,7 +125,8 @@ Module custom_mutex. Definition lock_namespace : namespace := nroot .@@ "MyMutex". - Definition locked `{Σ : cpp_logic} `{!lockG Σ} `{σ : genv} + sl.lock + Definition locked `{Σ : cpp_logic} `{!lockG Σ, !ownerG Σ} `{σ : genv} (γ: gname) (o_thr : option thread_idT) : Rep := _field "MyMutex::m_owner" |-> thread_idR 1$m o_thr ** pureR (owner_token_frac γ.(phys_state_gname) o_thr). #[only(timeless, exclusive)] derive locked. @@ -43,7 +139,11 @@ Module custom_mutex. _field "MyRecursiveMutex::m_count" |-> ulonglongR 1$m count. *) Section with_Σ. - Context `{Σ : cpp_logic, σ : genv, HAS_THREADS : !HasStdThreads Σ, !lockG Σ}. + Context `{Σ : cpp_logic, σ : genv, HAS_THREADS : !HasStdThreads Σ, + !lockG Σ, !ownerG Σ}. + + (* Abbreviation BASE p := + (p ,, _base "std::atomic" "std::__atomic_base"). *) Definition mutex_content (γ : gname) : Rep := ∃ o_owner lockedb, @@ -52,7 +152,8 @@ Module custom_mutex. Definition mutex_inv (this : ptr) (γ : gname) (P : mpred) : mpred := ∃ b : bool, - this ,, _field "MyMutex::m_lock" |-> atomic.R "int" 1$m (if b then 1 else 0)%Z ** + this ,, _field "MyMutex::m_lock" |-> + atomic.R "int" 1$m (if b then 1 else 0)%Z ** ∃ o_owner : option thread_idT, owner_token_auth γ.(phys_state_gname) o_owner ** (if b then @@ -78,35 +179,117 @@ Module custom_mutex. Context `{MOD : source ⊧ σ}. + Abbreviation GLOBALS q := + (_global "std::memory_order_seq_cst" |-> + primR "enum std::memory_order" q + (memory_order.to_val memory_order.seq_cst)). + + cpp.spec (default_ctor "std::thread::id") as thread_id_ctor_spec with ( + \this this + \post this |-> thread_idR 1$m None). + + cpp.spec (const_copy_ctor "std::thread::id") as thread_id_copy_ctor_spec with ( + \this this + \arg{other} "" (Vptr other) + \prepost{q o} other |-> thread_idR q o + \post this |-> thread_idR 1$m o). + + cpp.spec (dtor "std::thread::id") as thread_id_dtor_spec with ( + \this this + \pre{o} this |-> thread_idR 1$m o + \post emp). + + cpp.spec "std::thread::id::operator=(const std::thread::id&)" + as thread_id_copy_assign_spec with ( + \this this + \arg{other} "" (Vptr other) + \pre{old} this |-> thread_idR 1$m old + \prepost{q o} other |-> thread_idR q o + \post[Vref this] this |-> thread_idR 1$m o). + + cpp.spec "std::thread::id::operator=(std::thread::id&&)" + as thread_id_move_assign_spec with ( + \this this + \arg{other} "" (Vptr other) + \pre{old} this |-> thread_idR 1$m old + \prepost{o} other |-> thread_idR 1$m o + \post[Vref this] this |-> thread_idR 1$m o). + + cpp.spec "std::operator==(std::thread::id, std::thread::id)" + as thread_id_eq_spec with ( + \arg{lhs} "" (Vptr lhs) + \arg{rhs} "" (Vptr rhs) + \prepost{q1 o1} lhs |-> thread_idR q1 o1 + \prepost{q2 o2} rhs |-> thread_idR q2 o2 + \post[Vbool (bool_decide (o1 = o2))] emp). + + cpp.spec "std::this_thread::get_id()" as get_id_spec with ( + \persist{thr} current_thread thr + \post{result}[Vptr result] + result |-> thread_idR 1$m (Some thr)). + cpp.spec "MyMutex::MyMutex()" as ctor_spec with ( \this this \pre{P} ▷P - \post Exists g, this |-> IR g 1$m P ** used_threads g.(user_gname) ∅). + \require WeaklyObjective P + \post (|={⊤}=> Exists g, + this |-> IR g 1$m P ** used_threads g.(user_gname) ∅)). cpp.spec "MyMutex::~MyMutex()" as dtor_spec with ( \this this \pre{g P} this |-> IR g 1$m P ** used_threads g.(user_gname) ∅ \post P). - cpp.spec "MyMutex::do_lock()" as lock_spec with ( + cpp.spec "MyMutex::do_lock()" as do_lock_spec with ( \this this \prepost{q P g} this |-> IR g q P \persist{thr} current_thread thr \pre user g.(user_gname) thr - \prepost{q'} _global "std::memory_order_seq_cst" |-> primR "enum std::memory_order" q' (memory_order.to_val memory_order.seq_cst) - \post (▷ P ** + \prepost{q'} GLOBALS q' + \post (P ** this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None) ** owner_token_frac g.(phys_state_gname) (Some thr)). - cpp.spec "MyMutex::do_unlock()" as unlock_spec with ( + cpp.spec "MyMutex::do_unlock()" as do_unlock_spec with ( \this this \prepost{q P g} this |-> IR g q P \persist{thr} current_thread thr - \pre ▷P - \pre this |-> locked g (Some thr) + \pre (▷P ** + this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None) ** + owner_token_frac g.(phys_state_gname) (Some thr) \post user g.(user_gname) thr). - (* Axiom *) + Definition T : Type := gname * mpred. + + (* FIXME should GLOBALS be in lock specs, instead of do_lock? *) + Definition do_lock (this : ptr) (lk : T) (K : mpred) : mpred := + let g := lk.1 in + let P := lk.2 in + ∃ thr q', current_thread thr ** user g.(user_gname) thr ** GLOBALS q' ** + (GLOBALS q' ** P ** this |-> locked g (Some thr) -* K). + #[global] Arguments do_lock /. + + Definition do_unlock (this : ptr) (lk : T) (K : mpred) : mpred := + let g := lk.1 in + let P := lk.2 in + ∃ thr, current_thread thr ** this |-> locked g (Some thr) ** ▷P ** + (user g.(user_gname) thr -* K). + #[global] Arguments do_unlock /. + + #[global] Instance custom_mutex_basic_lockable : + BasicLockable (T := T) (Tnamed N) + (fun q gP => IR gP.1 q gP.2) := + { do_lock := do_lock + ; do_unlock := do_unlock }. + + cpp.spec "MyMutex::lock()" as lock_spec with + (\exact Reduce + (lock_basic_lockable (Tnamed N) (fun q gP => IR gP.1 q gP.2))). + + cpp.spec "MyMutex::unlock()" as unlock_spec with + (\exact Reduce + (unlock_basic_lockable (Tnamed N) (fun q gP => IR gP.1 q gP.2))). + cpp.spec "std::this_thread::yield()" as yield_spec with ( \post emp). @@ -142,68 +325,186 @@ Module custom_mutex. iDestruct (fupd_mask_subseteq) as ">Y"; [ | iModIntro ]; first solve_ndisj. work. 1: admit. (* can and should be an AC *) - iMod "Y" as "_"; wpose "Hc"; work. wname [cinv] "CI". wname [owner_token_auth] "OA". wname [_ |-> atomic.R _ _ _] "FL". wname [_ |-> thread_idR _ _] "PF". wname [user _ _] "U". ren_hyp b bool. - destruct b eqn:?; work. { - iSplitL "OA FL PF"; first last. { - iModIntro. rewrite /IR/mutex_inv. work $usenamed=true. - auto. - } - work $usenamed=true with br_erefl. - iExists true, _. - ework $usenamed=true with br_erefl. - } - iDestruct "PF" as "(P & ? & OF)". - iSplitL "FL OA U"; first last. { - iModIntro. rewrite /IR/mutex_inv. ework $usenamed=true with br_erefl. + destruct b eqn:Hb. + - iMod "Y" as "_". + iMod ("Hc" with "[FL OA PF]") as "_". + { iNext. iExists true. iFrame. } + iModIntro. rewrite /IR. work $usenamed=true with br_erefl. + auto. + - iDestruct "PF" as "(P & FO & OF)". + iMod (owner_token_update g.(phys_state_gname) _ _ (Some thr) + with "[$OA $OF]") as "(OA & OF)". + iMod "Y" as "_". + iMod ("Hc" with "[FL OA U]") as "_". + { iNext. iExists true. iFrame. done. } + iModIntro. rewrite /IR. work $usenamed=true with br_erefl. auto. - (* perform ghost update, but earlier *) - admit. - } - work $usenamed=true with br_erefl. - iExists true, _. - ework $usenamed=true with br_erefl. - (* should be proved by the previously mentioned ghost update *) - admit. - all: fail. - - (* iSplitL "OG FO I FL"; first last. { *) - (* iModIntro. rewrite /IR/mutex_inv. work $usenamed=true. *) - (* wfocus [| _ |] "". { iPureIntro. destruct b; auto. } *) - (* destruct b eqn:?; work. *) - (* } *) - (* destruct b eqn:?. { *) - (* work $usenamed=true with br_erefl. *) - (* iExists _, true. *) - (* ework $usenamed=true with br_erefl. *) - (* } *) - (* work $usenamed=true with br_erefl. *) - (* iExists _, true. *) - (* ework $usenamed=true with br_erefl. *) - (* iApply affine; last iAccu. *) Admitted. Hint Resolve do_exchange_C : sl_opacity. + + #[program] + Definition do_store_C (p : ptr) := + \cancelx + \using denoteModule source + \using{thr} current_thread thr + \consuming{g q P} p |-> IR g q P + \consuming P + \consuming p ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None + \consuming owner_token_frac g.(phys_state_gname) (Some thr) + \proving{K (_ : IsExistential K)} + std.atomic.do_store "int" (BASE (p ,, o_field σ "MyMutex::m_lock")) 0%Z K + \instantiate K := (p |-> IR g q P ** user g.(user_gname) thr) + \end@{mpredI}. + Next Obligation. + intros. iIntros "[#M ?]" (?? ->). + iDestruct (observe [| _ ⊧ _ |] with "M") as "%". + rewrite /std.atomic.do_store. + iAcIntro. rewrite /commit_acc /=. + rewrite {1}/IR/mutex_inv /=; work. + wname [cinv] "#?". + iInv lock_namespace as "?" "Hc"; work. + ren_hyp b bool. + iExists (if b then 1%Z else 0%Z). iFrame. + iApply fupd_mask_intro; first solve_ndisj. + iIntros "Y". iNext. iIntros "FL". + iMod "Y" as "_". + wname [P] "P". + wname [_ |-> thread_idR _ _] "FO". + wname [owner_token_frac] "OF". + wname [owner_token_auth] "OA". + iRename "P" into "CI". + wname [P] "RP". + wname [_ |-> thread_idR _ _] "OwnerField". + destruct b eqn:Hb. + - iDestruct "FO" as (owner) "(U & ->)". + iDestruct (observe [| Some owner = Some thr |] + (owner_token_auth g.(phys_state_gname) (Some owner) ** + owner_token_frac g.(phys_state_gname) (Some thr)) + with "[$OA $OF]") + as %Hagree. + inversion Hagree; subst owner. + iEval (rewrite _at_offsetR) in "FL". + iMod ("Hc" with "[FL OA RP OwnerField OF]") as "_". + { iNext. iExists false. + work $usenamed=true with br_erefl. + iExists (Some thr). iFrame. } + iModIntro. rewrite /IR. work $usenamed=true with br_erefl. + - iDestruct "FO" as "(RP2 & OwnerField2 & OF2)". + iEval (rewrite owner_token_frac.unlock) in "OF". + iEval (rewrite owner_token_frac.unlock) in "OF2". + iDestruct (own_valid_2 with "OF OF2") as %Hvalid. + rewrite excl_auth_frag_op_valid in Hvalid. + done. + Qed. + Hint Resolve do_store_C : sl_opacity. + + #[program] + Definition do_load_C (p : ptr) := + \cancelx + \using denoteModule source + \consuming{q (n : Z)} p |-> atomic.R "int" q n + \proving{(K : Z -> mpred) (_ : IsExistential K)} + std.atomic.do_load "int" (BASE p) K + \instantiate K := + (fun x : Z => p |-> atomic.R "int" q n ** [| x = n |]) + \end@{mpredI}. + Next Obligation. + intros. iIntros "[#M ?]" (?? ->). + iDestruct (observe [| _ ⊧ _ |] with "M") as "%". + rewrite /std.atomic.do_load. + iAcIntro. rewrite /commit_acc. + iDestruct (fupd_mask_subseteq) as ">Y"; [ | iModIntro ]; eauto. + work. iExists q. work. + iMod "Y". iModIntro. + work. + Qed. + Hint Resolve do_load_C : sl_opacity. + Hint Opaque locked : sl_opacity. - Lemma test_do_lock_ok : verify[source] "MyMutex::do_lock()". + Lemma mymutex_do_lock_proof : verify[source] "MyMutex::do_lock()". Proof using MOD HAS_THREADS. verify_spec; go. wp_while (fun _ => emp); go; first by ework. wp_if; go. Qed. - Lemma test_do_unlock_ok : verify[source] "MyMutex::do_unlock()". + Lemma mymutex_do_unlock_proof : verify[source] "MyMutex::do_unlock()". Proof using MOD HAS_THREADS. verify_spec; go. - iExists (user g.(user_gname) thr). - rewrite /locked. + Qed. + + Lemma mymutex_ctor_proof : verify[source] "MyMutex::MyMutex()". + Proof using MOD HAS_THREADS. + verify_spec; go. + wname [structR] "S". + iMod (own_alloc (● (GSet ∅ : lock_ghostUR))) as (gu) "UT". + { apply auth_auth_valid. done. } + iMod (own_alloc (●E None ⋅ ◯E None)) as (gp) "O". + { apply excl_auth_valid. } + iDestruct (own_op with "O") as "(OA & OF)". + iMod (cinv_alloc ⊤ lock_namespace + (mutex_inv this (MkGname gu gu gp) P) with "[-S UT]") + as (gi) "(#CI & CO)"; last first. + - iExists (MkGname gu gi gp). + rewrite /IR used_threads.unlock /=. + iModIntro. go $usenamed=true with br_erefl. + - rewrite /mutex_inv owner_token_auth.unlock + owner_token_frac.unlock /=. + iNext. iExists false. iFrame. + Qed. + + Lemma mymutex_dtor_proof : verify[source] "MyMutex::~MyMutex()". + Proof using MOD HAS_THREADS. + verify_spec. + rewrite /IR /mutex_inv. work. - Admitted. + wname [cinv] "#CI". + wname [cinv_own] "CO". + iMod (cinv_cancel with "CI CO") + as "Inv"; [done..|]. + go. + iDestruct "Inv" as (b) "(Lock & % & OA & State)". + destruct b eqn:Hb. + - iDestruct "State" as (th) "(U & %Eq)". + iDestruct (used_threads_empty_no_not_locked with "[$]") as %[]. + - iDestruct "State" as "(P & Owner & OF)". + ego $usenamed=true with br_erefl. + wname [used_threads] "UT". + iApply (affine with "[OA OF UT]"); last iAccu. apply mpred_BiAffine. + Qed. + + Lemma mymutex_lock_proof : verify[source] "MyMutex::lock()". + Proof using MOD HAS_THREADS. + verify_spec. + rewrite locked.unlock. + ego. + Qed. + + Lemma mymutex_unlock_proof : verify[source] "MyMutex::unlock()". + Proof using MOD HAS_THREADS. + verify_spec. + rewrite locked.unlock. + go. + iExists _, _. + go. + iExists _, _, _, _. + go. + iExists _, _. + go. + iExists _, _. + go. + iExists _. + go. + iExists q, m.2, m.1. + go. + Qed. End with_Σ. From 8392c6ce30fcb21816365792149ee35107838cdd Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Wed, 2 Sep 2026 13:18:18 +0200 Subject: [PATCH 27/51] Import linearity, drop unused lemmas --- .../test/mutex/custom_mutex_hpp_proof.v | 26 +++---------------- 1 file changed, 3 insertions(+), 23 deletions(-) diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index 4e62bd24..5d66d8a0 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -11,6 +11,7 @@ Require Import skylabs.brick.libstdcpp.lib.lock_ghost. Require Import skylabs.brick.libstdcpp.atomic.spec. Require Import skylabs.brick.libstdcpp.cassert.spec. +Import linearity. Require Import skylabs.brick.libstdcpp.test.mutex.custom_mutex_hpp. Module custom_mutex. @@ -68,16 +69,6 @@ Module custom_mutex. WeaklyObjective (PROP := iPropI _) (owner_token_frac γ o_thr). Proof. rewrite owner_token_frac.unlock. apply _. Qed. - Lemma owner_token_agree `{Σ : cpp_logic, !ownerG Σ} - γ (o1 o2 : option thread_idT) : - owner_token_auth γ o1 ** owner_token_frac γ o2 |-- [| o1 = o2 |]. - Proof. - rewrite owner_token_auth.unlock owner_token_frac.unlock. - iIntros "[A F]". - iDestruct (own_valid_2 with "A F") as %HV. - iPureIntro. - apply leibniz_equiv, excl_auth_agree, HV. - Qed. #[global] Instance owner_token_agree_observe `{Σ : cpp_logic, !ownerG Σ} γ (o1 o2 : option thread_idT) : @@ -92,19 +83,6 @@ Module custom_mutex. apply leibniz_equiv, excl_auth_agree, HV. Qed. - #[global] Instance owner_token_agree_observe_sep - `{Σ : cpp_logic, !ownerG Σ} γ (o1 o2 : option thread_idT) : - Observe [| o1 = o2 |] - (owner_token_auth γ o1 ** owner_token_frac γ o2). - Proof. - apply observe_intro_only_provable. - rewrite owner_token_auth.unlock owner_token_frac.unlock. - iIntros "[A F]". - iDestruct (own_valid_2 with "A F") as %HV. - iPureIntro. - apply leibniz_equiv, excl_auth_agree, HV. - Qed. - Lemma owner_token_update `{Σ : cpp_logic, !ownerG Σ} γ (oa ofrag o' : option thread_idT) : owner_token_auth γ oa ** owner_token_frac γ ofrag |-- @@ -145,10 +123,12 @@ Module custom_mutex. (* Abbreviation BASE p := (p ,, _base "std::atomic" "std::__atomic_base"). *) + (* Definition mutex_content (γ : gname) : Rep := ∃ o_owner lockedb, _field "MyMutex::m_lock" |-> atomic.R "bool" 1$m lockedb ** _field "MyMutex::m_owner" |-> thread_idR 1$m o_owner. + *) Definition mutex_inv (this : ptr) (γ : gname) (P : mpred) : mpred := ∃ b : bool, From acf94632e681fc30701a19e1b3400e476b3fbbfa Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Wed, 2 Sep 2026 13:44:34 +0200 Subject: [PATCH 28/51] Proof tweaks --- .../test/mutex/custom_mutex_hpp_proof.v | 40 +++++++++++-------- 1 file changed, 23 insertions(+), 17 deletions(-) diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index 5d66d8a0..5821cb0c 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -311,23 +311,33 @@ Module custom_mutex. wname [_ |-> thread_idR _ _] "PF". wname [user _ _] "U". ren_hyp b bool. + iMod "Y" as "_". destruct b eqn:Hb. - - iMod "Y" as "_". - iMod ("Hc" with "[FL OA PF]") as "_". - { iNext. iExists true. iFrame. } + - iMod ("Hc" with "[FL OA PF]") as "_". + { iExists true. ework $usenamed=true with br_erefl. } iModIntro. rewrite /IR. work $usenamed=true with br_erefl. auto. - iDestruct "PF" as "(P & FO & OF)". iMod (owner_token_update g.(phys_state_gname) _ _ (Some thr) with "[$OA $OF]") as "(OA & OF)". - iMod "Y" as "_". iMod ("Hc" with "[FL OA U]") as "_". - { iNext. iExists true. iFrame. done. } + { iExists true. ework $usenamed=true with br_erefl. } iModIntro. rewrite /IR. work $usenamed=true with br_erefl. auto. Admitted. Hint Resolve do_exchange_C : sl_opacity. + #[global] Instance owner_token_frac_excl g : + Exclusive1 (owner_token_frac g). + Proof. + intros; rewrite observe_2_pure owner_token_frac.unlock. + apply /observe_2_derive_only_provable. + by rewrite excl_auth_frag_op_valid. + Qed. + Import observe2_fwd. + Definition owner_token_frac_excl_F := ltac:(mk_obs2_fwd owner_token_frac_excl). + Hint Resolve owner_token_frac_excl_F : sl_opacity. + #[program] Definition do_store_C (p : ptr) := \cancelx @@ -363,24 +373,20 @@ Module custom_mutex. wname [_ |-> thread_idR _ _] "OwnerField". destruct b eqn:Hb. - iDestruct "FO" as (owner) "(U & ->)". - iDestruct (observe [| Some owner = Some thr |] - (owner_token_auth g.(phys_state_gname) (Some owner) ** - owner_token_frac g.(phys_state_gname) (Some thr)) - with "[$OA $OF]") - as %Hagree. - inversion Hagree; subst owner. + iDestruct (observe_2 [| Some owner = Some thr |] with "OA OF") + as %->%(inj _). iEval (rewrite _at_offsetR) in "FL". iMod ("Hc" with "[FL OA RP OwnerField OF]") as "_". { iNext. iExists false. work $usenamed=true with br_erefl. iExists (Some thr). iFrame. } iModIntro. rewrite /IR. work $usenamed=true with br_erefl. - - iDestruct "FO" as "(RP2 & OwnerField2 & OF2)". - iEval (rewrite owner_token_frac.unlock) in "OF". - iEval (rewrite owner_token_frac.unlock) in "OF2". - iDestruct (own_valid_2 with "OF OF2") as %Hvalid. - rewrite excl_auth_frag_op_valid in Hvalid. - done. + - + (* TODO AUTO *) + Fail by work $usenamed=true. + Succeed by iStopProof; work. + iDestruct "FO" as "?"; iDestruct "OF" as "?"; + work using owner_token_frac_excl_F. Qed. Hint Resolve do_store_C : sl_opacity. From 9e975fee469df9cf76d76a55d4f3d82ef45fd366 Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Wed, 2 Sep 2026 14:17:41 +0200 Subject: [PATCH 29/51] More proof tweaks --- .../test/mutex/custom_mutex_hpp_proof.v | 16 +++------------- 1 file changed, 3 insertions(+), 13 deletions(-) diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index 5821cb0c..0a4ba63a 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -477,19 +477,9 @@ Module custom_mutex. Proof using MOD HAS_THREADS. verify_spec. rewrite locked.unlock. - go. - iExists _, _. - go. - iExists _, _, _, _. - go. - iExists _, _. - go. - iExists _, _. - go. - iExists _. - go. - iExists q, m.2, m.1. - go. + (* TODO AUTO *) + Fail by ego. + repeat (go; ework). Qed. From 930e3ba4554f0ba0bf5bc3c09075c6a97f192896 Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Fri, 4 Sep 2026 12:39:06 +0200 Subject: [PATCH 30/51] Spec tweaks --- .../test/mutex/custom_mutex_hpp_proof.v | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index 0a4ba63a..e6da730c 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -226,17 +226,17 @@ Module custom_mutex. \persist{thr} current_thread thr \pre user g.(user_gname) thr \prepost{q'} GLOBALS q' - \post (P ** - this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None) ** + \post P ** + this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** owner_token_frac g.(phys_state_gname) (Some thr)). cpp.spec "MyMutex::do_unlock()" as do_unlock_spec with ( \this this \prepost{q P g} this |-> IR g q P \persist{thr} current_thread thr - \pre (▷P ** - this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None) ** - owner_token_frac g.(phys_state_gname) (Some thr) + \pre ▷P + \pre this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None + \pre owner_token_frac g.(phys_state_gname) (Some thr) \post user g.(user_gname) thr). Definition T : Type := gname * mpred. From deda9a6bda6fc82c2b7dd7817f60a82ccf6a48e4 Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Fri, 4 Sep 2026 16:47:41 +0000 Subject: [PATCH 31/51] change mutex to use a fractional used_threads and another separate piece of exclusive my_mutex --- .../proof/mutex/proof/lock_guard.v | 11 ++- .../proof/mutex/proof/unique_lock.v | 5 +- .../proof/mutex/spec/lock_guard.v | 28 +++---- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 81 +++++++------------ .../proof/mutex/spec/scoped_lock.v | 33 ++++---- 5 files changed, 67 insertions(+), 91 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/mutex/proof/lock_guard.v b/rocq-brick-libstdcpp/proof/mutex/proof/lock_guard.v index a828faae..3005bd17 100644 --- a/rocq-brick-libstdcpp/proof/mutex/proof/lock_guard.v +++ b/rocq-brick-libstdcpp/proof/mutex/proof/lock_guard.v @@ -3,14 +3,13 @@ Require Import skylabs.brick.libstdcpp.mutex.spec.mutex. Require Import skylabs.brick.libstdcpp.mutex.spec.lock_guard. Require Import skylabs.brick.libstdcpp.mutex.inc_hpp. -Require Import skylabs.brick.libstdcpp.lib.lock_ghost. Import linearity. Section with_cpp. Context `{Σ : cpp_logic, σ : genv}. Context {HAS_THREADS : HasStdThreads Σ}. - Context `{!lock_ghost.lockG Σ}. + Context `{!mutex.G Σ}. Import lock_guard. @@ -25,7 +24,9 @@ Section with_cpp. Proof. verify_spec. go. - by rewrite left_id_L. + iExists (mutex.locked g thr qt ** P), qt. + go with br_erefl. + by rewrite (left_id_L 1%Qp Qp.mul). Qed. Lemma dtor_ok : verify[source] dtor_spec. @@ -33,7 +34,9 @@ Section with_cpp. verify_spec. rewrite !R.unlock. go. - by rewrite !left_id_L. + iExists (mutex.not_locked g thr qt), qt. + go with br_erefl. + by rewrite (left_id_L 1%Qp Qp.mul). Qed. End with_cpp. diff --git a/rocq-brick-libstdcpp/proof/mutex/proof/unique_lock.v b/rocq-brick-libstdcpp/proof/mutex/proof/unique_lock.v index dc8a20d7..5018814c 100644 --- a/rocq-brick-libstdcpp/proof/mutex/proof/unique_lock.v +++ b/rocq-brick-libstdcpp/proof/mutex/proof/unique_lock.v @@ -6,13 +6,12 @@ Require Import skylabs.brick.libstdcpp.mutex.spec.prelude. Require Import skylabs.brick.libstdcpp.mutex.spec.unique_lock. Require Import skylabs.brick.libstdcpp.mutex.spec.mutex. Require Import skylabs.brick.libstdcpp.lib.tactics. -Require Import skylabs.brick.libstdcpp.lib.lock_ghost. NES.Begin unique_lock. Section with_cpp. Context `{Σ : cpp_logic} {σ : genv}. Context `{HAS_THREADS : !HasStdThreads Σ}. - Context `{!lock_ghost.lockG Σ}. + Context `{!mutex.G Σ}. Import R_unfold. @@ -45,7 +44,7 @@ NES.Begin unique_lock. "std::unique_lock::unique_lock(std::mutex&)". Proof. verify_spec; go. - iExists K, q. + iExists K, t, q. (* Time Succeed solve [setoid_rewrite cQp.scale_mut; setoid_rewrite (right_id_L 1%Qp Qp.mul); ego with br_erefl]. *) rewrite cQp.scale_mut (right_id_L 1%Qp Qp.mul). diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v b/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v index c95924eb..88456ca8 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v @@ -3,7 +3,6 @@ Require Import skylabs.brick.libstdcpp.mutex.spec.mutex. Require Export skylabs.brick.libstdcpp.runtime.pred. Require Import skylabs.brick.libstdcpp.mutex.inc_hpp. -Require Import skylabs.brick.libstdcpp.lib.lock_ghost. Import linearity. @@ -17,9 +16,10 @@ End TO_UPSTREAM. Module lock_guard. sl.lock - Definition R `{Σ : cpp_logic, !HasStdThreads Σ} {σ : genv} (mp : ptr * gname * Qp) (q : cQp.t) (P : mpred) : Rep := + Definition R `{Σ : cpp_logic, !HasStdThreads Σ} {σ : genv} + (mp : ptr * mutex.gname * Qp * Qp) (q : cQp.t) (P : mpred) : Rep := structR "std::lock_guard" q ** - let '(mp, g, q') := mp in + let '(mp, g, q', _) := mp in _field "std::lock_guard::_M_device" |-> refR<"std::mutex"> q mp ** pureR ( mp |-> mutex.R g (q * q')$m P). @@ -48,7 +48,7 @@ Module lock_guard. Section with_cpp. Context `{Σ : cpp_logic, σ : genv}. Context {HAS_THREADS : HasStdThreads Σ}. - Context `{!lock_ghost.lockG Σ}. + Context `{!mutex.G Σ}. #[global] Instance R_learn : Cbn (Learn (learn_eq ==> any ==> learn_eq ==> learn_hints.fin) lock_guard.R) := @@ -88,21 +88,21 @@ Section with_cpp. \this this \arg{mp} "m" (Vptr mp) \persist{thr} current_thread thr - \pre{g q P} mp |-> mutex.R g q$m P - \pre lock_ghost.user g thr + \pre{g q qt P} mp |-> mutex.R g q$m P + \pre mutex.not_locked g thr qt \post - this |-> R (mp, g, q) 1$m P ** - P ** mutex.locked g thr + this |-> R (mp, g, q, qt) 1$m P ** + P ** mutex.locked g thr qt ). cpp.spec "std::lock_guard::~lock_guard()" as dtor_spec from source with ( \this this - \pre{mp g q P} this |-> R (mp, g, q) 1$m P + \pre{mp g q qt P} this |-> R (mp, g, q, qt) 1$m P \persist{thr} current_thread thr - \pre mutex.locked g thr + \pre mutex.locked g thr qt \pre ▷P \post - lock_ghost.user g thr ** + mutex.not_locked g thr qt ** mp |-> mutex.R g q$m P ). @@ -110,10 +110,10 @@ Section with_cpp. Import skylabs.auto.cpp.prelude.proof. - Lemma mutex_borrow mp g P (this : ptr) (q1 q2 : Qp) : - this |-> R (mp, g, (q1 + q2)%Qp) 1$m P |-- + Lemma mutex_borrow mp g P (this : ptr) (q1 q2 qt : Qp) : + this |-> R (mp, g, (q1 + q2)%Qp, qt) 1$m P |-- mp |-> mutex.R g q1$m P ** - this |-> R (mp, g, q2) 1$m P. + this |-> R (mp, g, q2, qt) 1$m P. Proof. rewrite R.unlock. work. diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index 1bea8673..fdff5902 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -12,15 +12,18 @@ Require Export skylabs.brick.libstdcpp.runtime.pred. Require Import skylabs.brick.libstdcpp.mutex.inc_hpp. Require Import skylabs.brick.libstdcpp.mutex.requirements. -Require Import skylabs.brick.libstdcpp.lib.lock_ghost. -Export skylabs.brick.libstdcpp.lib.lock_ghost(lockG). +Require Import skylabs.brick.libstdcpp.lib.lock_ghost2. Import linearity. (* TODO UPSTREAM. *) #[global] Instance SplitRecord_prod A B : SplitRecord (@prod A B) := {}. -Module mutex. +Module Mutex (State : lock_ghost2.MUTEX_STATE). +Include State. + +#[global] Hint Opaque token not_locked locked : sl_opacity typeclass_instances. + Section with_cpp. Context `{Σ : cpp_logic}. @@ -40,56 +43,24 @@ Section with_cpp. End with_RepFor. - (** A resource enforcing that the thread calling unlock must be the same thread - that owns the lock - - << - \persist{th} >={ L_TI } th - \pre{j} mutex_locked g j - test_unlock(std::mutex & m) { - m.unlock(); - } - >> - - this succeeds: - - << - \persist{th} >={ L_TI } th - \pre mutex_locked g th - same test_unlock - >> - *) - Parameter locked : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv}, - gname -> thread_idT -> mpred. - #[only(timeless)] derive locked. - - #[only(exclusive)] derive locked. - - Context `{!lockG Σ}. - - Abbreviation used_threads γ s := - (lock_ghost.used_threads γ s). - - Abbreviation users γ ths := - (lock_ghost.users γ ths). - - Abbreviation user γ th := (users γ {[ th ]}). + Context `{!G Σ}. Context `{MOD : source ⊧ σ}. Context {HAS_THREADS : HasStdThreads Σ}. - #[global] Instance locked_learn : Cbn (Learn (req_eq ==> learn_eq ==> learn_hints.fin) locked). + #[global] Instance locked_learn : + Cbn (Learn (req_eq ==> learn_eq ==> req_eq ==> learn_hints.fin) locked). Proof. solve_learnable. Qed. cpp.spec "std::mutex::mutex()" as ctor_spec with ( \this this \pre{P} ▷P - \post Exists g, this |-> R g 1$m P ** used_threads g ∅). + \post Exists g, this |-> R g 1$m P ** token g 1). cpp.spec "std::mutex::~mutex()" as dtor_spec with ( \this this - \pre{g P} this |-> R g 1$m P ** used_threads g ∅ + \pre{g P} this |-> R g 1$m P ** token g 1 \post P). (* "Inline" version of these specs. *) @@ -97,41 +68,41 @@ Section with_cpp. \this this \prepost{q P g} this |-> R g q P \persist{thr} current_thread thr - \pre user g thr - \post P ** locked g thr). + \pre{qt} not_locked g thr qt + \post P ** locked g thr qt). Definition do_lock (lk : gname * mpred) (K: mpred) : mpred := let g := lk.1 in let P := lk.2 in - ∃ thr, current_thread thr ∗ user g thr ∗ + ∃ thr qt, current_thread thr ∗ not_locked g thr qt ∗ (* TODO readd *) (* ▷ *) - (locked g thr ** P -* K). + (locked g thr qt ** P -* K). #[global] Arguments do_lock /. cpp.spec "std::mutex::unlock()" as unlock_spec_alt with ( \this this \prepost{q P g} this |-> R g q P \persist{thr} current_thread thr - \pre locked g thr + \pre{qt} locked g thr qt \pre ▷P - \post user g thr). + \post not_locked g thr qt). Definition do_unlock (lk : gname * mpred) (Q : mpred) : mpred := let g := lk.1 in let P := lk.2 in - Exists thr, current_thread thr ** locked g thr ** ▷P ** + Exists thr qt, current_thread thr ** locked g thr qt ** ▷P ** (* TODO readd *) (* ▷ *) - (user g thr -* Q). + (not_locked g thr qt -* Q). #[global] Arguments do_unlock /. cpp.spec "std::mutex::try_lock()" as try_lock_spec_alt with ( \this this \prepost{q P g} this |-> R g q P \persist{th} current_thread th - \pre user g th - \post{b}[Vbool b] if b then P ** locked g th else user g th). + \pre{qt} not_locked g th qt + \post{b}[Vbool b] if b then P ** locked g th qt else not_locked g th qt). (* Obtain same specs from (Basic)Lockable. *) (** <> implements [BasicLockable] *) @@ -150,9 +121,9 @@ Section with_cpp. Definition do_try_lock (lk : gname * mpred) (Q : bool -> mpred) : mpred := let g := lk.1 in let P := lk.2 in - ∃ thr, current_thread thr ∗ user g thr ∗ + ∃ thr qt, current_thread thr ∗ not_locked g thr qt ∗ ∀ b : bool, - (if b then P ** locked g thr else user g thr) -∗ Q b. + (if b then P ** locked g thr qt else not_locked g thr qt) -∗ Q b. #[global] Arguments do_try_lock /. #[global,program] Instance mutex_lockable : Lockable (T:=T) "std::mutex" (λ q γP, R γP.1 q γP.2) := @@ -176,4 +147,8 @@ Section with_cpp. iSplit; iApply specify_mono; ework with br_erefl. Qed. End with_cpp. -End mutex. +End Mutex. + +(** The standard instantiation. Clients that need another camera package can + instantiate [Mutex] with any implementation of [MUTEX_STATE]. *) +Module mutex := Mutex lock_ghost2.LockState. diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v b/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v index b8811f8e..90d83f85 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v @@ -3,14 +3,13 @@ Require Import skylabs.brick.libstdcpp.mutex.inc_hpp. Require Export skylabs.brick.libstdcpp.runtime.pred. Require Import skylabs.brick.libstdcpp.mutex.spec.mutex. -Require Import skylabs.brick.libstdcpp.lib.lock_ghost. Module scoped_lock. Section with_cpp. Context `{Σ : cpp_logic}. Parameter R : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv}, - cQp.t -> list (ptr * gname * Qp * mpred) -> Rep. + cQp.t -> list (ptr * mutex.gname * Qp * Qp * mpred) -> Rep. #[only(type_ptr="std::scoped_lock")] derive R. #[only(cfractional,ascfractional,cfracvalid)] derive R. @@ -18,7 +17,7 @@ Module scoped_lock. Section with_threads. Context {σ : genv}. Context `{HAS_THREADS : !HasStdThreads Σ}. - Context `{!lock_ghost.lockG Σ}. + Context `{!mutex.G Σ}. #[global] Instance: LearnEqF1 R := ltac:(solve_learnable). @@ -29,15 +28,15 @@ Module scoped_lock. \this this \persist{thr} current_thread thr \arg{mp1} "" (Vptr mp1) - \pre{g1 q1 P1} mp1 |-> mutex.R g1 q1$m P1 - \pre lock_ghost.user g1 thr + \pre{g1 q1 qt1 P1} mp1 |-> mutex.R g1 q1$m P1 + \pre mutex.not_locked g1 thr qt1 \arg{mp2} "" (Vptr mp2) - \pre{g2 q2 P2} mp2 |-> mutex.R g2 q2$m P2 - \pre lock_ghost.user g2 thr + \pre{g2 q2 qt2 P2} mp2 |-> mutex.R g2 q2$m P2 + \pre mutex.not_locked g2 thr qt2 \post - this |-> R 1$m [ (mp1, g1, q1, P1); (mp2, g2, q2, P2)] ** - P1 ** mutex.locked g1 thr ** - P2 ** mutex.locked g2 thr + this |-> R 1$m [ (mp1, g1, q1, qt1, P1); (mp2, g2, q2, qt2, P2)] ** + P1 ** mutex.locked g1 thr qt1 ** + P2 ** mutex.locked g2 thr qt2 ). cpp.spec "std::scoped_lock<...>::~scoped_lock()" @@ -46,17 +45,17 @@ Module scoped_lock. \persist{thr} current_thread thr \pre{ mp1 mp2 - g1 q1 P1 - g2 q2 P2 + g1 q1 qt1 P1 + g2 q2 qt2 P2 } - this |-> R 1$m [ (mp1, g1, q1, P1); (mp2, g2, q2, P2)] + this |-> R 1$m [ (mp1, g1, q1, qt1, P1); (mp2, g2, q2, qt2, P2)] \pre |> P1 \pre |> P2 - \pre mutex.locked g1 thr - \pre mutex.locked g2 thr + \pre mutex.locked g1 thr qt1 + \pre mutex.locked g2 thr qt2 \post - mp1 |-> mutex.R g1 q1$m P1 ** lock_ghost.user g1 thr ** - mp2 |-> mutex.R g2 q2$m P2 ** lock_ghost.user g2 thr + mp1 |-> mutex.R g1 q1$m P1 ** mutex.not_locked g1 thr qt1 ** + mp2 |-> mutex.R g2 q2$m P2 ** mutex.not_locked g2 thr qt2 ). End with_threads. End with_cpp. From 41dbfb35f192f6449f0143f15d979467399659eb Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Fri, 4 Sep 2026 23:17:46 +0000 Subject: [PATCH 32/51] mutex proof WIP --- rocq-brick-libstdcpp/proof/lib/lock_ghost2.v | 416 ++++++++++++++++++ .../proof/mutex/proof/lock_guard.v | 2 +- .../proof/mutex/spec/lock_guard.v | 4 +- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 15 +- .../proof/mutex/spec/scoped_lock.v | 8 +- .../test/mutex/custom_mutex_hpp_proof.v | 155 ++----- 6 files changed, 469 insertions(+), 131 deletions(-) create mode 100644 rocq-brick-libstdcpp/proof/lib/lock_ghost2.v diff --git a/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v b/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v new file mode 100644 index 00000000..f0508bc5 --- /dev/null +++ b/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v @@ -0,0 +1,416 @@ +Require Import iris.algebra.agree. +Require Import iris.algebra.frac. +Require Import iris.algebra.gmap. +Require Import iris.algebra.gset. +Require Import iris.algebra.lib.excl_auth. +Require Import iris.algebra.lib.gmap_view. + +Require Import skylabs.auto.cpp.proof. +Require Export skylabs.brick.libstdcpp.runtime.pred. + +Import linearity. + +(** The mutex specification depends on the ghost state through these + interfaces. *) + +Module Type MUTEX_SETS. + Parameter cmraR : cmra. + + Class G `{Σ : cpp_logic} := { + #[local] has_own :: HasOwn (iPropI _Σ) cmraR; + #[local] has_upd :: HasOwnUpd (iPropI _Σ) cmraR; + #[local] has_valid :: HasOwnValid (iPropI _Σ) cmraR; + }. + #[global] Arguments G {_ _} Σ : assert. + + Parameter my_mutexes : forall `{Σ : cpp_logic, !G Σ}, + namespace -> iprop.gname -> thread_idT -> gset iprop.gname -> mpred. + +End MUTEX_SETS. + +Module Type MUTEX_TOKENS. + Parameter cmraR : cmra. + + Class G `{Σ : cpp_logic} := { + #[local] has_own :: HasOwn (iPropI _Σ) cmraR; + #[local] has_upd :: HasOwnUpd (iPropI _Σ) cmraR; + #[local] has_valid :: HasOwnValid (iPropI _Σ) cmraR; + }. + #[global] Arguments G {_ _} Σ : assert. + + Parameter token : forall `{Σ : cpp_logic, !G Σ}, + iprop.gname -> Qp -> mpred. + Parameter given_token : forall `{Σ : cpp_logic, !G Σ}, + iprop.gname -> Qp -> mpred. + + #[global] Declare Instance token_fractional + `{Σ : cpp_logic, !G Σ} γ : Fractional (token γ). + #[global] Declare Instance given_token_fractional + `{Σ : cpp_logic, !G Σ} γ : Fractional (given_token γ). + #[global] Declare Instance token_timeless + `{Σ : cpp_logic, !G Σ} γ q : Timeless (token γ q). + #[global] Declare Instance given_token_timeless + `{Σ : cpp_logic, !G Σ} γ q : Timeless (given_token γ q). + + Parameter alloc : forall `{Σ : cpp_logic, !G Σ}, + ⊢ |==> ∃ γ, token γ 1 ** given_token γ 1. +End MUTEX_TOKENS. + +Module Type MUTEX_STATE. + Declare Module Sets : MUTEX_SETS. + Declare Module Tokens : MUTEX_TOKENS. + Parameter owner_cmraR : cmra. + + Parameter gname : Set. + + Class G `{Σ : cpp_logic} := { + #[global] sets_G :: Sets.G Σ; + #[global] tokens_G :: Tokens.G Σ; + #[local] has_owner :: HasOwn (iPropI _Σ) owner_cmraR; + #[local] has_owner_upd :: HasOwnUpd (iPropI _Σ) owner_cmraR; + #[local] has_owner_valid :: HasOwnValid (iPropI _Σ) owner_cmraR; + }. + #[global] Arguments G {_ _} Σ : assert. + + Parameter owner_auth : forall `{Σ : cpp_logic, !G Σ}, + gname -> option thread_idT -> mpred. + Parameter owner_frag : forall `{Σ : cpp_logic, !G Σ}, + gname -> option thread_idT -> mpred. + + #[global] Declare Instance owner_auth_timeless + `{Σ : cpp_logic, !G Σ} γ o_thr : Timeless (owner_auth γ o_thr). + #[global] Declare Instance owner_frag_timeless + `{Σ : cpp_logic, !G Σ} γ o_thr : Timeless (owner_frag γ o_thr). + #[global] Declare Instance owner_frag_exclusive + `{Σ : cpp_logic, !G Σ} γ : Exclusive1 (owner_frag γ). + + Parameter token : forall `{Σ : cpp_logic, !G Σ}, + gname -> Qp -> mpred. + Parameter not_locked : forall `{Σ : cpp_logic, !G Σ}, + gname -> thread_idT -> Qp -> iprop.gname -> mpred. + Parameter locked : forall `{Σ : cpp_logic, !G Σ}, + gname -> option thread_idT -> Qp -> mpred. + + #[global] Declare Instance token_fractional + `{Σ : cpp_logic, !G Σ} γ : Fractional (token γ). + #[global] Declare Instance token_timeless + `{Σ : cpp_logic, !G Σ} γ q : Timeless (token γ q). + #[global] Declare Instance locked_timeless + `{Σ : cpp_logic, !G Σ} γ th q : Timeless (locked γ th q). + #[global] Declare Instance locked_exclusive + `{Σ : cpp_logic, !G Σ} γ q : Exclusive1 (fun th => locked γ th q). +End MUTEX_STATE. + +(** ** Exact per-thread mutex sets *) + +Module MutexSets. + Canonical Structure cmraR : cmra := + gmap_viewR thread_idT (agreeR (leibnizO (gset iprop.gname))). + + Class G `{Σ : cpp_logic} := { + #[local] has_own :: HasOwn (iPropI _Σ) cmraR; + #[local] has_upd :: HasOwnUpd (iPropI _Σ) cmraR; + #[local] has_valid :: HasOwnValid (iPropI _Σ) cmraR; + }. + #[global] Arguments G {_ _} Σ : assert. + + Definition mutex_sets_view + (M : gmap thread_idT (gset iprop.gname)) : + gmap thread_idT (agree (leibnizO (gset iprop.gname))) := + (λ X : gset iprop.gname, to_agree X) <$> M. + + sl.lock + Definition mutex_sets_auth `{Σ : cpp_logic, !G Σ} + (γpool : iprop.gname) + (M : gmap thread_idT (gset iprop.gname)) : mpred := + own γpool (gmap_view_auth (DfracOwn 1) (mutex_sets_view M)). + + sl.lock + Definition mutex_sets_frag `{Σ : cpp_logic, !G Σ} + (γpool : iprop.gname) (th : thread_idT) + (M : gset iprop.gname) : mpred := + own γpool + (gmap_view_frag + (V := agreeR (leibnizO (gset iprop.gname))) + th (DfracOwn 1) (to_agree M)). + + sl.lock + Definition my_mutexes_inv `{Σ : cpp_logic, !G Σ} + (γpool : iprop.gname) : mpred := + ∃ M : gmap thread_idT (gset iprop.gname), mutex_sets_auth γpool M. + + Definition my_mutexes `{Σ : cpp_logic, !G Σ} + (N : namespace) (γpool : iprop.gname) (th : thread_idT) + (M : gset iprop.gname) : mpred := + inv N (my_mutexes_inv γpool) ** mutex_sets_frag γpool th M. + + #[only(timeless)] derive mutex_sets_auth. + #[only(timeless)] derive mutex_sets_frag. + #[only(timeless)] derive my_mutexes_inv. + + #[global] Instance my_mutexes_inv_WeaklyObjective + `{Σ : cpp_logic, !G Σ} γpool : + WeaklyObjective (my_mutexes_inv γpool). + Proof. + rewrite my_mutexes_inv.unlock mutex_sets_auth.unlock. apply _. + Qed. + + Section theory. + Context `{Σ : cpp_logic, !G Σ}. + + Lemma mutex_sets_frag_exclusive γpool th M1 M2 : + mutex_sets_frag γpool th M1 ** mutex_sets_frag γpool th M2 |-- False. + Proof. + rewrite mutex_sets_frag.unlock. + iIntros "[H1 H2]". + iDestruct (own_valid_2 with "H1 H2") as %Hvalid. + apply gmap_view_frag_op_valid in Hvalid as [Hfrac _]. + rewrite dfrac_op_own dfrac_valid_own in Hfrac. + exfalso. exact (Qp.not_add_le_l 1 1 Hfrac). + Qed. + + Lemma mutex_sets_update γpool M th S S' : + mutex_sets_auth γpool M ** mutex_sets_frag γpool th S |-- + (|==> mutex_sets_auth γpool (<[th := S']> M) ** + mutex_sets_frag γpool th S'). + Proof. + rewrite mutex_sets_auth.unlock mutex_sets_frag.unlock + /mutex_sets_view fmap_insert. + iIntros "[HA HF]". + iMod (own_update_2 with "HA HF") as "[HA HF]". + { apply (gmap_view_replace + (V := agreeR (leibnizO (gset iprop.gname))) + (mutex_sets_view M) th (to_agree S) (to_agree S')). done. } + iModIntro. iFrame. + Qed. + + Lemma mutex_sets_alloc_thread γpool M th : + M !! th = None -> + mutex_sets_auth γpool M |-- + (|==> mutex_sets_auth γpool (<[th := ∅]> M) ** + mutex_sets_frag γpool th ∅). + Proof. + rewrite mutex_sets_auth.unlock mutex_sets_frag.unlock + /mutex_sets_view fmap_insert. + iIntros (Hfresh) "HA". + iMod (own_update with "HA") as "[HA HF]". + { apply (gmap_view_alloc + (V := agreeR (leibnizO (gset iprop.gname))) + (mutex_sets_view M) th (DfracOwn 1) (to_agree ∅)). + - rewrite lookup_fmap Hfresh. done. + - done. + - done. } + iModIntro. iFrame. + Qed. + + Lemma my_mutexes_exclusive N1 N2 γpool th M1 M2 : + my_mutexes N1 γpool th M1 ** my_mutexes N2 γpool th M2 |-- False. + Proof. + rewrite /my_mutexes. + iIntros "[[_ H1] [_ H2]]". + iApply (mutex_sets_frag_exclusive with "[$H1 $H2]"). + Qed. + + Lemma my_mutexes_alloc N th : + ⊢ |={⊤}=> ∃ γpool, my_mutexes N γpool th ∅. + Proof. + iMod (own_alloc + (gmap_view_auth + (V := agreeR (leibnizO (gset iprop.gname))) + (DfracOwn 1) (mutex_sets_view ∅))) as (γpool) "HA". + { apply gmap_view_auth_valid. } + iAssert (mutex_sets_auth γpool ∅) with "[HA]" as "Hauth". + { rewrite mutex_sets_auth.unlock. iExact "HA". } + have Hfresh : + (∅ : gmap thread_idT (gset iprop.gname)) !! th = None by done. + iMod (mutex_sets_alloc_thread γpool ∅ th Hfresh with "Hauth") + as "[HA HF]". + iMod (inv_alloc N _ (my_mutexes_inv γpool) with "[HA]") as "#Hinv". + { iNext. rewrite my_mutexes_inv.unlock. + iExists ({[th := ∅]} : gmap thread_idT (gset iprop.gname)). + iFrame. } + iModIntro. iExists γpool. rewrite /my_mutexes. iFrame. + Unshelve. all: try done. + Qed. + + Lemma my_mutexes_insert N γpool th M g : + my_mutexes N γpool th M |-- + (|={⊤}=> my_mutexes N γpool th (M ∪ {[g]})). + Proof. + rewrite /my_mutexes. + iIntros "[#Hinv HF]". + iInv N as "Hpool" "Hclose". + rewrite my_mutexes_inv.unlock. + iDestruct "Hpool" as (A) ">HA". + iMod (mutex_sets_update γpool A th M (M ∪ {[g]}) + with "[$HA $HF]") as "[HA HF]". + iMod ("Hclose" with "[HA]") as "_". + { iNext. iExists _. iFrame. } + iModIntro. iFrame "Hinv HF". + Qed. + End theory. +End MutexSets. + +(** ** The fractional token/given-token pair *) + +Module MutexTokens. + Canonical Structure cmraR : cmra := + prodUR (optionUR fracR) (optionUR fracR). + + Class G `{Σ : cpp_logic} := { + #[local] has_own :: HasOwn (iPropI _Σ) cmraR; + #[local] has_upd :: HasOwnUpd (iPropI _Σ) cmraR; + #[local] has_valid :: HasOwnValid (iPropI _Σ) cmraR; + }. + #[global] Arguments G {_ _} Σ : assert. + + Definition token `{Σ : cpp_logic, !G Σ} + (γ : iprop.gname) (q : Qp) : mpred := + own γ (Some q, None). + + Definition given_token `{Σ : cpp_logic, !G Σ} + (γ : iprop.gname) (q : Qp) : mpred := + own γ (None, Some q). + + #[global] Instance token_fractional + `{Σ : cpp_logic, !G Σ} γ : Fractional (token γ). + Proof. + intros q1 q2. rewrite /token -own_op /=. done. + Qed. + + #[global] Instance given_token_fractional + `{Σ : cpp_logic, !G Σ} γ : Fractional (given_token γ). + Proof. + intros q1 q2. rewrite /given_token -own_op /=. done. + Qed. + + #[global] Instance token_timeless + `{Σ : cpp_logic, !G Σ} γ q : Timeless (token γ q). + Proof. rewrite /token. apply _. Qed. + + #[global] Instance given_token_timeless + `{Σ : cpp_logic, !G Σ} γ q : Timeless (given_token γ q). + Proof. rewrite /given_token. apply _. Qed. + + Section theory. + Context `{Σ : cpp_logic, !G Σ}. + + Lemma alloc : + ⊢ |==> ∃ γ, token γ 1 ** given_token γ 1. + Proof. + iMod (own_alloc + (((Some 1%Qp, None) ⋅ (None, Some 1%Qp)) : cmraR)) as (γ) "H". + { done. } + iModIntro. iExists γ. + rewrite /token /given_token -own_op. iExact "H". + Qed. + End theory. +End MutexTokens. + +(** The concrete state abstracts over mutex sets and tokens, and implements + optional owner state directly. *) +Module MakeMutexState + (Sets0 : MUTEX_SETS) + (Tokens0 : MUTEX_TOKENS) : MUTEX_STATE. + Module Sets := Sets0. + Module Tokens := Tokens0. + + #[local] Existing Instance Tokens.token_fractional. + #[local] Existing Instance Tokens.given_token_fractional. + #[local] Existing Instance Tokens.token_timeless. + #[local] Existing Instance Tokens.given_token_timeless. + + Canonical Structure owner_cmraR : cmra := + excl_authR (optionO thread_idTO). + + Record mutex_gname : Set := MkGname { + pool_namespace : namespace; + pool_gname : iprop.gname; + token_gname : iprop.gname; + owner_gname : iprop.gname; + }. + Definition gname : Set := mutex_gname. + + Class G `{Σ : cpp_logic} := { + #[global] sets_G :: Sets.G Σ; + #[global] tokens_G :: Tokens.G Σ; + #[local] has_owner :: HasOwn (iPropI _Σ) owner_cmraR; + #[local] has_owner_upd :: HasOwnUpd (iPropI _Σ) owner_cmraR; + #[local] has_owner_valid :: HasOwnValid (iPropI _Σ) owner_cmraR; + }. + #[global] Arguments G {_ _} Σ : assert. + + Definition owner_auth `{Σ : cpp_logic, !G Σ} + (γ : gname) (o_thr : option thread_idT) : mpred := + own γ.(owner_gname) ((●E o_thr) : owner_cmraR). + + Definition owner_frag `{Σ : cpp_logic, !G Σ} + (γ : gname) (o_thr : option thread_idT) : mpred := + own γ.(owner_gname) ((◯E o_thr) : owner_cmraR). + + #[global] Hint Opaque owner_auth owner_frag : sl_opacity typeclass_instances. + + #[only(timeless)] derive owner_auth. + #[only(timeless)] derive owner_frag. + + #[global] Instance owner_frag_exclusive + `{Σ : cpp_logic, !G Σ} γ : Exclusive1 (owner_frag γ). + Proof. + intros o_thr1 o_thr2. rewrite /owner_frag. + iIntros "H1 H2". + iDestruct (own_valid_2 with "H1 H2") as %Hvalid. + move: Hvalid. rewrite excl_auth_frag_op_valid. done. + Qed. + + Definition token `{Σ : cpp_logic, !G Σ} + (γ : gname) (q : Qp) : mpred := + Tokens.token γ.(token_gname) q. + + Definition not_locked `{Σ : cpp_logic, !G Σ} + (γ : gname) (th : thread_idT) (q : Qp) + (inv_gname : iprop.gname) : mpred := + Sets.my_mutexes + γ.(pool_namespace) γ.(pool_gname) th {[inv_gname]} ** + Tokens.token γ.(token_gname) q. + + Definition locked `{Σ : cpp_logic, !G Σ} + (γ : gname) (o_thr : option thread_idT) (q : Qp) : mpred := + Tokens.given_token γ.(token_gname) q ** + owner_frag γ o_thr. + + Lemma not_locked_eq `{Σ : cpp_logic, !G Σ} γ th q inv_gname : + not_locked γ th q inv_gname ⊣⊢ + Sets.my_mutexes + γ.(pool_namespace) γ.(pool_gname) th + {[inv_gname]} ** + Tokens.token γ.(token_gname) q. + Proof. done. Qed. + + Lemma locked_eq `{Σ : cpp_logic, !G Σ} γ o_thr q : + locked γ o_thr q ⊣⊢ + Tokens.given_token γ.(token_gname) q ** + owner_frag γ o_thr. + Proof. done. Qed. + + #[global] Instance token_fractional + `{Σ : cpp_logic, !G Σ} γ : Fractional (token γ). + Proof. rewrite /token. apply Tokens.token_fractional. Qed. + + #[global] Instance token_timeless + `{Σ : cpp_logic, !G Σ} γ q : Timeless (token γ q). + Proof. rewrite /token. apply _. Qed. + + #[global] Instance locked_timeless + `{Σ : cpp_logic, !G Σ} γ th q : Timeless (locked γ th q). + Proof. rewrite /locked. apply _. Qed. + + #[global] Instance locked_exclusive + `{Σ : cpp_logic, !G Σ} γ q : Exclusive1 (fun th => locked γ th q). + Proof. + intros th1 th2. rewrite /locked. + apply _. + Qed. + +End MakeMutexState. + +Module LockState := MakeMutexState MutexSets MutexTokens. diff --git a/rocq-brick-libstdcpp/proof/mutex/proof/lock_guard.v b/rocq-brick-libstdcpp/proof/mutex/proof/lock_guard.v index 3005bd17..d9540e93 100644 --- a/rocq-brick-libstdcpp/proof/mutex/proof/lock_guard.v +++ b/rocq-brick-libstdcpp/proof/mutex/proof/lock_guard.v @@ -24,7 +24,7 @@ Section with_cpp. Proof. verify_spec. go. - iExists (mutex.locked g thr qt ** P), qt. + iExists (mutex.locked g (Some thr) qt ** P), qt. go with br_erefl. by rewrite (left_id_L 1%Qp Qp.mul). Qed. diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v b/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v index 88456ca8..a9e77ee9 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v @@ -92,14 +92,14 @@ Section with_cpp. \pre mutex.not_locked g thr qt \post this |-> R (mp, g, q, qt) 1$m P ** - P ** mutex.locked g thr qt + P ** mutex.locked g (Some thr) qt ). cpp.spec "std::lock_guard::~lock_guard()" as dtor_spec from source with ( \this this \pre{mp g q qt P} this |-> R (mp, g, q, qt) 1$m P \persist{thr} current_thread thr - \pre mutex.locked g thr qt + \pre mutex.locked g (Some thr) qt \pre ▷P \post mutex.not_locked g thr qt ** diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index fdff5902..3b935717 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -52,7 +52,6 @@ Section with_cpp. Cbn (Learn (req_eq ==> learn_eq ==> req_eq ==> learn_hints.fin) locked). Proof. solve_learnable. Qed. - cpp.spec "std::mutex::mutex()" as ctor_spec with ( \this this \pre{P} ▷P @@ -60,7 +59,7 @@ Section with_cpp. cpp.spec "std::mutex::~mutex()" as dtor_spec with ( \this this - \pre{g P} this |-> R g 1$m P ** token g 1 + \pre{g P} this |-> R g 1$m P ** token g.(lock_state_gname) 1 \post P). (* "Inline" version of these specs. *) @@ -69,7 +68,7 @@ Section with_cpp. \prepost{q P g} this |-> R g q P \persist{thr} current_thread thr \pre{qt} not_locked g thr qt - \post P ** locked g thr qt). + \post P ** locked g (Some thr) qt). Definition do_lock (lk : gname * mpred) (K: mpred) : mpred := let g := lk.1 in @@ -77,21 +76,21 @@ Section with_cpp. ∃ thr qt, current_thread thr ∗ not_locked g thr qt ∗ (* TODO readd *) (* ▷ *) - (locked g thr qt ** P -* K). + (locked g (Some thr) qt ** P -* K). #[global] Arguments do_lock /. cpp.spec "std::mutex::unlock()" as unlock_spec_alt with ( \this this \prepost{q P g} this |-> R g q P \persist{thr} current_thread thr - \pre{qt} locked g thr qt + \pre{qt} locked g (Some thr) qt \pre ▷P \post not_locked g thr qt). Definition do_unlock (lk : gname * mpred) (Q : mpred) : mpred := let g := lk.1 in let P := lk.2 in - Exists thr qt, current_thread thr ** locked g thr qt ** ▷P ** + Exists thr qt, current_thread thr ** locked g (Some thr) qt ** ▷P ** (* TODO readd *) (* ▷ *) (not_locked g thr qt -* Q). @@ -102,7 +101,7 @@ Section with_cpp. \prepost{q P g} this |-> R g q P \persist{th} current_thread th \pre{qt} not_locked g th qt - \post{b}[Vbool b] if b then P ** locked g th qt else not_locked g th qt). + \post{b}[Vbool b] if b then P ** locked g (Some th) qt else not_locked g th qt). (* Obtain same specs from (Basic)Lockable. *) (** <> implements [BasicLockable] *) @@ -123,7 +122,7 @@ Section with_cpp. let P := lk.2 in ∃ thr qt, current_thread thr ∗ not_locked g thr qt ∗ ∀ b : bool, - (if b then P ** locked g thr qt else not_locked g thr qt) -∗ Q b. + (if b then P ** locked g (Some thr) qt else not_locked g thr qt) -∗ Q b. #[global] Arguments do_try_lock /. #[global,program] Instance mutex_lockable : Lockable (T:=T) "std::mutex" (λ q γP, R γP.1 q γP.2) := diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v b/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v index 90d83f85..655d4804 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v @@ -35,8 +35,8 @@ Module scoped_lock. \pre mutex.not_locked g2 thr qt2 \post this |-> R 1$m [ (mp1, g1, q1, qt1, P1); (mp2, g2, q2, qt2, P2)] ** - P1 ** mutex.locked g1 thr qt1 ** - P2 ** mutex.locked g2 thr qt2 + P1 ** mutex.locked g1 (Some thr) qt1 ** + P2 ** mutex.locked g2 (Some thr) qt2 ). cpp.spec "std::scoped_lock<...>::~scoped_lock()" @@ -51,8 +51,8 @@ Module scoped_lock. this |-> R 1$m [ (mp1, g1, q1, qt1, P1); (mp2, g2, q2, qt2, P2)] \pre |> P1 \pre |> P2 - \pre mutex.locked g1 thr qt1 - \pre mutex.locked g2 thr qt2 + \pre mutex.locked g1 (Some thr) qt1 + \pre mutex.locked g2 (Some thr) qt2 \post mp1 |-> mutex.R g1 q1$m P1 ** mutex.not_locked g1 thr qt1 ** mp2 |-> mutex.R g2 q2$m P2 ** mutex.not_locked g2 thr qt2 diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index e6da730c..09c22da5 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -7,19 +7,13 @@ Require Import skylabs.auto.cpp.proof. Require Import skylabs.auto.cpp.hints.base_derived. Require Import skylabs.brick.libstdcpp.mutex.spec.mutex. Require Import skylabs.brick.libstdcpp.mutex.requirements. -Require Import skylabs.brick.libstdcpp.lib.lock_ghost. +Require Import skylabs.brick.libstdcpp.lib.lock_ghost2. Require Import skylabs.brick.libstdcpp.atomic.spec. Require Import skylabs.brick.libstdcpp.cassert.spec. - Import linearity. Require Import skylabs.brick.libstdcpp.test.mutex.custom_mutex_hpp. - Module custom_mutex. - #[local] Existing Instance lock_ghost.has_lock. - #[local] Existing Instance lock_ghost.has_lock_upd. - #[local] Existing Instance lock_ghost.has_lock_valid. - Abbreviation N := "MyMutex"%cpp_name. (* FIXME maybe don't need to split it? *) @@ -38,75 +32,18 @@ Module custom_mutex. WeaklyObjective (p |-> R). Proof. rewrite INTERNAL._at_eq. apply _. Qed. - Canonical Structure owner_stateO := optionO thread_idTO. - Canonical Structure owner_tokenR := excl_authR owner_stateO. - - Class ownerG `{Σ : cpp_logic} := { - #[local] has_owner_token :: HasOwn (iPropI _Σ) owner_tokenR; - #[local] has_owner_token_upd :: HasOwnUpd (iPropI _Σ) owner_tokenR; - #[local] has_owner_token_valid :: HasOwnValid (iPropI _Σ) owner_tokenR; - }. - #[global] Arguments ownerG {_ _} Σ : assert. - - sl.lock - Definition owner_token_auth `{Σ : cpp_logic, !ownerG Σ} - (γ : iprop.gname) (o_thr : option thread_idT) : mpred := - own γ (●E o_thr). - sl.lock - Definition owner_token_frac `{Σ : cpp_logic, !ownerG Σ} - (γ : iprop.gname) (o_thr : option thread_idT) : mpred := - own γ (◯E o_thr). - #[only(timeless, exclusive)] derive owner_token_auth. - #[only(timeless, exclusive)] derive owner_token_frac. - - #[global] Instance owner_token_auth_WeaklyObjective - `{Σ : cpp_logic, !ownerG Σ} γ o_thr : - WeaklyObjective (PROP := iPropI _) (owner_token_auth γ o_thr). - Proof. rewrite owner_token_auth.unlock. apply _. Qed. - - #[global] Instance owner_token_frac_WeaklyObjective - `{Σ : cpp_logic, !ownerG Σ} γ o_thr : - WeaklyObjective (PROP := iPropI _) (owner_token_frac γ o_thr). - Proof. rewrite owner_token_frac.unlock. apply _. Qed. - - - #[global] Instance owner_token_agree_observe - `{Σ : cpp_logic, !ownerG Σ} γ (o1 o2 : option thread_idT) : - Observe2 [| o1 = o2 |] - (owner_token_auth γ o1) (owner_token_frac γ o2). - Proof. - apply observe_2_intro_only_provable. - rewrite owner_token_auth.unlock owner_token_frac.unlock. - iIntros "A F". - iDestruct (own_valid_2 with "A F") as %HV. - iPureIntro. - apply leibniz_equiv, excl_auth_agree, HV. - Qed. - - Lemma owner_token_update `{Σ : cpp_logic, !ownerG Σ} - γ (oa ofrag o' : option thread_idT) : - owner_token_auth γ oa ** owner_token_frac γ ofrag |-- - (|==> owner_token_auth γ o' ** owner_token_frac γ o'). - Proof. - rewrite owner_token_auth.unlock owner_token_frac.unlock. - iIntros "[A F]". - iMod (own_update_2 with "A F") as "[$ $]"; - first apply (excl_auth_update _ _ o'). - done. - Qed. - Record gname : Set := MkGname - { user_gname : iprop.gname + { lock_state_gname : LockState.gname ; cinv_gname : iprop.gname - ; phys_state_gname : iprop.gname }. Definition lock_namespace : namespace := nroot .@@ "MyMutex". sl.lock - Definition locked `{Σ : cpp_logic} `{!lockG Σ, !ownerG Σ} `{σ : genv} - (γ: gname) (o_thr : option thread_idT) : Rep := - _field "MyMutex::m_owner" |-> thread_idR 1$m o_thr ** pureR (owner_token_frac γ.(phys_state_gname) o_thr). + Definition locked `{Σ : cpp_logic} `{!LockState.G Σ} `{σ : genv} + (γ: gname) (thr : thread_idT) (q : cQp.t) : Rep := + _field "MyMutex::m_owner" |-> thread_idR 1$m (Some thr) ** pureR (LockState.locked γ.(lock_state_gname) (Some thr) q%Qp). + #[global] Hint Opaque locked : sl_opacity typeclass_instances. #[only(timeless, exclusive)] derive locked. (* Definition IR `{Σ : cpp_logic, σ : genv, !HasStdThreads Σ, !recursive_mutex.lockedG Σ} (γ : gname) (q : cQp.t) : mpred := @@ -118,35 +55,28 @@ Module custom_mutex. Section with_Σ. Context `{Σ : cpp_logic, σ : genv, HAS_THREADS : !HasStdThreads Σ, - !lockG Σ, !ownerG Σ}. - - (* Abbreviation BASE p := - (p ,, _base "std::atomic" "std::__atomic_base"). *) - - (* - Definition mutex_content (γ : gname) : Rep := - ∃ o_owner lockedb, - _field "MyMutex::m_lock" |-> atomic.R "bool" 1$m lockedb ** - _field "MyMutex::m_owner" |-> thread_idR 1$m o_owner. - *) + !LockState.G Σ}. Definition mutex_inv (this : ptr) (γ : gname) (P : mpred) : mpred := ∃ b : bool, this ,, _field "MyMutex::m_lock" |-> atomic.R "int" 1$m (if b then 1 else 0)%Z ** ∃ o_owner : option thread_idT, - owner_token_auth γ.(phys_state_gname) o_owner ** + LockState.owner_auth γ.(lock_state_gname).(LockState.owner_gname) o_owner ** (if b then - ∃ th, user γ.(user_gname) th ** [| o_owner = Some th |] + ∃ th q1 q2, + LockState.not_locked γ.(lock_state_gname) th q1 γ.(cinv_gname) ** + MutexTokens.given_token γ.(lock_state_gname).(LockState.token_gname) q2 ** + [| (q1 + q2 = 1)%Qp |] else - (* owner_token γ.(phys_state_gname) o_owner ** *) + (* LockState.owner_auth γ.(lock_state_gname) o_owner ** *) P ** (** m_owner does not concern do_lock() and do_unlock(), the actual implementation of mutex, and does not always equal o_owner. It is just a resource that one can get from the invariant. *) this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** - owner_token_frac γ.(phys_state_gname) o_owner) - . + LockState.owner_frag γ.(lock_state_gname).(LockState.owner_gname) o_owner ** + MutexTokens.given_token γ.(lock_state_gname).(LockState.token_gname) 1%Qp). Definition IR (γ : gname) (q : cQp.t) (P : mpred) : Rep := structR N q$m ** @@ -213,62 +143,66 @@ Module custom_mutex. \pre{P} ▷P \require WeaklyObjective P \post (|={⊤}=> Exists g, - this |-> IR g 1$m P ** used_threads g.(user_gname) ∅)). + this |-> IR g 1$m P ** LockState.token g.(lock_state_gname) 1%Qp)). cpp.spec "MyMutex::~MyMutex()" as dtor_spec with ( \this this - \pre{g P} this |-> IR g 1$m P ** used_threads g.(user_gname) ∅ + \pre{g P} this |-> IR g 1$m P ** LockState.token g.(lock_state_gname) 1%Qp \post P). cpp.spec "MyMutex::do_lock()" as do_lock_spec with ( \this this - \prepost{q P g} this |-> IR g q P + \prepost{g q P} this |-> IR g q P \persist{thr} current_thread thr - \pre user g.(user_gname) thr + \pre LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname) \prepost{q'} GLOBALS q' - \post P ** + (* does not have to be q, but easier if it is *) + \post (P ** this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** - owner_token_frac g.(phys_state_gname) (Some thr)). + LockState.owner_frag g.(lock_state_gname).(LockState.owner_gname) (Some thr))). cpp.spec "MyMutex::do_unlock()" as do_unlock_spec with ( \this this - \prepost{q P g} this |-> IR g q P + \prepost{g q P} this |-> IR g q P \persist{thr} current_thread thr \pre ▷P \pre this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None - \pre owner_token_frac g.(phys_state_gname) (Some thr) - \post user g.(user_gname) thr). + \pre LockState.owner_frag g.(lock_state_gname).(LockState.owner_gname) (Some thr) + \post LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname)). - Definition T : Type := gname * mpred. + Definition T : Type := gname * cQp.t * mpred. - (* FIXME should GLOBALS be in lock specs, instead of do_lock? *) Definition do_lock (this : ptr) (lk : T) (K : mpred) : mpred := - let g := lk.1 in + let g := lk.1.1 in + let q := lk.1.2 in let P := lk.2 in - ∃ thr q', current_thread thr ** user g.(user_gname) thr ** GLOBALS q' ** - (GLOBALS q' ** P ** this |-> locked g (Some thr) -* K). + ∃ thr q', current_thread thr ** + LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname) ** + GLOBALS q' ** + (GLOBALS q' ** P ** this |-> locked g thr q -* K). #[global] Arguments do_lock /. Definition do_unlock (this : ptr) (lk : T) (K : mpred) : mpred := - let g := lk.1 in + let g := lk.1.1 in + let q := lk.1.2 in let P := lk.2 in - ∃ thr, current_thread thr ** this |-> locked g (Some thr) ** ▷P ** - (user g.(user_gname) thr -* K). + ∃ thr , current_thread thr ** this |-> locked g thr q ** ▷P ** + (LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname) -* K). #[global] Arguments do_unlock /. #[global] Instance custom_mutex_basic_lockable : BasicLockable (T := T) (Tnamed N) - (fun q gP => IR gP.1 q gP.2) := + (fun _ gqP => IR gqP.1.1 gqP.1.2 gqP.2) := { do_lock := do_lock ; do_unlock := do_unlock }. cpp.spec "MyMutex::lock()" as lock_spec with (\exact Reduce - (lock_basic_lockable (Tnamed N) (fun q gP => IR gP.1 q gP.2))). + (lock_basic_lockable (Tnamed N) (fun q gqP => IR gqP.1.1 gqP.1.2 gqP.2))). cpp.spec "MyMutex::unlock()" as unlock_spec with (\exact Reduce - (unlock_basic_lockable (Tnamed N) (fun q gP => IR gP.1 q gP.2))). + (unlock_basic_lockable (Tnamed N) (fun q gqP => IR gqP.1.1 gqP.1.2 gqP.2))). cpp.spec "std::this_thread::yield()" as yield_spec with ( \post emp). @@ -327,17 +261,6 @@ Module custom_mutex. Admitted. Hint Resolve do_exchange_C : sl_opacity. - #[global] Instance owner_token_frac_excl g : - Exclusive1 (owner_token_frac g). - Proof. - intros; rewrite observe_2_pure owner_token_frac.unlock. - apply /observe_2_derive_only_provable. - by rewrite excl_auth_frag_op_valid. - Qed. - Import observe2_fwd. - Definition owner_token_frac_excl_F := ltac:(mk_obs2_fwd owner_token_frac_excl). - Hint Resolve owner_token_frac_excl_F : sl_opacity. - #[program] Definition do_store_C (p : ptr) := \cancelx From 213bfc7c090d4ca4675baac1a2d8826c8f5153e3 Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Sun, 6 Sep 2026 23:44:10 +0000 Subject: [PATCH 33/51] complete mutex ghost refactor mutex.v now depends on a ghost state module defined in lock_ghosts2.v instead of the user ghost state. The usage is demonstrated in custom_mutex_hpp_proof.v. It has 3 pieces: - my_mutexes records the set of invariant gnames acquired by a thread, and should be allocated by spawn(). A singleton set should be given to a mutex invariant in exchange for the protected resources in it. - a pair of token/given_token. A thread acquiring the resource stores a fraction of token inside the invariant and gets back the same fraction of given_token; destructing lock requires the entire token and thus no thread can hold the lock. - a o_owner_tid, recording the thread ID of the current lock owner. The auth piece is in inv and frag is held by the current lock owner. --- rocq-brick-libstdcpp/proof/lib/lock_ghost2.v | 203 ++++++++++-- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 20 +- .../test/mutex/custom_mutex_hpp_proof.v | 291 +++++++++++------- 3 files changed, 375 insertions(+), 139 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v b/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v index f0508bc5..9e299025 100644 --- a/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v +++ b/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v @@ -72,17 +72,17 @@ Module Type MUTEX_STATE. }. #[global] Arguments G {_ _} Σ : assert. - Parameter owner_auth : forall `{Σ : cpp_logic, !G Σ}, + Parameter owner_tid_auth : forall `{Σ : cpp_logic, !G Σ}, gname -> option thread_idT -> mpred. - Parameter owner_frag : forall `{Σ : cpp_logic, !G Σ}, + Parameter owner_tid_frag : forall `{Σ : cpp_logic, !G Σ}, gname -> option thread_idT -> mpred. - #[global] Declare Instance owner_auth_timeless - `{Σ : cpp_logic, !G Σ} γ o_thr : Timeless (owner_auth γ o_thr). - #[global] Declare Instance owner_frag_timeless - `{Σ : cpp_logic, !G Σ} γ o_thr : Timeless (owner_frag γ o_thr). - #[global] Declare Instance owner_frag_exclusive - `{Σ : cpp_logic, !G Σ} γ : Exclusive1 (owner_frag γ). + #[global] Declare Instance owner_tid_auth_timeless + `{Σ : cpp_logic, !G Σ} γ o_thr : Timeless (owner_tid_auth γ o_thr). + #[global] Declare Instance owner_tid_frag_timeless + `{Σ : cpp_logic, !G Σ} γ o_thr : Timeless (owner_tid_frag γ o_thr). + #[global] Declare Instance owner_tid_frag_exclusive + `{Σ : cpp_logic, !G Σ} γ : Exclusive1 (owner_tid_frag γ). Parameter token : forall `{Σ : cpp_logic, !G Σ}, gname -> Qp -> mpred. @@ -155,9 +155,28 @@ Module MutexSets. rewrite my_mutexes_inv.unlock mutex_sets_auth.unlock. apply _. Qed. + #[global] Instance my_mutexes_WeaklyObjective `{Σ : cpp_logic, !G Σ} N γ th M : + WeaklyObjective (my_mutexes N γ th M). + Proof. rewrite /my_mutexes mutex_sets_frag.unlock. apply _. Qed. + + #[global] Hint Opaque my_mutexes : sl_opacity typeclass_instances. + Section theory. Context `{Σ : cpp_logic, !G Σ}. + Lemma alloc_pool N : + ⊢ |={⊤}=> ∃ γpool, inv N (my_mutexes_inv γpool). + Proof. + iMod (own_alloc + (gmap_view_auth (V := agreeR (leibnizO (gset iprop.gname))) + (DfracOwn 1) (mutex_sets_view ∅))) as (γpool) "HA". + { apply gmap_view_auth_valid. } + iMod (inv_alloc N _ (my_mutexes_inv γpool) with "[HA]") as "#HI". + { iNext. rewrite my_mutexes_inv.unlock mutex_sets_auth.unlock. + iExists ∅. iExact "HA". } + iModIntro. iExists γpool. iExact "HI". + Qed. + Lemma mutex_sets_frag_exclusive γpool th M1 M2 : mutex_sets_frag γpool th M1 ** mutex_sets_frag γpool th M2 |-- False. Proof. @@ -292,9 +311,120 @@ Module MutexTokens. `{Σ : cpp_logic, !G Σ} γ q : Timeless (given_token γ q). Proof. rewrite /given_token. apply _. Qed. + (** Ordinary and given-token shares in the invariant add up to one. + [token_not_full] contains a positive ordinary-token share, so it conflicts + with the full ordinary token required for destruction. *) + Definition token_not_full `{Σ : cpp_logic, !G Σ} (γ : iprop.gname) : mpred := + token γ 1 ∨ ∃ qt qg : Qp, + [| (qt + qg = 1)%Qp |] ** token γ qt ** given_token γ qg. + + (** Include the endpoint with no ordinary tokens. Transfers preserve the + balance even when a caller returns only part of its given-token share. *) + Definition token_full `{Σ : cpp_logic, !G Σ} (γ : iprop.gname) : mpred := + given_token γ 1 ∨ token_not_full γ. + + #[global] Instance token_full_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ : + WeaklyObjective (token_full γ). + Proof. rewrite /token_full /token_not_full /token /given_token. apply _. Qed. + + #[global] Instance token_not_full_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ : + WeaklyObjective (token_not_full γ). + Proof. rewrite /token_not_full /token /given_token. apply _. Qed. + + #[global] Hint Opaque token given_token token_not_full token_full : sl_opacity typeclass_instances. + Section theory. Context `{Σ : cpp_logic, !G Σ}. + #[local] Existing Instance mpred_BiAffine. + + Lemma token_valid γ q : token γ q |-- [| (q ≤ 1)%Qp |]. + Proof. + rewrite /token. iIntros "H". + iDestruct (own_valid with "H") as %Hvalid. + iPureIntro. exact (proj1 Hvalid). + Qed. + + Lemma given_token_valid γ q : given_token γ q |-- [| (q ≤ 1)%Qp |]. + Proof. + rewrite /given_token. iIntros "H". + iDestruct (own_valid with "H") as %Hvalid. + iPureIntro. exact (proj2 Hvalid). + Qed. + + Lemma token_valid_2 γ q1 q2 : + token γ q1 ** token γ q2 |-- [| (q1 + q2 ≤ 1)%Qp |]. + Proof. rewrite -fractional. apply token_valid. Qed. + + Lemma given_token_valid_2 γ q1 q2 : + given_token γ q1 ** given_token γ q2 |-- [| (q1 + q2 ≤ 1)%Qp |]. + Proof. rewrite -fractional. apply given_token_valid. Qed. + + Lemma token_not_full_full_token γ : + token_not_full γ ** token γ 1 |-- False. + Proof. + rewrite /token_not_full. iIntros "[H T]". + iDestruct "H" as "[H | H]". + - iDestruct (token_valid_2 with "[$T $H]") as %Hbad. + exfalso. exact (Qp.not_add_le_l 1 1 Hbad). + - iDestruct "H" as (qt qg) "(_ & H & _)". + iDestruct (token_valid_2 with "[$T $H]") as %Hbad. + exfalso. exact (Qp.not_add_le_l 1 qt Hbad). + Qed. + + Lemma acquire γ q : + token_full γ ** token γ q |-- given_token γ q ** token_not_full γ. + Proof. + rewrite /token_full /token_not_full. iIntros "[H T]". + iDestruct "H" as "[H | [H | H]]". + - iDestruct (token_valid with "T") as %Hq. + apply Qp.le_lteq in Hq as [Hq | ->]. + + apply Qp.lt_sum in Hq as [r Hr]. + iEval (rewrite Hr fractional) in "H". + iDestruct "H" as "[H R]". iFrame "H". + iRight. iExists q, r. iFrame. done. + + iFrame "H". iLeft. iExact "T". + - iDestruct (token_valid_2 with "[$H $T]") as %Hbad. + exfalso. exact (Qp.not_add_le_l 1 q Hbad). + - iDestruct "H" as (qt qg) "(%Hsum & T0 & G)". + iDestruct (token_valid_2 with "[$T0 $T]") as %Hvalid. + rewrite -Hsum in Hvalid. + apply Qp.add_le_mono_l, Qp.le_lteq in Hvalid as [Hlt | ->]. + + apply Qp.lt_sum in Hlt as [r Hr]. + iEval (rewrite Hr fractional) in "G". + iDestruct "G" as "[G R]". iFrame "G". + iRight. iExists (qt + q)%Qp, r. + iSplit; first (iPureIntro; by rewrite -Qp.add_assoc -Hr). + iFrame "R". rewrite fractional. iFrame. + + iFrame "G". iLeft. rewrite -Hsum fractional. iFrame. + Qed. + + Lemma release γ q : + token_not_full γ ** given_token γ q |-- token γ q ** token_full γ. + Proof. + rewrite /token_full /token_not_full. iIntros "[H G]". + iDestruct "H" as "[H | H]". + - iDestruct (given_token_valid with "G") as %Hq. + apply Qp.le_lteq in Hq as [Hq | ->]. + + apply Qp.lt_sum in Hq as [r Hr]. + iEval (rewrite Hr fractional) in "H". + iDestruct "H" as "[H R]". iFrame "H". + iRight. iRight. iExists r, q. iFrame. + iPureIntro. by rewrite Qp.add_comm. + + iFrame "H". iLeft. iExact "G". + - iDestruct "H" as (qt qg) "(%Hsum & T & G0)". + iDestruct (given_token_valid_2 with "[$G $G0]") as %Hvalid. + rewrite -Hsum in Hvalid. + apply Qp.add_le_mono_r, Qp.le_lteq in Hvalid as [Hlt | ->]. + + apply Qp.lt_sum in Hlt as [r Hr]. + iEval (rewrite Hr fractional) in "T". + iDestruct "T" as "[T R]". iFrame "T". + iRight. iRight. iExists r, (q + qg)%Qp. + iSplit; first (iPureIntro; by rewrite Qp.add_assoc (Qp.add_comm r q) -Hr). + iFrame "R". rewrite fractional. iFrame. + + iFrame "T". iLeft. rewrite -Hsum fractional. iFrame. + Qed. + Lemma alloc : ⊢ |==> ∃ γ, token γ 1 ** given_token γ 1. Proof. @@ -311,7 +441,7 @@ End MutexTokens. optional owner state directly. *) Module MakeMutexState (Sets0 : MUTEX_SETS) - (Tokens0 : MUTEX_TOKENS) : MUTEX_STATE. + (Tokens0 : MUTEX_TOKENS) <: MUTEX_STATE. Module Sets := Sets0. Module Tokens := Tokens0. @@ -334,34 +464,61 @@ Module MakeMutexState Class G `{Σ : cpp_logic} := { #[global] sets_G :: Sets.G Σ; #[global] tokens_G :: Tokens.G Σ; - #[local] has_owner :: HasOwn (iPropI _Σ) owner_cmraR; - #[local] has_owner_upd :: HasOwnUpd (iPropI _Σ) owner_cmraR; - #[local] has_owner_valid :: HasOwnValid (iPropI _Σ) owner_cmraR; + #[global] has_owner :: HasOwn (iPropI _Σ) owner_cmraR; + #[global] has_owner_upd :: HasOwnUpd (iPropI _Σ) owner_cmraR; + #[global] has_owner_valid :: HasOwnValid (iPropI _Σ) owner_cmraR; }. #[global] Arguments G {_ _} Σ : assert. - Definition owner_auth `{Σ : cpp_logic, !G Σ} + Definition owner_tid_auth `{Σ : cpp_logic, !G Σ} (γ : gname) (o_thr : option thread_idT) : mpred := own γ.(owner_gname) ((●E o_thr) : owner_cmraR). - Definition owner_frag `{Σ : cpp_logic, !G Σ} + Definition owner_tid_frag `{Σ : cpp_logic, !G Σ} (γ : gname) (o_thr : option thread_idT) : mpred := own γ.(owner_gname) ((◯E o_thr) : owner_cmraR). - #[global] Hint Opaque owner_auth owner_frag : sl_opacity typeclass_instances. + #[global] Hint Opaque owner_tid_auth owner_tid_frag : sl_opacity typeclass_instances. - #[only(timeless)] derive owner_auth. - #[only(timeless)] derive owner_frag. + #[only(timeless)] derive owner_tid_auth. + #[only(timeless)] derive owner_tid_frag. - #[global] Instance owner_frag_exclusive - `{Σ : cpp_logic, !G Σ} γ : Exclusive1 (owner_frag γ). + #[global] Instance owner_tid_frag_exclusive + `{Σ : cpp_logic, !G Σ} γ : Exclusive1 (owner_tid_frag γ). Proof. - intros o_thr1 o_thr2. rewrite /owner_frag. + intros o_thr1 o_thr2. rewrite /owner_tid_frag. iIntros "H1 H2". iDestruct (own_valid_2 with "H1 H2") as %Hvalid. move: Hvalid. rewrite excl_auth_frag_op_valid. done. Qed. + #[global] Instance owner_tid_auth_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ o_thr : + WeaklyObjective (owner_tid_auth γ o_thr). + Proof. rewrite /owner_tid_auth. apply _. Qed. + + #[global] Instance owner_tid_frag_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ o_thr : + WeaklyObjective (owner_tid_frag γ o_thr). + Proof. rewrite /owner_tid_frag. apply _. Qed. + + #[global] Instance owner_agree `{Σ : cpp_logic, !G Σ} γ o1 o2 : + Observe2 [| o1 = o2 |] (owner_tid_auth γ o1) (owner_tid_frag γ o2). + Proof. + apply observe_2_intro_only_provable. + rewrite /owner_tid_auth /owner_tid_frag. iIntros "A F". + iDestruct (own_valid_2 with "A F") as %HV. + iPureIntro. apply leibniz_equiv, excl_auth_agree, HV. + Qed. + + Lemma owner_update `{Σ : cpp_logic, !G Σ} γ oa ofrag o' : + owner_tid_auth γ oa ** owner_tid_frag γ ofrag |-- + (|==> owner_tid_auth γ o' ** owner_tid_frag γ o'). + Proof. + rewrite /owner_tid_auth /owner_tid_frag. iIntros "[A F]". + iMod (own_update_2 with "A F") as "[$ $]"; + first apply (excl_auth_update _ _ o'). + done. + Qed. + Definition token `{Σ : cpp_logic, !G Σ} (γ : gname) (q : Qp) : mpred := Tokens.token γ.(token_gname) q. @@ -376,7 +533,7 @@ Module MakeMutexState Definition locked `{Σ : cpp_logic, !G Σ} (γ : gname) (o_thr : option thread_idT) (q : Qp) : mpred := Tokens.given_token γ.(token_gname) q ** - owner_frag γ o_thr. + owner_tid_frag γ o_thr. Lemma not_locked_eq `{Σ : cpp_logic, !G Σ} γ th q inv_gname : not_locked γ th q inv_gname ⊣⊢ @@ -389,7 +546,7 @@ Module MakeMutexState Lemma locked_eq `{Σ : cpp_logic, !G Σ} γ o_thr q : locked γ o_thr q ⊣⊢ Tokens.given_token γ.(token_gname) q ** - owner_frag γ o_thr. + owner_tid_frag γ o_thr. Proof. done. Qed. #[global] Instance token_fractional @@ -411,6 +568,8 @@ Module MakeMutexState apply _. Qed. + #[global] Hint Opaque token not_locked locked : sl_opacity typeclass_instances. + End MakeMutexState. Module LockState := MakeMutexState MutexSets MutexTokens. diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index 3b935717..67cfba21 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -20,9 +20,21 @@ Import linearity. #[global] Instance SplitRecord_prod A B : SplitRecord (@prod A B) := {}. Module Mutex (State : lock_ghost2.MUTEX_STATE). -Include State. -#[global] Hint Opaque token not_locked locked : sl_opacity typeclass_instances. +(** Pair the abstract state with the invariant named by [State.not_locked]. *) +Record gname : Set := MkGname { + lock_state_gname : State.gname; + cinv_gname : iprop.gname; +}. + +Definition G := @State.G. +Existing Class G. +#[global] Arguments G {_ _} Σ : assert. +#[global] Instance state_G `{Σ : cpp_logic} (H : G Σ) : State.G Σ := H. + +Abbreviation token g q:= (State.token g.(lock_state_gname) q). +Abbreviation not_locked g th q := (State.not_locked g.(lock_state_gname) th q g.(cinv_gname)). +Abbreviation locked g o_thr q := (State.locked g.(lock_state_gname) o_thr q). Section with_cpp. Context `{Σ : cpp_logic}. @@ -49,7 +61,7 @@ Section with_cpp. Context {HAS_THREADS : HasStdThreads Σ}. #[global] Instance locked_learn : - Cbn (Learn (req_eq ==> learn_eq ==> req_eq ==> learn_hints.fin) locked). + Cbn (Learn (req_eq ==> learn_eq ==> req_eq ==> learn_hints.fin) State.locked). Proof. solve_learnable. Qed. cpp.spec "std::mutex::mutex()" as ctor_spec with ( @@ -59,7 +71,7 @@ Section with_cpp. cpp.spec "std::mutex::~mutex()" as dtor_spec with ( \this this - \pre{g P} this |-> R g 1$m P ** token g.(lock_state_gname) 1 + \pre{g P} this |-> R g 1$m P ** token g 1 \post P). (* "Inline" version of these specs. *) diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index 09c22da5..5bc5f864 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -46,37 +46,32 @@ Module custom_mutex. #[global] Hint Opaque locked : sl_opacity typeclass_instances. #[only(timeless, exclusive)] derive locked. - (* Definition IR `{Σ : cpp_logic, σ : genv, !HasStdThreads Σ, !recursive_mutex.lockedG Σ} (γ : gname) (q : cQp.t) : mpred := - ∃ x, recursive_mutex.owned_count_id_auth γ.(rec_gname) x. *) -(* - Definition rawR `{Σ : cpp_logic, σ : genv} (owner : option thread_idT) (count : nat) : Rep := - structR "std::recursive_mutex" 1$m ** - _field "MyRecursiveMutex::m_count" |-> ulonglongR 1$m count. *) - Section with_Σ. Context `{Σ : cpp_logic, σ : genv, HAS_THREADS : !HasStdThreads Σ, !LockState.G Σ}. + (** The invariant holds the thread's mutex set while the spinlock is held. + Its token balance supports both full and partial ownership transfers. *) Definition mutex_inv (this : ptr) (γ : gname) (P : mpred) : mpred := ∃ b : bool, this ,, _field "MyMutex::m_lock" |-> atomic.R "int" 1$m (if b then 1 else 0)%Z ** ∃ o_owner : option thread_idT, - LockState.owner_auth γ.(lock_state_gname).(LockState.owner_gname) o_owner ** + LockState.owner_tid_auth γ.(lock_state_gname) o_owner ** (if b then - ∃ th q1 q2, - LockState.not_locked γ.(lock_state_gname) th q1 γ.(cinv_gname) ** - MutexTokens.given_token γ.(lock_state_gname).(LockState.token_gname) q2 ** - [| (q1 + q2 = 1)%Qp |] + ∃ th, + MutexSets.my_mutexes + γ.(lock_state_gname).(LockState.pool_namespace) + γ.(lock_state_gname).(LockState.pool_gname) th {[γ.(cinv_gname)]} ** + [| o_owner = Some th |] ** + MutexTokens.token_not_full γ.(lock_state_gname).(LockState.token_gname) else - (* LockState.owner_auth γ.(lock_state_gname) o_owner ** *) P ** - (** m_owner does not concern do_lock() and do_unlock(), the actual - implementation of mutex, and does not always equal o_owner. - It is just a resource that one can get from the invariant. *) + (** The physical owner is cleared before [do_unlock]; the ghost owner + records the last acquiring thread until the next acquisition. *) this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** - LockState.owner_frag γ.(lock_state_gname).(LockState.owner_gname) o_owner ** - MutexTokens.given_token γ.(lock_state_gname).(LockState.token_gname) 1%Qp). + LockState.owner_tid_frag γ.(lock_state_gname) o_owner ** + MutexTokens.token_full γ.(lock_state_gname).(LockState.token_gname)). Definition IR (γ : gname) (q : cQp.t) (P : mpred) : Rep := structR N q$m ** @@ -159,7 +154,7 @@ Module custom_mutex. (* does not have to be q, but easier if it is *) \post (P ** this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** - LockState.owner_frag g.(lock_state_gname).(LockState.owner_gname) (Some thr))). + LockState.locked g.(lock_state_gname) (Some thr) q)). cpp.spec "MyMutex::do_unlock()" as do_unlock_spec with ( \this this @@ -167,7 +162,7 @@ Module custom_mutex. \persist{thr} current_thread thr \pre ▷P \pre this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None - \pre LockState.owner_frag g.(lock_state_gname).(LockState.owner_gname) (Some thr) + \pre LockState.locked g.(lock_state_gname) (Some thr) q \post LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname)). Definition T : Type := gname * cQp.t * mpred. @@ -196,6 +191,21 @@ Module custom_mutex. { do_lock := do_lock ; do_unlock := do_unlock }. + cpp.spec "MyMutex::lock()" as lock_spec_alt with ( + \this this + \prepost{g q P} this |-> IR g q P + \persist{thr} current_thread thr + \pre LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname) + \prepost{q'} GLOBALS q' + \post P ** this |-> locked g thr q). + + cpp.spec "MyMutex::unlock()" as unlock_spec_alt with ( + \this this + \prepost{g q P} this |-> IR g q P + \persist{thr} current_thread thr + \pre this |-> locked g thr q ** ▷P + \post LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname)). + cpp.spec "MyMutex::lock()" as lock_spec with (\exact Reduce (lock_basic_lockable (Tnamed N) (fun q gqP => IR gqP.1.1 gqP.1.2 gqP.2))). @@ -204,6 +214,32 @@ Module custom_mutex. (\exact Reduce (unlock_basic_lockable (Tnamed N) (fun q gqP => IR gqP.1.1 gqP.1.2 gqP.2))). + Lemma lock_spec_entails_lock_spec_alt : lock_spec -|- lock_spec_alt. + Proof. + iSplit; iApply specify_mono; ework with br_erefl. + lazymatch goal with + | |- environments.envs_entails _ ?Ggoal => + lazymatch Ggoal with + | context[IR ?gqP.1.1 ?gqP.1.2 ?gqP.2] => unify gqP (g, q, P) + end + end. + ework with br_erefl. + Unshelve. all: exact (1$m)%cQp. + Qed. + + Lemma unlock_spec_entails_unlock_spec_alt : unlock_spec -|- unlock_spec_alt. + Proof. + iSplit; iApply specify_mono; ework with br_erefl. + lazymatch goal with + | |- environments.envs_entails _ ?Ggoal => + lazymatch Ggoal with + | context[IR ?gqP.1.1 ?gqP.1.2 ?gqP.2] => unify gqP (g, q, P) + end + end. + ework with br_erefl. + Unshelve. all: exact (1$m)%cQp. + Qed. + cpp.spec "std::this_thread::yield()" as yield_spec with ( \post emp). @@ -221,44 +257,60 @@ Module custom_mutex. \using denoteModule source \using{thr} current_thread thr \consuming{g q P} p |-> IR g q P - \consuming user g.(user_gname) thr + \consuming LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname) \proving{K (_ : IsExistential K)} std.atomic.do_exchange "int" (BASE (p,, o_field σ "MyMutex::m_lock") ) 1%Z K \instantiate K := (fun res => p |-> IR g q P ** [| res = 0 \/ res = 1 |]%Z ** - if bool_decide (res = 0) then P ** owner_token_frac g.(phys_state_gname) (Some thr) ** + if bool_decide (res = 0) then P ** LockState.locked g.(lock_state_gname) (Some thr) q ** p ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None - else user g.(user_gname) thr) + else LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname)) \end@{mpredI}. Next Obligation. - intros. iIntros "[#M ?]" (?? ->). + intros. iIntros "[#M Hpre]" (?? ->). iDestruct (observe [| _ ⊧ _ |] with "M") as "%". + iDestruct "Hpre" as "(#Thr & IR & NL)". + iEval (rewrite /IR _at_sep _at_as_Rep) in "IR". + iDestruct "IR" as "(S & #CI & CO)". + rewrite /std.atomic.do_exchange. iAuIntro1. rewrite /atomic1_acc. - rewrite {1}/IR/mutex_inv/=; work. - wname [cinv] "#?". - iInv lock_namespace as "?" "Hc"; work. - iDestruct (fupd_mask_subseteq) as ">Y"; [ | iModIntro ]; first solve_ndisj. - work. - 1: admit. (* can and should be an AC *) - wname [cinv] "CI". - wname [owner_token_auth] "OA". - wname [_ |-> atomic.R _ _ _] "FL". - wname [_ |-> thread_idR _ _] "PF". - wname [user _ _] "U". - ren_hyp b bool. - iMod "Y" as "_". - destruct b eqn:Hb. - - iMod ("Hc" with "[FL OA PF]") as "_". - { iExists true. ework $usenamed=true with br_erefl. } - iModIntro. rewrite /IR. work $usenamed=true with br_erefl. - auto. - - iDestruct "PF" as "(P & FO & OF)". - iMod (owner_token_update g.(phys_state_gname) _ _ (Some thr) - with "[$OA $OF]") as "(OA & OF)". - iMod ("Hc" with "[FL OA U]") as "_". - { iExists true. ework $usenamed=true with br_erefl. } - iModIntro. rewrite /IR. work $usenamed=true with br_erefl. - auto. - Admitted. + iInv lock_namespace as "Inv" "Hclose". + iDestruct "Inv" as "[Inv CO]". + iEval (rewrite /mutex_inv) in "Inv". + iDestruct "Inv" as (b) "[>L Inv]". + iDestruct "Inv" as (oo) "[>OA State]". + iDestruct (fupd_mask_subseteq) as ">Y"; [ | iModIntro ]; first set_solver. + iExists (if b then 1 else 0)%Z. + iSplitL "L". + { ework $usenamed=true with br_erefl. } + iSplit. + - iIntros "L". iMod "Y" as "_". + iMod ("Hclose" with "[L OA State]") as "_". + { iNext. rewrite /mutex_inv. iExists b. + iSplitL "L"; first by ework $usenamed=true with br_erefl. + iExists oo. iFrame. } + iModIntro. iFrame. + - iNext. iIntros "L". iMod "Y" as "_". + destruct b. + + iMod ("Hclose" with "[L OA State]") as "_". + { iNext. rewrite /mutex_inv. iExists true. + iSplitL "L"; first by ework $usenamed=true with br_erefl. + iExists oo. iFrame. } + iModIntro. rewrite /IR _at_sep _at_as_Rep /=. + iFrame "CI". iFrame. iPureIntro. auto. + + iDestruct "State" as "(P & Owner & OF & Balance)". + iEval (rewrite /LockState.not_locked /LockState.token) in "NL". + iDestruct "NL" as "[Sets T]". + iDestruct (MutexTokens.acquire with "[$Balance $T]") as "[GT Balance]". + iMod (LockState.owner_update _ _ _ (Some thr) with "[$OA $OF]") + as "[OA OF]". + iMod ("Hclose" with "[L OA Sets Balance]") as "_". + { iNext. rewrite /mutex_inv. iExists true. + iSplitL "L"; first by ework $usenamed=true with br_erefl. + iExists (Some thr). iFrame "OA". + iExists thr. iFrame. done. } + iModIntro. rewrite /IR _at_sep _at_as_Rep /LockState.locked /=. + iFrame "CI". iFrame. iPureIntro. auto. + Qed. Hint Resolve do_exchange_C : sl_opacity. #[program] @@ -269,47 +321,44 @@ Module custom_mutex. \consuming{g q P} p |-> IR g q P \consuming P \consuming p ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None - \consuming owner_token_frac g.(phys_state_gname) (Some thr) + \consuming LockState.locked g.(lock_state_gname) (Some thr) q \proving{K (_ : IsExistential K)} std.atomic.do_store "int" (BASE (p ,, o_field σ "MyMutex::m_lock")) 0%Z K - \instantiate K := (p |-> IR g q P ** user g.(user_gname) thr) + \instantiate K := (p |-> IR g q P ** LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname)) \end@{mpredI}. Next Obligation. - intros. iIntros "[#M ?]" (?? ->). + intros. iIntros "[#M Hpre]" (?? ->). iDestruct (observe [| _ ⊧ _ |] with "M") as "%". + iDestruct "Hpre" as "(#Thr & IR & P & Owner & Locked)". + iEval (rewrite /IR _at_sep _at_as_Rep) in "IR". + iDestruct "IR" as "(S & #CI & CO)". + iEval (rewrite /LockState.locked) in "Locked". + iDestruct "Locked" as "[GT OF]". rewrite /std.atomic.do_store. iAcIntro. rewrite /commit_acc /=. - rewrite {1}/IR/mutex_inv /=; work. - wname [cinv] "#?". - iInv lock_namespace as "?" "Hc"; work. - ren_hyp b bool. - iExists (if b then 1%Z else 0%Z). iFrame. - iApply fupd_mask_intro; first solve_ndisj. - iIntros "Y". iNext. iIntros "FL". - iMod "Y" as "_". - wname [P] "P". - wname [_ |-> thread_idR _ _] "FO". - wname [owner_token_frac] "OF". - wname [owner_token_auth] "OA". - iRename "P" into "CI". - wname [P] "RP". - wname [_ |-> thread_idR _ _] "OwnerField". - destruct b eqn:Hb. - - iDestruct "FO" as (owner) "(U & ->)". - iDestruct (observe_2 [| Some owner = Some thr |] with "OA OF") - as %->%(inj _). - iEval (rewrite _at_offsetR) in "FL". - iMod ("Hc" with "[FL OA RP OwnerField OF]") as "_". - { iNext. iExists false. - work $usenamed=true with br_erefl. - iExists (Some thr). iFrame. } - iModIntro. rewrite /IR. work $usenamed=true with br_erefl. - - - (* TODO AUTO *) - Fail by work $usenamed=true. - Succeed by iStopProof; work. - iDestruct "FO" as "?"; iDestruct "OF" as "?"; - work using owner_token_frac_excl_F. + iInv lock_namespace as "Inv" "Hclose". + iDestruct "Inv" as "[Inv CO]". + iEval (rewrite /mutex_inv) in "Inv". + iDestruct "Inv" as (b) "[>L Inv]". + iDestruct "Inv" as (oo) "[>OA State]". + iDestruct (fupd_mask_subseteq) as ">Y"; [ | iModIntro ]; first set_solver. + iExists (if b then 1 else 0)%Z. + iSplitL "L"; first by ework $usenamed=true with br_erefl. + iNext. iIntros "L". iMod "Y" as "_". + destruct b. + - iDestruct "State" as (owner) "(Sets & %Heq & Balance)". + iDestruct (observe_2 [| oo = Some thr |] with "OA OF") as %Howner. + have -> : owner = thr by congruence. + iDestruct (MutexTokens.release with "[$Balance $GT]") as "[T Balance]". + iMod ("Hclose" with "[L OA P Owner OF Balance]") as "_". + { iNext. rewrite /mutex_inv. iExists false. + iSplitL "L"; first by ework $usenamed=true with br_erefl. + iExists oo. iFrame. by rewrite Howner. } + iModIntro. + rewrite /IR _at_sep _at_as_Rep /LockState.not_locked /=. + iFrame "CI". iFrame. + - iDestruct "State" as "(P0 & Owner0 & OF0 & Balance0)". + iDestruct (LockState.owner_tid_frag_exclusive with "OF0 OF") as %[]. Qed. Hint Resolve do_store_C : sl_opacity. @@ -349,24 +398,43 @@ Module custom_mutex. verify_spec; go. Qed. + Lemma mymutex_lock_alt_proof : verify[source] lock_spec_alt. + Proof using MOD HAS_THREADS. + verify_spec; ego. + rewrite locked.unlock. + ego. + Qed. + + Lemma mymutex_unlock_alt_proof : verify[source] unlock_spec_alt. + Proof using MOD HAS_THREADS. + verify_spec. + rewrite locked.unlock. + repeat (go; ework). + Qed. + Lemma mymutex_ctor_proof : verify[source] "MyMutex::MyMutex()". Proof using MOD HAS_THREADS. verify_spec; go. wname [structR] "S". - iMod (own_alloc (● (GSet ∅ : lock_ghostUR))) as (gu) "UT". - { apply auth_auth_valid. done. } - iMod (own_alloc (●E None ⋅ ◯E None)) as (gp) "O". + wname [P] "P". + wname [_ |-> atomic.R _ _ _] "L". + wname [_ |-> thread_idR _ _] "Owner". + iMod (MutexSets.alloc_pool (nroot .@@ "MyMutexPool")) as (gp) "#Pool". + iMod (MutexTokens.alloc) as (gt) "[T GT]". + iMod (own_alloc ((●E None ⋅ ◯E None) : LockState.owner_cmraR)) as (go) "O". { apply excl_auth_valid. } - iDestruct (own_op with "O") as "(OA & OF)". - iMod (cinv_alloc ⊤ lock_namespace - (mutex_inv this (MkGname gu gu gp) P) with "[-S UT]") - as (gi) "(#CI & CO)"; last first. - - iExists (MkGname gu gi gp). - rewrite /IR used_threads.unlock /=. - iModIntro. go $usenamed=true with br_erefl. - - rewrite /mutex_inv owner_token_auth.unlock - owner_token_frac.unlock /=. - iNext. iExists false. iFrame. + iDestruct (own_op with "O") as "[OA OF]". + pose (gs := LockState.MkGname (nroot .@@ "MyMutexPool") gp gt go). + iMod (cinv_alloc_cofinite ∅ ⊤ lock_namespace) as (gi) "(_ & CO & Halloc)". + iMod ("Halloc" $! (mutex_inv this (MkGname gs gi) P) + with "[] [L P Owner OA OF GT]") as "#CI". + { iPureIntro. rewrite /mutex_inv. apply _. } + { iNext. rewrite /mutex_inv /=. iExists false. iFrame "L". + iExists None. rewrite /LockState.owner_tid_auth /LockState.owner_tid_frag /gs /=. + iFrame. rewrite /MutexTokens.token_full. iLeft. iExact "GT". } + iModIntro. iExists (MkGname gs gi). + rewrite /IR _at_sep _at_as_Rep /LockState.token /gs /=. + iFrame "CI". iFrame. Qed. Lemma mymutex_dtor_proof : verify[source] "MyMutex::~MyMutex()". @@ -376,33 +444,30 @@ Module custom_mutex. work. wname [cinv] "#CI". wname [cinv_own] "CO". + wname [LockState.token] "T". iMod (cinv_cancel with "CI CO") as "Inv"; [done..|]. go. iDestruct "Inv" as (b) "(Lock & % & OA & State)". destruct b eqn:Hb. - - iDestruct "State" as (th) "(U & %Eq)". - iDestruct (used_threads_empty_no_not_locked with "[$]") as %[]. - - iDestruct "State" as "(P & Owner & OF)". + - iDestruct "State" as (th) "(Sets & %Eq & Balance)". + iEval (rewrite /LockState.token) in "T". + iDestruct (MutexTokens.token_not_full_full_token with "[$Balance $T]") as %[]. + - iDestruct "State" as "(P & Owner & OF & Balance)". ego $usenamed=true with br_erefl. - wname [used_threads] "UT". - iApply (affine with "[OA OF UT]"); last iAccu. apply mpred_BiAffine. - Qed. + iApply (affine with "[OA OF Balance T]"); last iAccu. apply mpred_BiAffine. + Qed. - Lemma mymutex_lock_proof : verify[source] "MyMutex::lock()". + Lemma mymutex_lock_proof : verify[source] lock_spec. Proof using MOD HAS_THREADS. - verify_spec. - rewrite locked.unlock. - ego. + rewrite lock_spec_entails_lock_spec_alt. + exact mymutex_lock_alt_proof. Qed. - Lemma mymutex_unlock_proof : verify[source] "MyMutex::unlock()". + Lemma mymutex_unlock_proof : verify[source] unlock_spec. Proof using MOD HAS_THREADS. - verify_spec. - rewrite locked.unlock. - (* TODO AUTO *) - Fail by ego. - repeat (go; ework). + rewrite unlock_spec_entails_unlock_spec_alt. + exact mymutex_unlock_alt_proof. Qed. From ec5892b6140d0136f5a25243cde7151d83ff9bcb Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Mon, 7 Sep 2026 08:21:12 +0000 Subject: [PATCH 34/51] refactor mutex specs, std::mutex and custom mutex are both implemntation of the spec module. --- .../proof/mutex/proof/lock_guard.v | 4 +- .../proof/mutex/spec/lock_guard.v | 8 +- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 277 ++++++++++++------ .../proof/mutex/spec/scoped_lock.v | 16 +- .../test/mutex/custom_mutex_hpp_proof.v | 251 +++++++--------- 5 files changed, 318 insertions(+), 238 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/mutex/proof/lock_guard.v b/rocq-brick-libstdcpp/proof/mutex/proof/lock_guard.v index d9540e93..718b9d50 100644 --- a/rocq-brick-libstdcpp/proof/mutex/proof/lock_guard.v +++ b/rocq-brick-libstdcpp/proof/mutex/proof/lock_guard.v @@ -24,7 +24,7 @@ Section with_cpp. Proof. verify_spec. go. - iExists (mutex.locked g (Some thr) qt ** P), qt. + iExists (mutex.locked mp g thr qt ** P), qt. go with br_erefl. by rewrite (left_id_L 1%Qp Qp.mul). Qed. @@ -34,7 +34,7 @@ Section with_cpp. verify_spec. rewrite !R.unlock. go. - iExists (mutex.not_locked g thr qt), qt. + iExists (mutex.not_locked mp g thr qt), qt. go with br_erefl. by rewrite (left_id_L 1%Qp Qp.mul). Qed. diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v b/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v index a9e77ee9..48095ffd 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v @@ -89,20 +89,20 @@ Section with_cpp. \arg{mp} "m" (Vptr mp) \persist{thr} current_thread thr \pre{g q qt P} mp |-> mutex.R g q$m P - \pre mutex.not_locked g thr qt + \pre mutex.not_locked mp g thr qt \post this |-> R (mp, g, q, qt) 1$m P ** - P ** mutex.locked g (Some thr) qt + P ** mutex.locked mp g thr qt ). cpp.spec "std::lock_guard::~lock_guard()" as dtor_spec from source with ( \this this \pre{mp g q qt P} this |-> R (mp, g, q, qt) 1$m P \persist{thr} current_thread thr - \pre mutex.locked g (Some thr) qt + \pre mutex.locked mp g thr qt \pre ▷P \post - mutex.not_locked g thr qt ** + mutex.not_locked mp g thr qt ** mp |-> mutex.R g q$m P ). diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index 67cfba21..233ceabf 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -19,22 +19,168 @@ Import linearity. (* TODO UPSTREAM. *) #[global] Instance SplitRecord_prod A B : SplitRecord (@prod A B) := {}. +Module mutex_spec (State : lock_ghost2.MUTEX_STATE). +Section with_cpp. + Context `{Σ : cpp_logic} {Name : Type}. + Context `{!State.G Σ}. + Context (R : Name -> cQp.t -> mpred -> Rep). + Context (state_name : Name -> State.gname). + Context {HAS_THREADS : HasStdThreads Σ} {Q : Type}. + (** FIXME is there a more modular way to provide not_locked, locked and ghost + names, e.g. make them parameters to the mutex_spec module? *) + Context (not_locked locked : ptr -> Name -> thread_idT -> Q -> mpred). + + (** The guarded predicate must be weakly objective for invariant allocation, + which R likely has. *) + Definition ctor_spec : ptr -> WpSpec mpred val val := + (\this this + \pre{P} ▷P ** [| WeaklyObjective P |] + \post |={⊤}=> Exists g, this |-> R g 1$m P ** State.token (state_name g) 1). + + Definition dtor_spec : ptr -> WpSpec mpred val val := + (\this this + \pre{g P} this |-> R g 1$m P ** State.token (state_name g) 1 + \post P). + + Definition lock_spec_alt : ptr -> WpSpec mpred val val := + (\this this + \prepost{q P g} this |-> R g q P + \persist{thr} current_thread thr + \pre{qt} not_locked this g thr qt + \post P ** locked this g thr qt). + + Definition unlock_spec_alt : ptr -> WpSpec mpred val val := + (\this this + \prepost{q P g} this |-> R g q P + \persist{thr} current_thread thr + \pre{qt} locked this g thr qt + \pre ▷P + \post not_locked this g thr qt). + + Definition try_lock_spec_alt : ptr -> WpSpec mpred val val := + (\this this + \prepost{q P g} this |-> R g q P + \persist{thr} current_thread thr + \pre{qt} not_locked this g thr qt + \post{b}[Vbool b] + if b then P ** locked this g thr qt else not_locked this g thr qt). + + (* TODO readd the later on the lock/unlock continuations. *) + Definition do_lock (this : ptr) (lk : Name * mpred) (K : mpred) : mpred := + ∃ thr qt, current_thread thr ** not_locked this lk.1 thr qt ** + (locked this lk.1 thr qt ** lk.2 -* K). + #[global] Arguments do_lock /. + + Definition do_unlock (this : ptr) (lk : Name * mpred) (K : mpred) : mpred := + ∃ thr qt, current_thread thr ** locked this lk.1 thr qt ** ▷lk.2 ** + (not_locked this lk.1 thr qt -* K). + #[global] Arguments do_unlock /. + + Definition do_try_lock (this : ptr) (lk : Name * mpred) + (K : bool -> mpred) : mpred := + ∃ thr qt, current_thread thr ** not_locked this lk.1 thr qt ** + ∀ b : bool, + (if b then lk.2 ** locked this lk.1 thr qt + else not_locked this lk.1 thr qt) -* K b. + #[global] Arguments do_try_lock /. + + Section equivalences. + Context {σ : genv}. + (* Context (not_locked locked : ptr -> Name -> thread_idT -> Q -> mpred). *) + Context (method_name class_name : globname). + Context {BL : BasicLockable (Tnamed class_name) (fun q gp => R gp.1 q gp.2)}. + + Definition spec_type_void_to_ret := (fun ret => specify {| info_name := method_name; info_type := tMethod class_name QM ret [] |}). + + Local Lemma method_spec_equiv (ret : type) + (Pspec Qspec : ptr -> WpSpec mpred val val) + (Heq : forall this xs K, Pspec this xs K ⊣⊢ Qspec this xs K) : + spec_type_void_to_ret ret Pspec ⊣⊢ spec_type_void_to_ret ret Qspec. + Proof. + iSplit; iApply specify_mono; intros this xs K; rewrite Heq; done. + Qed. + + Lemma lock_spec_entails_lock_spec_alt + (Hlock : requirements.do_lock (Tnamed class_name) = do_lock) : + spec_type_void_to_ret "void" + (lock_basic_lockable (Tnamed class_name) (fun q gp => R gp.1 q gp.2)) ⊣⊢ + spec_type_void_to_ret "void" lock_spec_alt. + Proof. + apply method_spec_equiv. intros this xs K. + unfold lock_basic_lockable. rewrite Hlock. + unfold lock_spec_alt, do_lock. + cbn. iSplit. + - ework with br_erefl. + - iIntros "H". iDestruct "H" as (q P g thr qt) + "(%Hxs & HR & #HT & HNL & HK)". + iExists q, (g, P), (P ** locked this g thr qt)%I. + iFrame "HR HK". iSplit; first done. + iExists thr, qt. iFrame "HT HNL". + iIntros "[HL HP]". iFrame. + Qed. + + Lemma unlock_spec_entails_unlock_spec_alt + (Hunlock : requirements.do_unlock (Tnamed class_name) = do_unlock) : + spec_type_void_to_ret "void" (unlock_basic_lockable (Tnamed class_name) (fun q gp => R gp.1 q gp.2)) ⊣⊢ + spec_type_void_to_ret "void" unlock_spec_alt. + Proof. + apply method_spec_equiv. intros this xs K. + unfold unlock_basic_lockable. rewrite Hunlock. + unfold unlock_spec_alt, do_unlock. + cbn. iSplit. + - ework with br_erefl. + - iIntros "H". iDestruct "H" as (q P g thr qt) + "(%Hxs & HR & #HT & HL & HP & HK)". + iExists q, (g, P), (not_locked this g thr qt). + iFrame "HR HK". iSplit; first done. + iExists thr, qt. iFrame "HT HL HP". + iIntros "$". + Qed. + + Context {L : Lockable (Tnamed class_name) (fun q gp => R gp.1 q gp.2)}. + + Lemma try_lock_spec_entails_try_lock_spec_alt + (Htry_lock : requirements.do_try_lock (Tnamed class_name) = do_try_lock) : + spec_type_void_to_ret "bool" (try_lock_lockable (Tnamed class_name) (fun q gp => R gp.1 q gp.2)) ⊣⊢ + spec_type_void_to_ret "bool" try_lock_spec_alt. + Proof. + apply method_spec_equiv. intros this xs K. + unfold try_lock_lockable. rewrite Htry_lock. + unfold try_lock_spec_alt, do_try_lock. + cbn. iSplit. + - ework with br_erefl. + - iIntros "H". iDestruct "H" as (q P g thr qt) + "(%Hxs & HR & #HT & HNL & HK)". + iExists q, (g, P), (fun b : bool => + if b then (P ** locked this g thr qt)%I else not_locked this g thr qt). + iFrame "HR HK". iSplit; first done. + iExists thr, qt. iFrame "HT HNL". + iIntros (b) "$". + Qed. + End equivalences. +End with_cpp. +End mutex_spec. + + +(** Specialize the reusable specs to the standard mutex representation and + bind them to their C++ names. *) Module Mutex (State : lock_ghost2.MUTEX_STATE). + Module Spec := mutex_spec State. -(** Pair the abstract state with the invariant named by [State.not_locked]. *) -Record gname : Set := MkGname { - lock_state_gname : State.gname; - cinv_gname : iprop.gname; -}. + (** Pair the abstract state with the invariant named by [State.not_locked]. *) + Record gname : Set := MkGname { + lock_state_gname : State.gname; + cinv_gname : iprop.gname; + }. -Definition G := @State.G. -Existing Class G. -#[global] Arguments G {_ _} Σ : assert. -#[global] Instance state_G `{Σ : cpp_logic} (H : G Σ) : State.G Σ := H. + Definition G := @State.G. + Existing Class G. + #[global] Arguments G {_ _} Σ : assert. + #[global] Instance state_G `{Σ : cpp_logic} (H : G Σ) : State.G Σ := H. -Abbreviation token g q:= (State.token g.(lock_state_gname) q). -Abbreviation not_locked g th q := (State.not_locked g.(lock_state_gname) th q g.(cinv_gname)). -Abbreviation locked g o_thr q := (State.locked g.(lock_state_gname) o_thr q). + Abbreviation token := (fun g q => State.token g.(lock_state_gname) q). + Abbreviation not_locked := (fun (_ : ptr) g th q => State.not_locked g.(lock_state_gname) th q g.(cinv_gname)). + Abbreviation locked := (fun (_ : ptr) g thr q => State.locked g.(lock_state_gname) (Some thr) q). Section with_cpp. Context `{Σ : cpp_logic}. @@ -64,102 +210,67 @@ Section with_cpp. Cbn (Learn (req_eq ==> learn_eq ==> req_eq ==> learn_hints.fin) State.locked). Proof. solve_learnable. Qed. - cpp.spec "std::mutex::mutex()" as ctor_spec with ( - \this this - \pre{P} ▷P - \post Exists g, this |-> R g 1$m P ** token g 1). - - cpp.spec "std::mutex::~mutex()" as dtor_spec with ( - \this this - \pre{g P} this |-> R g 1$m P ** token g 1 - \post P). - - (* "Inline" version of these specs. *) - cpp.spec "std::mutex::lock()" as lock_spec_alt with ( - \this this - \prepost{q P g} this |-> R g q P - \persist{thr} current_thread thr - \pre{qt} not_locked g thr qt - \post P ** locked g (Some thr) qt). - - Definition do_lock (lk : gname * mpred) (K: mpred) : mpred := - let g := lk.1 in - let P := lk.2 in - ∃ thr qt, current_thread thr ∗ not_locked g thr qt ∗ - (* TODO readd *) - (* ▷ *) - (locked g (Some thr) qt ** P -* K). - #[global] Arguments do_lock /. + cpp.spec "std::mutex::mutex()" as ctor_spec with + (\exact Reduce (Spec.ctor_spec R lock_state_gname)). - cpp.spec "std::mutex::unlock()" as unlock_spec_alt with ( - \this this - \prepost{q P g} this |-> R g q P - \persist{thr} current_thread thr - \pre{qt} locked g (Some thr) qt - \pre ▷P - \post not_locked g thr qt). - - Definition do_unlock (lk : gname * mpred) (Q : mpred) : mpred := - let g := lk.1 in - let P := lk.2 in - Exists thr qt, current_thread thr ** locked g (Some thr) qt ** ▷P ** - (* TODO readd *) - (* ▷ *) - (not_locked g thr qt -* Q). - #[global] Arguments do_unlock /. + cpp.spec "std::mutex::~mutex()" as dtor_spec with + (\exact Reduce (Spec.dtor_spec R lock_state_gname)). + + cpp.spec "std::mutex::lock()" as lock_spec_alt with + (\exact Reduce (Spec.lock_spec_alt R not_locked locked)). - cpp.spec "std::mutex::try_lock()" as try_lock_spec_alt with ( - \this this - \prepost{q P g} this |-> R g q P - \persist{th} current_thread th - \pre{qt} not_locked g th qt - \post{b}[Vbool b] if b then P ** locked g (Some th) qt else not_locked g th qt). + cpp.spec "std::mutex::unlock()" as unlock_spec_alt with + (\exact Reduce (Spec.unlock_spec_alt R not_locked locked)). - (* Obtain same specs from (Basic)Lockable. *) - (** <> implements [BasicLockable] *) + cpp.spec "std::mutex::try_lock()" as try_lock_spec_alt with + (\exact Reduce (Spec.try_lock_spec_alt R not_locked locked)). + + Definition do_lock := Spec.do_lock not_locked locked. + #[global] Arguments do_lock /. + Definition do_unlock := Spec.do_unlock not_locked locked. + #[global] Arguments do_unlock /. + Definition do_try_lock := Spec.do_try_lock not_locked locked. + #[global] Arguments do_try_lock /. + + (** <> implements [BasicLockable] and [Lockable]. *) Definition T : Type := gname * mpred. - #[global] Instance mutex_basic_lockable : BasicLockable (T:=T) "std::mutex" (λ q γP, R γP.1 q γP.2) := - { do_lock := fun this => do_lock - ; do_unlock := fun this => do_unlock }. + #[global] Instance mutex_basic_lockable : + BasicLockable (T:=T) "std::mutex" (λ q γP, R γP.1 q γP.2) := + { do_lock := do_lock + ; do_unlock := do_unlock }. cpp.spec "std::mutex::lock()" as lock_spec with - (\exact Reduce (lock_basic_lockable "std::mutex" (λ q γP, R γP.1 q γP.2))). + (\exact Reduce (lock_basic_lockable "std::mutex" (λ q γP, R γP.1 q γP.2))). cpp.spec "std::mutex::unlock()" as unlock_spec with - (\exact Reduce (unlock_basic_lockable "std::mutex" (λ q γP, R γP.1 q γP.2))). - - Definition do_try_lock (lk : gname * mpred) (Q : bool -> mpred) : mpred := - let g := lk.1 in - let P := lk.2 in - ∃ thr qt, current_thread thr ∗ not_locked g thr qt ∗ - ∀ b : bool, - (if b then P ** locked g (Some thr) qt else not_locked g thr qt) -∗ Q b. - #[global] Arguments do_try_lock /. + (\exact Reduce (unlock_basic_lockable "std::mutex" (λ q γP, R γP.1 q γP.2))). - #[global,program] Instance mutex_lockable : Lockable (T:=T) "std::mutex" (λ q γP, R γP.1 q γP.2) := - { do_try_lock := fun this => do_try_lock }. + #[global] Instance mutex_lockable : + Lockable (T:=T) "std::mutex" (λ q γP, R γP.1 q γP.2) := + { do_try_lock := do_try_lock }. cpp.spec "std::mutex::try_lock()" as try_lock_spec with - (\exact Reduce (try_lock_lockable "std::mutex" (λ q γP, R γP.1 q γP.2))). + (\exact Reduce (try_lock_lockable "std::mutex" (λ q γP, R γP.1 q γP.2))). Lemma lock_spec_entails_lock_spec_alt : lock_spec -|- lock_spec_alt. Proof. - iSplit; iApply specify_mono; ework with br_erefl. + apply (Spec.lock_spec_entails_lock_spec_alt R not_locked locked). + reflexivity. Qed. Lemma unlock_spec_entails_unlock_spec_alt : unlock_spec -|- unlock_spec_alt. Proof. - iSplit; iApply specify_mono; ework with br_erefl. + apply (Spec.unlock_spec_entails_unlock_spec_alt R not_locked locked). + reflexivity. Qed. Lemma try_lock_spec_entails_try_lock_spec_alt : try_lock_spec -|- try_lock_spec_alt. Proof. - iSplit; iApply specify_mono; ework with br_erefl. + apply (Spec.try_lock_spec_entails_try_lock_spec_alt R not_locked locked). + reflexivity. Qed. End with_cpp. End Mutex. -(** The standard instantiation. Clients that need another camera package can - instantiate [Mutex] with any implementation of [MUTEX_STATE]. *) Module mutex := Mutex lock_ghost2.LockState. diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v b/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v index 655d4804..9a317ffa 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v @@ -29,14 +29,14 @@ Module scoped_lock. \persist{thr} current_thread thr \arg{mp1} "" (Vptr mp1) \pre{g1 q1 qt1 P1} mp1 |-> mutex.R g1 q1$m P1 - \pre mutex.not_locked g1 thr qt1 + \pre mutex.not_locked mp1 g1 thr qt1 \arg{mp2} "" (Vptr mp2) \pre{g2 q2 qt2 P2} mp2 |-> mutex.R g2 q2$m P2 - \pre mutex.not_locked g2 thr qt2 + \pre mutex.not_locked mp2 g2 thr qt2 \post this |-> R 1$m [ (mp1, g1, q1, qt1, P1); (mp2, g2, q2, qt2, P2)] ** - P1 ** mutex.locked g1 (Some thr) qt1 ** - P2 ** mutex.locked g2 (Some thr) qt2 + P1 ** mutex.locked mp1 g1 thr qt1 ** + P2 ** mutex.locked mp2 g2 thr qt2 ). cpp.spec "std::scoped_lock<...>::~scoped_lock()" @@ -51,11 +51,11 @@ Module scoped_lock. this |-> R 1$m [ (mp1, g1, q1, qt1, P1); (mp2, g2, q2, qt2, P2)] \pre |> P1 \pre |> P2 - \pre mutex.locked g1 (Some thr) qt1 - \pre mutex.locked g2 (Some thr) qt2 + \pre mutex.locked mp1 g1 thr qt1 + \pre mutex.locked mp2 g2 thr qt2 \post - mp1 |-> mutex.R g1 q1$m P1 ** mutex.not_locked g1 thr qt1 ** - mp2 |-> mutex.R g2 q2$m P2 ** mutex.not_locked g2 thr qt2 + mp1 |-> mutex.R g1 q1$m P1 ** mutex.not_locked mp1 g1 thr qt1 ** + mp2 |-> mutex.R g2 q2$m P2 ** mutex.not_locked mp2 g2 thr qt2 ). End with_threads. End with_cpp. diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index 5bc5f864..bed55301 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -12,11 +12,13 @@ Require Import skylabs.brick.libstdcpp.atomic.spec. Require Import skylabs.brick.libstdcpp.cassert.spec. Import linearity. Require Import skylabs.brick.libstdcpp.test.mutex.custom_mutex_hpp. + Module custom_mutex. + Module Spec := mutex_spec LockState. + Abbreviation N := "MyMutex"%cpp_name. - (* FIXME maybe don't need to split it? *) Parameter thread_idR : ∀ `{Σ : cpp_logic, σ : genv}, cQp.t -> (* None if value is thread::id(), Some otherwise *) option thread_idT -> Rep. @@ -32,6 +34,59 @@ Module custom_mutex. WeaklyObjective (p |-> R). Proof. rewrite INTERNAL._at_eq. apply _. Qed. + (* thread::id operations and yield() are not proved for now. *) + Section unproved_specs. + Context `{Σ : cpp_logic, σ : genv, HAS_THREADS : !HasStdThreads Σ}. + Context `{MOD : source ⊧ σ}. + + cpp.spec (default_ctor "std::thread::id") as thread_id_ctor_spec with ( + \this this + \post this |-> thread_idR 1$m None). + + cpp.spec (const_copy_ctor "std::thread::id") as thread_id_copy_ctor_spec with ( + \this this + \arg{other} "" (Vptr other) + \prepost{q o} other |-> thread_idR q o + \post this |-> thread_idR 1$m o). + + cpp.spec (dtor "std::thread::id") as thread_id_dtor_spec with ( + \this this + \pre{o} this |-> thread_idR 1$m o + \post emp). + + cpp.spec "std::thread::id::operator=(const std::thread::id&)" + as thread_id_copy_assign_spec with ( + \this this + \arg{other} "" (Vptr other) + \pre{old} this |-> thread_idR 1$m old + \prepost{q o} other |-> thread_idR q o + \post[Vref this] this |-> thread_idR 1$m o). + + cpp.spec "std::thread::id::operator=(std::thread::id&&)" + as thread_id_move_assign_spec with ( + \this this + \arg{other} "" (Vptr other) + \pre{old} this |-> thread_idR 1$m old + \prepost{o} other |-> thread_idR 1$m o + \post[Vref this] this |-> thread_idR 1$m o). + + cpp.spec "std::operator==(std::thread::id, std::thread::id)" + as thread_id_eq_spec with ( + \arg{lhs} "" (Vptr lhs) + \arg{rhs} "" (Vptr rhs) + \prepost{q1 o1} lhs |-> thread_idR q1 o1 + \prepost{q2 o2} rhs |-> thread_idR q2 o2 + \post[Vbool (bool_decide (o1 = o2))] emp). + + cpp.spec "std::this_thread::get_id()" as get_id_spec with ( + \persist{thr} current_thread thr + \post{result}[Vptr result] + result |-> thread_idR 1$m (Some thr)). + + cpp.spec "std::this_thread::yield()" as yield_spec with ( + \post emp). + End unproved_specs. + Record gname : Set := MkGname { lock_state_gname : LockState.gname ; cinv_gname : iprop.gname @@ -40,11 +95,11 @@ Module custom_mutex. Definition lock_namespace : namespace := nroot .@@ "MyMutex". sl.lock - Definition locked `{Σ : cpp_logic} `{!LockState.G Σ} `{σ : genv} + Definition lockedR `{Σ : cpp_logic} `{!LockState.G Σ} `{σ : genv} (γ: gname) (thr : thread_idT) (q : cQp.t) : Rep := _field "MyMutex::m_owner" |-> thread_idR 1$m (Some thr) ** pureR (LockState.locked γ.(lock_state_gname) (Some thr) q%Qp). - #[global] Hint Opaque locked : sl_opacity typeclass_instances. - #[only(timeless, exclusive)] derive locked. + #[global] Hint Opaque lockedR : sl_opacity typeclass_instances. + #[only(timeless, exclusive)] derive lockedR. Section with_Σ. Context `{Σ : cpp_logic, σ : genv, HAS_THREADS : !HasStdThreads Σ, @@ -89,100 +144,49 @@ Module custom_mutex. primR "enum std::memory_order" q (memory_order.to_val memory_order.seq_cst)). - cpp.spec (default_ctor "std::thread::id") as thread_id_ctor_spec with ( - \this this - \post this |-> thread_idR 1$m None). + Abbreviation token := (fun g q => LockState.token g.(lock_state_gname) q). - cpp.spec (const_copy_ctor "std::thread::id") as thread_id_copy_ctor_spec with ( - \this this - \arg{other} "" (Vptr other) - \prepost{q o} other |-> thread_idR q o - \post this |-> thread_idR 1$m o). - - cpp.spec (dtor "std::thread::id") as thread_id_dtor_spec with ( - \this this - \pre{o} this |-> thread_idR 1$m o - \post emp). + cpp.spec "MyMutex::MyMutex()" as ctor_spec with + (\exact Reduce (Spec.ctor_spec IR lock_state_gname)). - cpp.spec "std::thread::id::operator=(const std::thread::id&)" - as thread_id_copy_assign_spec with ( - \this this - \arg{other} "" (Vptr other) - \pre{old} this |-> thread_idR 1$m old - \prepost{q o} other |-> thread_idR q o - \post[Vref this] this |-> thread_idR 1$m o). - - cpp.spec "std::thread::id::operator=(std::thread::id&&)" - as thread_id_move_assign_spec with ( - \this this - \arg{other} "" (Vptr other) - \pre{old} this |-> thread_idR 1$m old - \prepost{o} other |-> thread_idR 1$m o - \post[Vref this] this |-> thread_idR 1$m o). - - cpp.spec "std::operator==(std::thread::id, std::thread::id)" - as thread_id_eq_spec with ( - \arg{lhs} "" (Vptr lhs) - \arg{rhs} "" (Vptr rhs) - \prepost{q1 o1} lhs |-> thread_idR q1 o1 - \prepost{q2 o2} rhs |-> thread_idR q2 o2 - \post[Vbool (bool_decide (o1 = o2))] emp). - - cpp.spec "std::this_thread::get_id()" as get_id_spec with ( - \persist{thr} current_thread thr - \post{result}[Vptr result] - result |-> thread_idR 1$m (Some thr)). - - cpp.spec "MyMutex::MyMutex()" as ctor_spec with ( - \this this - \pre{P} ▷P - \require WeaklyObjective P - \post (|={⊤}=> Exists g, - this |-> IR g 1$m P ** LockState.token g.(lock_state_gname) 1%Qp)). - - cpp.spec "MyMutex::~MyMutex()" as dtor_spec with ( - \this this - \pre{g P} this |-> IR g 1$m P ** LockState.token g.(lock_state_gname) 1%Qp - \post P). - - cpp.spec "MyMutex::do_lock()" as do_lock_spec with ( - \this this - \prepost{g q P} this |-> IR g q P - \persist{thr} current_thread thr - \pre LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname) - \prepost{q'} GLOBALS q' - (* does not have to be q, but easier if it is *) - \post (P ** - this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** - LockState.locked g.(lock_state_gname) (Some thr) q)). - - cpp.spec "MyMutex::do_unlock()" as do_unlock_spec with ( - \this this - \prepost{g q P} this |-> IR g q P - \persist{thr} current_thread thr - \pre ▷P - \pre this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None - \pre LockState.locked g.(lock_state_gname) (Some thr) q - \post LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname)). + cpp.spec "MyMutex::~MyMutex()" as dtor_spec with + (\exact Reduce (Spec.dtor_spec IR lock_state_gname)). + (** Keep the representation fraction in the state, since this implementation + uses the same fraction for [IR] and the locking tokens. *) Definition T : Type := gname * cQp.t * mpred. - - Definition do_lock (this : ptr) (lk : T) (K : mpred) : mpred := - let g := lk.1.1 in - let q := lk.1.2 in - let P := lk.2 in - ∃ thr q', current_thread thr ** - LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname) ** - GLOBALS q' ** - (GLOBALS q' ** P ** this |-> locked g thr q -* K). + Abbreviation mutexR := (fun (gq : gname * cQp.t) (_ : cQp.t) P => + IR gq.1 gq.2 P). + (* the raw assertions are used for the internal do_lock() and do_unlock() *) + Abbreviation not_locked_raw := + (fun (_ : ptr) (gq : gname * cQp.t) thr (_ : unit) => + LockState.not_locked gq.1.(lock_state_gname) thr gq.2 gq.1.(cinv_gname)). + Abbreviation locked_raw := + (fun (this : ptr) (gq : gname * cQp.t) thr (_ : unit) => + (this |-> lockedR gq.1 thr gq.2)%I). + + (** Locking additionally preserves the globals used by the spin loop. *) + Abbreviation not_locked := (fun this gq thr q' => + (not_locked_raw this gq thr tt ** GLOBALS q')%I). + Abbreviation locked := (fun this gq thr q' => + (GLOBALS q' ** locked_raw this gq thr tt)%I). + + Abbreviation raw_locked_raw := + (fun (this : ptr) (gq : gname * cQp.t) thr (_ : unit) => + (this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** + LockState.locked gq.1.(lock_state_gname) (Some thr) gq.2)%I). + Abbreviation raw_locked := (fun this gq thr q' => + (GLOBALS q' ** raw_locked_raw this gq thr tt)%I). + + cpp.spec "MyMutex::do_lock()" as do_lock_spec with + (\exact Reduce (Spec.lock_spec_alt mutexR not_locked raw_locked)). + + cpp.spec "MyMutex::do_unlock()" as do_unlock_spec with + (\exact Reduce (Spec.unlock_spec_alt mutexR not_locked_raw raw_locked_raw)). + + Definition do_lock := Spec.do_lock not_locked locked. #[global] Arguments do_lock /. - - Definition do_unlock (this : ptr) (lk : T) (K : mpred) : mpred := - let g := lk.1.1 in - let q := lk.1.2 in - let P := lk.2 in - ∃ thr , current_thread thr ** this |-> locked g thr q ** ▷P ** - (LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname) -* K). + Definition do_unlock := Spec.do_unlock not_locked_raw locked_raw. #[global] Arguments do_unlock /. #[global] Instance custom_mutex_basic_lockable : @@ -191,20 +195,11 @@ Module custom_mutex. { do_lock := do_lock ; do_unlock := do_unlock }. - cpp.spec "MyMutex::lock()" as lock_spec_alt with ( - \this this - \prepost{g q P} this |-> IR g q P - \persist{thr} current_thread thr - \pre LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname) - \prepost{q'} GLOBALS q' - \post P ** this |-> locked g thr q). + cpp.spec "MyMutex::lock()" as lock_spec_alt with + (\exact Reduce (Spec.lock_spec_alt mutexR not_locked locked)). - cpp.spec "MyMutex::unlock()" as unlock_spec_alt with ( - \this this - \prepost{g q P} this |-> IR g q P - \persist{thr} current_thread thr - \pre this |-> locked g thr q ** ▷P - \post LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname)). + cpp.spec "MyMutex::unlock()" as unlock_spec_alt with + (\exact Reduce (Spec.unlock_spec_alt mutexR not_locked_raw locked_raw)). cpp.spec "MyMutex::lock()" as lock_spec with (\exact Reduce @@ -214,35 +209,6 @@ Module custom_mutex. (\exact Reduce (unlock_basic_lockable (Tnamed N) (fun q gqP => IR gqP.1.1 gqP.1.2 gqP.2))). - Lemma lock_spec_entails_lock_spec_alt : lock_spec -|- lock_spec_alt. - Proof. - iSplit; iApply specify_mono; ework with br_erefl. - lazymatch goal with - | |- environments.envs_entails _ ?Ggoal => - lazymatch Ggoal with - | context[IR ?gqP.1.1 ?gqP.1.2 ?gqP.2] => unify gqP (g, q, P) - end - end. - ework with br_erefl. - Unshelve. all: exact (1$m)%cQp. - Qed. - - Lemma unlock_spec_entails_unlock_spec_alt : unlock_spec -|- unlock_spec_alt. - Proof. - iSplit; iApply specify_mono; ework with br_erefl. - lazymatch goal with - | |- environments.envs_entails _ ?Ggoal => - lazymatch Ggoal with - | context[IR ?gqP.1.1 ?gqP.1.2 ?gqP.2] => unify gqP (g, q, P) - end - end. - ework with br_erefl. - Unshelve. all: exact (1$m)%cQp. - Qed. - - cpp.spec "std::this_thread::yield()" as yield_spec with ( - \post emp). - Abbreviation BASE p := (p ,, _base "std::atomic" "std::__atomic_base"). Definition bi_later_exist_F := [FWD] @bi.later_exist. @@ -384,7 +350,7 @@ Module custom_mutex. Qed. Hint Resolve do_load_C : sl_opacity. - Hint Opaque locked : sl_opacity. + Hint Opaque lockedR : sl_opacity. Lemma mymutex_do_lock_proof : verify[source] "MyMutex::do_lock()". Proof using MOD HAS_THREADS. @@ -401,15 +367,17 @@ Module custom_mutex. Lemma mymutex_lock_alt_proof : verify[source] lock_spec_alt. Proof using MOD HAS_THREADS. verify_spec; ego. - rewrite locked.unlock. + rewrite lockedR.unlock. ego. + Unshelve. all: first [exact (1$m)%cQp | exact tt]. Qed. Lemma mymutex_unlock_alt_proof : verify[source] unlock_spec_alt. Proof using MOD HAS_THREADS. verify_spec. - rewrite locked.unlock. + rewrite lockedR.unlock. repeat (go; ework). + Unshelve. all: first [exact (1$m)%cQp | exact tt]. Qed. Lemma mymutex_ctor_proof : verify[source] "MyMutex::MyMutex()". @@ -460,16 +428,17 @@ Module custom_mutex. Lemma mymutex_lock_proof : verify[source] lock_spec. Proof using MOD HAS_THREADS. - rewrite lock_spec_entails_lock_spec_alt. + have -> : lock_spec ⊣⊢ lock_spec_alt. + { apply (Spec.lock_spec_entails_lock_spec_alt mutexR not_locked locked). done. } exact mymutex_lock_alt_proof. Qed. Lemma mymutex_unlock_proof : verify[source] unlock_spec. Proof using MOD HAS_THREADS. - rewrite unlock_spec_entails_unlock_spec_alt. + have -> : unlock_spec ⊣⊢ unlock_spec_alt. + { apply (Spec.unlock_spec_entails_unlock_spec_alt mutexR not_locked_raw locked_raw). done. } exact mymutex_unlock_alt_proof. Qed. - End with_Σ. End custom_mutex. From 1c16450a45fa79304c8b26e7396b837087ae46f5 Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Wed, 9 Sep 2026 02:46:56 +0000 Subject: [PATCH 35/51] better model for my_mutex, all properties described in MUTEX_SETS --- rocq-brick-libstdcpp/proof/lib/lock_ghost2.v | 506 ++++++++++++------- 1 file changed, 334 insertions(+), 172 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v b/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v index 9e299025..bd34f839 100644 --- a/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v +++ b/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v @@ -1,5 +1,6 @@ Require Import iris.algebra.agree. Require Import iris.algebra.frac. +Require Import iris.algebra.functions. Require Import iris.algebra.gmap. Require Import iris.algebra.gset. Require Import iris.algebra.lib.excl_auth. @@ -10,9 +11,6 @@ Require Export skylabs.brick.libstdcpp.runtime.pred. Import linearity. -(** The mutex specification depends on the ghost state through these - interfaces. *) - Module Type MUTEX_SETS. Parameter cmraR : cmra. @@ -23,9 +21,65 @@ Module Type MUTEX_SETS. }. #[global] Arguments G {_ _} Σ : assert. - Parameter my_mutexes : forall `{Σ : cpp_logic, !G Σ}, - namespace -> iprop.gname -> thread_idT -> gset iprop.gname -> mpred. - + (** All predicates use the same ghost name [γ], with [th] selecting an + entry. [mutex_set_map γ T] retains the authorities for thread IDs + outside the allocated set [T]. *) + Parameter mutex_set_map : forall `{Σ : cpp_logic, !G Σ}, + iprop.gname -> gset thread_idT -> mpred. + Parameter mutex_set_frag : forall `{Σ : cpp_logic, !G Σ}, + iprop.gname -> thread_idT -> gset_disj iprop.gname -> mpred. + Parameter mutex_set_auth : forall `{Σ : cpp_logic, !G Σ}, + iprop.gname -> thread_idT -> gset_disj iprop.gname -> mpred. + + (** [sa] records mutexes seen by this thread; [sf] contains its available + mutex fragments, which move to lock invariants while locks are held. *) + Definition my_mutexes `{Σ : cpp_logic, !G Σ} γ th sa sf : mpred := + mutex_set_auth γ th sa ** mutex_set_frag γ th sf. + + #[global] Declare Instance mutex_set_map_timeless + `{Σ : cpp_logic, !G Σ} γ M : Timeless (mutex_set_map γ M). + #[global] Declare Instance mutex_set_frag_timeless + `{Σ : cpp_logic, !G Σ} γ th s : Timeless (mutex_set_frag γ th s). + #[global] Declare Instance mutex_set_auth_timeless + `{Σ : cpp_logic, !G Σ} γ th s : Timeless (mutex_set_auth γ th s). + #[global] Declare Instance my_mutexes_timeless + `{Σ : cpp_logic, !G Σ} γ th sa sf : Timeless (my_mutexes γ th sa sf). + + #[global] Declare Instance mutex_set_map_WeaklyObjective + `{Σ : cpp_logic, !G Σ} γ M : WeaklyObjective (mutex_set_map γ M). + #[global] Declare Instance mutex_set_frag_WeaklyObjective + `{Σ : cpp_logic, !G Σ} γ th s : WeaklyObjective (mutex_set_frag γ th s). + #[global] Declare Instance mutex_set_auth_WeaklyObjective + `{Σ : cpp_logic, !G Σ} γ th s : WeaklyObjective (mutex_set_auth γ th s). + #[global] Declare Instance my_mutexes_WeaklyObjective + `{Σ : cpp_logic, !G Σ} γ th sa sf : WeaklyObjective (my_mutexes γ th sa sf). + + Parameter mutex_set_frag_exclusive : forall `{Σ : cpp_logic, !G Σ} γ th γm, + mutex_set_frag γ th (GSet {[γm]}) ** mutex_set_frag γ th (GSet {[γm]}) |-- False. + Parameter alloc_mutex_set_map : forall `{Σ : cpp_logic, !G Σ}, + ⊢ |==> ∃ γ, mutex_set_map γ ∅. + Parameter mutex_sets_alloc_thread : forall `{Σ : cpp_logic, !G Σ} γ T th, + th ∉ T -> + mutex_set_map γ T |-- + (|==> mutex_set_map γ (T ∪ {[th]}) ** + my_mutexes γ th (GSet ∅) (GSet ∅)). + Parameter my_mutexes_alloc_mutex_name : forall `{Σ : cpp_logic, !G Σ} γ th sa sf γm, + γm ∉ sa -> + my_mutexes γ th (GSet sa) sf |-- + (|==> my_mutexes γ th (GSet (sa ∪ {[γm]})) sf ** + mutex_set_frag γ th (GSet {[γm]})). + + (** Distinct threads can own arbitrary, possibly overlapping mutex sets. + The registry and both authoritative sets are retained as the remainder. *) + Parameter mutex_set_frags_alloc : forall `{Σ : cpp_logic, !G Σ} + (th1 th2 : thread_idT) (s1 s2 : gset iprop.gname), + th1 ≠ th2 -> + ⊢ |==> ∃ γ, + mutex_set_frag γ th1 (GSet s1) ** + mutex_set_frag γ th2 (GSet s2) ** + (mutex_set_map γ {[th1; th2]} ** + mutex_set_auth γ th1 (GSet s1) ** + mutex_set_auth γ th2 (GSet s2)). End MUTEX_SETS. Module Type MUTEX_TOKENS. @@ -52,38 +106,36 @@ Module Type MUTEX_TOKENS. #[global] Declare Instance given_token_timeless `{Σ : cpp_logic, !G Σ} γ q : Timeless (given_token γ q). + Parameter token_full token_not_full : forall `{Σ : cpp_logic, !G Σ}, + iprop.gname -> mpred. + #[global] Declare Instance token_full_WeaklyObjective + `{Σ : cpp_logic, !G Σ} γ : WeaklyObjective (token_full γ). + #[global] Declare Instance token_not_full_WeaklyObjective + `{Σ : cpp_logic, !G Σ} γ : WeaklyObjective (token_not_full γ). + + Parameter token_full_init : forall `{Σ : cpp_logic, !G Σ} γ, + given_token γ 1 |-- token_full γ. + Parameter acquire : forall `{Σ : cpp_logic, !G Σ} γ q, + token_full γ ** token γ q |-- given_token γ q ** token_not_full γ. + Parameter release : forall `{Σ : cpp_logic, !G Σ} γ q, + token_not_full γ ** given_token γ q |-- token γ q ** token_full γ. + Parameter token_not_full_full_token : forall `{Σ : cpp_logic, !G Σ} γ, + token_not_full γ ** token γ 1 |-- False. + Parameter alloc : forall `{Σ : cpp_logic, !G Σ}, ⊢ |==> ∃ γ, token γ 1 ** given_token γ 1. End MUTEX_TOKENS. Module Type MUTEX_STATE. - Declare Module Sets : MUTEX_SETS. - Declare Module Tokens : MUTEX_TOKENS. - Parameter owner_cmraR : cmra. - Parameter gname : Set. + Parameter (pool_name : gname -> iprop.gname). - Class G `{Σ : cpp_logic} := { - #[global] sets_G :: Sets.G Σ; - #[global] tokens_G :: Tokens.G Σ; - #[local] has_owner :: HasOwn (iPropI _Σ) owner_cmraR; - #[local] has_owner_upd :: HasOwnUpd (iPropI _Σ) owner_cmraR; - #[local] has_owner_valid :: HasOwnValid (iPropI _Σ) owner_cmraR; - }. + Parameter G : forall `{Σ : cpp_logic}, Type. + Existing Class G. #[global] Arguments G {_ _} Σ : assert. - Parameter owner_tid_auth : forall `{Σ : cpp_logic, !G Σ}, - gname -> option thread_idT -> mpred. - Parameter owner_tid_frag : forall `{Σ : cpp_logic, !G Σ}, - gname -> option thread_idT -> mpred. - - #[global] Declare Instance owner_tid_auth_timeless - `{Σ : cpp_logic, !G Σ} γ o_thr : Timeless (owner_tid_auth γ o_thr). - #[global] Declare Instance owner_tid_frag_timeless - `{Σ : cpp_logic, !G Σ} γ o_thr : Timeless (owner_tid_frag γ o_thr). - #[global] Declare Instance owner_tid_frag_exclusive - `{Σ : cpp_logic, !G Σ} γ : Exclusive1 (owner_tid_frag γ). - + (** Client resources. [not_locked] permits this thread to attempt acquisition; + [locked] records ownership after successful acquisition. *) Parameter token : forall `{Σ : cpp_logic, !G Σ}, gname -> Qp -> mpred. Parameter not_locked : forall `{Σ : cpp_logic, !G Σ}, @@ -91,6 +143,15 @@ Module Type MUTEX_STATE. Parameter locked : forall `{Σ : cpp_logic, !G Σ}, gname -> option thread_idT -> Qp -> mpred. + (** The ghost resources kept inside the mutex invariant. The boolean agrees + with the physical lock bit; the invariant name connects acquisitions to + the same mutex. Its representation is private to the implementation. *) + Parameter state : forall `{Σ : cpp_logic, !G Σ}, + gname -> iprop.gname -> bool -> mpred. + #[global] Declare Instance state_WeaklyObjective + `{Σ : cpp_logic, !G Σ} γ inv_gname b : + WeaklyObjective (state γ inv_gname b). + #[global] Declare Instance token_fractional `{Σ : cpp_logic, !G Σ} γ : Fractional (token γ). #[global] Declare Instance token_timeless @@ -99,13 +160,33 @@ Module Type MUTEX_STATE. `{Σ : cpp_logic, !G Σ} γ th q : Timeless (locked γ th q). #[global] Declare Instance locked_exclusive `{Σ : cpp_logic, !G Σ} γ q : Exclusive1 (fun th => locked γ th q). -End MUTEX_STATE. -(** ** Exact per-thread mutex sets *) + (** Each mutex uses the caller's shared mutex-set pool. *) + Parameter alloc : forall `{Σ : cpp_logic, !G Σ} (γpool : iprop.gname) inv_gname, + ⊢ |==> ∃ γ, [| pool_name γ = γpool |] ** + token γ 1 ** state γ inv_gname false. + + (** Successful acquisition and release exchange client resources with the + invariant. Failed acquisition leaves both resources unchanged. *) + Parameter do_lock : forall `{Σ : cpp_logic, !G Σ} γ inv_gname th q, + state γ inv_gname false ** not_locked γ th q inv_gname |-- + (|==> state γ inv_gname true ** locked γ (Some th) q). + Parameter do_unlock : forall `{Σ : cpp_logic, !G Σ} γ inv_gname th q, + state γ inv_gname true ** locked γ (Some th) q |-- + (|==> state γ inv_gname false ** not_locked γ th q inv_gname). + + (** Ownership rules out an unlocked physical state. Full destruction + permission rules out a locked physical state. *) + Parameter unlocked_locked : forall `{Σ : cpp_logic, !G Σ} γ inv_gname th q, + state γ inv_gname false ** locked γ th q |-- False. + Parameter locked_full_token : forall `{Σ : cpp_logic, !G Σ} γ inv_gname, + state γ inv_gname true ** token γ 1 |-- False. +End MUTEX_STATE. -Module MutexSets. +Module MutexSets : MUTEX_SETS. + Canonical Structure threadR := authUR (gset_disjR iprop.gname). Canonical Structure cmraR : cmra := - gmap_viewR thread_idT (agreeR (leibnizO (gset iprop.gname))). + discrete_funUR (fun _ : thread_idT => threadR). Class G `{Σ : cpp_logic} := { #[local] has_own :: HasOwn (iPropI _Σ) cmraR; @@ -114,160 +195,160 @@ Module MutexSets. }. #[global] Arguments G {_ _} Σ : assert. - Definition mutex_sets_view - (M : gmap thread_idT (gset iprop.gname)) : - gmap thread_idT (agree (leibnizO (gset iprop.gname))) := - (λ X : gset iprop.gname, to_agree X) <$> M. - - sl.lock - Definition mutex_sets_auth `{Σ : cpp_logic, !G Σ} - (γpool : iprop.gname) - (M : gmap thread_idT (gset iprop.gname)) : mpred := - own γpool (gmap_view_auth (DfracOwn 1) (mutex_sets_view M)). - - sl.lock - Definition mutex_sets_frag `{Σ : cpp_logic, !G Σ} - (γpool : iprop.gname) (th : thread_idT) - (M : gset iprop.gname) : mpred := - own γpool - (gmap_view_frag - (V := agreeR (leibnizO (gset iprop.gname))) - th (DfracOwn 1) (to_agree M)). - - sl.lock - Definition my_mutexes_inv `{Σ : cpp_logic, !G Σ} - (γpool : iprop.gname) : mpred := - ∃ M : gmap thread_idT (gset iprop.gname), mutex_sets_auth γpool M. - - Definition my_mutexes `{Σ : cpp_logic, !G Σ} - (N : namespace) (γpool : iprop.gname) (th : thread_idT) - (M : gset iprop.gname) : mpred := - inv N (my_mutexes_inv γpool) ** mutex_sets_frag γpool th M. - - #[only(timeless)] derive mutex_sets_auth. - #[only(timeless)] derive mutex_sets_frag. - #[only(timeless)] derive my_mutexes_inv. - - #[global] Instance my_mutexes_inv_WeaklyObjective - `{Σ : cpp_logic, !G Σ} γpool : - WeaklyObjective (my_mutexes_inv γpool). - Proof. - rewrite my_mutexes_inv.unlock mutex_sets_auth.unlock. apply _. - Qed. - - #[global] Instance my_mutexes_WeaklyObjective `{Σ : cpp_logic, !G Σ} N γ th M : - WeaklyObjective (my_mutexes N γ th M). - Proof. rewrite /my_mutexes mutex_sets_frag.unlock. apply _. Qed. - #[global] Hint Opaque my_mutexes : sl_opacity typeclass_instances. + Definition mutex_set_auth `{Σ : cpp_logic, !G Σ} + (γ : iprop.gname) (th : thread_idT) (s : gset_disj iprop.gname) : mpred := + own γ (discrete_fun_singleton th (● s) : cmraR). + + Definition mutex_set_frag `{Σ : cpp_logic, !G Σ} + (γ : iprop.gname) (th : thread_idT) (s : gset_disj iprop.gname) : mpred := + own γ (discrete_fun_singleton th (◯ s) : cmraR). + + Definition my_mutexes `{Σ : cpp_logic, !G Σ} γ th sa sf : mpred := + mutex_set_auth γ th sa ** mutex_set_frag γ th sf. + + Definition reserve (M : gset thread_idT) : cmraR := + fun th => if decide (th ∈ M) then ε else ● (GSet ∅). + + Definition mutex_set_map `{Σ : cpp_logic, !G Σ} + (γ : iprop.gname) (M : gset thread_idT) : mpred := + own γ (reserve M). + + #[global] Instance mutex_set_map_timeless `{Σ : cpp_logic, !G Σ} γ M : + Timeless (mutex_set_map γ M). + Proof. rewrite /mutex_set_map. apply _. Qed. + #[global] Instance mutex_set_frag_timeless `{Σ : cpp_logic, !G Σ} γ th s : + Timeless (mutex_set_frag γ th s). + Proof. rewrite /mutex_set_frag. apply _. Qed. + #[global] Instance mutex_set_auth_timeless `{Σ : cpp_logic, !G Σ} γ th s : + Timeless (mutex_set_auth γ th s). + Proof. rewrite /mutex_set_auth. apply _. Qed. + #[global] Instance my_mutexes_timeless `{Σ : cpp_logic, !G Σ} γ th sa sf : + Timeless (my_mutexes γ th sa sf). + Proof. rewrite /my_mutexes. apply _. Qed. + + #[global] Instance mutex_set_map_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ M : + WeaklyObjective (mutex_set_map γ M). + Proof. rewrite /mutex_set_map. apply _. Qed. + #[global] Instance mutex_set_frag_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ th s : + WeaklyObjective (mutex_set_frag γ th s). + Proof. rewrite /mutex_set_frag. apply _. Qed. + #[global] Instance mutex_set_auth_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ th s : + WeaklyObjective (mutex_set_auth γ th s). + Proof. rewrite /mutex_set_auth. apply _. Qed. + #[global] Instance my_mutexes_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ th sa sf : + WeaklyObjective (my_mutexes γ th sa sf). + Proof. rewrite /my_mutexes. apply _. Qed. Section theory. Context `{Σ : cpp_logic, !G Σ}. - Lemma alloc_pool N : - ⊢ |={⊤}=> ∃ γpool, inv N (my_mutexes_inv γpool). + Lemma mutex_set_frag_exclusive γ th γm : + mutex_set_frag γ th (GSet {[γm]}) ** + mutex_set_frag γ th (GSet {[γm]}) |-- False. Proof. - iMod (own_alloc - (gmap_view_auth (V := agreeR (leibnizO (gset iprop.gname))) - (DfracOwn 1) (mutex_sets_view ∅))) as (γpool) "HA". - { apply gmap_view_auth_valid. } - iMod (inv_alloc N _ (my_mutexes_inv γpool) with "[HA]") as "#HI". - { iNext. rewrite my_mutexes_inv.unlock mutex_sets_auth.unlock. - iExists ∅. iExact "HA". } - iModIntro. iExists γpool. iExact "HI". - Qed. - - Lemma mutex_sets_frag_exclusive γpool th M1 M2 : - mutex_sets_frag γpool th M1 ** mutex_sets_frag γpool th M2 |-- False. - Proof. - rewrite mutex_sets_frag.unlock. + rewrite /mutex_set_frag. iIntros "[H1 H2]". iDestruct (own_valid_2 with "H1 H2") as %Hvalid. - apply gmap_view_frag_op_valid in Hvalid as [Hfrac _]. - rewrite dfrac_op_own dfrac_valid_own in Hfrac. - exfalso. exact (Qp.not_add_le_l 1 1 Hfrac). + iPureIntro. + specialize (Hvalid th). + rewrite discrete_fun_lookup_op !discrete_fun_lookup_singleton in Hvalid. + rewrite -auth_frag_op auth_frag_valid gset_disj_valid_op in Hvalid. + set_solver. Qed. - Lemma mutex_sets_update γpool M th S S' : - mutex_sets_auth γpool M ** mutex_sets_frag γpool th S |-- - (|==> mutex_sets_auth γpool (<[th := S']> M) ** - mutex_sets_frag γpool th S'). + Lemma alloc_mutex_set_map : + ⊢ |==> ∃ γ, mutex_set_map γ ∅. Proof. - rewrite mutex_sets_auth.unlock mutex_sets_frag.unlock - /mutex_sets_view fmap_insert. - iIntros "[HA HF]". - iMod (own_update_2 with "HA HF") as "[HA HF]". - { apply (gmap_view_replace - (V := agreeR (leibnizO (gset iprop.gname))) - (mutex_sets_view M) th (to_agree S) (to_agree S')). done. } - iModIntro. iFrame. + iMod (own_alloc (reserve ∅)) as (γ) "Hmap". + { intros th. rewrite /reserve. + apply auth_auth_valid. done. } + iModIntro. iExists γ. iExact "Hmap". Qed. - Lemma mutex_sets_alloc_thread γpool M th : - M !! th = None -> - mutex_sets_auth γpool M |-- - (|==> mutex_sets_auth γpool (<[th := ∅]> M) ** - mutex_sets_frag γpool th ∅). + Lemma my_mutexes_alloc_mutex_name γ th sa sf γm : + γm ∉ sa -> + my_mutexes γ th (GSet sa) sf |-- + (|==> my_mutexes γ th (GSet (sa ∪ {[γm]})) sf ** + mutex_set_frag γ th (GSet {[γm]})). Proof. - rewrite mutex_sets_auth.unlock mutex_sets_frag.unlock - /mutex_sets_view fmap_insert. - iIntros (Hfresh) "HA". - iMod (own_update with "HA") as "[HA HF]". - { apply (gmap_view_alloc - (V := agreeR (leibnizO (gset iprop.gname))) - (mutex_sets_view M) th (DfracOwn 1) (to_agree ∅)). - - rewrite lookup_fmap Hfresh. done. - - done. - - done. } + rewrite /my_mutexes /mutex_set_auth /mutex_set_frag. + iIntros (Hfresh) "[HA HF]". + iMod (own_update γ _ + ((discrete_fun_singleton th (● GSet (sa ∪ {[γm]})) ⋅ + discrete_fun_singleton th (◯ GSet {[γm]})) : cmraR) + with "HA") as "[HA Hnew]". + { rewrite discrete_fun_singleton_op. + apply discrete_fun_singleton_update. + rewrite (comm_L union). + apply auth_update_alloc. + apply gset_disj_alloc_empty_local_update. set_solver. } iModIntro. iFrame. Qed. - Lemma my_mutexes_exclusive N1 N2 γpool th M1 M2 : - my_mutexes N1 γpool th M1 ** my_mutexes N2 γpool th M2 |-- False. + Lemma mutex_sets_alloc_thread_with_set + γ (T : gset thread_idT) th (s : gset iprop.gname) : + th ∉ T -> + mutex_set_map γ T |-- + (|==> mutex_set_map γ (T ∪ {[th]}) ** + my_mutexes γ th (GSet s) (GSet s)). Proof. - rewrite /my_mutexes. - iIntros "[[_ H1] [_ H2]]". - iApply (mutex_sets_frag_exclusive with "[$H1 $H2]"). + rewrite /mutex_set_map /my_mutexes /mutex_set_auth /mutex_set_frag. + iIntros (Hfresh) "Hmap". + iMod (own_update γ _ (reserve (T ∪ {[th]}) ⋅ + (discrete_fun_singleton th (● GSet s) ⋅ discrete_fun_singleton th (◯ GSet s))) + with "Hmap") as "[Hmap [HA HF]]". + { apply discrete_fun_update. intros th'. + rewrite !discrete_fun_lookup_op. + destruct (decide (th = th')) as [<-|Hne]. + - rewrite !discrete_fun_lookup_singleton /reserve. + case_decide; first contradiction. + case_decide; last set_solver. + rewrite left_id. + apply auth_update_alloc. + rewrite -{1}(right_id_L ∅ union s). + apply gset_disj_alloc_empty_local_update. set_solver. + - rewrite !discrete_fun_lookup_singleton_ne; try done. + rewrite left_id right_id /reserve. + destruct (decide (th' ∈ T)). + + rewrite !decide_True; try set_solver. + + rewrite !decide_False; try set_solver. + } + iModIntro. iFrame. Qed. - Lemma my_mutexes_alloc N th : - ⊢ |={⊤}=> ∃ γpool, my_mutexes N γpool th ∅. + Lemma mutex_sets_alloc_thread γ T th : + th ∉ T -> + mutex_set_map γ T |-- + (|==> mutex_set_map γ (T ∪ {[th]}) ** + my_mutexes γ th (GSet ∅) (GSet ∅)). + Proof. apply mutex_sets_alloc_thread_with_set. Qed. + + Lemma mutex_set_frags_alloc (th1 th2 : thread_idT) (s1 s2 : gset iprop.gname) : + th1 ≠ th2 -> + ⊢ |==> ∃ γ, + mutex_set_frag γ th1 (GSet s1) ** + mutex_set_frag γ th2 (GSet s2) ** + (mutex_set_map γ {[th1; th2]} ** + mutex_set_auth γ th1 (GSet s1) ** + mutex_set_auth γ th2 (GSet s2)). Proof. - iMod (own_alloc - (gmap_view_auth - (V := agreeR (leibnizO (gset iprop.gname))) - (DfracOwn 1) (mutex_sets_view ∅))) as (γpool) "HA". - { apply gmap_view_auth_valid. } - iAssert (mutex_sets_auth γpool ∅) with "[HA]" as "Hauth". - { rewrite mutex_sets_auth.unlock. iExact "HA". } - have Hfresh : - (∅ : gmap thread_idT (gset iprop.gname)) !! th = None by done. - iMod (mutex_sets_alloc_thread γpool ∅ th Hfresh with "Hauth") - as "[HA HF]". - iMod (inv_alloc N _ (my_mutexes_inv γpool) with "[HA]") as "#Hinv". - { iNext. rewrite my_mutexes_inv.unlock. - iExists ({[th := ∅]} : gmap thread_idT (gset iprop.gname)). - iFrame. } - iModIntro. iExists γpool. rewrite /my_mutexes. iFrame. - Unshelve. all: try done. + iIntros (Hneq). + iMod alloc_mutex_set_map as (γ) "Hmap". + iMod (mutex_sets_alloc_thread_with_set γ ∅ th1 s1 ltac:(set_solver) + with "Hmap") as "[Hmap Ht1]". + iEval (rewrite left_id_L) in "Hmap". + iMod (mutex_sets_alloc_thread_with_set γ {[th1]} th2 s2 ltac:(set_solver) + with "Hmap") as "[Hmap Ht2]". + iDestruct "Ht1" as "[Ha1 Hf1]". + iDestruct "Ht2" as "[Ha2 Hf2]". + iModIntro. iExists γ. iFrame. Qed. - Lemma my_mutexes_insert N γpool th M g : - my_mutexes N γpool th M |-- - (|={⊤}=> my_mutexes N γpool th (M ∪ {[g]})). - Proof. - rewrite /my_mutexes. - iIntros "[#Hinv HF]". - iInv N as "Hpool" "Hclose". - rewrite my_mutexes_inv.unlock. - iDestruct "Hpool" as (A) ">HA". - iMod (mutex_sets_update γpool A th M (M ∪ {[g]}) - with "[$HA $HF]") as "[HA HF]". - iMod ("Hclose" with "[HA]") as "_". - { iNext. iExists _. iFrame. } - iModIntro. iFrame "Hinv HF". - Qed. End theory. + + #[global] Hint Opaque mutex_set_map mutex_set_auth mutex_set_frag + my_mutexes : sl_opacity typeclass_instances. End MutexSets. (** ** The fractional token/given-token pair *) @@ -338,6 +419,9 @@ Module MutexTokens. #[local] Existing Instance mpred_BiAffine. + Lemma token_full_init γ : given_token γ 1 |-- token_full γ. + Proof. rewrite /token_full. iIntros "T". iLeft. iExact "T". Qed. + Lemma token_valid γ q : token γ q |-- [| (q ≤ 1)%Qp |]. Proof. rewrite /token. iIntros "H". @@ -454,21 +538,24 @@ Module MakeMutexState excl_authR (optionO thread_idTO). Record mutex_gname : Set := MkGname { - pool_namespace : namespace; pool_gname : iprop.gname; token_gname : iprop.gname; owner_gname : iprop.gname; }. Definition gname : Set := mutex_gname. + Definition pool_name (γ : gname) : iprop.gname := γ.(pool_gname). - Class G `{Σ : cpp_logic} := { + Class stateG `{Σ : cpp_logic} := { #[global] sets_G :: Sets.G Σ; #[global] tokens_G :: Tokens.G Σ; #[global] has_owner :: HasOwn (iPropI _Σ) owner_cmraR; #[global] has_owner_upd :: HasOwnUpd (iPropI _Σ) owner_cmraR; #[global] has_owner_valid :: HasOwnValid (iPropI _Σ) owner_cmraR; }. + Definition G := @stateG. + Existing Class G. #[global] Arguments G {_ _} Σ : assert. + #[global] Instance state_G `{Σ : cpp_logic} (H : G Σ) : @stateG _ _ Σ := H. Definition owner_tid_auth `{Σ : cpp_logic, !G Σ} (γ : gname) (o_thr : option thread_idT) : mpred := @@ -524,10 +611,9 @@ Module MakeMutexState Tokens.token γ.(token_gname) q. Definition not_locked `{Σ : cpp_logic, !G Σ} - (γ : gname) (th : thread_idT) (q : Qp) + (γ : gname) (th : thread_idT) (q : Qp) (inv_gname : iprop.gname) : mpred := - Sets.my_mutexes - γ.(pool_namespace) γ.(pool_gname) th {[inv_gname]} ** + Sets.mutex_set_frag γ.(pool_gname) th (GSet {[inv_gname]}) ** Tokens.token γ.(token_gname) q. Definition locked `{Σ : cpp_logic, !G Σ} @@ -537,9 +623,7 @@ Module MakeMutexState Lemma not_locked_eq `{Σ : cpp_logic, !G Σ} γ th q inv_gname : not_locked γ th q inv_gname ⊣⊢ - Sets.my_mutexes - γ.(pool_namespace) γ.(pool_gname) th - {[inv_gname]} ** + Sets.mutex_set_frag γ.(pool_gname) th (GSet {[inv_gname]}) ** Tokens.token γ.(token_gname) q. Proof. done. Qed. @@ -568,7 +652,85 @@ Module MakeMutexState apply _. Qed. - #[global] Hint Opaque token not_locked locked : sl_opacity typeclass_instances. + (** While held, the invariant owns this thread's singleton mutex fragment + and the token balance. The thread retains its mutex-set authority. + When free, both halves of the previous owner remain in the invariant. *) + Definition state `{Σ : cpp_logic, !G Σ} + (γ : gname) (inv_gname : iprop.gname) (b : bool) : mpred := + (if b then + ∃ th, owner_tid_auth γ (Some th) ** + Sets.mutex_set_frag γ.(pool_gname) th (GSet {[inv_gname]}) ** + Tokens.token_not_full γ.(token_gname) + else + ∃ owner, owner_tid_auth γ owner ** owner_tid_frag γ owner ** + Tokens.token_full γ.(token_gname))%I. + + #[global] Instance state_WeaklyObjective + `{Σ : cpp_logic, !G Σ} γ inv_gname b : + WeaklyObjective (state γ inv_gname b). + Proof. rewrite /state. destruct b; apply _. Qed. + + Section state_laws. + Context `{Σ : cpp_logic, !G Σ}. + + Lemma alloc (γpool : iprop.gname) inv_gname : + ⊢ |==> ∃ γ, [| pool_name γ = γpool |] ** + token γ 1 ** state γ inv_gname false. + Proof. + iMod Tokens.alloc as (gt) "[T GT]". + iMod (own_alloc ((●E None ⋅ ◯E None) : owner_cmraR)) as (go) "O". + { apply excl_auth_valid. } + iDestruct (own_op with "O") as "[OA OF]". + iModIntro. iExists (MkGname γpool gt go). + iSplit; first done. + rewrite /token /state /=. iFrame "T". iExists None. + rewrite /owner_tid_auth /owner_tid_frag /=. iFrame "OA OF". + iApply Tokens.token_full_init. iExact "GT". + Qed. + + Lemma do_lock γ inv_gname th q : + state γ inv_gname false ** not_locked γ th q inv_gname |-- + (|==> state γ inv_gname true ** locked γ (Some th) q). + Proof. + rewrite /state /not_locked /locked. + iIntros "[State [Sets T]]". + iDestruct "State" as (owner) "(OA & OF & Balance)". + iDestruct (Tokens.acquire with "[$Balance $T]") as "[GT Balance]". + iMod (owner_update _ _ _ (Some th) with "[$OA $OF]") as "[OA OF]". + iModIntro. iFrame "GT OF". iExists th. iFrame. + Qed. + + Lemma do_unlock γ inv_gname th q : + state γ inv_gname true ** locked γ (Some th) q |-- + (|==> state γ inv_gname false ** not_locked γ th q inv_gname). + Proof. + rewrite /state /locked /not_locked. + iIntros "[State [GT OF]]". + iDestruct "State" as (owner) "(OA & Sets & Balance)". + iDestruct (observe_2 [| Some owner = Some th |] with "OA OF") as %Heq. + injection Heq as ->. + iDestruct (Tokens.release with "[$Balance $GT]") as "[T Balance]". + iModIntro. iFrame "Sets T". iExists (Some th). iFrame. + Qed. + + Lemma unlocked_locked γ inv_gname th q : + state γ inv_gname false ** locked γ th q |-- False. + Proof. + rewrite /state /locked. iIntros "[State [_ OF]]". + iDestruct "State" as (owner) "(_ & OF0 & _)". + iDestruct (owner_tid_frag_exclusive with "OF0 OF") as %[]. + Qed. + + Lemma locked_full_token γ inv_gname : + state γ inv_gname true ** token γ 1 |-- False. + Proof. + rewrite /state /token. iIntros "[State T]". + iDestruct "State" as (th) "(_ & _ & Balance)". + iApply (Tokens.token_not_full_full_token with "[$Balance $T]"). + Qed. + End state_laws. + + #[global] Hint Opaque token not_locked locked state : sl_opacity typeclass_instances. End MakeMutexState. From 04bf5ed1dc11e89c84d236a985c66af66ee75dd6 Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Wed, 9 Sep 2026 19:06:03 +0000 Subject: [PATCH 36/51] mutex ghost state module instantiation is now associated with implementation proof --- rocq-brick-libstdcpp/proof/lib/lock_ghost2.v | 322 +++++---------- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 93 ++--- .../test/mutex/custom_mutex_hpp_proof.v | 383 ++++++++++++------ 3 files changed, 398 insertions(+), 400 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v b/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v index bd34f839..cf952763 100644 --- a/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v +++ b/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v @@ -11,6 +11,18 @@ Require Export skylabs.brick.libstdcpp.runtime.pred. Import linearity. +(** Ghost state and laws for mutex specs and proofs. *) + +(** MUTEX_SETS has 2 parts: `mutex_set_map g (T:get thread_idT)` for registering + new threads and allocating their `my_mutexes g th` with + `mutex_sets_alloc_thread`, which is a pair of `mutex_set_auth` and + `mutex_set_frag` of gnames. + The thread keeps auth and trades a fraction `mutex_set_frag {[ginv]}` to + `inv ginv P` for resources so it only gets resources once from the invariant + until it gives resources back (`mutex_set_frag_exclusive`). + If `ginv` is not allcated yet, it can be allocated with + `my_mutexes_alloc_mutex_name`. +*) Module Type MUTEX_SETS. Parameter cmraR : cmra. @@ -21,9 +33,6 @@ Module Type MUTEX_SETS. }. #[global] Arguments G {_ _} Σ : assert. - (** All predicates use the same ghost name [γ], with [th] selecting an - entry. [mutex_set_map γ T] retains the authorities for thread IDs - outside the allocated set [T]. *) Parameter mutex_set_map : forall `{Σ : cpp_logic, !G Σ}, iprop.gname -> gset thread_idT -> mpred. Parameter mutex_set_frag : forall `{Σ : cpp_logic, !G Σ}, @@ -69,8 +78,10 @@ Module Type MUTEX_SETS. (|==> my_mutexes γ th (GSet (sa ∪ {[γm]})) sf ** mutex_set_frag γ th (GSet {[γm]})). - (** Distinct threads can own arbitrary, possibly overlapping mutex sets. - The registry and both authoritative sets are retained as the remainder. *) + (** This is more of a sanity check. Maybe there are better rules that should + be included in the module instead of this. + Distinct threads can allocate, possibly overlapping gname sets. + Frags are given to the lock invariants while auth are held by threads. *) Parameter mutex_set_frags_alloc : forall `{Σ : cpp_logic, !G Σ} (th1 th2 : thread_idT) (s1 s2 : gset iprop.gname), th1 ≠ th2 -> @@ -126,63 +137,73 @@ Module Type MUTEX_TOKENS. ⊢ |==> ∃ γ, token γ 1 ** given_token γ 1. End MUTEX_TOKENS. +(** Authoritative and exclusive fragment ownership of an optional thread ID. *) +Module Type OWNER_TID. + Parameter cmraR : cmra. + + Class G `{Σ : cpp_logic} := { + #[local] has_own :: HasOwn (iPropI _Σ) cmraR; + #[local] has_upd :: HasOwnUpd (iPropI _Σ) cmraR; + #[local] has_valid :: HasOwnValid (iPropI _Σ) cmraR; + }. + #[global] Arguments G {_ _} Σ : assert. + + Parameter owner_tid_auth owner_tid_frag : forall `{Σ : cpp_logic, !G Σ}, + iprop.gname -> option thread_idT -> mpred. + + #[global] Declare Instance owner_tid_auth_timeless + `{Σ : cpp_logic, !G Σ} γ o : Timeless (owner_tid_auth γ o). + #[global] Declare Instance owner_tid_frag_timeless + `{Σ : cpp_logic, !G Σ} γ o : Timeless (owner_tid_frag γ o). + #[global] Declare Instance owner_tid_frag_exclusive + `{Σ : cpp_logic, !G Σ} γ : Exclusive1 (owner_tid_frag γ). + #[global] Declare Instance owner_tid_auth_WeaklyObjective + `{Σ : cpp_logic, !G Σ} γ o : WeaklyObjective (owner_tid_auth γ o). + #[global] Declare Instance owner_tid_frag_WeaklyObjective + `{Σ : cpp_logic, !G Σ} γ o : WeaklyObjective (owner_tid_frag γ o). + #[global] Declare Instance owner_agree + `{Σ : cpp_logic, !G Σ} γ o1 o2 : + Observe2 [| o1 = o2 |] (owner_tid_auth γ o1) (owner_tid_frag γ o2). + + Parameter alloc : forall `{Σ : cpp_logic, !G Σ} o, + ⊢ |==> ∃ γ, owner_tid_auth γ o ** owner_tid_frag γ o. + Parameter owner_update : forall `{Σ : cpp_logic, !G Σ} γ oa ofrag o', + owner_tid_auth γ oa ** owner_tid_frag γ ofrag |-- + (|==> owner_tid_auth γ o' ** owner_tid_frag γ o'). +End OWNER_TID. + +(** A MUTEX_STATE says a mutex spec is parametrized by some `token`, `not_locked` + and `locked`. The exact model depends on the implementation. *) Module Type MUTEX_STATE. Parameter gname : Set. - Parameter (pool_name : gname -> iprop.gname). + Parameter Q : Type. + (* FIXME do we need these? *) + Parameter pool_name inv_name : gname -> iprop.gname. Parameter G : forall `{Σ : cpp_logic}, Type. Existing Class G. #[global] Arguments G {_ _} Σ : assert. - (** Client resources. [not_locked] permits this thread to attempt acquisition; - [locked] records ownership after successful acquisition. *) + (** [Q] describes the permissions transferred by lock and unlock. *) Parameter token : forall `{Σ : cpp_logic, !G Σ}, gname -> Qp -> mpred. - Parameter not_locked : forall `{Σ : cpp_logic, !G Σ}, - gname -> thread_idT -> Qp -> iprop.gname -> mpred. - Parameter locked : forall `{Σ : cpp_logic, !G Σ}, - gname -> option thread_idT -> Qp -> mpred. - - (** The ghost resources kept inside the mutex invariant. The boolean agrees - with the physical lock bit; the invariant name connects acquisitions to - the same mutex. Its representation is private to the implementation. *) - Parameter state : forall `{Σ : cpp_logic, !G Σ}, - gname -> iprop.gname -> bool -> mpred. - #[global] Declare Instance state_WeaklyObjective - `{Σ : cpp_logic, !G Σ} γ inv_gname b : - WeaklyObjective (state γ inv_gname b). + Parameter not_locked locked : forall `{Σ : cpp_logic, !G Σ} {σ : genv}, + ptr -> gname -> thread_idT -> Q -> mpred. #[global] Declare Instance token_fractional `{Σ : cpp_logic, !G Σ} γ : Fractional (token γ). #[global] Declare Instance token_timeless `{Σ : cpp_logic, !G Σ} γ q : Timeless (token γ q). #[global] Declare Instance locked_timeless - `{Σ : cpp_logic, !G Σ} γ th q : Timeless (locked γ th q). + `{Σ : cpp_logic, !G Σ} {σ : genv} this γ th q : + Timeless (locked this γ th q). #[global] Declare Instance locked_exclusive - `{Σ : cpp_logic, !G Σ} γ q : Exclusive1 (fun th => locked γ th q). - - (** Each mutex uses the caller's shared mutex-set pool. *) - Parameter alloc : forall `{Σ : cpp_logic, !G Σ} (γpool : iprop.gname) inv_gname, - ⊢ |==> ∃ γ, [| pool_name γ = γpool |] ** - token γ 1 ** state γ inv_gname false. - - (** Successful acquisition and release exchange client resources with the - invariant. Failed acquisition leaves both resources unchanged. *) - Parameter do_lock : forall `{Σ : cpp_logic, !G Σ} γ inv_gname th q, - state γ inv_gname false ** not_locked γ th q inv_gname |-- - (|==> state γ inv_gname true ** locked γ (Some th) q). - Parameter do_unlock : forall `{Σ : cpp_logic, !G Σ} γ inv_gname th q, - state γ inv_gname true ** locked γ (Some th) q |-- - (|==> state γ inv_gname false ** not_locked γ th q inv_gname). - - (** Ownership rules out an unlocked physical state. Full destruction - permission rules out a locked physical state. *) - Parameter unlocked_locked : forall `{Σ : cpp_logic, !G Σ} γ inv_gname th q, - state γ inv_gname false ** locked γ th q |-- False. - Parameter locked_full_token : forall `{Σ : cpp_logic, !G Σ} γ inv_gname, - state γ inv_gname true ** token γ 1 |-- False. + `{Σ : cpp_logic, !G Σ} {σ : genv} this γ q : + Exclusive1 (fun th => locked this γ th q). End MUTEX_STATE. +(* Proofs that the ghost state modules are inhabited. *) + Module MutexSets : MUTEX_SETS. Canonical Structure threadR := authUR (gset_disjR iprop.gname). Canonical Structure cmraR : cmra := @@ -353,7 +374,7 @@ End MutexSets. (** ** The fractional token/given-token pair *) -Module MutexTokens. +Module MutexTokens <: MUTEX_TOKENS. Canonical Structure cmraR : cmra := prodUR (optionUR fracR) (optionUR fracR). @@ -521,70 +542,45 @@ Module MutexTokens. End theory. End MutexTokens. -(** The concrete state abstracts over mutex sets and tokens, and implements - optional owner state directly. *) -Module MakeMutexState - (Sets0 : MUTEX_SETS) - (Tokens0 : MUTEX_TOKENS) <: MUTEX_STATE. - Module Sets := Sets0. - Module Tokens := Tokens0. - - #[local] Existing Instance Tokens.token_fractional. - #[local] Existing Instance Tokens.given_token_fractional. - #[local] Existing Instance Tokens.token_timeless. - #[local] Existing Instance Tokens.given_token_timeless. - - Canonical Structure owner_cmraR : cmra := - excl_authR (optionO thread_idTO). - - Record mutex_gname : Set := MkGname { - pool_gname : iprop.gname; - token_gname : iprop.gname; - owner_gname : iprop.gname; - }. - Definition gname : Set := mutex_gname. - Definition pool_name (γ : gname) : iprop.gname := γ.(pool_gname). - - Class stateG `{Σ : cpp_logic} := { - #[global] sets_G :: Sets.G Σ; - #[global] tokens_G :: Tokens.G Σ; - #[global] has_owner :: HasOwn (iPropI _Σ) owner_cmraR; - #[global] has_owner_upd :: HasOwnUpd (iPropI _Σ) owner_cmraR; - #[global] has_owner_valid :: HasOwnValid (iPropI _Σ) owner_cmraR; +(** The exclusive-authoritative implementation of [OWNER_TID]. *) +Module OwnerTid : OWNER_TID. + Canonical Structure cmraR : cmra := excl_authR (optionO thread_idTO). + + Class G `{Σ : cpp_logic} := { + #[local] has_own :: HasOwn (iPropI _Σ) cmraR; + #[local] has_upd :: HasOwnUpd (iPropI _Σ) cmraR; + #[local] has_valid :: HasOwnValid (iPropI _Σ) cmraR; }. - Definition G := @stateG. - Existing Class G. #[global] Arguments G {_ _} Σ : assert. - #[global] Instance state_G `{Σ : cpp_logic} (H : G Σ) : @stateG _ _ Σ := H. Definition owner_tid_auth `{Σ : cpp_logic, !G Σ} - (γ : gname) (o_thr : option thread_idT) : mpred := - own γ.(owner_gname) ((●E o_thr) : owner_cmraR). - + (γ : iprop.gname) (o : option thread_idT) : mpred := + own γ ((●E o) : cmraR). Definition owner_tid_frag `{Σ : cpp_logic, !G Σ} - (γ : gname) (o_thr : option thread_idT) : mpred := - own γ.(owner_gname) ((◯E o_thr) : owner_cmraR). + (γ : iprop.gname) (o : option thread_idT) : mpred := + own γ ((◯E o) : cmraR). - #[global] Hint Opaque owner_tid_auth owner_tid_frag : sl_opacity typeclass_instances. - - #[only(timeless)] derive owner_tid_auth. - #[only(timeless)] derive owner_tid_frag. + #[global] Instance owner_tid_auth_timeless + `{Σ : cpp_logic, !G Σ} γ o : Timeless (owner_tid_auth γ o). + Proof. rewrite /owner_tid_auth. apply _. Qed. + #[global] Instance owner_tid_frag_timeless + `{Σ : cpp_logic, !G Σ} γ o : Timeless (owner_tid_frag γ o). + Proof. rewrite /owner_tid_frag. apply _. Qed. #[global] Instance owner_tid_frag_exclusive `{Σ : cpp_logic, !G Σ} γ : Exclusive1 (owner_tid_frag γ). Proof. - intros o_thr1 o_thr2. rewrite /owner_tid_frag. + intros o1 o2. rewrite /owner_tid_frag. iIntros "H1 H2". iDestruct (own_valid_2 with "H1 H2") as %Hvalid. move: Hvalid. rewrite excl_auth_frag_op_valid. done. Qed. - #[global] Instance owner_tid_auth_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ o_thr : - WeaklyObjective (owner_tid_auth γ o_thr). + #[global] Instance owner_tid_auth_WeaklyObjective + `{Σ : cpp_logic, !G Σ} γ o : WeaklyObjective (owner_tid_auth γ o). Proof. rewrite /owner_tid_auth. apply _. Qed. - - #[global] Instance owner_tid_frag_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ o_thr : - WeaklyObjective (owner_tid_frag γ o_thr). + #[global] Instance owner_tid_frag_WeaklyObjective + `{Σ : cpp_logic, !G Σ} γ o : WeaklyObjective (owner_tid_frag γ o). Proof. rewrite /owner_tid_frag. apply _. Qed. #[global] Instance owner_agree `{Σ : cpp_logic, !G Σ} γ o1 o2 : @@ -596,6 +592,15 @@ Module MakeMutexState iPureIntro. apply leibniz_equiv, excl_auth_agree, HV. Qed. + Lemma alloc `{Σ : cpp_logic, !G Σ} o : + ⊢ |==> ∃ γ, owner_tid_auth γ o ** owner_tid_frag γ o. + Proof. + iMod (own_alloc ((●E o ⋅ ◯E o) : cmraR)) as (γ) "H". + { apply excl_auth_valid. } + iModIntro. iExists γ. + rewrite /owner_tid_auth /owner_tid_frag -own_op. iExact "H". + Qed. + Lemma owner_update `{Σ : cpp_logic, !G Σ} γ oa ofrag o' : owner_tid_auth γ oa ** owner_tid_frag γ ofrag |-- (|==> owner_tid_auth γ o' ** owner_tid_frag γ o'). @@ -606,132 +611,5 @@ Module MakeMutexState done. Qed. - Definition token `{Σ : cpp_logic, !G Σ} - (γ : gname) (q : Qp) : mpred := - Tokens.token γ.(token_gname) q. - - Definition not_locked `{Σ : cpp_logic, !G Σ} - (γ : gname) (th : thread_idT) (q : Qp) - (inv_gname : iprop.gname) : mpred := - Sets.mutex_set_frag γ.(pool_gname) th (GSet {[inv_gname]}) ** - Tokens.token γ.(token_gname) q. - - Definition locked `{Σ : cpp_logic, !G Σ} - (γ : gname) (o_thr : option thread_idT) (q : Qp) : mpred := - Tokens.given_token γ.(token_gname) q ** - owner_tid_frag γ o_thr. - - Lemma not_locked_eq `{Σ : cpp_logic, !G Σ} γ th q inv_gname : - not_locked γ th q inv_gname ⊣⊢ - Sets.mutex_set_frag γ.(pool_gname) th (GSet {[inv_gname]}) ** - Tokens.token γ.(token_gname) q. - Proof. done. Qed. - - Lemma locked_eq `{Σ : cpp_logic, !G Σ} γ o_thr q : - locked γ o_thr q ⊣⊢ - Tokens.given_token γ.(token_gname) q ** - owner_tid_frag γ o_thr. - Proof. done. Qed. - - #[global] Instance token_fractional - `{Σ : cpp_logic, !G Σ} γ : Fractional (token γ). - Proof. rewrite /token. apply Tokens.token_fractional. Qed. - - #[global] Instance token_timeless - `{Σ : cpp_logic, !G Σ} γ q : Timeless (token γ q). - Proof. rewrite /token. apply _. Qed. - - #[global] Instance locked_timeless - `{Σ : cpp_logic, !G Σ} γ th q : Timeless (locked γ th q). - Proof. rewrite /locked. apply _. Qed. - - #[global] Instance locked_exclusive - `{Σ : cpp_logic, !G Σ} γ q : Exclusive1 (fun th => locked γ th q). - Proof. - intros th1 th2. rewrite /locked. - apply _. - Qed. - - (** While held, the invariant owns this thread's singleton mutex fragment - and the token balance. The thread retains its mutex-set authority. - When free, both halves of the previous owner remain in the invariant. *) - Definition state `{Σ : cpp_logic, !G Σ} - (γ : gname) (inv_gname : iprop.gname) (b : bool) : mpred := - (if b then - ∃ th, owner_tid_auth γ (Some th) ** - Sets.mutex_set_frag γ.(pool_gname) th (GSet {[inv_gname]}) ** - Tokens.token_not_full γ.(token_gname) - else - ∃ owner, owner_tid_auth γ owner ** owner_tid_frag γ owner ** - Tokens.token_full γ.(token_gname))%I. - - #[global] Instance state_WeaklyObjective - `{Σ : cpp_logic, !G Σ} γ inv_gname b : - WeaklyObjective (state γ inv_gname b). - Proof. rewrite /state. destruct b; apply _. Qed. - - Section state_laws. - Context `{Σ : cpp_logic, !G Σ}. - - Lemma alloc (γpool : iprop.gname) inv_gname : - ⊢ |==> ∃ γ, [| pool_name γ = γpool |] ** - token γ 1 ** state γ inv_gname false. - Proof. - iMod Tokens.alloc as (gt) "[T GT]". - iMod (own_alloc ((●E None ⋅ ◯E None) : owner_cmraR)) as (go) "O". - { apply excl_auth_valid. } - iDestruct (own_op with "O") as "[OA OF]". - iModIntro. iExists (MkGname γpool gt go). - iSplit; first done. - rewrite /token /state /=. iFrame "T". iExists None. - rewrite /owner_tid_auth /owner_tid_frag /=. iFrame "OA OF". - iApply Tokens.token_full_init. iExact "GT". - Qed. - - Lemma do_lock γ inv_gname th q : - state γ inv_gname false ** not_locked γ th q inv_gname |-- - (|==> state γ inv_gname true ** locked γ (Some th) q). - Proof. - rewrite /state /not_locked /locked. - iIntros "[State [Sets T]]". - iDestruct "State" as (owner) "(OA & OF & Balance)". - iDestruct (Tokens.acquire with "[$Balance $T]") as "[GT Balance]". - iMod (owner_update _ _ _ (Some th) with "[$OA $OF]") as "[OA OF]". - iModIntro. iFrame "GT OF". iExists th. iFrame. - Qed. - - Lemma do_unlock γ inv_gname th q : - state γ inv_gname true ** locked γ (Some th) q |-- - (|==> state γ inv_gname false ** not_locked γ th q inv_gname). - Proof. - rewrite /state /locked /not_locked. - iIntros "[State [GT OF]]". - iDestruct "State" as (owner) "(OA & Sets & Balance)". - iDestruct (observe_2 [| Some owner = Some th |] with "OA OF") as %Heq. - injection Heq as ->. - iDestruct (Tokens.release with "[$Balance $GT]") as "[T Balance]". - iModIntro. iFrame "Sets T". iExists (Some th). iFrame. - Qed. - - Lemma unlocked_locked γ inv_gname th q : - state γ inv_gname false ** locked γ th q |-- False. - Proof. - rewrite /state /locked. iIntros "[State [_ OF]]". - iDestruct "State" as (owner) "(_ & OF0 & _)". - iDestruct (owner_tid_frag_exclusive with "OF0 OF") as %[]. - Qed. - - Lemma locked_full_token γ inv_gname : - state γ inv_gname true ** token γ 1 |-- False. - Proof. - rewrite /state /token. iIntros "[State T]". - iDestruct "State" as (th) "(_ & _ & Balance)". - iApply (Tokens.token_not_full_full_token with "[$Balance $T]"). - Qed. - End state_laws. - - #[global] Hint Opaque token not_locked locked state : sl_opacity typeclass_instances. - -End MakeMutexState. - -Module LockState := MakeMutexState MutexSets MutexTokens. + #[global] Hint Opaque owner_tid_auth owner_tid_frag : sl_opacity typeclass_instances. +End OwnerTid. diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index 233ceabf..8bf80f0c 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -21,21 +21,19 @@ Import linearity. Module mutex_spec (State : lock_ghost2.MUTEX_STATE). Section with_cpp. - Context `{Σ : cpp_logic} {Name : Type}. + Context `{Σ : cpp_logic} {σ : genv} {Name : Type}. Context `{!State.G Σ}. Context (R : Name -> cQp.t -> mpred -> Rep). Context (state_name : Name -> State.gname). - Context {HAS_THREADS : HasStdThreads Σ} {Q : Type}. - (** FIXME is there a more modular way to provide not_locked, locked and ghost - names, e.g. make them parameters to the mutex_spec module? *) - Context (not_locked locked : ptr -> Name -> thread_idT -> Q -> mpred). + Context {HAS_THREADS : HasStdThreads Σ}. (** The guarded predicate must be weakly objective for invariant allocation, which R likely has. *) Definition ctor_spec : ptr -> WpSpec mpred val val := (\this this - \pre{P} ▷P ** [| WeaklyObjective P |] - \post |={⊤}=> Exists g, this |-> R g 1$m P ** State.token (state_name g) 1). + \pre{P γpool} ▷P ** [| WeaklyObjective P |] + \post |={⊤}=> Exists g, [| State.pool_name (state_name g) = γpool |] ** + this |-> R g 1$m P ** State.token (state_name g) 1). Definition dtor_spec : ptr -> WpSpec mpred val val := (\this this @@ -46,47 +44,46 @@ Section with_cpp. (\this this \prepost{q P g} this |-> R g q P \persist{thr} current_thread thr - \pre{qt} not_locked this g thr qt - \post P ** locked this g thr qt). + \pre{qt} State.not_locked this (state_name g) thr qt + \post P ** State.locked this (state_name g) thr qt). Definition unlock_spec_alt : ptr -> WpSpec mpred val val := (\this this \prepost{q P g} this |-> R g q P \persist{thr} current_thread thr - \pre{qt} locked this g thr qt + \pre{qt} State.locked this (state_name g) thr qt \pre ▷P - \post not_locked this g thr qt). + \post State.not_locked this (state_name g) thr qt). Definition try_lock_spec_alt : ptr -> WpSpec mpred val val := (\this this \prepost{q P g} this |-> R g q P \persist{thr} current_thread thr - \pre{qt} not_locked this g thr qt + \pre{qt} State.not_locked this (state_name g) thr qt \post{b}[Vbool b] - if b then P ** locked this g thr qt else not_locked this g thr qt). + if b then P ** State.locked this (state_name g) thr qt + else State.not_locked this (state_name g) thr qt). (* TODO readd the later on the lock/unlock continuations. *) Definition do_lock (this : ptr) (lk : Name * mpred) (K : mpred) : mpred := - ∃ thr qt, current_thread thr ** not_locked this lk.1 thr qt ** - (locked this lk.1 thr qt ** lk.2 -* K). + ∃ thr qt, current_thread thr ** State.not_locked this (state_name lk.1) thr qt ** + (State.locked this (state_name lk.1) thr qt ** lk.2 -* K). #[global] Arguments do_lock /. Definition do_unlock (this : ptr) (lk : Name * mpred) (K : mpred) : mpred := - ∃ thr qt, current_thread thr ** locked this lk.1 thr qt ** ▷lk.2 ** - (not_locked this lk.1 thr qt -* K). + ∃ thr qt, current_thread thr ** State.locked this (state_name lk.1) thr qt ** ▷lk.2 ** + (State.not_locked this (state_name lk.1) thr qt -* K). #[global] Arguments do_unlock /. Definition do_try_lock (this : ptr) (lk : Name * mpred) (K : bool -> mpred) : mpred := - ∃ thr qt, current_thread thr ** not_locked this lk.1 thr qt ** + ∃ thr qt, current_thread thr ** State.not_locked this (state_name lk.1) thr qt ** ∀ b : bool, - (if b then lk.2 ** locked this lk.1 thr qt - else not_locked this lk.1 thr qt) -* K b. + (if b then lk.2 ** State.locked this (state_name lk.1) thr qt + else State.not_locked this (state_name lk.1) thr qt) -* K b. #[global] Arguments do_try_lock /. Section equivalences. - Context {σ : genv}. - (* Context (not_locked locked : ptr -> Name -> thread_idT -> Q -> mpred). *) Context (method_name class_name : globname). Context {BL : BasicLockable (Tnamed class_name) (fun q gp => R gp.1 q gp.2)}. @@ -113,7 +110,7 @@ Section with_cpp. - ework with br_erefl. - iIntros "H". iDestruct "H" as (q P g thr qt) "(%Hxs & HR & #HT & HNL & HK)". - iExists q, (g, P), (P ** locked this g thr qt)%I. + iExists q, (g, P), (P ** State.locked this (state_name g) thr qt)%I. iFrame "HR HK". iSplit; first done. iExists thr, qt. iFrame "HT HNL". iIntros "[HL HP]". iFrame. @@ -131,7 +128,7 @@ Section with_cpp. - ework with br_erefl. - iIntros "H". iDestruct "H" as (q P g thr qt) "(%Hxs & HR & #HT & HL & HP & HK)". - iExists q, (g, P), (not_locked this g thr qt). + iExists q, (g, P), (State.not_locked this (state_name g) thr qt). iFrame "HR HK". iSplit; first done. iExists thr, qt. iFrame "HT HL HP". iIntros "$". @@ -152,7 +149,8 @@ Section with_cpp. - iIntros "H". iDestruct "H" as (q P g thr qt) "(%Hxs & HR & #HT & HNL & HK)". iExists q, (g, P), (fun b : bool => - if b then (P ** locked this g thr qt)%I else not_locked this g thr qt). + if b then (P ** State.locked this (state_name g) thr qt)%I + else State.not_locked this (state_name g) thr qt). iFrame "HR HK". iSplit; first done. iExists thr, qt. iFrame "HT HNL". iIntros (b) "$". @@ -164,29 +162,28 @@ End mutex_spec. (** Specialize the reusable specs to the standard mutex representation and bind them to their C++ names. *) -Module Mutex (State : lock_ghost2.MUTEX_STATE). +Module StdMutex (State : lock_ghost2.MUTEX_STATE). Module Spec := mutex_spec State. - (** Pair the abstract state with the invariant named by [State.not_locked]. *) - Record gname : Set := MkGname { - lock_state_gname : State.gname; - cinv_gname : iprop.gname; - }. + Definition gname := State.gname. + Definition lock_state_gname (g : gname) := g. + Abbreviation cinv_gname := State.inv_name. Definition G := @State.G. Existing Class G. #[global] Arguments G {_ _} Σ : assert. #[global] Instance state_G `{Σ : cpp_logic} (H : G Σ) : State.G Σ := H. - Abbreviation token := (fun g q => State.token g.(lock_state_gname) q). - Abbreviation not_locked := (fun (_ : ptr) g th q => State.not_locked g.(lock_state_gname) th q g.(cinv_gname)). - Abbreviation locked := (fun (_ : ptr) g thr q => State.locked g.(lock_state_gname) (Some thr) q). + Abbreviation token := State.token. + Abbreviation not_locked := State.not_locked. + Abbreviation locked := State.locked. Section with_cpp. Context `{Σ : cpp_logic}. (** Fractional ownership of a <> guarding the predicate <

>. *) Parameter R : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv}, gname -> cQp.t -> mpred -> Rep. + #[global] Hint Opaque R : sl_opacity typeclass_instances. #[only(cfractional,cfracvalid,ascfractional,type_ptr="std::mutex")] derive R. #[global] Declare Instance R_learnable : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv}, Cbn (Learn (learn_eq ==> any ==> learn_eq ==> learn_hints.fin) R). @@ -207,7 +204,7 @@ Section with_cpp. Context {HAS_THREADS : HasStdThreads Σ}. #[global] Instance locked_learn : - Cbn (Learn (req_eq ==> learn_eq ==> req_eq ==> learn_hints.fin) State.locked). + Cbn (Learn (req_eq ==> learn_eq ==> req_eq ==> req_eq ==> learn_hints.fin) locked). Proof. solve_learnable. Qed. cpp.spec "std::mutex::mutex()" as ctor_spec with @@ -217,19 +214,19 @@ Section with_cpp. (\exact Reduce (Spec.dtor_spec R lock_state_gname)). cpp.spec "std::mutex::lock()" as lock_spec_alt with - (\exact Reduce (Spec.lock_spec_alt R not_locked locked)). + (\exact Reduce (Spec.lock_spec_alt R lock_state_gname)). cpp.spec "std::mutex::unlock()" as unlock_spec_alt with - (\exact Reduce (Spec.unlock_spec_alt R not_locked locked)). + (\exact Reduce (Spec.unlock_spec_alt R lock_state_gname)). cpp.spec "std::mutex::try_lock()" as try_lock_spec_alt with - (\exact Reduce (Spec.try_lock_spec_alt R not_locked locked)). + (\exact Reduce (Spec.try_lock_spec_alt R lock_state_gname)). - Definition do_lock := Spec.do_lock not_locked locked. + Definition do_lock := Spec.do_lock lock_state_gname. #[global] Arguments do_lock /. - Definition do_unlock := Spec.do_unlock not_locked locked. + Definition do_unlock := Spec.do_unlock lock_state_gname. #[global] Arguments do_unlock /. - Definition do_try_lock := Spec.do_try_lock not_locked locked. + Definition do_try_lock := Spec.do_try_lock lock_state_gname. #[global] Arguments do_try_lock /. (** <> implements [BasicLockable] and [Lockable]. *) @@ -255,22 +252,26 @@ Section with_cpp. Lemma lock_spec_entails_lock_spec_alt : lock_spec -|- lock_spec_alt. Proof. - apply (Spec.lock_spec_entails_lock_spec_alt R not_locked locked). + apply (Spec.lock_spec_entails_lock_spec_alt R lock_state_gname). reflexivity. Qed. Lemma unlock_spec_entails_unlock_spec_alt : unlock_spec -|- unlock_spec_alt. Proof. - apply (Spec.unlock_spec_entails_unlock_spec_alt R not_locked locked). + apply (Spec.unlock_spec_entails_unlock_spec_alt R lock_state_gname). reflexivity. Qed. Lemma try_lock_spec_entails_try_lock_spec_alt : try_lock_spec -|- try_lock_spec_alt. Proof. - apply (Spec.try_lock_spec_entails_try_lock_spec_alt R not_locked locked). + apply (Spec.try_lock_spec_entails_try_lock_spec_alt R lock_state_gname). reflexivity. Qed. End with_cpp. -End Mutex. +End StdMutex. -Module mutex := Mutex lock_ghost2.LockState. +(** The standard-library implementation remains abstract; concrete mutex + implementations instantiate [MUTEX_STATE] beside their proofs. *) +Declare Module StdMutexState : lock_ghost2.MUTEX_STATE with Definition Q := Qp. +Module StdMutexInst := StdMutex StdMutexState. +Module mutex := StdMutexInst. diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index bed55301..0a399265 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -1,6 +1,5 @@ (** Provisional *) -Require Import iris.algebra.lib.excl_auth. Require Import iris.algebra.gset. Require Import skylabs.auto.cpp.proof. @@ -13,11 +12,143 @@ Require Import skylabs.brick.libstdcpp.cassert.spec. Import linearity. Require Import skylabs.brick.libstdcpp.test.mutex.custom_mutex_hpp. -Module custom_mutex. +(** The ghost implementation and its physical client predicates are specific + to [MyMutex]. The entire mutex-set pool still uses one shared ghost name. *) +Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) + (Owners0 : OWNER_TID) <: MUTEX_STATE. + Record mutex_gname : Set := MkGname { + pool_gname : iprop.gname; + invariant_gname : iprop.gname; + token_gname : iprop.gname; + owner_gname : iprop.gname; + }. + Definition gname : Set := mutex_gname * cQp.t. + Definition Q : Type := cQp.t. + Definition pool_name (γ : gname) : iprop.gname := γ.1.(pool_gname). + Definition inv_name (γ : gname) : iprop.gname := γ.1.(invariant_gname). + + Class stateG `{Σ : cpp_logic} := { + #[global] sets_G :: Sets0.G Σ; + #[global] tokens_G :: Tokens0.G Σ; + #[global] owners_G :: Owners0.G Σ; + }. + Definition G := @stateG. + Existing Class G. + #[global] Arguments G {_ _} Σ : assert. + #[global] Instance state_G `{Σ : cpp_logic} (H : G Σ) : @stateG _ _ Σ := H. + + Definition token `{Σ : cpp_logic, !G Σ} + (γ : gname) (q : Qp) : mpred := + Tokens0.token γ.1.(token_gname) q. + + Definition lock_permit `{Σ : cpp_logic, !G Σ} + (γ : mutex_gname) (th : thread_idT) (q : Qp) : mpred := + Sets0.mutex_set_frag γ.(pool_gname) th (GSet {[γ.(invariant_gname)]}) ** + Tokens0.token γ.(token_gname) q. + + Definition owner_token `{Σ : cpp_logic, !G Σ} + (γ : mutex_gname) (th : thread_idT) (q : Qp) : mpred := + Tokens0.given_token γ.(token_gname) q ** + Owners0.owner_tid_frag γ.(owner_gname) (Some th). + + #[global] Instance token_fractional + `{Σ : cpp_logic, !G Σ} γ : Fractional (token γ). + Proof. rewrite /token. apply Tokens0.token_fractional. Qed. + + #[global] Instance token_timeless + `{Σ : cpp_logic, !G Σ} γ q : Timeless (token γ q). + Proof. rewrite /token. apply _. Qed. + + #[global] Instance owner_token_timeless + `{Σ : cpp_logic, !G Σ} γ th q : Timeless (owner_token γ th q). + Proof. rewrite /owner_token. apply _. Qed. + + #[global] Instance owner_token_exclusive + `{Σ : cpp_logic, !G Σ} γ q : Exclusive1 (fun th => owner_token γ th q). + Proof. + intros th1 th2. rewrite /owner_token. + apply _. + Qed. + + (** While held, the invariant owns this thread's singleton mutex fragment + and the token balance. The thread retains its mutex-set authority. + When free, both halves of the previous owner remain in the invariant. *) + Definition state `{Σ : cpp_logic, !G Σ} + (γ : mutex_gname) (b : bool) : mpred := + (if b then + ∃ th, Owners0.owner_tid_auth γ.(owner_gname) (Some th) ** + Sets0.mutex_set_frag γ.(pool_gname) th (GSet {[γ.(invariant_gname)]}) ** + Tokens0.token_not_full γ.(token_gname) + else + ∃ owner, Owners0.owner_tid_auth γ.(owner_gname) owner ** + Owners0.owner_tid_frag γ.(owner_gname) owner ** + Tokens0.token_full γ.(token_gname))%I. + + #[global] Instance state_WeaklyObjective + `{Σ : cpp_logic, !G Σ} γ b : + WeaklyObjective (state γ b). + Proof. rewrite /state. destruct b; apply _. Qed. + + Section state_laws. + Context `{Σ : cpp_logic, !G Σ}. + + Lemma alloc (γpool : iprop.gname) inv_gname : + ⊢ |==> ∃ γ, [| γ.(pool_gname) = γpool |] ** [| γ.(invariant_gname) = inv_gname |] ** + token (γ, (1$m)%cQp) 1 ** state γ false. + Proof. + iMod Tokens0.alloc as (gt) "[T GT]". + iMod (Owners0.alloc None) as (go) "[OA OF]". + iModIntro. iExists (MkGname γpool inv_gname gt go). + iSplit; first done. iSplit; first done. + rewrite /token /state /=. iFrame "T". iExists None. + iFrame "OA OF". + iApply Tokens0.token_full_init. iExact "GT". + Qed. - Module Spec := mutex_spec LockState. + Lemma do_lock γ th q : + state γ false ** lock_permit γ th q |-- + (|==> state γ true ** owner_token γ th q). + Proof. + rewrite /state /lock_permit /owner_token. + iIntros "[State [Sets T]]". + iDestruct "State" as (owner) "(OA & OF & Balance)". + iDestruct (Tokens0.acquire with "[$Balance $T]") as "[GT Balance]". + iMod (Owners0.owner_update γ.(owner_gname) _ _ (Some th) + with "[$OA $OF]") as "[OA OF]". + iModIntro. iFrame "GT OF". iExists th. iFrame. + Qed. - Abbreviation N := "MyMutex"%cpp_name. + Lemma do_unlock γ th q : + state γ true ** owner_token γ th q |-- + (|==> state γ false ** lock_permit γ th q). + Proof. + rewrite /state /owner_token /lock_permit. + iIntros "[State [GT OF]]". + iDestruct "State" as (owner) "(OA & Sets & Balance)". + iDestruct (observe_2 [| Some owner = Some th |] with "OA OF") as %Heq. + injection Heq as ->. + iDestruct (Tokens0.release with "[$Balance $GT]") as "[T Balance]". + iModIntro. iFrame "Sets T". iExists (Some th). iFrame. + Qed. + + Lemma unlocked_owner_token γ th q : + state γ false ** owner_token γ th q |-- False. + Proof. + rewrite /state /owner_token. iIntros "[State [_ OF]]". + iDestruct "State" as (owner) "(_ & OF0 & _)". + iDestruct (Owners0.owner_tid_frag_exclusive with "OF0 OF") as %[]. + Qed. + + Lemma locked_full_token γ : + state γ true ** token (γ, (1$m)%cQp) 1 |-- False. + Proof. + rewrite /state /token. iIntros "[State T]". + iDestruct "State" as (th) "(_ & _ & Balance)". + iApply (Tokens0.token_not_full_full_token with "[$Balance $T]"). + Qed. + End state_laws. + + #[global] Hint Opaque token lock_permit owner_token state : sl_opacity typeclass_instances. Parameter thread_idR : ∀ `{Σ : cpp_logic, σ : genv}, cQp.t -> (* None if value is thread::id(), Some otherwise *) @@ -29,6 +160,47 @@ Module custom_mutex. WeaklyObjective (thread_idR q o p). #[global] Existing Instance thread_idR_WeaklyObjective. + Definition globals `{Σ : cpp_logic} {σ : genv} (q : cQp.t) : mpred := + _global "std::memory_order_seq_cst" |-> + primR "enum std::memory_order" q + (memory_order.to_val memory_order.seq_cst). + + Definition not_locked `{Σ : cpp_logic, !G Σ} {σ : genv} + (this : ptr) (γ : gname) (th : thread_idT) (q : Q) : mpred := + lock_permit γ.1 th γ.2 ** globals q. + #[global] Arguments not_locked /. + #[global] Arguments globals /. + + (** Public ownership includes the physical owner written by [lock]. *) + Definition locked `{Σ : cpp_logic, !G Σ} {σ : genv} + (this : ptr) (γ : gname) (th : thread_idT) (q : Q) : mpred := + globals q ** + (this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m (Some th) ** + owner_token γ.1 th γ.2). + #[global] Arguments locked /. + #[global] Instance locked_timeless `{Σ : cpp_logic, !G Σ} {σ : genv} + this γ th q : Timeless (locked this γ th q). + Proof. rewrite /locked /globals. apply _. Qed. + #[global] Instance locked_exclusive `{Σ : cpp_logic, !G Σ} {σ : genv} + this γ q : Exclusive1 (fun th => locked this γ th q). + Proof. + intros th1 th2. rewrite /locked. + apply observe_2_sep_r. apply observe_2_sep_r. apply _. + Qed. + +End CustomMutexState. + +Module LockState := CustomMutexState MutexSets MutexTokens OwnerTid. + +(** Verify the implementation using its ghost resources and public state predicates. *) +Module custom_mutex. + Module State := LockState. + Module Spec := mutex_spec State. + + Abbreviation N := "MyMutex"%cpp_name. + Abbreviation thread_idR := LockState.thread_idR. + #[local] Hint Opaque LockState.thread_idR : sl_opacity typeclass_instances. + #[local] Instance at_WeaklyObjective `{Σ : cpp_logic} (p : ptr) (R : Rep) `{!WeaklyObjective (R p)} : WeaklyObjective (p |-> R). @@ -87,52 +259,31 @@ Module custom_mutex. \post emp). End unproved_specs. - Record gname : Set := MkGname - { lock_state_gname : LockState.gname - ; cinv_gname : iprop.gname - }. + Definition gname : Set := State.mutex_gname. + Definition lock_state_gname (γ : gname) : State.gname := (γ, (1$m)%cQp). + Definition cinv_gname : gname -> iprop.gname := State.invariant_gname. Definition lock_namespace : namespace := nroot .@@ "MyMutex". - sl.lock - Definition lockedR `{Σ : cpp_logic} `{!LockState.G Σ} `{σ : genv} - (γ: gname) (thr : thread_idT) (q : cQp.t) : Rep := - _field "MyMutex::m_owner" |-> thread_idR 1$m (Some thr) ** pureR (LockState.locked γ.(lock_state_gname) (Some thr) q%Qp). - #[global] Hint Opaque lockedR : sl_opacity typeclass_instances. - #[only(timeless, exclusive)] derive lockedR. - Section with_Σ. Context `{Σ : cpp_logic, σ : genv, HAS_THREADS : !HasStdThreads Σ, - !LockState.G Σ}. + !State.G Σ}. - (** The invariant holds the thread's mutex set while the spinlock is held. - Its token balance supports both full and partial ownership transfers. *) + (** The physical lock bit agrees with the abstract ghost state. The + protected resources and cleared owner field are available while free. *) Definition mutex_inv (this : ptr) (γ : gname) (P : mpred) : mpred := ∃ b : bool, this ,, _field "MyMutex::m_lock" |-> atomic.R "int" 1$m (if b then 1 else 0)%Z ** - ∃ o_owner : option thread_idT, - LockState.owner_tid_auth γ.(lock_state_gname) o_owner ** - (if b then - ∃ th, - MutexSets.my_mutexes - γ.(lock_state_gname).(LockState.pool_namespace) - γ.(lock_state_gname).(LockState.pool_gname) th {[γ.(cinv_gname)]} ** - [| o_owner = Some th |] ** - MutexTokens.token_not_full γ.(lock_state_gname).(LockState.token_gname) - else - P ** - (** The physical owner is cleared before [do_unlock]; the ghost owner - records the last acquiring thread until the next acquisition. *) - this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** - LockState.owner_tid_frag γ.(lock_state_gname) o_owner ** - MutexTokens.token_full γ.(lock_state_gname).(LockState.token_gname)). + State.state γ b ** + if b then emp else + P ** this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None. Definition IR (γ : gname) (q : cQp.t) (P : mpred) : Rep := structR N q$m ** as_Rep (fun this => - cinv lock_namespace γ.(cinv_gname) (mutex_inv this γ P) ** - cinv_own γ.(cinv_gname) q + cinv lock_namespace (cinv_gname γ) (mutex_inv this γ P) ** + cinv_own (cinv_gname γ) q ). Hint Opaque IR : sl_opacity typeclass_instances. #[only(type_ptr,cfractional,ascfractional,cfracvalid)] derive IR. @@ -144,7 +295,7 @@ Module custom_mutex. primR "enum std::memory_order" q (memory_order.to_val memory_order.seq_cst)). - Abbreviation token := (fun g q => LockState.token g.(lock_state_gname) q). + Abbreviation token := (fun g q => State.token (g, (1$m)%cQp) q). cpp.spec "MyMutex::MyMutex()" as ctor_spec with (\exact Reduce (Spec.ctor_spec IR lock_state_gname)). @@ -157,36 +308,28 @@ Module custom_mutex. Definition T : Type := gname * cQp.t * mpred. Abbreviation mutexR := (fun (gq : gname * cQp.t) (_ : cQp.t) P => IR gq.1 gq.2 P). - (* the raw assertions are used for the internal do_lock() and do_unlock() *) - Abbreviation not_locked_raw := - (fun (_ : ptr) (gq : gname * cQp.t) thr (_ : unit) => - LockState.not_locked gq.1.(lock_state_gname) thr gq.2 gq.1.(cinv_gname)). - Abbreviation locked_raw := - (fun (this : ptr) (gq : gname * cQp.t) thr (_ : unit) => - (this |-> lockedR gq.1 thr gq.2)%I). - - (** Locking additionally preserves the globals used by the spin loop. *) - Abbreviation not_locked := (fun this gq thr q' => - (not_locked_raw this gq thr tt ** GLOBALS q')%I). - Abbreviation locked := (fun this gq thr q' => - (GLOBALS q' ** locked_raw this gq thr tt)%I). - - Abbreviation raw_locked_raw := - (fun (this : ptr) (gq : gname * cQp.t) thr (_ : unit) => - (this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** - LockState.locked gq.1.(lock_state_gname) (Some thr) gq.2)%I). - Abbreviation raw_locked := (fun this gq thr q' => - (GLOBALS q' ** raw_locked_raw this gq thr tt)%I). - - cpp.spec "MyMutex::do_lock()" as do_lock_spec with - (\exact Reduce (Spec.lock_spec_alt mutexR not_locked raw_locked)). - - cpp.spec "MyMutex::do_unlock()" as do_unlock_spec with - (\exact Reduce (Spec.unlock_spec_alt mutexR not_locked_raw raw_locked_raw)). - - Definition do_lock := Spec.do_lock not_locked locked. + cpp.spec "MyMutex::do_lock()" as do_lock_spec with ( + \this this + \prepost{g q P} this |-> IR g q P + \persist{thr} current_thread thr + \pre{qg} State.lock_permit g thr q ** GLOBALS qg + \post P ** GLOBALS qg ** + this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** + State.owner_token g thr q). + + cpp.spec "MyMutex::do_unlock()" as do_unlock_spec with ( + \this this + \prepost{g q P} this |-> IR g q P + \persist{thr} current_thread thr + \pre{qg} GLOBALS qg ** + this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** + State.owner_token g thr q + \pre ▷P + \post State.lock_permit g thr q ** GLOBALS qg). + + Definition do_lock := Spec.do_lock (fun g => g). #[global] Arguments do_lock /. - Definition do_unlock := Spec.do_unlock not_locked_raw locked_raw. + Definition do_unlock := Spec.do_unlock (fun g => g). #[global] Arguments do_unlock /. #[global] Instance custom_mutex_basic_lockable : @@ -196,10 +339,10 @@ Module custom_mutex. ; do_unlock := do_unlock }. cpp.spec "MyMutex::lock()" as lock_spec_alt with - (\exact Reduce (Spec.lock_spec_alt mutexR not_locked locked)). + (\exact Reduce (Spec.lock_spec_alt mutexR (fun g => g))). cpp.spec "MyMutex::unlock()" as unlock_spec_alt with - (\exact Reduce (Spec.unlock_spec_alt mutexR not_locked_raw locked_raw)). + (\exact Reduce (Spec.unlock_spec_alt mutexR (fun g => g))). cpp.spec "MyMutex::lock()" as lock_spec with (\exact Reduce @@ -223,13 +366,13 @@ Module custom_mutex. \using denoteModule source \using{thr} current_thread thr \consuming{g q P} p |-> IR g q P - \consuming LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname) + \consuming State.lock_permit g thr q \proving{K (_ : IsExistential K)} std.atomic.do_exchange "int" (BASE (p,, o_field σ "MyMutex::m_lock") ) 1%Z K \instantiate K := (fun res => p |-> IR g q P ** [| res = 0 \/ res = 1 |]%Z ** - if bool_decide (res = 0) then P ** LockState.locked g.(lock_state_gname) (Some thr) q ** + if bool_decide (res = 0) then P ** State.owner_token g thr q ** p ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None - else LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname)) + else State.lock_permit g thr q) \end@{mpredI}. Next Obligation. intros. iIntros "[#M Hpre]" (?? ->). @@ -242,39 +385,33 @@ Module custom_mutex. iInv lock_namespace as "Inv" "Hclose". iDestruct "Inv" as "[Inv CO]". iEval (rewrite /mutex_inv) in "Inv". - iDestruct "Inv" as (b) "[>L Inv]". - iDestruct "Inv" as (oo) "[>OA State]". + iDestruct "Inv" as (b) "(>L & State & Resources)". iDestruct (fupd_mask_subseteq) as ">Y"; [ | iModIntro ]; first set_solver. iExists (if b then 1 else 0)%Z. iSplitL "L". { ework $usenamed=true with br_erefl. } iSplit. - iIntros "L". iMod "Y" as "_". - iMod ("Hclose" with "[L OA State]") as "_". + iMod ("Hclose" with "[L State Resources]") as "_". { iNext. rewrite /mutex_inv. iExists b. iSplitL "L"; first by ework $usenamed=true with br_erefl. - iExists oo. iFrame. } + iFrame. } iModIntro. iFrame. - iNext. iIntros "L". iMod "Y" as "_". destruct b. - + iMod ("Hclose" with "[L OA State]") as "_". + + iMod ("Hclose" with "[L State Resources]") as "_". { iNext. rewrite /mutex_inv. iExists true. iSplitL "L"; first by ework $usenamed=true with br_erefl. - iExists oo. iFrame. } + iFrame. } iModIntro. rewrite /IR _at_sep _at_as_Rep /=. iFrame "CI". iFrame. iPureIntro. auto. - + iDestruct "State" as "(P & Owner & OF & Balance)". - iEval (rewrite /LockState.not_locked /LockState.token) in "NL". - iDestruct "NL" as "[Sets T]". - iDestruct (MutexTokens.acquire with "[$Balance $T]") as "[GT Balance]". - iMod (LockState.owner_update _ _ _ (Some thr) with "[$OA $OF]") - as "[OA OF]". - iMod ("Hclose" with "[L OA Sets Balance]") as "_". + + iDestruct "Resources" as "[P Owner]". + iMod (State.do_lock with "[$State $NL]") as "[State Locked]". + iMod ("Hclose" with "[L State]") as "_". { iNext. rewrite /mutex_inv. iExists true. iSplitL "L"; first by ework $usenamed=true with br_erefl. - iExists (Some thr). iFrame "OA". - iExists thr. iFrame. done. } - iModIntro. rewrite /IR _at_sep _at_as_Rep /LockState.locked /=. + iFrame. } + iModIntro. rewrite /IR _at_sep _at_as_Rep /=. iFrame "CI". iFrame. iPureIntro. auto. Qed. Hint Resolve do_exchange_C : sl_opacity. @@ -287,10 +424,10 @@ Module custom_mutex. \consuming{g q P} p |-> IR g q P \consuming P \consuming p ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None - \consuming LockState.locked g.(lock_state_gname) (Some thr) q + \consuming State.owner_token g thr q \proving{K (_ : IsExistential K)} std.atomic.do_store "int" (BASE (p ,, o_field σ "MyMutex::m_lock")) 0%Z K - \instantiate K := (p |-> IR g q P ** LockState.not_locked g.(lock_state_gname) thr q g.(cinv_gname)) + \instantiate K := (p |-> IR g q P ** State.lock_permit g thr q) \end@{mpredI}. Next Obligation. intros. iIntros "[#M Hpre]" (?? ->). @@ -298,33 +435,26 @@ Module custom_mutex. iDestruct "Hpre" as "(#Thr & IR & P & Owner & Locked)". iEval (rewrite /IR _at_sep _at_as_Rep) in "IR". iDestruct "IR" as "(S & #CI & CO)". - iEval (rewrite /LockState.locked) in "Locked". - iDestruct "Locked" as "[GT OF]". rewrite /std.atomic.do_store. iAcIntro. rewrite /commit_acc /=. iInv lock_namespace as "Inv" "Hclose". iDestruct "Inv" as "[Inv CO]". iEval (rewrite /mutex_inv) in "Inv". - iDestruct "Inv" as (b) "[>L Inv]". - iDestruct "Inv" as (oo) "[>OA State]". + iDestruct "Inv" as (b) "(>L & State & Resources)". iDestruct (fupd_mask_subseteq) as ">Y"; [ | iModIntro ]; first set_solver. iExists (if b then 1 else 0)%Z. iSplitL "L"; first by ework $usenamed=true with br_erefl. iNext. iIntros "L". iMod "Y" as "_". destruct b. - - iDestruct "State" as (owner) "(Sets & %Heq & Balance)". - iDestruct (observe_2 [| oo = Some thr |] with "OA OF") as %Howner. - have -> : owner = thr by congruence. - iDestruct (MutexTokens.release with "[$Balance $GT]") as "[T Balance]". - iMod ("Hclose" with "[L OA P Owner OF Balance]") as "_". + - iMod (State.do_unlock with "[$State $Locked]") as "[State NL]". + iMod ("Hclose" with "[L State P Owner]") as "_". { iNext. rewrite /mutex_inv. iExists false. iSplitL "L"; first by ework $usenamed=true with br_erefl. - iExists oo. iFrame. by rewrite Howner. } + iFrame. } iModIntro. - rewrite /IR _at_sep _at_as_Rep /LockState.not_locked /=. + rewrite /IR _at_sep _at_as_Rep /=. iFrame "CI". iFrame. - - iDestruct "State" as "(P0 & Owner0 & OF0 & Balance0)". - iDestruct (LockState.owner_tid_frag_exclusive with "OF0 OF") as %[]. + - iDestruct (State.unlocked_owner_token with "[$State $Locked]") as %[]. Qed. Hint Resolve do_store_C : sl_opacity. @@ -350,8 +480,6 @@ Module custom_mutex. Qed. Hint Resolve do_load_C : sl_opacity. - Hint Opaque lockedR : sl_opacity. - Lemma mymutex_do_lock_proof : verify[source] "MyMutex::do_lock()". Proof using MOD HAS_THREADS. verify_spec; go. @@ -367,17 +495,14 @@ Module custom_mutex. Lemma mymutex_lock_alt_proof : verify[source] lock_spec_alt. Proof using MOD HAS_THREADS. verify_spec; ego. - rewrite lockedR.unlock. - ego. - Unshelve. all: first [exact (1$m)%cQp | exact tt]. + Unshelve. all: exact (1$m)%cQp. Qed. Lemma mymutex_unlock_alt_proof : verify[source] unlock_spec_alt. Proof using MOD HAS_THREADS. verify_spec. - rewrite lockedR.unlock. repeat (go; ework). - Unshelve. all: first [exact (1$m)%cQp | exact tt]. + Unshelve. all: exact (1$m)%cQp. Qed. Lemma mymutex_ctor_proof : verify[source] "MyMutex::MyMutex()". @@ -387,21 +512,16 @@ Module custom_mutex. wname [P] "P". wname [_ |-> atomic.R _ _ _] "L". wname [_ |-> thread_idR _ _] "Owner". - iMod (MutexSets.alloc_pool (nroot .@@ "MyMutexPool")) as (gp) "#Pool". - iMod (MutexTokens.alloc) as (gt) "[T GT]". - iMod (own_alloc ((●E None ⋅ ◯E None) : LockState.owner_cmraR)) as (go) "O". - { apply excl_auth_valid. } - iDestruct (own_op with "O") as "[OA OF]". - pose (gs := LockState.MkGname (nroot .@@ "MyMutexPool") gp gt go). iMod (cinv_alloc_cofinite ∅ ⊤ lock_namespace) as (gi) "(_ & CO & Halloc)". - iMod ("Halloc" $! (mutex_inv this (MkGname gs gi) P) - with "[] [L P Owner OA OF GT]") as "#CI". + iMod (State.alloc γpool gi) as (gs) "(%Hpool & %Hinv & T & State)". + iMod ("Halloc" $! (mutex_inv this gs P) + with "[] [L P Owner State]") as "#CI". { iPureIntro. rewrite /mutex_inv. apply _. } - { iNext. rewrite /mutex_inv /=. iExists false. iFrame "L". - iExists None. rewrite /LockState.owner_tid_auth /LockState.owner_tid_frag /gs /=. - iFrame. rewrite /MutexTokens.token_full. iLeft. iExact "GT". } - iModIntro. iExists (MkGname gs gi). - rewrite /IR _at_sep _at_as_Rep /LockState.token /gs /=. + { iNext. rewrite /mutex_inv /=. iExists false. iFrame. } + iModIntro. iExists gs. + iSplit; first done. + subst gi. + rewrite /IR _at_sep _at_as_Rep /cinv_gname /=. iFrame "CI". iFrame. Qed. @@ -412,31 +532,30 @@ Module custom_mutex. work. wname [cinv] "#CI". wname [cinv_own] "CO". - wname [LockState.token] "T". + wname [State.token] "T". iMod (cinv_cancel with "CI CO") as "Inv"; [done..|]. go. - iDestruct "Inv" as (b) "(Lock & % & OA & State)". - destruct b eqn:Hb. - - iDestruct "State" as (th) "(Sets & %Eq & Balance)". - iEval (rewrite /LockState.token) in "T". - iDestruct (MutexTokens.token_not_full_full_token with "[$Balance $T]") as %[]. - - iDestruct "State" as "(P & Owner & OF & Balance)". + iDestruct "Inv" as (b) "(Lock & State & Resources)". + destruct b. + - iDestruct (State.locked_full_token with "[$State $T]") as %[]. + - iDestruct "Resources" as "[P Owner]". + iAssert emp with "[State T]" as "_". + { iApply (affine with "[State T]"); last iAccu. apply mpred_BiAffine. } ego $usenamed=true with br_erefl. - iApply (affine with "[OA OF Balance T]"); last iAccu. apply mpred_BiAffine. Qed. Lemma mymutex_lock_proof : verify[source] lock_spec. Proof using MOD HAS_THREADS. have -> : lock_spec ⊣⊢ lock_spec_alt. - { apply (Spec.lock_spec_entails_lock_spec_alt mutexR not_locked locked). done. } + { apply (Spec.lock_spec_entails_lock_spec_alt mutexR (fun g => g)). done. } exact mymutex_lock_alt_proof. Qed. Lemma mymutex_unlock_proof : verify[source] unlock_spec. Proof using MOD HAS_THREADS. have -> : unlock_spec ⊣⊢ unlock_spec_alt. - { apply (Spec.unlock_spec_entails_unlock_spec_alt mutexR not_locked_raw locked_raw). done. } + { apply (Spec.unlock_spec_entails_unlock_spec_alt mutexR (fun g => g)). done. } exact mymutex_unlock_alt_proof. Qed. From 1711628bc7328564b32d0c3b55847356f89164d3 Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Wed, 9 Sep 2026 19:50:15 +0000 Subject: [PATCH 37/51] rename MUTEX_STATE to MUTEX_PREDS --- rocq-brick-libstdcpp/proof/lib/lock_ghost2.v | 32 +----- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 100 ++++++++++++------ .../test/mutex/custom_mutex_hpp_proof.v | 2 +- 3 files changed, 67 insertions(+), 67 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v b/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v index cf952763..b1a684ab 100644 --- a/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v +++ b/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v @@ -11,7 +11,7 @@ Require Export skylabs.brick.libstdcpp.runtime.pred. Import linearity. -(** Ghost state and laws for mutex specs and proofs. *) +(** Various ghost state constructions and laws for concurrency library specs and proofs. *) (** MUTEX_SETS has 2 parts: `mutex_set_map g (T:get thread_idT)` for registering new threads and allocating their `my_mutexes g th` with @@ -172,36 +172,6 @@ Module Type OWNER_TID. (|==> owner_tid_auth γ o' ** owner_tid_frag γ o'). End OWNER_TID. -(** A MUTEX_STATE says a mutex spec is parametrized by some `token`, `not_locked` - and `locked`. The exact model depends on the implementation. *) -Module Type MUTEX_STATE. - Parameter gname : Set. - Parameter Q : Type. - (* FIXME do we need these? *) - Parameter pool_name inv_name : gname -> iprop.gname. - - Parameter G : forall `{Σ : cpp_logic}, Type. - Existing Class G. - #[global] Arguments G {_ _} Σ : assert. - - (** [Q] describes the permissions transferred by lock and unlock. *) - Parameter token : forall `{Σ : cpp_logic, !G Σ}, - gname -> Qp -> mpred. - Parameter not_locked locked : forall `{Σ : cpp_logic, !G Σ} {σ : genv}, - ptr -> gname -> thread_idT -> Q -> mpred. - - #[global] Declare Instance token_fractional - `{Σ : cpp_logic, !G Σ} γ : Fractional (token γ). - #[global] Declare Instance token_timeless - `{Σ : cpp_logic, !G Σ} γ q : Timeless (token γ q). - #[global] Declare Instance locked_timeless - `{Σ : cpp_logic, !G Σ} {σ : genv} this γ th q : - Timeless (locked this γ th q). - #[global] Declare Instance locked_exclusive - `{Σ : cpp_logic, !G Σ} {σ : genv} this γ q : - Exclusive1 (fun th => locked this γ th q). -End MUTEX_STATE. - (* Proofs that the ghost state modules are inhabited. *) Module MutexSets : MUTEX_SETS. diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index 8bf80f0c..59eff024 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -16,15 +16,45 @@ Require Import skylabs.brick.libstdcpp.lib.lock_ghost2. Import linearity. +(** A MUTEX_PREDS says a mutex spec is parametrized by some `token`, `not_locked` + and `locked`. The exact model depends on the implementation. *) +Module Type MUTEX_PREDS. + Parameter gname : Set. + Parameter Q : Type. + (* FIXME do we need these? *) + Parameter pool_name inv_name : gname -> iprop.gname. + + Parameter G : forall `{Σ : cpp_logic}, Type. + Existing Class G. + #[global] Arguments G {_ _} Σ : assert. + + (** [Q] describes the permissions transferred by lock and unlock. *) + Parameter token : forall `{Σ : cpp_logic, !G Σ}, + gname -> Qp -> mpred. + Parameter not_locked locked : forall `{Σ : cpp_logic, !G Σ} {σ : genv}, + ptr -> gname -> thread_idT -> Q -> mpred. + + #[global] Declare Instance token_fractional + `{Σ : cpp_logic, !G Σ} γ : Fractional (token γ). + #[global] Declare Instance token_timeless + `{Σ : cpp_logic, !G Σ} γ q : Timeless (token γ q). + #[global] Declare Instance locked_timeless + `{Σ : cpp_logic, !G Σ} {σ : genv} this γ th q : + Timeless (locked this γ th q). + #[global] Declare Instance locked_exclusive + `{Σ : cpp_logic, !G Σ} {σ : genv} this γ q : + Exclusive1 (fun th => locked this γ th q). +End MUTEX_PREDS. + (* TODO UPSTREAM. *) #[global] Instance SplitRecord_prod A B : SplitRecord (@prod A B) := {}. -Module mutex_spec (State : lock_ghost2.MUTEX_STATE). +Module mutex_spec (Preds : MUTEX_PREDS). Section with_cpp. Context `{Σ : cpp_logic} {σ : genv} {Name : Type}. - Context `{!State.G Σ}. + Context `{!Preds.G Σ}. Context (R : Name -> cQp.t -> mpred -> Rep). - Context (state_name : Name -> State.gname). + Context (state_name : Name -> Preds.gname). Context {HAS_THREADS : HasStdThreads Σ}. (** The guarded predicate must be weakly objective for invariant allocation, @@ -32,55 +62,55 @@ Section with_cpp. Definition ctor_spec : ptr -> WpSpec mpred val val := (\this this \pre{P γpool} ▷P ** [| WeaklyObjective P |] - \post |={⊤}=> Exists g, [| State.pool_name (state_name g) = γpool |] ** - this |-> R g 1$m P ** State.token (state_name g) 1). + \post |={⊤}=> Exists g, [| Preds.pool_name (state_name g) = γpool |] ** + this |-> R g 1$m P ** Preds.token (state_name g) 1). Definition dtor_spec : ptr -> WpSpec mpred val val := (\this this - \pre{g P} this |-> R g 1$m P ** State.token (state_name g) 1 + \pre{g P} this |-> R g 1$m P ** Preds.token (state_name g) 1 \post P). Definition lock_spec_alt : ptr -> WpSpec mpred val val := (\this this \prepost{q P g} this |-> R g q P \persist{thr} current_thread thr - \pre{qt} State.not_locked this (state_name g) thr qt - \post P ** State.locked this (state_name g) thr qt). + \pre{qt} Preds.not_locked this (state_name g) thr qt + \post P ** Preds.locked this (state_name g) thr qt). Definition unlock_spec_alt : ptr -> WpSpec mpred val val := (\this this \prepost{q P g} this |-> R g q P \persist{thr} current_thread thr - \pre{qt} State.locked this (state_name g) thr qt + \pre{qt} Preds.locked this (state_name g) thr qt \pre ▷P - \post State.not_locked this (state_name g) thr qt). + \post Preds.not_locked this (state_name g) thr qt). Definition try_lock_spec_alt : ptr -> WpSpec mpred val val := (\this this \prepost{q P g} this |-> R g q P \persist{thr} current_thread thr - \pre{qt} State.not_locked this (state_name g) thr qt + \pre{qt} Preds.not_locked this (state_name g) thr qt \post{b}[Vbool b] - if b then P ** State.locked this (state_name g) thr qt - else State.not_locked this (state_name g) thr qt). + if b then P ** Preds.locked this (state_name g) thr qt + else Preds.not_locked this (state_name g) thr qt). (* TODO readd the later on the lock/unlock continuations. *) Definition do_lock (this : ptr) (lk : Name * mpred) (K : mpred) : mpred := - ∃ thr qt, current_thread thr ** State.not_locked this (state_name lk.1) thr qt ** - (State.locked this (state_name lk.1) thr qt ** lk.2 -* K). + ∃ thr qt, current_thread thr ** Preds.not_locked this (state_name lk.1) thr qt ** + (Preds.locked this (state_name lk.1) thr qt ** lk.2 -* K). #[global] Arguments do_lock /. Definition do_unlock (this : ptr) (lk : Name * mpred) (K : mpred) : mpred := - ∃ thr qt, current_thread thr ** State.locked this (state_name lk.1) thr qt ** ▷lk.2 ** - (State.not_locked this (state_name lk.1) thr qt -* K). + ∃ thr qt, current_thread thr ** Preds.locked this (state_name lk.1) thr qt ** ▷lk.2 ** + (Preds.not_locked this (state_name lk.1) thr qt -* K). #[global] Arguments do_unlock /. Definition do_try_lock (this : ptr) (lk : Name * mpred) (K : bool -> mpred) : mpred := - ∃ thr qt, current_thread thr ** State.not_locked this (state_name lk.1) thr qt ** + ∃ thr qt, current_thread thr ** Preds.not_locked this (state_name lk.1) thr qt ** ∀ b : bool, - (if b then lk.2 ** State.locked this (state_name lk.1) thr qt - else State.not_locked this (state_name lk.1) thr qt) -* K b. + (if b then lk.2 ** Preds.locked this (state_name lk.1) thr qt + else Preds.not_locked this (state_name lk.1) thr qt) -* K b. #[global] Arguments do_try_lock /. Section equivalences. @@ -110,7 +140,7 @@ Section with_cpp. - ework with br_erefl. - iIntros "H". iDestruct "H" as (q P g thr qt) "(%Hxs & HR & #HT & HNL & HK)". - iExists q, (g, P), (P ** State.locked this (state_name g) thr qt)%I. + iExists q, (g, P), (P ** Preds.locked this (state_name g) thr qt)%I. iFrame "HR HK". iSplit; first done. iExists thr, qt. iFrame "HT HNL". iIntros "[HL HP]". iFrame. @@ -128,7 +158,7 @@ Section with_cpp. - ework with br_erefl. - iIntros "H". iDestruct "H" as (q P g thr qt) "(%Hxs & HR & #HT & HL & HP & HK)". - iExists q, (g, P), (State.not_locked this (state_name g) thr qt). + iExists q, (g, P), (Preds.not_locked this (state_name g) thr qt). iFrame "HR HK". iSplit; first done. iExists thr, qt. iFrame "HT HL HP". iIntros "$". @@ -149,8 +179,8 @@ Section with_cpp. - iIntros "H". iDestruct "H" as (q P g thr qt) "(%Hxs & HR & #HT & HNL & HK)". iExists q, (g, P), (fun b : bool => - if b then (P ** State.locked this (state_name g) thr qt)%I - else State.not_locked this (state_name g) thr qt). + if b then (P ** Preds.locked this (state_name g) thr qt)%I + else Preds.not_locked this (state_name g) thr qt). iFrame "HR HK". iSplit; first done. iExists thr, qt. iFrame "HT HNL". iIntros (b) "$". @@ -162,21 +192,21 @@ End mutex_spec. (** Specialize the reusable specs to the standard mutex representation and bind them to their C++ names. *) -Module StdMutex (State : lock_ghost2.MUTEX_STATE). - Module Spec := mutex_spec State. +Module StdMutex (Preds : MUTEX_PREDS). + Module Spec := mutex_spec Preds. - Definition gname := State.gname. + Definition gname := Preds.gname. Definition lock_state_gname (g : gname) := g. - Abbreviation cinv_gname := State.inv_name. + Abbreviation cinv_gname := Preds.inv_name. - Definition G := @State.G. + Definition G := @Preds.G. Existing Class G. #[global] Arguments G {_ _} Σ : assert. - #[global] Instance state_G `{Σ : cpp_logic} (H : G Σ) : State.G Σ := H. + #[global] Instance state_G `{Σ : cpp_logic} (H : G Σ) : Preds.G Σ := H. - Abbreviation token := State.token. - Abbreviation not_locked := State.not_locked. - Abbreviation locked := State.locked. + Abbreviation token := Preds.token. + Abbreviation not_locked := Preds.not_locked. + Abbreviation locked := Preds.locked. Section with_cpp. Context `{Σ : cpp_logic}. @@ -271,7 +301,7 @@ End with_cpp. End StdMutex. (** The standard-library implementation remains abstract; concrete mutex - implementations instantiate [MUTEX_STATE] beside their proofs. *) -Declare Module StdMutexState : lock_ghost2.MUTEX_STATE with Definition Q := Qp. + implementations instantiate [MUTEX_PREDS] beside their proofs. *) +Declare Module StdMutexState : MUTEX_PREDS with Definition Q := Qp. Module StdMutexInst := StdMutex StdMutexState. Module mutex := StdMutexInst. diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index 0a399265..a3a4c756 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -15,7 +15,7 @@ Require Import skylabs.brick.libstdcpp.test.mutex.custom_mutex_hpp. (** The ghost implementation and its physical client predicates are specific to [MyMutex]. The entire mutex-set pool still uses one shared ghost name. *) Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) - (Owners0 : OWNER_TID) <: MUTEX_STATE. + (Owners0 : OWNER_TID) <: MUTEX_PREDS. Record mutex_gname : Set := MkGname { pool_gname : iprop.gname; invariant_gname : iprop.gname; From 8020b9bd54bfe936cc9fd1020a7bf699c4775622 Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Wed, 9 Sep 2026 21:20:13 +0000 Subject: [PATCH 38/51] code clean up --- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 156 +++++++++--------- .../test/mutex/custom_mutex_hpp_proof.v | 92 +++++------ 2 files changed, 119 insertions(+), 129 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index 59eff024..7824cf4f 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -20,7 +20,6 @@ Import linearity. and `locked`. The exact model depends on the implementation. *) Module Type MUTEX_PREDS. Parameter gname : Set. - Parameter Q : Type. (* FIXME do we need these? *) Parameter pool_name inv_name : gname -> iprop.gname. @@ -28,14 +27,15 @@ Module Type MUTEX_PREDS. Existing Class G. #[global] Arguments G {_ _} Σ : assert. - (** [Q] describes the permissions transferred by lock and unlock. *) + (** [cQp.t] describes the permissions transferred by lock and unlock. + The permission might involve points-to, so use cQp.t instead of QP. *) Parameter token : forall `{Σ : cpp_logic, !G Σ}, - gname -> Qp -> mpred. + gname -> cQp.t -> mpred. Parameter not_locked locked : forall `{Σ : cpp_logic, !G Σ} {σ : genv}, - ptr -> gname -> thread_idT -> Q -> mpred. + ptr -> gname -> thread_idT -> cQp.t -> mpred. #[global] Declare Instance token_fractional - `{Σ : cpp_logic, !G Σ} γ : Fractional (token γ). + `{Σ : cpp_logic, !G Σ} γ : CFractional (token γ). #[global] Declare Instance token_timeless `{Σ : cpp_logic, !G Σ} γ q : Timeless (token γ q). #[global] Declare Instance locked_timeless @@ -63,11 +63,11 @@ Section with_cpp. (\this this \pre{P γpool} ▷P ** [| WeaklyObjective P |] \post |={⊤}=> Exists g, [| Preds.pool_name (state_name g) = γpool |] ** - this |-> R g 1$m P ** Preds.token (state_name g) 1). + this |-> R g 1$m P ** Preds.token (state_name g) 1$m). Definition dtor_spec : ptr -> WpSpec mpred val val := (\this this - \pre{g P} this |-> R g 1$m P ** Preds.token (state_name g) 1 + \pre{g P} this |-> R g 1$m P ** Preds.token (state_name g) 1$m \post P). Definition lock_spec_alt : ptr -> WpSpec mpred val val := @@ -208,100 +208,94 @@ Module StdMutex (Preds : MUTEX_PREDS). Abbreviation not_locked := Preds.not_locked. Abbreviation locked := Preds.locked. -Section with_cpp. - Context `{Σ : cpp_logic}. + Section with_cpp. + Context `{Σ : cpp_logic}. - (** Fractional ownership of a <> guarding the predicate <

>. *) - Parameter R : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv}, gname -> cQp.t -> mpred -> Rep. - #[global] Hint Opaque R : sl_opacity typeclass_instances. - #[only(cfractional,cfracvalid,ascfractional,type_ptr="std::mutex")] derive R. - #[global] Declare Instance R_learnable : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv}, - Cbn (Learn (learn_eq ==> any ==> learn_eq ==> learn_hints.fin) R). + (** Fractional ownership of a <> guarding the predicate <

>. *) + Parameter R : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv}, gname -> cQp.t -> mpred -> Rep. + #[global] Hint Opaque R : sl_opacity typeclass_instances. + #[only(cfractional,cfracvalid,ascfractional,type_ptr="std::mutex")] derive R. + #[global] Declare Instance R_learnable : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv}, + Cbn (Learn (learn_eq ==> any ==> learn_eq ==> learn_hints.fin) R). - Section with_RepFor. - Import rep.RepFor. - Import RepScheme. + Section with_RepFor. + Import rep.RepFor. + Import RepScheme. - #[global] Instance repfor `{!HasStdThreads Σ} {σ : genv} : - rep.RepFor.C "std::mutex" [ArgType.Constant _; ArgType.CFrac; ArgType.Constant _] - (funI γ q P => R γ q P) := {}. - End with_RepFor. + #[global] Instance repfor `{!HasStdThreads Σ} {σ : genv} : + rep.RepFor.C "std::mutex" [ArgType.Constant _; ArgType.CFrac; ArgType.Constant _] + (funI γ q P => R γ q P) := {}. + End with_RepFor. - Context `{!G Σ}. + Context `{!G Σ}. - Context `{MOD : source ⊧ σ}. - Context {HAS_THREADS : HasStdThreads Σ}. + Context `{MOD : source ⊧ σ}. + Context {HAS_THREADS : HasStdThreads Σ}. - #[global] Instance locked_learn : - Cbn (Learn (req_eq ==> learn_eq ==> req_eq ==> req_eq ==> learn_hints.fin) locked). - Proof. solve_learnable. Qed. + #[global] Instance locked_learn : + Cbn (Learn (req_eq ==> learn_eq ==> req_eq ==> req_eq ==> learn_hints.fin) locked). + Proof. solve_learnable. Qed. - cpp.spec "std::mutex::mutex()" as ctor_spec with - (\exact Reduce (Spec.ctor_spec R lock_state_gname)). + cpp.spec "std::mutex::mutex()" as ctor_spec with + (\exact Reduce (Spec.ctor_spec R lock_state_gname)). - cpp.spec "std::mutex::~mutex()" as dtor_spec with - (\exact Reduce (Spec.dtor_spec R lock_state_gname)). + cpp.spec "std::mutex::~mutex()" as dtor_spec with + (\exact Reduce (Spec.dtor_spec R lock_state_gname)). - cpp.spec "std::mutex::lock()" as lock_spec_alt with - (\exact Reduce (Spec.lock_spec_alt R lock_state_gname)). + cpp.spec "std::mutex::lock()" as lock_spec_alt with + (\exact Reduce (Spec.lock_spec_alt R lock_state_gname)). - cpp.spec "std::mutex::unlock()" as unlock_spec_alt with - (\exact Reduce (Spec.unlock_spec_alt R lock_state_gname)). + cpp.spec "std::mutex::unlock()" as unlock_spec_alt with + (\exact Reduce (Spec.unlock_spec_alt R lock_state_gname)). - cpp.spec "std::mutex::try_lock()" as try_lock_spec_alt with - (\exact Reduce (Spec.try_lock_spec_alt R lock_state_gname)). + cpp.spec "std::mutex::try_lock()" as try_lock_spec_alt with + (\exact Reduce (Spec.try_lock_spec_alt R lock_state_gname)). - Definition do_lock := Spec.do_lock lock_state_gname. - #[global] Arguments do_lock /. - Definition do_unlock := Spec.do_unlock lock_state_gname. - #[global] Arguments do_unlock /. - Definition do_try_lock := Spec.do_try_lock lock_state_gname. - #[global] Arguments do_try_lock /. + Definition do_lock := Spec.do_lock lock_state_gname. + #[global] Arguments do_lock /. + Definition do_unlock := Spec.do_unlock lock_state_gname. + #[global] Arguments do_unlock /. + Definition do_try_lock := Spec.do_try_lock lock_state_gname. + #[global] Arguments do_try_lock /. - (** <> implements [BasicLockable] and [Lockable]. *) - Definition T : Type := gname * mpred. + (** <> implements [BasicLockable] and [Lockable]. *) + Definition T : Type := gname * mpred. - #[global] Instance mutex_basic_lockable : - BasicLockable (T:=T) "std::mutex" (λ q γP, R γP.1 q γP.2) := - { do_lock := do_lock - ; do_unlock := do_unlock }. + #[global] Instance mutex_basic_lockable : + BasicLockable (T:=T) "std::mutex" (λ q γP, R γP.1 q γP.2) := + { do_lock := do_lock + ; do_unlock := do_unlock }. - cpp.spec "std::mutex::lock()" as lock_spec with - (\exact Reduce (lock_basic_lockable "std::mutex" (λ q γP, R γP.1 q γP.2))). + cpp.spec "std::mutex::lock()" as lock_spec with + (\exact Reduce (lock_basic_lockable "std::mutex" (λ q γP, R γP.1 q γP.2))). - cpp.spec "std::mutex::unlock()" as unlock_spec with - (\exact Reduce (unlock_basic_lockable "std::mutex" (λ q γP, R γP.1 q γP.2))). + cpp.spec "std::mutex::unlock()" as unlock_spec with + (\exact Reduce (unlock_basic_lockable "std::mutex" (λ q γP, R γP.1 q γP.2))). - #[global] Instance mutex_lockable : - Lockable (T:=T) "std::mutex" (λ q γP, R γP.1 q γP.2) := - { do_try_lock := do_try_lock }. + #[global] Instance mutex_lockable : + Lockable (T:=T) "std::mutex" (λ q γP, R γP.1 q γP.2) := + { do_try_lock := do_try_lock }. - cpp.spec "std::mutex::try_lock()" as try_lock_spec with - (\exact Reduce (try_lock_lockable "std::mutex" (λ q γP, R γP.1 q γP.2))). + cpp.spec "std::mutex::try_lock()" as try_lock_spec with + (\exact Reduce (try_lock_lockable "std::mutex" (λ q γP, R γP.1 q γP.2))). - Lemma lock_spec_entails_lock_spec_alt : lock_spec -|- lock_spec_alt. - Proof. - apply (Spec.lock_spec_entails_lock_spec_alt R lock_state_gname). - reflexivity. - Qed. + Lemma lock_spec_entails_lock_spec_alt : lock_spec -|- lock_spec_alt. + Proof. + apply (Spec.lock_spec_entails_lock_spec_alt R lock_state_gname). + reflexivity. + Qed. - Lemma unlock_spec_entails_unlock_spec_alt : unlock_spec -|- unlock_spec_alt. - Proof. - apply (Spec.unlock_spec_entails_unlock_spec_alt R lock_state_gname). - reflexivity. - Qed. + Lemma unlock_spec_entails_unlock_spec_alt : unlock_spec -|- unlock_spec_alt. + Proof. + apply (Spec.unlock_spec_entails_unlock_spec_alt R lock_state_gname). + reflexivity. + Qed. - Lemma try_lock_spec_entails_try_lock_spec_alt : try_lock_spec -|- try_lock_spec_alt. - Proof. - apply (Spec.try_lock_spec_entails_try_lock_spec_alt R lock_state_gname). - reflexivity. - Qed. -End with_cpp. + Lemma try_lock_spec_entails_try_lock_spec_alt : try_lock_spec -|- try_lock_spec_alt. + Proof. + apply (Spec.try_lock_spec_entails_try_lock_spec_alt R lock_state_gname). + reflexivity. + Qed. + End with_cpp. End StdMutex. - -(** The standard-library implementation remains abstract; concrete mutex - implementations instantiate [MUTEX_PREDS] beside their proofs. *) -Declare Module StdMutexState : MUTEX_PREDS with Definition Q := Qp. -Module StdMutexInst := StdMutex StdMutexState. -Module mutex := StdMutexInst. diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index a3a4c756..990ddd6b 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -22,10 +22,9 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) token_gname : iprop.gname; owner_gname : iprop.gname; }. - Definition gname : Set := mutex_gname * cQp.t. - Definition Q : Type := cQp.t. - Definition pool_name (γ : gname) : iprop.gname := γ.1.(pool_gname). - Definition inv_name (γ : gname) : iprop.gname := γ.1.(invariant_gname). + Definition gname : Set := mutex_gname. + Definition pool_name (γ : gname) : iprop.gname := γ.(pool_gname). + Definition inv_name (γ : gname) : iprop.gname := γ.(invariant_gname). Class stateG `{Σ : cpp_logic} := { #[global] sets_G :: Sets0.G Σ; @@ -38,10 +37,10 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) #[global] Instance state_G `{Σ : cpp_logic} (H : G Σ) : @stateG _ _ Σ := H. Definition token `{Σ : cpp_logic, !G Σ} - (γ : gname) (q : Qp) : mpred := - Tokens0.token γ.1.(token_gname) q. + (γ : gname) (q : cQp.t) : mpred := + Tokens0.token γ.(token_gname) q. - Definition lock_permit `{Σ : cpp_logic, !G Σ} + Definition not_locked_ghost `{Σ : cpp_logic, !G Σ} (γ : mutex_gname) (th : thread_idT) (q : Qp) : mpred := Sets0.mutex_set_frag γ.(pool_gname) th (GSet {[γ.(invariant_gname)]}) ** Tokens0.token γ.(token_gname) q. @@ -52,8 +51,11 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) Owners0.owner_tid_frag γ.(owner_gname) (Some th). #[global] Instance token_fractional - `{Σ : cpp_logic, !G Σ} γ : Fractional (token γ). - Proof. rewrite /token. apply Tokens0.token_fractional. Qed. + `{Σ : cpp_logic, !G Σ} γ : CFractional (token γ). + Proof. + intros q1 q2. rewrite /token cQp.frac_add. + apply Tokens0.token_fractional. + Qed. #[global] Instance token_timeless `{Σ : cpp_logic, !G Σ} γ q : Timeless (token γ q). @@ -94,7 +96,7 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) Lemma alloc (γpool : iprop.gname) inv_gname : ⊢ |==> ∃ γ, [| γ.(pool_gname) = γpool |] ** [| γ.(invariant_gname) = inv_gname |] ** - token (γ, (1$m)%cQp) 1 ** state γ false. + token γ 1$m ** state γ false. Proof. iMod Tokens0.alloc as (gt) "[T GT]". iMod (Owners0.alloc None) as (go) "[OA OF]". @@ -106,10 +108,10 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) Qed. Lemma do_lock γ th q : - state γ false ** lock_permit γ th q |-- + state γ false ** not_locked_ghost γ th q |-- (|==> state γ true ** owner_token γ th q). Proof. - rewrite /state /lock_permit /owner_token. + rewrite /state /not_locked_ghost /owner_token. iIntros "[State [Sets T]]". iDestruct "State" as (owner) "(OA & OF & Balance)". iDestruct (Tokens0.acquire with "[$Balance $T]") as "[GT Balance]". @@ -120,9 +122,9 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) Lemma do_unlock γ th q : state γ true ** owner_token γ th q |-- - (|==> state γ false ** lock_permit γ th q). + (|==> state γ false ** not_locked_ghost γ th q). Proof. - rewrite /state /owner_token /lock_permit. + rewrite /state /owner_token /not_locked_ghost. iIntros "[State [GT OF]]". iDestruct "State" as (owner) "(OA & Sets & Balance)". iDestruct (observe_2 [| Some owner = Some th |] with "OA OF") as %Heq. @@ -140,7 +142,7 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) Qed. Lemma locked_full_token γ : - state γ true ** token (γ, (1$m)%cQp) 1 |-- False. + state γ true ** token γ 1$m |-- False. Proof. rewrite /state /token. iIntros "[State T]". iDestruct "State" as (th) "(_ & _ & Balance)". @@ -148,7 +150,7 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) Qed. End state_laws. - #[global] Hint Opaque token lock_permit owner_token state : sl_opacity typeclass_instances. + #[global] Hint Opaque token not_locked_ghost owner_token state : sl_opacity typeclass_instances. Parameter thread_idR : ∀ `{Σ : cpp_logic, σ : genv}, cQp.t -> (* None if value is thread::id(), Some otherwise *) @@ -166,17 +168,17 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) (memory_order.to_val memory_order.seq_cst). Definition not_locked `{Σ : cpp_logic, !G Σ} {σ : genv} - (this : ptr) (γ : gname) (th : thread_idT) (q : Q) : mpred := - lock_permit γ.1 th γ.2 ** globals q. + (this : ptr) (γ : gname) (th : thread_idT) (q : cQp.t) : mpred := + not_locked_ghost γ th q ** globals q. #[global] Arguments not_locked /. #[global] Arguments globals /. (** Public ownership includes the physical owner written by [lock]. *) Definition locked `{Σ : cpp_logic, !G Σ} {σ : genv} - (this : ptr) (γ : gname) (th : thread_idT) (q : Q) : mpred := + (this : ptr) (γ : gname) (th : thread_idT) (q : cQp.t) : mpred := globals q ** (this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m (Some th) ** - owner_token γ.1 th γ.2). + owner_token γ th q). #[global] Arguments locked /. #[global] Instance locked_timeless `{Σ : cpp_logic, !G Σ} {σ : genv} this γ th q : Timeless (locked this γ th q). @@ -260,7 +262,7 @@ Module custom_mutex. End unproved_specs. Definition gname : Set := State.mutex_gname. - Definition lock_state_gname (γ : gname) : State.gname := (γ, (1$m)%cQp). + Definition lock_state_gname (γ : gname) : State.gname := γ. Definition cinv_gname : gname -> iprop.gname := State.invariant_gname. Definition lock_namespace : namespace := nroot .@@ "MyMutex". @@ -295,62 +297,56 @@ Module custom_mutex. primR "enum std::memory_order" q (memory_order.to_val memory_order.seq_cst)). - Abbreviation token := (fun g q => State.token (g, (1$m)%cQp) q). - cpp.spec "MyMutex::MyMutex()" as ctor_spec with (\exact Reduce (Spec.ctor_spec IR lock_state_gname)). cpp.spec "MyMutex::~MyMutex()" as dtor_spec with (\exact Reduce (Spec.dtor_spec IR lock_state_gname)). - (** Keep the representation fraction in the state, since this implementation - uses the same fraction for [IR] and the locking tokens. *) - Definition T : Type := gname * cQp.t * mpred. - Abbreviation mutexR := (fun (gq : gname * cQp.t) (_ : cQp.t) P => - IR gq.1 gq.2 P). + Definition T : Type := gname * mpred. cpp.spec "MyMutex::do_lock()" as do_lock_spec with ( \this this \prepost{g q P} this |-> IR g q P \persist{thr} current_thread thr - \pre{qg} State.lock_permit g thr q ** GLOBALS qg - \post P ** GLOBALS qg ** + \pre{(qt : cQp.t)} State.not_locked_ghost g thr qt ** GLOBALS qt + \post P ** GLOBALS qt ** this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** - State.owner_token g thr q). + State.owner_token g thr qt). cpp.spec "MyMutex::do_unlock()" as do_unlock_spec with ( \this this \prepost{g q P} this |-> IR g q P \persist{thr} current_thread thr - \pre{qg} GLOBALS qg ** + \pre{qt} GLOBALS qt ** this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** - State.owner_token g thr q + State.owner_token g thr qt \pre ▷P - \post State.lock_permit g thr q ** GLOBALS qg). + \post State.not_locked_ghost g thr qt ** GLOBALS qt). - Definition do_lock := Spec.do_lock (fun g => g). + Definition do_lock := Spec.do_lock lock_state_gname. #[global] Arguments do_lock /. - Definition do_unlock := Spec.do_unlock (fun g => g). + Definition do_unlock := Spec.do_unlock lock_state_gname. #[global] Arguments do_unlock /. #[global] Instance custom_mutex_basic_lockable : BasicLockable (T := T) (Tnamed N) - (fun _ gqP => IR gqP.1.1 gqP.1.2 gqP.2) := + (fun q gP => IR gP.1 q gP.2) := { do_lock := do_lock ; do_unlock := do_unlock }. cpp.spec "MyMutex::lock()" as lock_spec_alt with - (\exact Reduce (Spec.lock_spec_alt mutexR (fun g => g))). + (\exact Reduce (Spec.lock_spec_alt IR lock_state_gname)). cpp.spec "MyMutex::unlock()" as unlock_spec_alt with - (\exact Reduce (Spec.unlock_spec_alt mutexR (fun g => g))). + (\exact Reduce (Spec.unlock_spec_alt IR lock_state_gname)). cpp.spec "MyMutex::lock()" as lock_spec with (\exact Reduce - (lock_basic_lockable (Tnamed N) (fun q gqP => IR gqP.1.1 gqP.1.2 gqP.2))). + (lock_basic_lockable (Tnamed N) (fun q gP => IR gP.1 q gP.2))). cpp.spec "MyMutex::unlock()" as unlock_spec with (\exact Reduce - (unlock_basic_lockable (Tnamed N) (fun q gqP => IR gqP.1.1 gqP.1.2 gqP.2))). + (unlock_basic_lockable (Tnamed N) (fun q gP => IR gP.1 q gP.2))). Abbreviation BASE p := (p ,, _base "std::atomic" "std::__atomic_base"). @@ -366,13 +362,13 @@ Module custom_mutex. \using denoteModule source \using{thr} current_thread thr \consuming{g q P} p |-> IR g q P - \consuming State.lock_permit g thr q + \consuming{qt} State.not_locked_ghost g thr qt \proving{K (_ : IsExistential K)} std.atomic.do_exchange "int" (BASE (p,, o_field σ "MyMutex::m_lock") ) 1%Z K \instantiate K := (fun res => p |-> IR g q P ** [| res = 0 \/ res = 1 |]%Z ** - if bool_decide (res = 0) then P ** State.owner_token g thr q ** + if bool_decide (res = 0) then P ** State.owner_token g thr qt ** p ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None - else State.lock_permit g thr q) + else State.not_locked_ghost g thr qt) \end@{mpredI}. Next Obligation. intros. iIntros "[#M Hpre]" (?? ->). @@ -424,10 +420,10 @@ Module custom_mutex. \consuming{g q P} p |-> IR g q P \consuming P \consuming p ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None - \consuming State.owner_token g thr q + \consuming{qt} State.owner_token g thr qt \proving{K (_ : IsExistential K)} std.atomic.do_store "int" (BASE (p ,, o_field σ "MyMutex::m_lock")) 0%Z K - \instantiate K := (p |-> IR g q P ** State.lock_permit g thr q) + \instantiate K := (p |-> IR g q P ** State.not_locked_ghost g thr qt) \end@{mpredI}. Next Obligation. intros. iIntros "[#M Hpre]" (?? ->). @@ -548,14 +544,14 @@ Module custom_mutex. Lemma mymutex_lock_proof : verify[source] lock_spec. Proof using MOD HAS_THREADS. have -> : lock_spec ⊣⊢ lock_spec_alt. - { apply (Spec.lock_spec_entails_lock_spec_alt mutexR (fun g => g)). done. } + { apply (Spec.lock_spec_entails_lock_spec_alt IR lock_state_gname). done. } exact mymutex_lock_alt_proof. Qed. Lemma mymutex_unlock_proof : verify[source] unlock_spec. Proof using MOD HAS_THREADS. have -> : unlock_spec ⊣⊢ unlock_spec_alt. - { apply (Spec.unlock_spec_entails_unlock_spec_alt mutexR (fun g => g)). done. } + { apply (Spec.unlock_spec_entails_unlock_spec_alt IR lock_state_gname). done. } exact mymutex_unlock_alt_proof. Qed. From 81821471f40a0764aa69589c55e6010b1b6ab56d Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Wed, 9 Sep 2026 21:44:22 +0000 Subject: [PATCH 39/51] more clean up --- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 29 +++++++++--------- .../proof/shared_mutex/shared_mutex.v | 4 +-- .../test/mutex/custom_mutex_hpp_proof.v | 30 +++++++------------ .../test/vector/test_cpp_proof.v | 4 +-- 4 files changed, 27 insertions(+), 40 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index 7824cf4f..a7cbb6ba 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -20,8 +20,8 @@ Import linearity. and `locked`. The exact model depends on the implementation. *) Module Type MUTEX_PREDS. Parameter gname : Set. - (* FIXME do we need these? *) - Parameter pool_name inv_name : gname -> iprop.gname. + (** Mutex-set pool agreed before mutex creation. *) + Parameter pool_name : gname -> iprop.gname. Parameter G : forall `{Σ : cpp_logic}, Type. Existing Class G. @@ -42,11 +42,11 @@ Module Type MUTEX_PREDS. `{Σ : cpp_logic, !G Σ} {σ : genv} this γ th q : Timeless (locked this γ th q). #[global] Declare Instance locked_exclusive - `{Σ : cpp_logic, !G Σ} {σ : genv} this γ q : - Exclusive1 (fun th => locked this γ th q). + `{Σ : cpp_logic, !G Σ} {σ : genv} this γ : + Exclusive2 (locked this γ). End MUTEX_PREDS. -(* TODO UPSTREAM. *) +(* TODO UPSTREAM. FIXME what does this do? *) #[global] Instance SplitRecord_prod A B : SplitRecord (@prod A B) := {}. Module mutex_spec (Preds : MUTEX_PREDS). @@ -127,7 +127,7 @@ Section with_cpp. iSplit; iApply specify_mono; intros this xs K; rewrite Heq; done. Qed. - Lemma lock_spec_entails_lock_spec_alt + Lemma lock_spec_equiv_lock_spec_alt (Hlock : requirements.do_lock (Tnamed class_name) = do_lock) : spec_type_void_to_ret "void" (lock_basic_lockable (Tnamed class_name) (fun q gp => R gp.1 q gp.2)) ⊣⊢ @@ -146,7 +146,7 @@ Section with_cpp. iIntros "[HL HP]". iFrame. Qed. - Lemma unlock_spec_entails_unlock_spec_alt + Lemma unlock_spec_equiv_unlock_spec_alt (Hunlock : requirements.do_unlock (Tnamed class_name) = do_unlock) : spec_type_void_to_ret "void" (unlock_basic_lockable (Tnamed class_name) (fun q gp => R gp.1 q gp.2)) ⊣⊢ spec_type_void_to_ret "void" unlock_spec_alt. @@ -166,7 +166,7 @@ Section with_cpp. Context {L : Lockable (Tnamed class_name) (fun q gp => R gp.1 q gp.2)}. - Lemma try_lock_spec_entails_try_lock_spec_alt + Lemma try_lock_spec_equiv_try_lock_spec_alt (Htry_lock : requirements.do_try_lock (Tnamed class_name) = do_try_lock) : spec_type_void_to_ret "bool" (try_lock_lockable (Tnamed class_name) (fun q gp => R gp.1 q gp.2)) ⊣⊢ spec_type_void_to_ret "bool" try_lock_spec_alt. @@ -197,7 +197,6 @@ Module StdMutex (Preds : MUTEX_PREDS). Definition gname := Preds.gname. Definition lock_state_gname (g : gname) := g. - Abbreviation cinv_gname := Preds.inv_name. Definition G := @Preds.G. Existing Class G. @@ -280,21 +279,21 @@ Module StdMutex (Preds : MUTEX_PREDS). cpp.spec "std::mutex::try_lock()" as try_lock_spec with (\exact Reduce (try_lock_lockable "std::mutex" (λ q γP, R γP.1 q γP.2))). - Lemma lock_spec_entails_lock_spec_alt : lock_spec -|- lock_spec_alt. + Lemma lock_spec_equiv_lock_spec_alt : lock_spec -|- lock_spec_alt. Proof. - apply (Spec.lock_spec_entails_lock_spec_alt R lock_state_gname). + apply (Spec.lock_spec_equiv_lock_spec_alt R lock_state_gname). reflexivity. Qed. - Lemma unlock_spec_entails_unlock_spec_alt : unlock_spec -|- unlock_spec_alt. + Lemma unlock_spec_equiv_unlock_spec_alt : unlock_spec -|- unlock_spec_alt. Proof. - apply (Spec.unlock_spec_entails_unlock_spec_alt R lock_state_gname). + apply (Spec.unlock_spec_equiv_unlock_spec_alt R lock_state_gname). reflexivity. Qed. - Lemma try_lock_spec_entails_try_lock_spec_alt : try_lock_spec -|- try_lock_spec_alt. + Lemma try_lock_spec_equiv_try_lock_spec_alt : try_lock_spec -|- try_lock_spec_alt. Proof. - apply (Spec.try_lock_spec_entails_try_lock_spec_alt R lock_state_gname). + apply (Spec.try_lock_spec_equiv_try_lock_spec_alt R lock_state_gname). reflexivity. Qed. End with_cpp. diff --git a/rocq-brick-libstdcpp/proof/shared_mutex/shared_mutex.v b/rocq-brick-libstdcpp/proof/shared_mutex/shared_mutex.v index e5541e62..423054ea 100644 --- a/rocq-brick-libstdcpp/proof/shared_mutex/shared_mutex.v +++ b/rocq-brick-libstdcpp/proof/shared_mutex/shared_mutex.v @@ -10,13 +10,11 @@ Require Export skylabs.brick.libstdcpp.runtime.pred. Require Import skylabs.brick.libstdcpp.shared_mutex.inc_hpp. Require Import skylabs.brick.libstdcpp.mutex.requirements. Require Import skylabs.brick.libstdcpp.lib.lock_ghost. +Require Import skylabs.brick.libstdcpp.lib.tactics. Import linearity. Import lock_ghost. -(* TODO UPSTREAM. *) -#[global] Instance SplitRecord_prod A B : SplitRecord (@prod A B) := {}. - Module shared_mutex. Section with_cpp. diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index 990ddd6b..2f166758 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -24,7 +24,6 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) }. Definition gname : Set := mutex_gname. Definition pool_name (γ : gname) : iprop.gname := γ.(pool_gname). - Definition inv_name (γ : gname) : iprop.gname := γ.(invariant_gname). Class stateG `{Σ : cpp_logic} := { #[global] sets_G :: Sets0.G Σ; @@ -66,10 +65,10 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) Proof. rewrite /owner_token. apply _. Qed. #[global] Instance owner_token_exclusive - `{Σ : cpp_logic, !G Σ} γ q : Exclusive1 (fun th => owner_token γ th q). + `{Σ : cpp_logic, !G Σ} γ : Exclusive2 (owner_token γ). Proof. - intros th1 th2. rewrite /owner_token. - apply _. + intros th1 th2 q1 q2. rewrite /owner_token. + apply observe_2_sep_r. apply _. Qed. (** While held, the invariant owns this thread's singleton mutex fragment @@ -184,9 +183,9 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) this γ th q : Timeless (locked this γ th q). Proof. rewrite /locked /globals. apply _. Qed. #[global] Instance locked_exclusive `{Σ : cpp_logic, !G Σ} {σ : genv} - this γ q : Exclusive1 (fun th => locked this γ th q). + this γ : Exclusive2 (locked this γ). Proof. - intros th1 th2. rewrite /locked. + intros th1 th2 q1 q2. rewrite /locked. apply observe_2_sep_r. apply observe_2_sep_r. apply _. Qed. @@ -292,11 +291,6 @@ Module custom_mutex. Context `{MOD : source ⊧ σ}. - Abbreviation GLOBALS q := - (_global "std::memory_order_seq_cst" |-> - primR "enum std::memory_order" q - (memory_order.to_val memory_order.seq_cst)). - cpp.spec "MyMutex::MyMutex()" as ctor_spec with (\exact Reduce (Spec.ctor_spec IR lock_state_gname)). @@ -308,8 +302,8 @@ Module custom_mutex. \this this \prepost{g q P} this |-> IR g q P \persist{thr} current_thread thr - \pre{(qt : cQp.t)} State.not_locked_ghost g thr qt ** GLOBALS qt - \post P ** GLOBALS qt ** + \pre{(qt : cQp.t)} State.not_locked_ghost g thr qt ** State.globals qt + \post P ** State.globals qt ** this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** State.owner_token g thr qt). @@ -317,11 +311,11 @@ Module custom_mutex. \this this \prepost{g q P} this |-> IR g q P \persist{thr} current_thread thr - \pre{qt} GLOBALS qt ** + \pre{qt} State.globals qt ** this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** State.owner_token g thr qt \pre ▷P - \post State.not_locked_ghost g thr qt ** GLOBALS qt). + \post State.not_locked_ghost g thr qt ** State.globals qt). Definition do_lock := Spec.do_lock lock_state_gname. #[global] Arguments do_lock /. @@ -352,9 +346,7 @@ Module custom_mutex. Definition bi_later_exist_F := [FWD] @bi.later_exist. Definition bi_later_sep_F := [FWD] @bi.later_sep. - Definition bi_later_sep_B := [BWD->] @bi.later_sep. Hint Resolve bi_later_exist_F bi_later_sep_F : br_hints. - Import linearity. #[program] Definition do_exchange_C (p : ptr) := @@ -544,14 +536,14 @@ Module custom_mutex. Lemma mymutex_lock_proof : verify[source] lock_spec. Proof using MOD HAS_THREADS. have -> : lock_spec ⊣⊢ lock_spec_alt. - { apply (Spec.lock_spec_entails_lock_spec_alt IR lock_state_gname). done. } + { apply (Spec.lock_spec_equiv_lock_spec_alt IR lock_state_gname). done. } exact mymutex_lock_alt_proof. Qed. Lemma mymutex_unlock_proof : verify[source] unlock_spec. Proof using MOD HAS_THREADS. have -> : unlock_spec ⊣⊢ unlock_spec_alt. - { apply (Spec.unlock_spec_entails_unlock_spec_alt IR lock_state_gname). done. } + { apply (Spec.unlock_spec_equiv_unlock_spec_alt IR lock_state_gname). done. } exact mymutex_unlock_alt_proof. Qed. diff --git a/rocq-brick-libstdcpp/test/vector/test_cpp_proof.v b/rocq-brick-libstdcpp/test/vector/test_cpp_proof.v index 91b979d7..f727abbe 100644 --- a/rocq-brick-libstdcpp/test/vector/test_cpp_proof.v +++ b/rocq-brick-libstdcpp/test/vector/test_cpp_proof.v @@ -7,6 +7,7 @@ Require Import skylabs.brick.libstdcpp.allocator.spec. Require Import skylabs.brick.libstdcpp.cassert.spec. Require Import skylabs.brick.libstdcpp.vector.spec. Require Import skylabs.brick.libstdcpp.algorithms.spec. +Require Import skylabs.brick.libstdcpp.lib.tactics. Require Import skylabs.brick.libstdcpp.test.vector.test_cpp. Require Import skylabs.auto.cpp.prelude.test. @@ -203,9 +204,6 @@ Section with_cpp. Import linearity. Import normalize.normalize_ptr normalize.only_provable_norm. - (* UPSTREAM. Where? *) - #[global] Instance SplitRecord_prod A B : SplitRecord (@prod A B) := {}. - Lemma test_int_iter_ok : verify[ source ] test_int_iter. Proof using MOD. verify_spec. From 0d81ece4656a90f262d59d7978cac6780a82fe57 Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Wed, 9 Sep 2026 21:50:00 +0000 Subject: [PATCH 40/51] add instances to MUTEX_PREDS --- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 7 +++++++ .../test/mutex/custom_mutex_hpp_proof.v | 11 +++++++++++ 2 files changed, 18 insertions(+) diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index a7cbb6ba..1f80ae19 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -38,6 +38,13 @@ Module Type MUTEX_PREDS. `{Σ : cpp_logic, !G Σ} γ : CFractional (token γ). #[global] Declare Instance token_timeless `{Σ : cpp_logic, !G Σ} γ q : Timeless (token γ q). + #[global] Declare Instance not_locked_timeless + `{Σ : cpp_logic, !G Σ} {σ : genv} this γ th q : + Timeless (not_locked this γ th q). + (** Each thread has at most one handle to attempt locking this mutex. *) + #[global] Declare Instance not_locked_exclusive + `{Σ : cpp_logic, !G Σ} {σ : genv} this γ th : + Exclusive1 (not_locked this γ th). #[global] Declare Instance locked_timeless `{Σ : cpp_logic, !G Σ} {σ : genv} this γ th q : Timeless (locked this γ th q). diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index 2f166758..3a2ef8ea 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -172,6 +172,17 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) #[global] Arguments not_locked /. #[global] Arguments globals /. + #[global] Instance not_locked_timeless `{Σ : cpp_logic, !G Σ} {σ : genv} + this γ th q : Timeless (not_locked this γ th q). + Proof. rewrite /not_locked /not_locked_ghost /globals. apply _. Qed. + #[global] Instance not_locked_exclusive `{Σ : cpp_logic, !G Σ} {σ : genv} + this γ th : Exclusive1 (not_locked this γ th). + Proof. + intros q1 q2. rewrite /not_locked /not_locked_ghost. + iIntros "[[F1 _] _] [[F2 _] _]". + iDestruct (Sets0.mutex_set_frag_exclusive with "[$F1 $F2]") as %[]. + Qed. + (** Public ownership includes the physical owner written by [lock]. *) Definition locked `{Σ : cpp_logic, !G Σ} {σ : genv} (this : ptr) (γ : gname) (th : thread_idT) (q : cQp.t) : mpred := From 250308ecfe05b07ea78df48f0718d2cfaf3db575 Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Wed, 9 Sep 2026 21:50:38 +0000 Subject: [PATCH 41/51] add comments --- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 1 + 1 file changed, 1 insertion(+) diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index 1f80ae19..01692f03 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -224,6 +224,7 @@ Module StdMutex (Preds : MUTEX_PREDS). #[global] Declare Instance R_learnable : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv}, Cbn (Learn (learn_eq ==> any ==> learn_eq ==> learn_hints.fin) R). + (* FIXME can we delete this? *) Section with_RepFor. Import rep.RepFor. Import RepScheme. From 4d84fa43aaef541b9a689c289c29e42bf478c29b Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Thu, 10 Sep 2026 05:30:57 +0000 Subject: [PATCH 42/51] make lock_guard and scoped_lock compile --- rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v | 4 ++-- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 5 +++++ rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v | 2 +- 3 files changed, 8 insertions(+), 3 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v b/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v index 48095ffd..287840f6 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/lock_guard.v @@ -17,7 +17,7 @@ Module lock_guard. sl.lock Definition R `{Σ : cpp_logic, !HasStdThreads Σ} {σ : genv} - (mp : ptr * mutex.gname * Qp * Qp) (q : cQp.t) (P : mpred) : Rep := + (mp : ptr * mutex.gname * Qp * cQp.t) (q : cQp.t) (P : mpred) : Rep := structR "std::lock_guard" q ** let '(mp, g, q', _) := mp in _field "std::lock_guard::_M_device" |-> refR<"std::mutex"> q mp ** @@ -110,7 +110,7 @@ Section with_cpp. Import skylabs.auto.cpp.prelude.proof. - Lemma mutex_borrow mp g P (this : ptr) (q1 q2 qt : Qp) : + Lemma mutex_borrow mp g P (this : ptr) (q1 q2 : Qp) (qt : cQp.t) : this |-> R (mp, g, (q1 + q2)%Qp, qt) 1$m P |-- mp |-> mutex.R g q1$m P ** this |-> R (mp, g, q2, qt) 1$m P. diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index 01692f03..628d064d 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -306,3 +306,8 @@ Module StdMutex (Preds : MUTEX_PREDS). Qed. End with_cpp. End StdMutex. + +(** The standard-library implementation remains abstract; concrete mutex + implementations supply their own [MUTEX_PREDS]. *) +Declare Module StdMutexPreds : MUTEX_PREDS. +Module mutex := StdMutex StdMutexPreds. diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v b/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v index 9a317ffa..d20ff142 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/scoped_lock.v @@ -9,7 +9,7 @@ Module scoped_lock. Context `{Σ : cpp_logic}. Parameter R : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv}, - cQp.t -> list (ptr * mutex.gname * Qp * Qp * mpred) -> Rep. + cQp.t -> list (ptr * mutex.gname * Qp * cQp.t * mpred) -> Rep. #[only(type_ptr="std::scoped_lock")] derive R. #[only(cfractional,ascfractional,cfracvalid)] derive R. From e1d8387e92c320e519b24a2ddb1061ce0fdc55ee Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Sat, 12 Sep 2026 04:04:32 +0000 Subject: [PATCH 43/51] change my_mutexes to track opened masks --- rocq-brick-libstdcpp/proof/lib/lock_ghost2.v | 254 +++++++----------- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 8 +- .../test/mutex/custom_mutex_hpp_proof.v | 66 ++--- 3 files changed, 143 insertions(+), 185 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v b/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v index b1a684ab..3739c0ba 100644 --- a/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v +++ b/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v @@ -5,6 +5,7 @@ Require Import iris.algebra.gmap. Require Import iris.algebra.gset. Require Import iris.algebra.lib.excl_auth. Require Import iris.algebra.lib.gmap_view. +Require Import iris.algebra.coPset. Require Import skylabs.auto.cpp.proof. Require Export skylabs.brick.libstdcpp.runtime.pred. @@ -13,16 +14,6 @@ Import linearity. (** Various ghost state constructions and laws for concurrency library specs and proofs. *) -(** MUTEX_SETS has 2 parts: `mutex_set_map g (T:get thread_idT)` for registering - new threads and allocating their `my_mutexes g th` with - `mutex_sets_alloc_thread`, which is a pair of `mutex_set_auth` and - `mutex_set_frag` of gnames. - The thread keeps auth and trades a fraction `mutex_set_frag {[ginv]}` to - `inv ginv P` for resources so it only gets resources once from the invariant - until it gives resources back (`mutex_set_frag_exclusive`). - If `ginv` is not allcated yet, it can be allocated with - `my_mutexes_alloc_mutex_name`. -*) Module Type MUTEX_SETS. Parameter cmraR : cmra. @@ -35,62 +26,60 @@ Module Type MUTEX_SETS. Parameter mutex_set_map : forall `{Σ : cpp_logic, !G Σ}, iprop.gname -> gset thread_idT -> mpred. - Parameter mutex_set_frag : forall `{Σ : cpp_logic, !G Σ}, - iprop.gname -> thread_idT -> gset_disj iprop.gname -> mpred. - Parameter mutex_set_auth : forall `{Σ : cpp_logic, !G Σ}, - iprop.gname -> thread_idT -> gset_disj iprop.gname -> mpred. - - (** [sa] records mutexes seen by this thread; [sf] contains its available - mutex fragments, which move to lock invariants while locks are held. *) - Definition my_mutexes `{Σ : cpp_logic, !G Σ} γ th sa sf : mpred := - mutex_set_auth γ th sa ** mutex_set_frag γ th sf. - + Parameter my_mutexes : forall `{Σ : cpp_logic, !G Σ}, + iprop.gname -> thread_idT -> coPset.coPset_disj -> mpred. + #[global] Declare Instance mutex_set_map_timeless `{Σ : cpp_logic, !G Σ} γ M : Timeless (mutex_set_map γ M). - #[global] Declare Instance mutex_set_frag_timeless - `{Σ : cpp_logic, !G Σ} γ th s : Timeless (mutex_set_frag γ th s). - #[global] Declare Instance mutex_set_auth_timeless - `{Σ : cpp_logic, !G Σ} γ th s : Timeless (mutex_set_auth γ th s). #[global] Declare Instance my_mutexes_timeless - `{Σ : cpp_logic, !G Σ} γ th sa sf : Timeless (my_mutexes γ th sa sf). + `{Σ : cpp_logic, !G Σ} γ th E : Timeless (my_mutexes γ th E). #[global] Declare Instance mutex_set_map_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ M : WeaklyObjective (mutex_set_map γ M). - #[global] Declare Instance mutex_set_frag_WeaklyObjective - `{Σ : cpp_logic, !G Σ} γ th s : WeaklyObjective (mutex_set_frag γ th s). - #[global] Declare Instance mutex_set_auth_WeaklyObjective - `{Σ : cpp_logic, !G Σ} γ th s : WeaklyObjective (mutex_set_auth γ th s). #[global] Declare Instance my_mutexes_WeaklyObjective - `{Σ : cpp_logic, !G Σ} γ th sa sf : WeaklyObjective (my_mutexes γ th sa sf). + `{Σ : cpp_logic, !G Σ} γ th E : WeaklyObjective (my_mutexes γ th E). - Parameter mutex_set_frag_exclusive : forall `{Σ : cpp_logic, !G Σ} γ th γm, - mutex_set_frag γ th (GSet {[γm]}) ** mutex_set_frag γ th (GSet {[γm]}) |-- False. + Parameter my_mutexes_exclusive : forall `{Σ : cpp_logic, !G Σ} γ th (E1 E2: coPset), + E1 ∩ E2 <> ∅ -> + my_mutexes γ th (CoPset E1) ** + my_mutexes γ th (CoPset E2) |-- False. Parameter alloc_mutex_set_map : forall `{Σ : cpp_logic, !G Σ}, ⊢ |==> ∃ γ, mutex_set_map γ ∅. Parameter mutex_sets_alloc_thread : forall `{Σ : cpp_logic, !G Σ} γ T th, th ∉ T -> mutex_set_map γ T |-- (|==> mutex_set_map γ (T ∪ {[th]}) ** - my_mutexes γ th (GSet ∅) (GSet ∅)). - Parameter my_mutexes_alloc_mutex_name : forall `{Σ : cpp_logic, !G Σ} γ th sa sf γm, - γm ∉ sa -> - my_mutexes γ th (GSet sa) sf |-- - (|==> my_mutexes γ th (GSet (sa ∪ {[γm]})) sf ** - mutex_set_frag γ th (GSet {[γm]})). - - (** This is more of a sanity check. Maybe there are better rules that should - be included in the module instead of this. - Distinct threads can allocate, possibly overlapping gname sets. - Frags are given to the lock invariants while auth are held by threads. *) - Parameter mutex_set_frags_alloc : forall `{Σ : cpp_logic, !G Σ} - (th1 th2 : thread_idT) (s1 s2 : gset iprop.gname), + my_mutexes γ th (CoPset ⊤)). + Parameter my_mutexes_alloc_mutex_name : forall `{Σ : cpp_logic, !G Σ} + γ th (E N : coPset), + N ⊆ E -> + my_mutexes γ th (CoPset E) |-- + my_mutexes γ th (CoPset (E \ N)) ** my_mutexes γ th (CoPset N). + + (* an example that two threads can allocate the same namespace token. *) + Lemma my_mutexes_alloc_eg : forall `{Σ : cpp_logic, !G Σ} + (th1 th2 : thread_idT) (N : coPset), th1 ≠ th2 -> ⊢ |==> ∃ γ, - mutex_set_frag γ th1 (GSet s1) ** - mutex_set_frag γ th2 (GSet s2) ** + my_mutexes γ th1 (CoPset N) ** + my_mutexes γ th2 (CoPset N) ** (mutex_set_map γ {[th1; th2]} ** - mutex_set_auth γ th1 (GSet s1) ** - mutex_set_auth γ th2 (GSet s2)). + my_mutexes γ th1 (CoPset (⊤ \ N)) ** + my_mutexes γ th2 (CoPset (⊤ \ N))). + Proof. + intros until N. intros Hneq. + iMod alloc_mutex_set_map as (γ) "Hmap". + iMod (mutex_sets_alloc_thread γ ∅ th1 ltac:(set_solver) + with "Hmap") as "[Hmap Ht1]". + iEval (rewrite left_id_L) in "Hmap". + iMod (mutex_sets_alloc_thread γ {[th1]} th2 ltac:(set_solver) + with "Hmap") as "[Hmap Ht2]". + iDestruct (my_mutexes_alloc_mutex_name γ th1 ⊤ N ltac:(set_solver) + with "Ht1") as "[Hr1 Hn1]". + iDestruct (my_mutexes_alloc_mutex_name γ th2 ⊤ N ltac:(set_solver) + with "Ht2") as "[Hr2 Hn2]". + iModIntro. iExists γ. iFrame. + Qed. End MUTEX_SETS. Module Type MUTEX_TOKENS. @@ -175,9 +164,8 @@ End OWNER_TID. (* Proofs that the ghost state modules are inhabited. *) Module MutexSets : MUTEX_SETS. - Canonical Structure threadR := authUR (gset_disjR iprop.gname). Canonical Structure cmraR : cmra := - discrete_funUR (fun _ : thread_idT => threadR). + discrete_funUR (fun _ : thread_idT => coPset_disjR). Class G `{Σ : cpp_logic} := { #[local] has_own :: HasOwn (iPropI _Σ) cmraR; @@ -186,20 +174,13 @@ Module MutexSets : MUTEX_SETS. }. #[global] Arguments G {_ _} Σ : assert. + Definition my_mutexes `{Σ : cpp_logic, !G Σ} + (γ : iprop.gname) (th : thread_idT) (E : coPset_disj) : mpred := + own γ (discrete_fun_singleton th E : cmraR). - Definition mutex_set_auth `{Σ : cpp_logic, !G Σ} - (γ : iprop.gname) (th : thread_idT) (s : gset_disj iprop.gname) : mpred := - own γ (discrete_fun_singleton th (● s) : cmraR). - - Definition mutex_set_frag `{Σ : cpp_logic, !G Σ} - (γ : iprop.gname) (th : thread_idT) (s : gset_disj iprop.gname) : mpred := - own γ (discrete_fun_singleton th (◯ s) : cmraR). - - Definition my_mutexes `{Σ : cpp_logic, !G Σ} γ th sa sf : mpred := - mutex_set_auth γ th sa ** mutex_set_frag γ th sf. - + (** The pool reserves the full set for each thread not yet registered. *) Definition reserve (M : gset thread_idT) : cmraR := - fun th => if decide (th ∈ M) then ε else ● (GSet ∅). + fun th => if decide (th ∈ M) then ε else CoPset ⊤. Definition mutex_set_map `{Σ : cpp_logic, !G Σ} (γ : iprop.gname) (M : gset thread_idT) : mpred := @@ -208,43 +189,32 @@ Module MutexSets : MUTEX_SETS. #[global] Instance mutex_set_map_timeless `{Σ : cpp_logic, !G Σ} γ M : Timeless (mutex_set_map γ M). Proof. rewrite /mutex_set_map. apply _. Qed. - #[global] Instance mutex_set_frag_timeless `{Σ : cpp_logic, !G Σ} γ th s : - Timeless (mutex_set_frag γ th s). - Proof. rewrite /mutex_set_frag. apply _. Qed. - #[global] Instance mutex_set_auth_timeless `{Σ : cpp_logic, !G Σ} γ th s : - Timeless (mutex_set_auth γ th s). - Proof. rewrite /mutex_set_auth. apply _. Qed. - #[global] Instance my_mutexes_timeless `{Σ : cpp_logic, !G Σ} γ th sa sf : - Timeless (my_mutexes γ th sa sf). + #[global] Instance my_mutexes_timeless `{Σ : cpp_logic, !G Σ} γ th E : + Timeless (my_mutexes γ th E). Proof. rewrite /my_mutexes. apply _. Qed. #[global] Instance mutex_set_map_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ M : WeaklyObjective (mutex_set_map γ M). Proof. rewrite /mutex_set_map. apply _. Qed. - #[global] Instance mutex_set_frag_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ th s : - WeaklyObjective (mutex_set_frag γ th s). - Proof. rewrite /mutex_set_frag. apply _. Qed. - #[global] Instance mutex_set_auth_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ th s : - WeaklyObjective (mutex_set_auth γ th s). - Proof. rewrite /mutex_set_auth. apply _. Qed. - #[global] Instance my_mutexes_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ th sa sf : - WeaklyObjective (my_mutexes γ th sa sf). + #[global] Instance my_mutexes_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ th E : + WeaklyObjective (my_mutexes γ th E). Proof. rewrite /my_mutexes. apply _. Qed. Section theory. Context `{Σ : cpp_logic, !G Σ}. - Lemma mutex_set_frag_exclusive γ th γm : - mutex_set_frag γ th (GSet {[γm]}) ** - mutex_set_frag γ th (GSet {[γm]}) |-- False. + Lemma my_mutexes_exclusive γ th (E1 E2 : coPset) : + E1 ∩ E2 <> ∅ -> + my_mutexes γ th (CoPset E1) ** + my_mutexes γ th (CoPset E2) |-- False. Proof. - rewrite /mutex_set_frag. - iIntros "[H1 H2]". + rewrite /my_mutexes. + iIntros (Hoverlap) "[H1 H2]". iDestruct (own_valid_2 with "H1 H2") as %Hvalid. iPureIntro. specialize (Hvalid th). rewrite discrete_fun_lookup_op !discrete_fun_lookup_singleton in Hvalid. - rewrite -auth_frag_op auth_frag_valid gset_disj_valid_op in Hvalid. + rewrite coPset_disj_valid_op in Hvalid. set_solver. Qed. @@ -252,55 +222,30 @@ Module MutexSets : MUTEX_SETS. ⊢ |==> ∃ γ, mutex_set_map γ ∅. Proof. iMod (own_alloc (reserve ∅)) as (γ) "Hmap". - { intros th. rewrite /reserve. - apply auth_auth_valid. done. } + { intros th. rewrite /reserve. case_decide; done. } iModIntro. iExists γ. iExact "Hmap". Qed. - Lemma my_mutexes_alloc_mutex_name γ th sa sf γm : - γm ∉ sa -> - my_mutexes γ th (GSet sa) sf |-- - (|==> my_mutexes γ th (GSet (sa ∪ {[γm]})) sf ** - mutex_set_frag γ th (GSet {[γm]})). - Proof. - rewrite /my_mutexes /mutex_set_auth /mutex_set_frag. - iIntros (Hfresh) "[HA HF]". - iMod (own_update γ _ - ((discrete_fun_singleton th (● GSet (sa ∪ {[γm]})) ⋅ - discrete_fun_singleton th (◯ GSet {[γm]})) : cmraR) - with "HA") as "[HA Hnew]". - { rewrite discrete_fun_singleton_op. - apply discrete_fun_singleton_update. - rewrite (comm_L union). - apply auth_update_alloc. - apply gset_disj_alloc_empty_local_update. set_solver. } - iModIntro. iFrame. - Qed. - - Lemma mutex_sets_alloc_thread_with_set - γ (T : gset thread_idT) th (s : gset iprop.gname) : + Lemma mutex_sets_alloc_thread γ T th : th ∉ T -> mutex_set_map γ T |-- (|==> mutex_set_map γ (T ∪ {[th]}) ** - my_mutexes γ th (GSet s) (GSet s)). + my_mutexes γ th (CoPset ⊤)). Proof. - rewrite /mutex_set_map /my_mutexes /mutex_set_auth /mutex_set_frag. + rewrite /mutex_set_map /my_mutexes. iIntros (Hfresh) "Hmap". iMod (own_update γ _ (reserve (T ∪ {[th]}) ⋅ - (discrete_fun_singleton th (● GSet s) ⋅ discrete_fun_singleton th (◯ GSet s))) - with "Hmap") as "[Hmap [HA HF]]". + discrete_fun_singleton th (CoPset ⊤)) + with "Hmap") as "[Hmap Ht]". { apply discrete_fun_update. intros th'. - rewrite !discrete_fun_lookup_op. + rewrite discrete_fun_lookup_op. destruct (decide (th = th')) as [<-|Hne]. - - rewrite !discrete_fun_lookup_singleton /reserve. - case_decide; first contradiction. - case_decide; last set_solver. - rewrite left_id. - apply auth_update_alloc. - rewrite -{1}(right_id_L ∅ union s). - apply gset_disj_alloc_empty_local_update. set_solver. - - rewrite !discrete_fun_lookup_singleton_ne; try done. - rewrite left_id right_id /reserve. + - rewrite discrete_fun_lookup_singleton /reserve. + rewrite decide_False; last done. + rewrite decide_True; last set_solver. + by rewrite left_id. + - rewrite discrete_fun_lookup_singleton_ne; last done. + rewrite right_id /reserve. destruct (decide (th' ∈ T)). + rewrite !decide_True; try set_solver. + rewrite !decide_False; try set_solver. @@ -308,38 +253,47 @@ Module MutexSets : MUTEX_SETS. iModIntro. iFrame. Qed. - Lemma mutex_sets_alloc_thread γ T th : - th ∉ T -> - mutex_set_map γ T |-- - (|==> mutex_set_map γ (T ∪ {[th]}) ** - my_mutexes γ th (GSet ∅) (GSet ∅)). - Proof. apply mutex_sets_alloc_thread_with_set. Qed. - - Lemma mutex_set_frags_alloc (th1 th2 : thread_idT) (s1 s2 : gset iprop.gname) : - th1 ≠ th2 -> - ⊢ |==> ∃ γ, - mutex_set_frag γ th1 (GSet s1) ** - mutex_set_frag γ th2 (GSet s2) ** - (mutex_set_map γ {[th1; th2]} ** - mutex_set_auth γ th1 (GSet s1) ** - mutex_set_auth γ th2 (GSet s2)). + Lemma my_mutexes_alloc_mutex_name γ th (E N : coPset) : + N ⊆ E -> + my_mutexes γ th (CoPset E) |-- + my_mutexes γ th (CoPset (E \ N)) ** my_mutexes γ th (CoPset N). Proof. - iIntros (Hneq). - iMod alloc_mutex_set_map as (γ) "Hmap". - iMod (mutex_sets_alloc_thread_with_set γ ∅ th1 s1 ltac:(set_solver) - with "Hmap") as "[Hmap Ht1]". - iEval (rewrite left_id_L) in "Hmap". - iMod (mutex_sets_alloc_thread_with_set γ {[th1]} th2 s2 ltac:(set_solver) - with "Hmap") as "[Hmap Ht2]". - iDestruct "Ht1" as "[Ha1 Hf1]". - iDestruct "Ht2" as "[Ha2 Hf2]". - iModIntro. iExists γ. iFrame. + intros Hsub. + rewrite /my_mutexes -own_op discrete_fun_singleton_op. + rewrite coPset_disj_union; last set_solver. + rewrite difference_union_L. + have -> : E ∪ N = E by set_solver. + done. Qed. End theory. - #[global] Hint Opaque mutex_set_map mutex_set_auth mutex_set_frag - my_mutexes : sl_opacity typeclass_instances. + (* an example that two threads can allocate the same namespace token. *) + Lemma my_mutexes_alloc_eg : forall `{Σ : cpp_logic, !G Σ} + (th1 th2 : thread_idT) (N : coPset), + th1 ≠ th2 -> + ⊢ |==> ∃ γ, + my_mutexes γ th1 (CoPset N) ** + my_mutexes γ th2 (CoPset N) ** + (mutex_set_map γ {[th1; th2]} ** + my_mutexes γ th1 (CoPset (⊤ \ N)) ** + my_mutexes γ th2 (CoPset (⊤ \ N))). + Proof. + intros until N. intros Hneq. + iMod alloc_mutex_set_map as (γ) "Hmap". + iMod (mutex_sets_alloc_thread γ ∅ th1 ltac:(set_solver) + with "Hmap") as "[Hmap Ht1]". + iEval (rewrite left_id_L) in "Hmap". + iMod (mutex_sets_alloc_thread γ {[th1]} th2 ltac:(set_solver) + with "Hmap") as "[Hmap Ht2]". + iDestruct (my_mutexes_alloc_mutex_name γ th1 ⊤ N ltac:(set_solver) + with "Ht1") as "[Hr1 Hn1]". + iDestruct (my_mutexes_alloc_mutex_name γ th2 ⊤ N ltac:(set_solver) + with "Ht2") as "[Hr2 Hn2]". + iModIntro. iExists γ. iFrame. + Qed. + + #[global] Hint Opaque mutex_set_map my_mutexes : sl_opacity typeclass_instances. End MutexSets. (** ** The fractional token/given-token pair *) diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index 628d064d..2d530ffd 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -18,10 +18,12 @@ Import linearity. (** A MUTEX_PREDS says a mutex spec is parametrized by some `token`, `not_locked` and `locked`. The exact model depends on the implementation. *) + +(* TODO add my_mutexes rules to MUTEX_PREDS *) Module Type MUTEX_PREDS. Parameter gname : Set. (** Mutex-set pool agreed before mutex creation. *) - Parameter pool_name : gname -> iprop.gname. + Parameter mutex_inv_namespace : namespace. Parameter G : forall `{Σ : cpp_logic}, Type. Existing Class G. @@ -68,8 +70,8 @@ Section with_cpp. which R likely has. *) Definition ctor_spec : ptr -> WpSpec mpred val val := (\this this - \pre{P γpool} ▷P ** [| WeaklyObjective P |] - \post |={⊤}=> Exists g, [| Preds.pool_name (state_name g) = γpool |] ** + \pre{P} ▷P ** [| WeaklyObjective P |] + \post |={⊤}=> Exists g, this |-> R g 1$m P ** Preds.token (state_name g) 1$m). Definition dtor_spec : ptr -> WpSpec mpred val val := diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index 3a2ef8ea..7c873498 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -1,6 +1,6 @@ (** Provisional *) -Require Import iris.algebra.gset. +Require Import iris.algebra.coPset. Require Import skylabs.auto.cpp.proof. Require Import skylabs.auto.cpp.hints.base_derived. @@ -18,13 +18,15 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) (Owners0 : OWNER_TID) <: MUTEX_PREDS. Record mutex_gname : Set := MkGname { pool_gname : iprop.gname; - invariant_gname : iprop.gname; token_gname : iprop.gname; owner_gname : iprop.gname; }. Definition gname : Set := mutex_gname. Definition pool_name (γ : gname) : iprop.gname := γ.(pool_gname). + Definition mutex_inv_namespace : namespace := + nroot .@@ "MyMutex" .@ "inv_namespace". + Class stateG `{Σ : cpp_logic} := { #[global] sets_G :: Sets0.G Σ; #[global] tokens_G :: Tokens0.G Σ; @@ -41,7 +43,7 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) Definition not_locked_ghost `{Σ : cpp_logic, !G Σ} (γ : mutex_gname) (th : thread_idT) (q : Qp) : mpred := - Sets0.mutex_set_frag γ.(pool_gname) th (GSet {[γ.(invariant_gname)]}) ** + Sets0.my_mutexes γ.(pool_gname) th (coPset.CoPset $ ↑mutex_inv_namespace) ** Tokens0.token γ.(token_gname) q. Definition owner_token `{Σ : cpp_logic, !G Σ} @@ -71,14 +73,14 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) apply observe_2_sep_r. apply _. Qed. - (** While held, the invariant owns this thread's singleton mutex fragment - and the token balance. The thread retains its mutex-set authority. + (** While held, the invariant owns this thread's singleton mutex set + and the token balance. The thread retains its remaining mutex names. When free, both halves of the previous owner remain in the invariant. *) Definition state `{Σ : cpp_logic, !G Σ} (γ : mutex_gname) (b : bool) : mpred := (if b then ∃ th, Owners0.owner_tid_auth γ.(owner_gname) (Some th) ** - Sets0.mutex_set_frag γ.(pool_gname) th (GSet {[γ.(invariant_gname)]}) ** + Sets0.my_mutexes γ.(pool_gname) th (coPset.CoPset $ ↑mutex_inv_namespace) ** Tokens0.token_not_full γ.(token_gname) else ∃ owner, Owners0.owner_tid_auth γ.(owner_gname) owner ** @@ -93,14 +95,14 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) Section state_laws. Context `{Σ : cpp_logic, !G Σ}. - Lemma alloc (γpool : iprop.gname) inv_gname : - ⊢ |==> ∃ γ, [| γ.(pool_gname) = γpool |] ** [| γ.(invariant_gname) = inv_gname |] ** + Lemma alloc (γpool : iprop.gname) : + ⊢ |==> ∃ γ, [| γ.(pool_gname) = γpool |] ** token γ 1$m ** state γ false. Proof. iMod Tokens0.alloc as (gt) "[T GT]". iMod (Owners0.alloc None) as (go) "[OA OF]". - iModIntro. iExists (MkGname γpool inv_gname gt go). - iSplit; first done. iSplit; first done. + iModIntro. iExists (MkGname γpool gt go). + iSplit; first done. rewrite /token /state /=. iFrame "T". iExists None. iFrame "OA OF". iApply Tokens0.token_full_init. iExact "GT". @@ -180,7 +182,11 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) Proof. intros q1 q2. rewrite /not_locked /not_locked_ghost. iIntros "[[F1 _] _] [[F2 _] _]". - iDestruct (Sets0.mutex_set_frag_exclusive with "[$F1 $F2]") as %[]. + have Hnonempty : (↑ mutex_inv_namespace : coPset) ∩ ↑ mutex_inv_namespace ≠ ∅. + { rewrite intersection_idemp_L. apply nclose_non_empty. } + iDestruct (Sets0.my_mutexes_exclusive γ.(pool_gname) th + (↑ mutex_inv_namespace) (↑ mutex_inv_namespace) Hnonempty + with "[$F1 $F2]") as %[]. Qed. (** Public ownership includes the physical owner written by [lock]. *) @@ -271,11 +277,10 @@ Module custom_mutex. \post emp). End unproved_specs. - Definition gname : Set := State.mutex_gname. - Definition lock_state_gname (γ : gname) : State.gname := γ. - Definition cinv_gname : gname -> iprop.gname := State.invariant_gname. - - Definition lock_namespace : namespace := nroot .@@ "MyMutex". + Record gname : Set := MkGname { + lock_state_gname :> State.mutex_gname; + cinv_gname : iprop.gname; + }. Section with_Σ. Context `{Σ : cpp_logic, σ : genv, HAS_THREADS : !HasStdThreads Σ, @@ -294,7 +299,7 @@ Module custom_mutex. Definition IR (γ : gname) (q : cQp.t) (P : mpred) : Rep := structR N q$m ** as_Rep (fun this => - cinv lock_namespace (cinv_gname γ) (mutex_inv this γ P) ** + cinv State.mutex_inv_namespace (cinv_gname γ) (mutex_inv this γ P) ** cinv_own (cinv_gname γ) q ). Hint Opaque IR : sl_opacity typeclass_instances. @@ -381,7 +386,7 @@ Module custom_mutex. iDestruct "IR" as "(S & #CI & CO)". rewrite /std.atomic.do_exchange. iAuIntro1. rewrite /atomic1_acc. - iInv lock_namespace as "Inv" "Hclose". + iInv State.mutex_inv_namespace as "Inv" "Hclose". iDestruct "Inv" as "[Inv CO]". iEval (rewrite /mutex_inv) in "Inv". iDestruct "Inv" as (b) "(>L & State & Resources)". @@ -405,7 +410,7 @@ Module custom_mutex. iModIntro. rewrite /IR _at_sep _at_as_Rep /=. iFrame "CI". iFrame. iPureIntro. auto. + iDestruct "Resources" as "[P Owner]". - iMod (State.do_lock with "[$State $NL]") as "[State Locked]". + iMod (State.do_lock _ with "[$State $NL]") as "[State Locked]". iMod ("Hclose" with "[L State]") as "_". { iNext. rewrite /mutex_inv. iExists true. iSplitL "L"; first by ework $usenamed=true with br_erefl. @@ -436,7 +441,7 @@ Module custom_mutex. iDestruct "IR" as "(S & #CI & CO)". rewrite /std.atomic.do_store. iAcIntro. rewrite /commit_acc /=. - iInv lock_namespace as "Inv" "Hclose". + iInv State.mutex_inv_namespace as "Inv" "Hclose". iDestruct "Inv" as "[Inv CO]". iEval (rewrite /mutex_inv) in "Inv". iDestruct "Inv" as (b) "(>L & State & Resources)". @@ -445,7 +450,7 @@ Module custom_mutex. iSplitL "L"; first by ework $usenamed=true with br_erefl. iNext. iIntros "L". iMod "Y" as "_". destruct b. - - iMod (State.do_unlock with "[$State $Locked]") as "[State NL]". + - iMod (State.do_unlock _ with "[$State $Locked]") as "[State NL]". iMod ("Hclose" with "[L State P Owner]") as "_". { iNext. rewrite /mutex_inv. iExists false. iSplitL "L"; first by ework $usenamed=true with br_erefl. @@ -511,17 +516,14 @@ Module custom_mutex. wname [P] "P". wname [_ |-> atomic.R _ _ _] "L". wname [_ |-> thread_idR _ _] "Owner". - iMod (cinv_alloc_cofinite ∅ ⊤ lock_namespace) as (gi) "(_ & CO & Halloc)". - iMod (State.alloc γpool gi) as (gs) "(%Hpool & %Hinv & T & State)". - iMod ("Halloc" $! (mutex_inv this gs P) - with "[] [L P Owner State]") as "#CI". - { iPureIntro. rewrite /mutex_inv. apply _. } - { iNext. rewrite /mutex_inv /=. iExists false. iFrame. } - iModIntro. iExists gs. - iSplit; first done. - subst gi. - rewrite /IR _at_sep _at_as_Rep /cinv_gname /=. - iFrame "CI". iFrame. + iMod (State.alloc 1%positive) as (gs) "(_ & T & State)". + iMod (cinv_alloc with "[L P Owner State]") + as (gi) "[#CI CO]"; last first. + - iModIntro. iExists (MkGname gs gi). + rewrite /IR _at_sep _at_as_Rep /mutex_inv /=. + iFrame "CI". iFrame. + - iNext. iExists false. iFrame. + - apply _. Qed. Lemma mymutex_dtor_proof : verify[source] "MyMutex::~MyMutex()". From 1ed2edf933d209a6ab8d458fd10dac52f430963d Mon Sep 17 00:00:00 2001 From: Ke Du Date: Mon, 14 Sep 2026 16:22:50 -0500 Subject: [PATCH 44/51] add mutex client --- rocq-brick-libstdcpp/proof/thread/spec.v | 65 +++++++++++++++++++ rocq-brick-libstdcpp/proof/thread/thread.hpp | 1 + .../test/mutex/double_incr.cpp | 24 +++++++ 3 files changed, 90 insertions(+) create mode 100644 rocq-brick-libstdcpp/proof/thread/thread.hpp create mode 100644 rocq-brick-libstdcpp/test/mutex/double_incr.cpp diff --git a/rocq-brick-libstdcpp/proof/thread/spec.v b/rocq-brick-libstdcpp/proof/thread/spec.v index e69de29b..a2b01d3c 100644 --- a/rocq-brick-libstdcpp/proof/thread/spec.v +++ b/rocq-brick-libstdcpp/proof/thread/spec.v @@ -0,0 +1,65 @@ +Require Import skylabs.bi.tls_modalities. +Require Import skylabs.auto.cpp.prelude.proof. +(* Require Export skylabs.brick.libstdcpp.thread.pred. *) +Require Import skylabs.brick.libstdcpp.runtime.pred. +Require Import skylabs.brick.libstdcpp.thread.thread_hpp. + +(** Specifications for the nullary function-pointer specialization of + <>. [spawn_spec] is the constructor contract, to be bound to + the constructor specialization in the client's translation unit. The + forwarding-reference argument points to a function-pointer object; the + constructor copies its value before starting the child. + + These are normal-return contracts. They do not specify creation failures, + arbitrary callable objects, argument decay/copying, or detach. *) +Section with_cpp. + Context `{Σ : cpp_logic} {σ : genv}. + Context {HAS_THREADS : HasStdThreads Σ}. + + (** Exclusive ownership of a thread object. [None] is non-joinable; + [Some (child, Q)] owns the right to join [child] and receive [Q], + interpreted in that child's thread context. In particular, this + predicate must not be declared persistent or fractionally splittable. *) + Parameter R : option (thread_idT * mpred) -> Rep. + #[global] Hint Opaque R : sl_opacity typeclass_instances. + #[only(type_ptr="std::thread")] derive R. + #[global] Declare Instance R_exclusive state (this : ptr) : + Exclusive0 (this |-> R state). + + Definition entry_type : type := Tfunction (FunctionType Tvoid []). + + (** The obligation is linear: resources needed by the child are consumed + at spawn. Quantification allows the runtime to choose the child's ID. + The modality prevents the parent's thread-local facts from being + silently reused in the child. *) + Definition spawn_spec : ptr -> WpSpec mpred val val := + (\this this + \arg{fp : ptr} "f" (Vptr fp) + \prepost{q f} fp |-> primR (Tptr entry_type) q (Vptr f) + \persist{parent} current_thread parent + \pre{Q : thread_idT -> mpred} + (∀ child, [| child <> parent |] -* + @(threadTI, child) + (wp_fptr (σ.(genv_tu).(types)) entry_type f [] + (fun _ => Q child))) + \post Exists child, + [| child <> parent |] ** this |-> R (Some (child, Q child))). + + (** Joining consumes the join right exactly once and leaves the object + non-joinable. Keep the child's modality on [Q]: join does not turn + child-local ownership into ownership local to the caller. *) + Definition join_spec : ptr -> WpSpec mpred val val := + (\this this + \persist{parent} current_thread parent + \pre{child Q} this |-> R (Some (child, Q)) + \require child <> parent + \post this |-> R None ** @(threadTI, child) Q). + + (** Supply the instantiated constructor name from the translation unit. *) + cpp.spec "std::thread::thread()" as ctor_spec with + (\exact Reduce spawn_spec). + + Definition join : mpred := + specify {| info_name := "std::thread::join()"; + info_type := tMethod "std::thread" QM "void" [] |} join_spec. +End with_cpp. diff --git a/rocq-brick-libstdcpp/proof/thread/thread.hpp b/rocq-brick-libstdcpp/proof/thread/thread.hpp new file mode 100644 index 00000000..ee6744fe --- /dev/null +++ b/rocq-brick-libstdcpp/proof/thread/thread.hpp @@ -0,0 +1 @@ +#include \ No newline at end of file diff --git a/rocq-brick-libstdcpp/test/mutex/double_incr.cpp b/rocq-brick-libstdcpp/test/mutex/double_incr.cpp new file mode 100644 index 00000000..0d7a822f --- /dev/null +++ b/rocq-brick-libstdcpp/test/mutex/double_incr.cpp @@ -0,0 +1,24 @@ +#include +#include +#include + +unsigned int x = 0; +std::mutex m; + +void double_incr() { + m.lock(); + x++; + x++; + m.unlock(); +} + +int main() { + std::thread t1(double_incr); + std::thread t2(double_incr); + + t1.join(); + t2.join(); + + assert(x == 4); + return 0; +} From e389cec68d88d52e31bd869649f21685744fe388 Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Wed, 16 Sep 2026 02:56:12 +0000 Subject: [PATCH 45/51] [mutex.v] move mutex predicates to MUTEX_PREDS if they are not specific to implementation; add my_mutexes allocation rule and mutex invariant initalization rule --- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 271 +++++++++--------- 1 file changed, 136 insertions(+), 135 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index 2d530ffd..5ec907aa 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -19,9 +19,9 @@ Import linearity. (** A MUTEX_PREDS says a mutex spec is parametrized by some `token`, `not_locked` and `locked`. The exact model depends on the implementation. *) -(* TODO add my_mutexes rules to MUTEX_PREDS *) Module Type MUTEX_PREDS. Parameter gname : Set. + Parameter cpp_ty : type. (** Mutex-set pool agreed before mutex creation. *) Parameter mutex_inv_namespace : namespace. @@ -29,6 +29,9 @@ Module Type MUTEX_PREDS. Existing Class G. #[global] Arguments G {_ _} Σ : assert. + (** Registration uses the same mutex-set model as the state predicates. *) + #[global] Declare Instance sets_G `{Σ : cpp_logic, !G Σ} : MutexSets.G Σ. + (** [cQp.t] describes the permissions transferred by lock and unlock. The permission might involve points-to, so use cQp.t instead of QP. *) Parameter token : forall `{Σ : cpp_logic, !G Σ}, @@ -53,6 +56,80 @@ Module Type MUTEX_PREDS. #[global] Declare Instance locked_exclusive `{Σ : cpp_logic, !G Σ} {σ : genv} this γ : Exclusive2 (locked this γ). + + (** The thread-registration pool used by this mutex. *) + Parameter pool_name : gname -> iprop.gname. + + Section with_cpp. + Context `{Σ : cpp_logic}. + + (** Fractional ownership of a mutex guarding the predicate <

>. *) + Parameter R : forall `{!G Σ} {HAS_THREADS : HasStdThreads Σ} {σ : genv}, gname -> cQp.t -> mpred -> Rep. + Context `{!G Σ}. + #[global] Hint Opaque R : sl_opacity typeclass_instances. + #[only(cfractional,cfracvalid,ascfractional)] derive R. + (* #[global] Declare Instance R_type_ptr : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv} g q P, + Typed class_name (R g q P). *) + #[global] Declare Instance R_learnable : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv}, + Cbn (Learn (learn_eq ==> any ==> learn_eq ==> learn_hints.fin) R). + + Context {σ : genv}. + Context {HAS_THREADS : HasStdThreads Σ}. + + #[global] Instance locked_learn : + Cbn (Learn (req_eq ==> learn_eq ==> req_eq ==> req_eq ==> learn_hints.fin) locked). + Proof. solve_learnable. Qed. + + (* TODO readd the later on the lock/unlock continuations. *) + Definition do_lock (this : ptr) (lk : gname * mpred) (K : mpred) : mpred := + ∃ thr qt, current_thread thr ** not_locked this lk.1 thr qt ** + (locked this lk.1 thr qt ** lk.2 -* K). + #[global] Arguments do_lock /. + + Definition do_unlock (this : ptr) (lk : gname * mpred) (K : mpred) : mpred := + ∃ thr qt, current_thread thr ** locked this lk.1 thr qt ** ▷lk.2 ** + (not_locked this lk.1 thr qt -* K). + #[global] Arguments do_unlock /. + + #[global] Instance mutex_basic_lockable : + BasicLockable (T := gname * mpred) cpp_ty + (fun q gP => R gP.1 q gP.2) := + { do_lock := do_lock + ; do_unlock := do_unlock }. + + Definition do_try_lock (this : ptr) (lk : gname * mpred) + (K : bool -> mpred) : mpred := + ∃ thr qt, current_thread thr ** not_locked this lk.1 thr qt ** + ∀ b : bool, + (if b then lk.2 ** locked this lk.1 thr qt + else not_locked this lk.1 thr qt) -* K b. + #[global] Arguments do_try_lock /. + + #[global] Instance mutex_lockable : + Lockable (T:=gname * mpred) cpp_ty (λ q γP, R γP.1 q γP.2) := + { do_try_lock := do_try_lock }. + + (** Install [P] in an initialized mutex using its full representation and + token. The physical mutex remains initialized and unlocked. *) + Parameter install : forall (this : ptr) (old : gname) + (pool : iprop.gname) (P : mpred), + WeaklyObjective P -> + this |-> R old 1$m emp ** token old 1$m ** ▷P |-- + (|={⊤}=> ∃ g, + this |-> R g 1$m P ** token g 1$m). + + (** Register a thread by consuming its handle for this mutex's namespace + and its token share. [my_mutexes_alloc_mutex_name] splits this handle + from the full namespace pool supplied when the thread is spawned. *) + Parameter register_thread : forall + (this : ptr) (g : gname) (q : cQp.t) (P : mpred) + (th : thread_idT) (qt : cQp.t), + this |-> R g q P ** token g qt ** + MutexSets.my_mutexes (pool_name g) th + (coPset.CoPset $ ↑mutex_inv_namespace) |-- + this |-> R g q P ** not_locked this g th qt. + + End with_cpp. End MUTEX_PREDS. (* TODO UPSTREAM. FIXME what does this do? *) @@ -60,136 +137,102 @@ End MUTEX_PREDS. Module mutex_spec (Preds : MUTEX_PREDS). Section with_cpp. - Context `{Σ : cpp_logic} {σ : genv} {Name : Type}. - Context `{!Preds.G Σ}. - Context (R : Name -> cQp.t -> mpred -> Rep). - Context (state_name : Name -> Preds.gname). + Import Preds. + Context `{Σ : cpp_logic} {σ : genv}. + Context `{!G Σ}. Context {HAS_THREADS : HasStdThreads Σ}. + (** The guarded predicate must be weakly objective for invariant allocation, which R likely has. *) - Definition ctor_spec : ptr -> WpSpec mpred val val := - (\this this - \pre{P} ▷P ** [| WeaklyObjective P |] - \post |={⊤}=> Exists g, - this |-> R g 1$m P ** Preds.token (state_name g) 1$m). + Definition ctor_spec (this : ptr) : WpSpec mpred val val := + (\pre{P} ▷P + \require WeaklyObjective P + \post |={⊤}=> Exists g, + this |-> R g 1$m P ** token g 1$m). Definition dtor_spec : ptr -> WpSpec mpred val val := (\this this - \pre{g P} this |-> R g 1$m P ** Preds.token (state_name g) 1$m + \pre{g P} this |-> R g 1$m P ** token g 1$m \post P). Definition lock_spec_alt : ptr -> WpSpec mpred val val := (\this this \prepost{q P g} this |-> R g q P \persist{thr} current_thread thr - \pre{qt} Preds.not_locked this (state_name g) thr qt - \post P ** Preds.locked this (state_name g) thr qt). + \pre{qt} not_locked this g thr qt + \post P ** locked this g thr qt). Definition unlock_spec_alt : ptr -> WpSpec mpred val val := (\this this \prepost{q P g} this |-> R g q P \persist{thr} current_thread thr - \pre{qt} Preds.locked this (state_name g) thr qt + \pre{qt} locked this g thr qt \pre ▷P - \post Preds.not_locked this (state_name g) thr qt). + \post not_locked this g thr qt). Definition try_lock_spec_alt : ptr -> WpSpec mpred val val := (\this this \prepost{q P g} this |-> R g q P \persist{thr} current_thread thr - \pre{qt} Preds.not_locked this (state_name g) thr qt + \pre{qt} not_locked this g thr qt \post{b}[Vbool b] - if b then P ** Preds.locked this (state_name g) thr qt - else Preds.not_locked this (state_name g) thr qt). - - (* TODO readd the later on the lock/unlock continuations. *) - Definition do_lock (this : ptr) (lk : Name * mpred) (K : mpred) : mpred := - ∃ thr qt, current_thread thr ** Preds.not_locked this (state_name lk.1) thr qt ** - (Preds.locked this (state_name lk.1) thr qt ** lk.2 -* K). - #[global] Arguments do_lock /. - - Definition do_unlock (this : ptr) (lk : Name * mpred) (K : mpred) : mpred := - ∃ thr qt, current_thread thr ** Preds.locked this (state_name lk.1) thr qt ** ▷lk.2 ** - (Preds.not_locked this (state_name lk.1) thr qt -* K). - #[global] Arguments do_unlock /. - - Definition do_try_lock (this : ptr) (lk : Name * mpred) - (K : bool -> mpred) : mpred := - ∃ thr qt, current_thread thr ** Preds.not_locked this (state_name lk.1) thr qt ** - ∀ b : bool, - (if b then lk.2 ** Preds.locked this (state_name lk.1) thr qt - else Preds.not_locked this (state_name lk.1) thr qt) -* K b. - #[global] Arguments do_try_lock /. + if b then P ** locked this g thr qt + else not_locked this g thr qt). - Section equivalences. - Context (method_name class_name : globname). - Context {BL : BasicLockable (Tnamed class_name) (fun q gp => R gp.1 q gp.2)}. - - Definition spec_type_void_to_ret := (fun ret => specify {| info_name := method_name; info_type := tMethod class_name QM ret [] |}). - - Local Lemma method_spec_equiv (ret : type) - (Pspec Qspec : ptr -> WpSpec mpred val val) - (Heq : forall this xs K, Pspec this xs K ⊣⊢ Qspec this xs K) : - spec_type_void_to_ret ret Pspec ⊣⊢ spec_type_void_to_ret ret Qspec. - Proof. - iSplit; iApply specify_mono; intros this xs K; rewrite Heq; done. - Qed. + Definition lock_spec : ptr -> WpSpec mpred val val := + lock_basic_lockable cpp_ty (fun q gP => R gP.1 q gP.2). + + Definition unlock_spec : ptr -> WpSpec mpred val val := + unlock_basic_lockable cpp_ty (fun q gP => R gP.1 q gP.2). - Lemma lock_spec_equiv_lock_spec_alt - (Hlock : requirements.do_lock (Tnamed class_name) = do_lock) : - spec_type_void_to_ret "void" - (lock_basic_lockable (Tnamed class_name) (fun q gp => R gp.1 q gp.2)) ⊣⊢ - spec_type_void_to_ret "void" lock_spec_alt. + Section equivalences. + Lemma lock_spec_equiv_lock_spec_alt this xs K : + lock_spec this xs K ⊣⊢ lock_spec_alt this xs K. Proof. - apply method_spec_equiv. intros this xs K. - unfold lock_basic_lockable. rewrite Hlock. + unfold lock_spec, lock_basic_lockable. unfold lock_spec_alt, do_lock. cbn. iSplit. - ework with br_erefl. - iIntros "H". iDestruct "H" as (q P g thr qt) "(%Hxs & HR & #HT & HNL & HK)". - iExists q, (g, P), (P ** Preds.locked this (state_name g) thr qt)%I. + iExists q, (g, P), (P ** Preds.locked this g thr qt)%I. iFrame "HR HK". iSplit; first done. iExists thr, qt. iFrame "HT HNL". iIntros "[HL HP]". iFrame. Qed. - Lemma unlock_spec_equiv_unlock_spec_alt - (Hunlock : requirements.do_unlock (Tnamed class_name) = do_unlock) : - spec_type_void_to_ret "void" (unlock_basic_lockable (Tnamed class_name) (fun q gp => R gp.1 q gp.2)) ⊣⊢ - spec_type_void_to_ret "void" unlock_spec_alt. + Lemma unlock_spec_equiv_unlock_spec_alt this xs K : + unlock_spec this xs K ⊣⊢ unlock_spec_alt this xs K. Proof. - apply method_spec_equiv. intros this xs K. - unfold unlock_basic_lockable. rewrite Hunlock. + unfold unlock_spec, unlock_basic_lockable. unfold unlock_spec_alt, do_unlock. cbn. iSplit. - ework with br_erefl. - iIntros "H". iDestruct "H" as (q P g thr qt) "(%Hxs & HR & #HT & HL & HP & HK)". - iExists q, (g, P), (Preds.not_locked this (state_name g) thr qt). + iExists q, (g, P), (Preds.not_locked this g thr qt). iFrame "HR HK". iSplit; first done. iExists thr, qt. iFrame "HT HL HP". iIntros "$". Qed. - Context {L : Lockable (Tnamed class_name) (fun q gp => R gp.1 q gp.2)}. + Definition try_lock_spec : ptr -> WpSpec mpred val val := + try_lock_lockable cpp_ty (fun q gP => R gP.1 q gP.2). Lemma try_lock_spec_equiv_try_lock_spec_alt - (Htry_lock : requirements.do_try_lock (Tnamed class_name) = do_try_lock) : - spec_type_void_to_ret "bool" (try_lock_lockable (Tnamed class_name) (fun q gp => R gp.1 q gp.2)) ⊣⊢ - spec_type_void_to_ret "bool" try_lock_spec_alt. + (Htry_lock : requirements.do_try_lock cpp_ty = do_try_lock) this xs K : + try_lock_spec this xs K ⊣⊢ try_lock_spec_alt this xs K. Proof. - apply method_spec_equiv. intros this xs K. - unfold try_lock_lockable. rewrite Htry_lock. + unfold try_lock_spec, try_lock_lockable. rewrite Htry_lock. unfold try_lock_spec_alt, do_try_lock. cbn. iSplit. - ework with br_erefl. - iIntros "H". iDestruct "H" as (q P g thr qt) "(%Hxs & HR & #HT & HNL & HK)". iExists q, (g, P), (fun b : bool => - if b then (P ** Preds.locked this (state_name g) thr qt)%I - else Preds.not_locked this (state_name g) thr qt). + if b then (P ** Preds.locked this g thr qt)%I + else Preds.not_locked this g thr qt). iFrame "HR HK". iSplit; first done. iExists thr, qt. iFrame "HT HNL". iIntros (b) "$". @@ -201,30 +244,14 @@ End mutex_spec. (** Specialize the reusable specs to the standard mutex representation and bind them to their C++ names. *) -Module StdMutex (Preds : MUTEX_PREDS). - Module Spec := mutex_spec Preds. - - Definition gname := Preds.gname. - Definition lock_state_gname (g : gname) := g. - - Definition G := @Preds.G. - Existing Class G. - #[global] Arguments G {_ _} Σ : assert. - #[global] Instance state_G `{Σ : cpp_logic} (H : G Σ) : Preds.G Σ := H. +Module StdMutex (Preds : MUTEX_PREDS with Definition cpp_ty := "std::mutex"%cpp_type). + Include Preds. + #[global] Hint Opaque token not_locked locked R : sl_opacity. - Abbreviation token := Preds.token. - Abbreviation not_locked := Preds.not_locked. - Abbreviation locked := Preds.locked. + Module Spec := mutex_spec Preds. Section with_cpp. - Context `{Σ : cpp_logic}. - - (** Fractional ownership of a <> guarding the predicate <

>. *) - Parameter R : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv}, gname -> cQp.t -> mpred -> Rep. - #[global] Hint Opaque R : sl_opacity typeclass_instances. - #[only(cfractional,cfracvalid,ascfractional,type_ptr="std::mutex")] derive R. - #[global] Declare Instance R_learnable : forall {HAS_THREADS : HasStdThreads Σ} {σ : genv}, - Cbn (Learn (learn_eq ==> any ==> learn_eq ==> learn_hints.fin) R). + Context `{Σ : cpp_logic, !G Σ}. (* FIXME can we delete this? *) Section with_RepFor. @@ -236,80 +263,54 @@ Module StdMutex (Preds : MUTEX_PREDS). (funI γ q P => R γ q P) := {}. End with_RepFor. - - Context `{!G Σ}. - Context `{MOD : source ⊧ σ}. Context {HAS_THREADS : HasStdThreads Σ}. - #[global] Instance locked_learn : - Cbn (Learn (req_eq ==> learn_eq ==> req_eq ==> req_eq ==> learn_hints.fin) locked). - Proof. solve_learnable. Qed. - cpp.spec "std::mutex::mutex()" as ctor_spec with - (\exact Reduce (Spec.ctor_spec R lock_state_gname)). + (\exact Reduce (Spec.ctor_spec)). cpp.spec "std::mutex::~mutex()" as dtor_spec with - (\exact Reduce (Spec.dtor_spec R lock_state_gname)). + (\exact Reduce (Spec.dtor_spec)). cpp.spec "std::mutex::lock()" as lock_spec_alt with - (\exact Reduce (Spec.lock_spec_alt R lock_state_gname)). + (\exact Reduce (Spec.lock_spec_alt)). cpp.spec "std::mutex::unlock()" as unlock_spec_alt with - (\exact Reduce (Spec.unlock_spec_alt R lock_state_gname)). + (\exact Reduce (Spec.unlock_spec_alt)). cpp.spec "std::mutex::try_lock()" as try_lock_spec_alt with - (\exact Reduce (Spec.try_lock_spec_alt R lock_state_gname)). - - Definition do_lock := Spec.do_lock lock_state_gname. - #[global] Arguments do_lock /. - Definition do_unlock := Spec.do_unlock lock_state_gname. - #[global] Arguments do_unlock /. - Definition do_try_lock := Spec.do_try_lock lock_state_gname. - #[global] Arguments do_try_lock /. - - (** <> implements [BasicLockable] and [Lockable]. *) - Definition T : Type := gname * mpred. - - #[global] Instance mutex_basic_lockable : - BasicLockable (T:=T) "std::mutex" (λ q γP, R γP.1 q γP.2) := - { do_lock := do_lock - ; do_unlock := do_unlock }. + (\exact Reduce (Spec.try_lock_spec_alt)). cpp.spec "std::mutex::lock()" as lock_spec with - (\exact Reduce (lock_basic_lockable "std::mutex" (λ q γP, R γP.1 q γP.2))). + (\exact Reduce (Spec.lock_spec)). cpp.spec "std::mutex::unlock()" as unlock_spec with - (\exact Reduce (unlock_basic_lockable "std::mutex" (λ q γP, R γP.1 q γP.2))). - - #[global] Instance mutex_lockable : - Lockable (T:=T) "std::mutex" (λ q γP, R γP.1 q γP.2) := - { do_try_lock := do_try_lock }. + (\exact Reduce (Spec.unlock_spec)). cpp.spec "std::mutex::try_lock()" as try_lock_spec with - (\exact Reduce (try_lock_lockable "std::mutex" (λ q γP, R γP.1 q γP.2))). + (\exact Reduce (Spec.try_lock_spec)). Lemma lock_spec_equiv_lock_spec_alt : lock_spec -|- lock_spec_alt. Proof. - apply (Spec.lock_spec_equiv_lock_spec_alt R lock_state_gname). - reflexivity. + iSplit; iApply specify_mono; intros this xs K; + rewrite Spec.lock_spec_equiv_lock_spec_alt; done. Qed. Lemma unlock_spec_equiv_unlock_spec_alt : unlock_spec -|- unlock_spec_alt. Proof. - apply (Spec.unlock_spec_equiv_unlock_spec_alt R lock_state_gname). - reflexivity. + iSplit; iApply specify_mono; intros this xs K; + rewrite Spec.unlock_spec_equiv_unlock_spec_alt; done. Qed. Lemma try_lock_spec_equiv_try_lock_spec_alt : try_lock_spec -|- try_lock_spec_alt. Proof. - apply (Spec.try_lock_spec_equiv_try_lock_spec_alt R lock_state_gname). - reflexivity. + iSplit; iApply specify_mono; intros this xs K; + rewrite Spec.try_lock_spec_equiv_try_lock_spec_alt; done. Qed. End with_cpp. End StdMutex. (** The standard-library implementation remains abstract; concrete mutex implementations supply their own [MUTEX_PREDS]. *) -Declare Module StdMutexPreds : MUTEX_PREDS. +Declare Module StdMutexPreds : MUTEX_PREDS with Definition cpp_ty := "std::mutex"%cpp_type. Module mutex := StdMutex StdMutexPreds. From 8592e134822bb7a76983f2b9efd151900d210a40 Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Wed, 16 Sep 2026 06:40:06 +0000 Subject: [PATCH 46/51] move thread specs to [thread/spec.v], fix [custom_mutex_hpp_proof.v] --- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 7 +- rocq-brick-libstdcpp/proof/thread/spec.v | 158 ++++-- rocq-brick-libstdcpp/proof/thread/thread.hpp | 5 +- .../test/mutex/custom_mutex_hpp_proof.v | 452 ++++++++++-------- 4 files changed, 382 insertions(+), 240 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index 5ec907aa..07a55b79 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -110,8 +110,11 @@ Module Type MUTEX_PREDS. { do_try_lock := do_try_lock }. (** Install [P] in an initialized mutex using its full representation and - token. The physical mutex remains initialized and unlocked. *) - Parameter install : forall (this : ptr) (old : gname) + token. The physical mutex remains initialized and unlocked. + + Initializing [this |-> R old 1$m emp] probably depends on the mutex + implementation. *) + Parameter init_R : forall (this : ptr) (old : gname) (pool : iprop.gname) (P : mpred), WeaklyObjective P -> this |-> R old 1$m emp ** token old 1$m ** ▷P |-- diff --git a/rocq-brick-libstdcpp/proof/thread/spec.v b/rocq-brick-libstdcpp/proof/thread/spec.v index a2b01d3c..fde75f0e 100644 --- a/rocq-brick-libstdcpp/proof/thread/spec.v +++ b/rocq-brick-libstdcpp/proof/thread/spec.v @@ -1,65 +1,149 @@ Require Import skylabs.bi.tls_modalities. Require Import skylabs.auto.cpp.prelude.proof. -(* Require Export skylabs.brick.libstdcpp.thread.pred. *) Require Import skylabs.brick.libstdcpp.runtime.pred. +Require Import skylabs.brick.libstdcpp.lib.lock_ghost2. Require Import skylabs.brick.libstdcpp.thread.thread_hpp. -(** Specifications for the nullary function-pointer specialization of - <>. [spawn_spec] is the constructor contract, to be bound to - the constructor specialization in the client's translation unit. The - forwarding-reference argument points to a function-pointer object; the - constructor copies its value before starting the child. - - These are normal-return contracts. They do not specify creation failures, - arbitrary callable objects, argument decay/copying, or detach. *) +(** Specs for thread creation and joining. *) Section with_cpp. Context `{Σ : cpp_logic} {σ : genv}. Context {HAS_THREADS : HasStdThreads Σ}. + Context `{!MutexSets.G Σ}. - (** Exclusive ownership of a thread object. [None] is non-joinable; - [Some (child, Q)] owns the right to join [child] and receive [Q], - interpreted in that child's thread context. In particular, this - predicate must not be declared persistent or fractionally splittable. *) + (** Exclusive ownership of a thread object. + [R $ None] is already joined thread and non-joinable; + [R $ Some (child, Q)] is a handle to join [child] and receive [Q]. + R would require the mpred to be WeaklyObjective. *) Parameter R : option (thread_idT * mpred) -> Rep. #[global] Hint Opaque R : sl_opacity typeclass_instances. #[only(type_ptr="std::thread")] derive R. #[global] Declare Instance R_exclusive state (this : ptr) : Exclusive0 (this |-> R state). + (** The mutex-set map tracks spawned thread IDs and supplies each child + with its [MutexSets.my_mutexes] handle. *) + Definition spawned_threads_inv (N : namespace) (γ : iprop.gname) : mpred := + inv N (Exists tids, MutexSets.mutex_set_map γ tids). + + Lemma spawned_threads_inv_alloc N : + ⊢ |={⊤}=> ∃ γ, spawned_threads_inv N γ. + Proof. + iMod MutexSets.alloc_mutex_set_map as (γ) "Hmap". + iMod (inv_alloc N _ (Exists tids, MutexSets.mutex_set_map γ tids) + with "[Hmap]") as "Hinv". + { iNext. iExists ∅. done. } + iModIntro. iExists γ. done. + Qed. + Definition entry_type : type := Tfunction (FunctionType Tvoid []). - (** The obligation is linear: resources needed by the child are consumed - at spawn. Quantification allows the runtime to choose the child's ID. - The modality prevents the parent's thread-local facts from being - silently reused in the child. *) - Definition spawn_spec : ptr -> WpSpec mpred val val := + (** Passing a function lvalue binds a function reference directly, without + an intermediate function-pointer object. The child receives its mutex + namespace pool before running the entry point. Resources that the entry + point returns can be included in [Q] and recovered by joining. *) + Definition spawn_spec_body : ptr -> WpSpec mpred val val := (\this this - \arg{fp : ptr} "f" (Vptr fp) - \prepost{q f} fp |-> primR (Tptr entry_type) q (Vptr f) + \arg{f : ptr} "f" (Vptr f) + \pre{N γ} spawned_threads_inv N γ \persist{parent} current_thread parent - \pre{Q : thread_idT -> mpred} - (∀ child, [| child <> parent |] -* - @(threadTI, child) - (wp_fptr (σ.(genv_tu).(types)) entry_type f [] - (fun _ => Q child))) + \pre{Q : mpred} [| WeaklyObjective Q |] + \pre + (∀ child, + (MutexSets.my_mutexes γ child (coPset.CoPset ⊤) -* + (* FIXME is the usage of this wp_fptr correct? *) + wp_fptr (σ.(genv_tu).(types)) entry_type f [] + (* f returns void so Q does not depend on return value *) + (fun _ => Q))) \post Exists child, - [| child <> parent |] ** this |-> R (Some (child, Q child))). + [| child <> parent |] ** this |-> R (Some (child, Q))). - (** Joining consumes the join right exactly once and leaves the object - non-joinable. Keep the child's modality on [Q]: join does not turn - child-local ownership into ownership local to the caller. *) - Definition join_spec : ptr -> WpSpec mpred val val := + (** Must be joinable, takes resource and leaves the object non-joinable. *) + Definition join_spec_body : ptr -> WpSpec mpred val val := (\this this \persist{parent} current_thread parent \pre{child Q} this |-> R (Some (child, Q)) + (* error if joining itself *) \require child <> parent - \post this |-> R None ** @(threadTI, child) Q). + \post this |-> R None ** Q). + + cpp.spec "std::thread::thread, void>(void (*&)())" as ctor_spec from source with + (\exact Reduce spawn_spec_body). + + cpp.spec "std::thread::thread, void>(void (&)())" + as ctor_ref_spec from source with + (\exact Reduce spawn_spec_body). - (** Supply the instantiated constructor name from the translation unit. *) - cpp.spec "std::thread::thread()" as ctor_spec with - (\exact Reduce spawn_spec). + (** Must be joined (and resources transferred) so can be destroyed. *) + cpp.spec "std::thread::~thread()" as dtor_spec from source with + (\this this + \pre this |-> R None + \post emp). - Definition join : mpred := - specify {| info_name := "std::thread::join()"; - info_type := tMethod "std::thread" QM "void" [] |} join_spec. + cpp.spec "std::thread::join()" as join from source with + (\exact Reduce join_spec_body). End with_cpp. + +(** Specifications for thread IDs and the current thread's operations. *) +Section thread_id_specs. + Parameter thread_idR : ∀ `{Σ : cpp_logic, σ : genv}, cQp.t -> + (* None if value is thread::id(), Some otherwise *) + option thread_idT -> Rep. + #[only(cfracsplittable, type_ptr="std::thread::id")] derive thread_idR. + #[global] Axiom thread_idR_WeaklyObjective : + ∀ `{Σ : cpp_logic, σ : genv} (q : cQp.t) + (o : option thread_idT) (p : ptr), + WeaklyObjective (thread_idR q o p). + #[global] Existing Instance thread_idR_WeaklyObjective. + + Context `{Σ : cpp_logic} {σ : genv}. + Context {HAS_THREADS : HasStdThreads Σ}. + + cpp.spec (default_ctor "std::thread::id") + as thread_id_ctor_spec from source with ( + \this this + \post this |-> thread_idR 1$m None). + + cpp.spec (const_copy_ctor "std::thread::id") + as thread_id_copy_ctor_spec from source with ( + \this this + \arg{other} "" (Vptr other) + \prepost{q o} other |-> thread_idR q o + \post this |-> thread_idR 1$m o). + + cpp.spec (dtor "std::thread::id") as thread_id_dtor_spec from source with ( + \this this + \pre{o} this |-> thread_idR 1$m o + \post emp). + + cpp.spec "std::thread::id::operator=(const std::thread::id&)" + as thread_id_copy_assign_spec from source with ( + \this this + \arg{other} "" (Vptr other) + \pre{old} this |-> thread_idR 1$m old + \prepost{q o} other |-> thread_idR q o + \post[Vref this] this |-> thread_idR 1$m o). + + cpp.spec "std::thread::id::operator=(std::thread::id&&)" + as thread_id_move_assign_spec from source with ( + \this this + \arg{other} "" (Vptr other) + \pre{old} this |-> thread_idR 1$m old + \prepost{o} other |-> thread_idR 1$m o + \post[Vref this] this |-> thread_idR 1$m o). + + cpp.spec "std::operator==(std::thread::id, std::thread::id)" + as thread_id_eq_spec from source with ( + \arg{lhs} "" (Vptr lhs) + \arg{rhs} "" (Vptr rhs) + \prepost{q1 o1} lhs |-> thread_idR q1 o1 + \prepost{q2 o2} rhs |-> thread_idR q2 o2 + \post[Vbool (bool_decide (o1 = o2))] emp). + + cpp.spec "std::this_thread::get_id()" as get_id_spec from source with ( + \persist{thr} current_thread thr + \post{result}[Vptr result] + result |-> thread_idR 1$m (Some thr)). + + cpp.spec "std::this_thread::yield()" as yield_spec from source with ( + \post emp). +End thread_id_specs. diff --git a/rocq-brick-libstdcpp/proof/thread/thread.hpp b/rocq-brick-libstdcpp/proof/thread/thread.hpp index ee6744fe..983beeca 100644 --- a/rocq-brick-libstdcpp/proof/thread/thread.hpp +++ b/rocq-brick-libstdcpp/proof/thread/thread.hpp @@ -1 +1,4 @@ -#include \ No newline at end of file +#include + +template std::thread::thread(void (*&)()); +template std::thread::thread(void (&)()); diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index 7c873498..d9269494 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -9,58 +9,69 @@ Require Import skylabs.brick.libstdcpp.mutex.requirements. Require Import skylabs.brick.libstdcpp.lib.lock_ghost2. Require Import skylabs.brick.libstdcpp.atomic.spec. Require Import skylabs.brick.libstdcpp.cassert.spec. +Require Import skylabs.brick.libstdcpp.thread.spec. Import linearity. Require Import skylabs.brick.libstdcpp.test.mutex.custom_mutex_hpp. -(** The ghost implementation and its physical client predicates are specific - to [MyMutex]. The entire mutex-set pool still uses one shared ghost name. *) -Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) - (Owners0 : OWNER_TID) <: MUTEX_PREDS. - Record mutex_gname : Set := MkGname { +(** The concrete mutex supplies both the ghost state and the physical + predicates used by [mutex_spec]. The mutex-set pool is shared, and the + memory-order global remains a separate precondition of the C++ methods. *) +Module CustomMutexPreds <: MUTEX_PREDS. + Import MutexSets MutexTokens OwnerTid. + + Record state_gname : Set := MkStateGname { pool_gname : iprop.gname; token_gname : iprop.gname; owner_gname : iprop.gname; }. + + Definition class_name : name := "MyMutex"%cpp_name. + Definition cpp_ty : type := Tnamed class_name. + Record mutex_gname : Set := MkGname { + lock_state_gname :> state_gname; + cinv_gname : iprop.gname; + }. Definition gname : Set := mutex_gname. - Definition pool_name (γ : gname) : iprop.gname := γ.(pool_gname). + Definition pool_name (γ : gname) : iprop.gname := + γ.(lock_state_gname).(pool_gname). Definition mutex_inv_namespace : namespace := nroot .@@ "MyMutex" .@ "inv_namespace". Class stateG `{Σ : cpp_logic} := { - #[global] sets_G :: Sets0.G Σ; - #[global] tokens_G :: Tokens0.G Σ; - #[global] owners_G :: Owners0.G Σ; + #[global] sets_G :: MutexSets.G Σ; + #[global] tokens_G :: MutexTokens.G Σ; + #[global] owners_G :: OwnerTid.G Σ; }. Definition G := @stateG. Existing Class G. #[global] Arguments G {_ _} Σ : assert. #[global] Instance state_G `{Σ : cpp_logic} (H : G Σ) : @stateG _ _ Σ := H. - Definition token `{Σ : cpp_logic, !G Σ} - (γ : gname) (q : cQp.t) : mpred := - Tokens0.token γ.(token_gname) q. + Definition state_token `{Σ : cpp_logic, !G Σ} + (γ : state_gname) (q : cQp.t) : mpred := + MutexTokens.token γ.(token_gname) q. Definition not_locked_ghost `{Σ : cpp_logic, !G Σ} - (γ : mutex_gname) (th : thread_idT) (q : Qp) : mpred := - Sets0.my_mutexes γ.(pool_gname) th (coPset.CoPset $ ↑mutex_inv_namespace) ** - Tokens0.token γ.(token_gname) q. + (γ : state_gname) (th : thread_idT) (q : Qp) : mpred := + MutexSets.my_mutexes γ.(pool_gname) th (coPset.CoPset $ ↑mutex_inv_namespace) ** + MutexTokens.token γ.(token_gname) q. Definition owner_token `{Σ : cpp_logic, !G Σ} - (γ : mutex_gname) (th : thread_idT) (q : Qp) : mpred := - Tokens0.given_token γ.(token_gname) q ** - Owners0.owner_tid_frag γ.(owner_gname) (Some th). + (γ : state_gname) (th : thread_idT) (q : Qp) : mpred := + MutexTokens.given_token γ.(token_gname) q ** + OwnerTid.owner_tid_frag γ.(owner_gname) (Some th). - #[global] Instance token_fractional - `{Σ : cpp_logic, !G Σ} γ : CFractional (token γ). + #[global] Instance state_token_fractional + `{Σ : cpp_logic, !G Σ} γ : CFractional (state_token γ). Proof. - intros q1 q2. rewrite /token cQp.frac_add. - apply Tokens0.token_fractional. + intros q1 q2. rewrite /state_token cQp.frac_add. + apply MutexTokens.token_fractional. Qed. - #[global] Instance token_timeless - `{Σ : cpp_logic, !G Σ} γ q : Timeless (token γ q). - Proof. rewrite /token. apply _. Qed. + #[global] Instance state_token_timeless + `{Σ : cpp_logic, !G Σ} γ q : Timeless (state_token γ q). + Proof. rewrite /state_token. apply _. Qed. #[global] Instance owner_token_timeless `{Σ : cpp_logic, !G Σ} γ th q : Timeless (owner_token γ th q). @@ -77,15 +88,15 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) and the token balance. The thread retains its remaining mutex names. When free, both halves of the previous owner remain in the invariant. *) Definition state `{Σ : cpp_logic, !G Σ} - (γ : mutex_gname) (b : bool) : mpred := + (γ : state_gname) (b : bool) : mpred := (if b then - ∃ th, Owners0.owner_tid_auth γ.(owner_gname) (Some th) ** - Sets0.my_mutexes γ.(pool_gname) th (coPset.CoPset $ ↑mutex_inv_namespace) ** - Tokens0.token_not_full γ.(token_gname) + ∃ th, OwnerTid.owner_tid_auth γ.(owner_gname) (Some th) ** + MutexSets.my_mutexes γ.(pool_gname) th (coPset.CoPset $ ↑mutex_inv_namespace) ** + MutexTokens.token_not_full γ.(token_gname) else - ∃ owner, Owners0.owner_tid_auth γ.(owner_gname) owner ** - Owners0.owner_tid_frag γ.(owner_gname) owner ** - Tokens0.token_full γ.(token_gname))%I. + ∃ owner, OwnerTid.owner_tid_auth γ.(owner_gname) owner ** + OwnerTid.owner_tid_frag γ.(owner_gname) owner ** + MutexTokens.token_full γ.(token_gname))%I. #[global] Instance state_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ b : @@ -95,33 +106,33 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) Section state_laws. Context `{Σ : cpp_logic, !G Σ}. - Lemma alloc (γpool : iprop.gname) : + Lemma alloc_state (γpool : iprop.gname) : ⊢ |==> ∃ γ, [| γ.(pool_gname) = γpool |] ** - token γ 1$m ** state γ false. + state_token γ 1$m ** state γ false. Proof. - iMod Tokens0.alloc as (gt) "[T GT]". - iMod (Owners0.alloc None) as (go) "[OA OF]". - iModIntro. iExists (MkGname γpool gt go). + iMod MutexTokens.alloc as (gt) "[T GT]". + iMod (OwnerTid.alloc None) as (go) "[OA OF]". + iModIntro. iExists (MkStateGname γpool gt go). iSplit; first done. - rewrite /token /state /=. iFrame "T". iExists None. + rewrite /state_token /state /=. iFrame "T". iExists None. iFrame "OA OF". - iApply Tokens0.token_full_init. iExact "GT". + iApply MutexTokens.token_full_init. iExact "GT". Qed. - Lemma do_lock γ th q : + Lemma state_lock γ th q : state γ false ** not_locked_ghost γ th q |-- (|==> state γ true ** owner_token γ th q). Proof. rewrite /state /not_locked_ghost /owner_token. iIntros "[State [Sets T]]". iDestruct "State" as (owner) "(OA & OF & Balance)". - iDestruct (Tokens0.acquire with "[$Balance $T]") as "[GT Balance]". - iMod (Owners0.owner_update γ.(owner_gname) _ _ (Some th) + iDestruct (MutexTokens.acquire with "[$Balance $T]") as "[GT Balance]". + iMod (OwnerTid.owner_update γ.(owner_gname) _ _ (Some th) with "[$OA $OF]") as "[OA OF]". iModIntro. iFrame "GT OF". iExists th. iFrame. Qed. - Lemma do_unlock γ th q : + Lemma state_unlock γ th q : state γ true ** owner_token γ th q |-- (|==> state γ false ** not_locked_ghost γ th q). Proof. @@ -130,7 +141,7 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) iDestruct "State" as (owner) "(OA & Sets & Balance)". iDestruct (observe_2 [| Some owner = Some th |] with "OA OF") as %Heq. injection Heq as ->. - iDestruct (Tokens0.release with "[$Balance $GT]") as "[T Balance]". + iDestruct (MutexTokens.release with "[$Balance $GT]") as "[T Balance]". iModIntro. iFrame "Sets T". iExists (Some th). iFrame. Qed. @@ -139,224 +150,261 @@ Module CustomMutexState (Sets0 : MUTEX_SETS) (Tokens0 : MUTEX_TOKENS) Proof. rewrite /state /owner_token. iIntros "[State [_ OF]]". iDestruct "State" as (owner) "(_ & OF0 & _)". - iDestruct (Owners0.owner_tid_frag_exclusive with "OF0 OF") as %[]. + iDestruct (OwnerTid.owner_tid_frag_exclusive with "OF0 OF") as %[]. Qed. Lemma locked_full_token γ : - state γ true ** token γ 1$m |-- False. + state γ true ** state_token γ 1$m |-- False. Proof. - rewrite /state /token. iIntros "[State T]". + rewrite /state /state_token. iIntros "[State T]". iDestruct "State" as (th) "(_ & _ & Balance)". - iApply (Tokens0.token_not_full_full_token with "[$Balance $T]"). + iApply (MutexTokens.token_not_full_full_token with "[$Balance $T]"). Qed. End state_laws. - #[global] Hint Opaque token not_locked_ghost owner_token state : sl_opacity typeclass_instances. - - Parameter thread_idR : ∀ `{Σ : cpp_logic, σ : genv}, cQp.t -> - (* None if value is thread::id(), Some otherwise *) - option thread_idT -> Rep. - #[only(cfracsplittable, type_ptr="std::thread::id")] derive thread_idR. - #[global] Axiom thread_idR_WeaklyObjective : - ∀ `{Σ : cpp_logic, σ : genv} (q : cQp.t) - (o : option thread_idT) (p : ptr), - WeaklyObjective (thread_idR q o p). - #[global] Existing Instance thread_idR_WeaklyObjective. + #[global] Hint Opaque state_token not_locked_ghost owner_token state : sl_opacity typeclass_instances. Definition globals `{Σ : cpp_logic} {σ : genv} (q : cQp.t) : mpred := _global "std::memory_order_seq_cst" |-> primR "enum std::memory_order" q (memory_order.to_val memory_order.seq_cst). + #[global] Arguments globals /. + + Definition token `{Σ : cpp_logic, !G Σ} (γ : gname) (q : cQp.t) : mpred := + state_token γ q. Definition not_locked `{Σ : cpp_logic, !G Σ} {σ : genv} (this : ptr) (γ : gname) (th : thread_idT) (q : cQp.t) : mpred := - not_locked_ghost γ th q ** globals q. + not_locked_ghost γ th q. + Definition locked `{Σ : cpp_logic, !G Σ} {σ : genv} + (this : ptr) (γ : gname) (th : thread_idT) (q : cQp.t) : mpred := + this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m (Some th) ** + owner_token γ th q. + #[global] Hint Opaque token : sl_opacity typeclass_instances. + #[global] Hint Opaque locked : typeclass_instances. #[global] Arguments not_locked /. - #[global] Arguments globals /. + #[global] Arguments locked /. + #[global] Instance token_fractional `{Σ : cpp_logic, !G Σ} γ : + CFractional (token γ). + Proof. rewrite /token. apply state_token_fractional. Qed. + #[global] Instance token_timeless `{Σ : cpp_logic, !G Σ} γ q : + Timeless (token γ q). + Proof. rewrite /token. apply _. Qed. #[global] Instance not_locked_timeless `{Σ : cpp_logic, !G Σ} {σ : genv} this γ th q : Timeless (not_locked this γ th q). - Proof. rewrite /not_locked /not_locked_ghost /globals. apply _. Qed. + Proof. rewrite /not_locked /not_locked_ghost. apply _. Qed. #[global] Instance not_locked_exclusive `{Σ : cpp_logic, !G Σ} {σ : genv} this γ th : Exclusive1 (not_locked this γ th). Proof. intros q1 q2. rewrite /not_locked /not_locked_ghost. - iIntros "[[F1 _] _] [[F2 _] _]". + iIntros "[F1 _] [F2 _]". have Hnonempty : (↑ mutex_inv_namespace : coPset) ∩ ↑ mutex_inv_namespace ≠ ∅. { rewrite intersection_idemp_L. apply nclose_non_empty. } - iDestruct (Sets0.my_mutexes_exclusive γ.(pool_gname) th + iDestruct (MutexSets.my_mutexes_exclusive _ th (↑ mutex_inv_namespace) (↑ mutex_inv_namespace) Hnonempty with "[$F1 $F2]") as %[]. Qed. - - (** Public ownership includes the physical owner written by [lock]. *) - Definition locked `{Σ : cpp_logic, !G Σ} {σ : genv} - (this : ptr) (γ : gname) (th : thread_idT) (q : cQp.t) : mpred := - globals q ** - (this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m (Some th) ** - owner_token γ th q). - #[global] Arguments locked /. #[global] Instance locked_timeless `{Σ : cpp_logic, !G Σ} {σ : genv} this γ th q : Timeless (locked this γ th q). - Proof. rewrite /locked /globals. apply _. Qed. + Proof. rewrite /locked. apply _. Qed. #[global] Instance locked_exclusive `{Σ : cpp_logic, !G Σ} {σ : genv} this γ : Exclusive2 (locked this γ). - Proof. - intros th1 th2 q1 q2. rewrite /locked. - apply observe_2_sep_r. apply observe_2_sep_r. apply _. - Qed. - -End CustomMutexState. - -Module LockState := CustomMutexState MutexSets MutexTokens OwnerTid. - -(** Verify the implementation using its ghost resources and public state predicates. *) -Module custom_mutex. - Module State := LockState. - Module Spec := mutex_spec State. - - Abbreviation N := "MyMutex"%cpp_name. - Abbreviation thread_idR := LockState.thread_idR. - #[local] Hint Opaque LockState.thread_idR : sl_opacity typeclass_instances. + Proof. intros th1 th2 q1 q2. rewrite /locked. apply observe_2_sep_r. apply _. Qed. #[local] Instance at_WeaklyObjective `{Σ : cpp_logic} (p : ptr) (R : Rep) `{!WeaklyObjective (R p)} : WeaklyObjective (p |-> R). Proof. rewrite INTERNAL._at_eq. apply _. Qed. - (* thread::id operations and yield() are not proved for now. *) - Section unproved_specs. - Context `{Σ : cpp_logic, σ : genv, HAS_THREADS : !HasStdThreads Σ}. - Context `{MOD : source ⊧ σ}. - - cpp.spec (default_ctor "std::thread::id") as thread_id_ctor_spec with ( - \this this - \post this |-> thread_idR 1$m None). - - cpp.spec (const_copy_ctor "std::thread::id") as thread_id_copy_ctor_spec with ( - \this this - \arg{other} "" (Vptr other) - \prepost{q o} other |-> thread_idR q o - \post this |-> thread_idR 1$m o). - - cpp.spec (dtor "std::thread::id") as thread_id_dtor_spec with ( - \this this - \pre{o} this |-> thread_idR 1$m o - \post emp). - - cpp.spec "std::thread::id::operator=(const std::thread::id&)" - as thread_id_copy_assign_spec with ( - \this this - \arg{other} "" (Vptr other) - \pre{old} this |-> thread_idR 1$m old - \prepost{q o} other |-> thread_idR q o - \post[Vref this] this |-> thread_idR 1$m o). - - cpp.spec "std::thread::id::operator=(std::thread::id&&)" - as thread_id_move_assign_spec with ( - \this this - \arg{other} "" (Vptr other) - \pre{old} this |-> thread_idR 1$m old - \prepost{o} other |-> thread_idR 1$m o - \post[Vref this] this |-> thread_idR 1$m o). - - cpp.spec "std::operator==(std::thread::id, std::thread::id)" - as thread_id_eq_spec with ( - \arg{lhs} "" (Vptr lhs) - \arg{rhs} "" (Vptr rhs) - \prepost{q1 o1} lhs |-> thread_idR q1 o1 - \prepost{q2 o2} rhs |-> thread_idR q2 o2 - \post[Vbool (bool_decide (o1 = o2))] emp). - - cpp.spec "std::this_thread::get_id()" as get_id_spec with ( - \persist{thr} current_thread thr - \post{result}[Vptr result] - result |-> thread_idR 1$m (Some thr)). - - cpp.spec "std::this_thread::yield()" as yield_spec with ( - \post emp). - End unproved_specs. - - Record gname : Set := MkGname { - lock_state_gname :> State.mutex_gname; - cinv_gname : iprop.gname; - }. - Section with_Σ. - Context `{Σ : cpp_logic, σ : genv, HAS_THREADS : !HasStdThreads Σ, - !State.G Σ}. + Context `{Σ : cpp_logic, !G Σ}. (** The physical lock bit agrees with the abstract ghost state. The protected resources and cleared owner field are available while free. *) - Definition mutex_inv (this : ptr) (γ : gname) (P : mpred) : mpred := + Definition mutex_inv {σ : genv} (this : ptr) (γ : gname) (P : mpred) : mpred := ∃ b : bool, this ,, _field "MyMutex::m_lock" |-> atomic.R "int" 1$m (if b then 1 else 0)%Z ** - State.state γ b ** + state γ b ** if b then emp else P ** this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None. - Definition IR (γ : gname) (q : cQp.t) (P : mpred) : Rep := - structR N q$m ** + Definition R {HAS_THREADS : HasStdThreads Σ} {σ : genv} (γ : gname) (q : cQp.t) (P : mpred) : Rep := + structR class_name q$m ** as_Rep (fun this => - cinv State.mutex_inv_namespace (cinv_gname γ) (mutex_inv this γ P) ** + cinv mutex_inv_namespace (cinv_gname γ) (mutex_inv this γ P) ** cinv_own (cinv_gname γ) q ). - Hint Opaque IR : sl_opacity typeclass_instances. - #[only(type_ptr,cfractional,ascfractional,cfracvalid)] derive IR. + #[global] Hint Opaque R : sl_opacity typeclass_instances. + #[only(type_ptr,cfractional,ascfractional,cfracvalid)] derive R. + + #[global] Instance R_learnable {HAS_THREADS : HasStdThreads Σ} {σ : genv} : + Cbn (Learn (learn_eq ==> any ==> learn_eq ==> learn_hints.fin) R). + Proof. solve_learnable. Qed. + + Context {σ : genv} {HAS_THREADS : HasStdThreads Σ}. + + #[global] Instance locked_learn : + Cbn (Learn (req_eq ==> learn_eq ==> req_eq ==> req_eq ==> learn_hints.fin) locked). + Proof. solve_learnable. Qed. + + Definition do_lock (this : ptr) (lk : gname * mpred) (K : mpred) : mpred := + ∃ thr qt, current_thread thr ** not_locked this lk.1 thr qt ** + (locked this lk.1 thr qt ** lk.2 -* K). + #[global] Arguments do_lock /. + + Definition do_unlock (this : ptr) (lk : gname * mpred) (K : mpred) : mpred := + ∃ thr qt, current_thread thr ** locked this lk.1 thr qt ** ▷lk.2 ** + (not_locked this lk.1 thr qt -* K). + #[global] Arguments do_unlock /. + + #[global] Instance mutex_basic_lockable : + BasicLockable (T := gname * mpred) cpp_ty + (fun q gP => R gP.1 q gP.2) := + { do_lock := do_lock + ; do_unlock := do_unlock }. + + Definition do_try_lock (this : ptr) (lk : gname * mpred) + (K : bool -> mpred) : mpred := + ∃ thr qt, current_thread thr ** not_locked this lk.1 thr qt ** + ∀ b : bool, + (if b then lk.2 ** locked this lk.1 thr qt + else not_locked this lk.1 thr qt) -* K b. + #[global] Arguments do_try_lock /. + + #[global] Instance mutex_lockable : + Lockable (T := gname * mpred) cpp_ty + (fun q gP => R gP.1 q gP.2) := + { do_try_lock := do_try_lock }. + + Lemma init_R (this : ptr) (old : gname) + (pool : iprop.gname) (P : mpred) : + WeaklyObjective P -> + this |-> R old 1$m emp ** token old 1$m ** ▷P |-- + (|={⊤}=> ∃ g, this |-> R g 1$m P ** token g 1$m). + Proof. + intros HP. iIntros "(HR & T & P)". + iEval (rewrite /R _at_sep _at_as_Rep) in "HR". + iDestruct "HR" as "(S & #CI & CO)". + iMod (cinv_cancel with "CI CO") as "Inv"; [done..|]. + iMod (alloc_state pool) as (gs) "(_ & Tnew & Stnew)". + iMod (cinv_alloc with "[Inv P Stnew T]") as (gi) "[#CInew COnew]"; last first. + - iModIntro. iExists (MkGname gs gi). + rewrite /R _at_sep _at_as_Rep /token /mutex_inv /=. + iFrame "CInew S COnew Tnew". + - iNext. rewrite /mutex_inv. + iDestruct "Inv" as (b) "(L & St & Resources)". + destruct b. + + iDestruct (locked_full_token with "[$St $T]") as %[]. + + iDestruct "Resources" as "[_ Owner]". + iExists false. iFrame "L Stnew P Owner". + iApply (affine with "[St T]"); last iAccu. apply mpred_BiAffine. + - apply _. + Qed. + + Lemma register_thread + (this : ptr) (g : gname) (q : cQp.t) (P : mpred) + (th : thread_idT) (qt : cQp.t) : + this |-> R g q P ** token g qt ** + MutexSets.my_mutexes (pool_name g) th + (coPset.CoPset $ ↑mutex_inv_namespace) |-- + this |-> R g q P ** not_locked this g th qt. + Proof. + rewrite /not_locked /not_locked_ghost /token /state_token /pool_name. + iIntros "($ & T & M)". iFrame. + Qed. + End with_Σ. +End CustomMutexPreds. + +(** Verify the implementation using its ghost resources and public state predicates. *) +Module custom_mutex. + Import CustomMutexPreds. + Module Spec := mutex_spec CustomMutexPreds. + + Abbreviation N := "MyMutex"%cpp_name. + #[local] Hint Opaque thread_idR : sl_opacity typeclass_instances. + + #[local] Instance at_WeaklyObjective `{Σ : cpp_logic} + (p : ptr) (R : Rep) `{!WeaklyObjective (R p)} : + WeaklyObjective (p |-> R). + Proof. rewrite INTERNAL._at_eq. apply _. Qed. + + Abbreviation IR := CustomMutexPreds.R. + + Section with_Σ. + Context `{Σ : cpp_logic, σ : genv, HAS_THREADS : !HasStdThreads Σ, + !CustomMutexPreds.G Σ}. Context `{MOD : source ⊧ σ}. + (* FIXME any reason to keep Reduce? *) cpp.spec "MyMutex::MyMutex()" as ctor_spec with - (\exact Reduce (Spec.ctor_spec IR lock_state_gname)). + (\exact Reduce (Spec.ctor_spec)). cpp.spec "MyMutex::~MyMutex()" as dtor_spec with - (\exact Reduce (Spec.dtor_spec IR lock_state_gname)). + (\exact Reduce (Spec.dtor_spec)). Definition T : Type := gname * mpred. cpp.spec "MyMutex::do_lock()" as do_lock_spec with ( \this this \prepost{g q P} this |-> IR g q P \persist{thr} current_thread thr - \pre{(qt : cQp.t)} State.not_locked_ghost g thr qt ** State.globals qt - \post P ** State.globals qt ** + \prepost{qg} globals qg + \pre{(qt : Qp)} not_locked_ghost g thr qt + \post P ** this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** - State.owner_token g thr qt). + owner_token g thr qt). cpp.spec "MyMutex::do_unlock()" as do_unlock_spec with ( \this this \prepost{g q P} this |-> IR g q P \persist{thr} current_thread thr - \pre{qt} State.globals qt ** - this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** - State.owner_token g thr qt + \prepost{qg} globals qg + \pre{qt} this ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None ** + owner_token g thr qt \pre ▷P - \post State.not_locked_ghost g thr qt ** State.globals qt). - - Definition do_lock := Spec.do_lock lock_state_gname. - #[global] Arguments do_lock /. - Definition do_unlock := Spec.do_unlock lock_state_gname. - #[global] Arguments do_unlock /. - - #[global] Instance custom_mutex_basic_lockable : - BasicLockable (T := T) (Tnamed N) - (fun q gP => IR gP.1 q gP.2) := - { do_lock := do_lock - ; do_unlock := do_unlock }. + \post not_locked_ghost g thr qt). cpp.spec "MyMutex::lock()" as lock_spec_alt with - (\exact Reduce (Spec.lock_spec_alt IR lock_state_gname)). + (\this this + \prepost{qg} globals qg + \exact Reduce (Spec.lock_spec_alt this)). cpp.spec "MyMutex::unlock()" as unlock_spec_alt with - (\exact Reduce (Spec.unlock_spec_alt IR lock_state_gname)). + (\this this + \prepost{qg} globals qg + \exact Reduce (Spec.unlock_spec_alt this)). cpp.spec "MyMutex::lock()" as lock_spec with - (\exact Reduce - (lock_basic_lockable (Tnamed N) (fun q gP => IR gP.1 q gP.2))). + (\this this + \prepost{qg} globals qg + \exact Reduce + (Spec.lock_spec this)). cpp.spec "MyMutex::unlock()" as unlock_spec with - (\exact Reduce - (unlock_basic_lockable (Tnamed N) (fun q gP => IR gP.1 q gP.2))). + (\this this + \prepost{qg} globals qg + \exact Reduce + (Spec.unlock_spec this)). + + Lemma lock_spec_equiv_lock_spec_alt : lock_spec ⊣⊢ lock_spec_alt. + Proof. + rewrite /lock_spec /lock_spec_alt /specify. + do 2 f_equiv. intros this xs K. + rewrite !add_with_equiv. + f_equiv=> qg. + by rewrite !add_prepost_equiv Spec.lock_spec_equiv_lock_spec_alt. + Qed. + + Lemma unlock_spec_equiv_unlock_spec_alt : unlock_spec ⊣⊢ unlock_spec_alt. + Proof. + rewrite /unlock_spec /unlock_spec_alt /specify. + do 2 f_equiv. intros this xs K. + rewrite !add_with_equiv. + f_equiv=> qg. + by rewrite !add_prepost_equiv Spec.unlock_spec_equiv_unlock_spec_alt. + Qed. Abbreviation BASE p := (p ,, _base "std::atomic" "std::__atomic_base"). @@ -370,13 +418,13 @@ Module custom_mutex. \using denoteModule source \using{thr} current_thread thr \consuming{g q P} p |-> IR g q P - \consuming{qt} State.not_locked_ghost g thr qt + \consuming{qt} not_locked_ghost g thr qt \proving{K (_ : IsExistential K)} std.atomic.do_exchange "int" (BASE (p,, o_field σ "MyMutex::m_lock") ) 1%Z K \instantiate K := (fun res => p |-> IR g q P ** [| res = 0 \/ res = 1 |]%Z ** - if bool_decide (res = 0) then P ** State.owner_token g thr qt ** + if bool_decide (res = 0) then P ** owner_token g thr qt ** p ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None - else State.not_locked_ghost g thr qt) + else not_locked_ghost g thr qt) \end@{mpredI}. Next Obligation. intros. iIntros "[#M Hpre]" (?? ->). @@ -386,7 +434,7 @@ Module custom_mutex. iDestruct "IR" as "(S & #CI & CO)". rewrite /std.atomic.do_exchange. iAuIntro1. rewrite /atomic1_acc. - iInv State.mutex_inv_namespace as "Inv" "Hclose". + iInv mutex_inv_namespace as "Inv" "Hclose". iDestruct "Inv" as "[Inv CO]". iEval (rewrite /mutex_inv) in "Inv". iDestruct "Inv" as (b) "(>L & State & Resources)". @@ -410,7 +458,7 @@ Module custom_mutex. iModIntro. rewrite /IR _at_sep _at_as_Rep /=. iFrame "CI". iFrame. iPureIntro. auto. + iDestruct "Resources" as "[P Owner]". - iMod (State.do_lock _ with "[$State $NL]") as "[State Locked]". + iMod (state_lock _ with "[$State $NL]") as "[State Locked]". iMod ("Hclose" with "[L State]") as "_". { iNext. rewrite /mutex_inv. iExists true. iSplitL "L"; first by ework $usenamed=true with br_erefl. @@ -428,10 +476,10 @@ Module custom_mutex. \consuming{g q P} p |-> IR g q P \consuming P \consuming p ,, _field "MyMutex::m_owner" |-> thread_idR 1$m None - \consuming{qt} State.owner_token g thr qt + \consuming{qt} owner_token g thr qt \proving{K (_ : IsExistential K)} std.atomic.do_store "int" (BASE (p ,, o_field σ "MyMutex::m_lock")) 0%Z K - \instantiate K := (p |-> IR g q P ** State.not_locked_ghost g thr qt) + \instantiate K := (p |-> IR g q P ** not_locked_ghost g thr qt) \end@{mpredI}. Next Obligation. intros. iIntros "[#M Hpre]" (?? ->). @@ -441,7 +489,7 @@ Module custom_mutex. iDestruct "IR" as "(S & #CI & CO)". rewrite /std.atomic.do_store. iAcIntro. rewrite /commit_acc /=. - iInv State.mutex_inv_namespace as "Inv" "Hclose". + iInv mutex_inv_namespace as "Inv" "Hclose". iDestruct "Inv" as "[Inv CO]". iEval (rewrite /mutex_inv) in "Inv". iDestruct "Inv" as (b) "(>L & State & Resources)". @@ -450,7 +498,7 @@ Module custom_mutex. iSplitL "L"; first by ework $usenamed=true with br_erefl. iNext. iIntros "L". iMod "Y" as "_". destruct b. - - iMod (State.do_unlock _ with "[$State $Locked]") as "[State NL]". + - iMod (state_unlock _ with "[$State $Locked]") as "[State NL]". iMod ("Hclose" with "[L State P Owner]") as "_". { iNext. rewrite /mutex_inv. iExists false. iSplitL "L"; first by ework $usenamed=true with br_erefl. @@ -458,7 +506,7 @@ Module custom_mutex. iModIntro. rewrite /IR _at_sep _at_as_Rep /=. iFrame "CI". iFrame. - - iDestruct (State.unlocked_owner_token with "[$State $Locked]") as %[]. + - iDestruct (unlocked_owner_token with "[$State $Locked]") as %[]. Qed. Hint Resolve do_store_C : sl_opacity. @@ -496,9 +544,13 @@ Module custom_mutex. verify_spec; go. Qed. + #[local] Remove Hints CustomMutexPreds.locked_learn : typeclass_instances. + Lemma mymutex_lock_alt_proof : verify[source] lock_spec_alt. Proof using MOD HAS_THREADS. verify_spec; ego. + wname [CustomMutexPreds.not_locked_ghost] "NL". + iFrame "NL". ego. Unshelve. all: exact (1$m)%cQp. Qed. @@ -506,6 +558,8 @@ Module custom_mutex. Proof using MOD HAS_THREADS. verify_spec. repeat (go; ework). + wname [CustomMutexPreds.owner_token] "Owner". + iFrame "Owner". ego. Unshelve. all: exact (1$m)%cQp. Qed. @@ -516,7 +570,7 @@ Module custom_mutex. wname [P] "P". wname [_ |-> atomic.R _ _ _] "L". wname [_ |-> thread_idR _ _] "Owner". - iMod (State.alloc 1%positive) as (gs) "(_ & T & State)". + iMod (alloc_state 1%positive) as (gs) "(_ & T & State)". iMod (cinv_alloc with "[L P Owner State]") as (gi) "[#CI CO]"; last first. - iModIntro. iExists (MkGname gs gi). @@ -533,13 +587,13 @@ Module custom_mutex. work. wname [cinv] "#CI". wname [cinv_own] "CO". - wname [State.token] "T". + wname [CustomMutexPreds.token] "T". iMod (cinv_cancel with "CI CO") as "Inv"; [done..|]. go. iDestruct "Inv" as (b) "(Lock & State & Resources)". destruct b. - - iDestruct (State.locked_full_token with "[$State $T]") as %[]. + - iDestruct (locked_full_token with "[$State $T]") as %[]. - iDestruct "Resources" as "[P Owner]". iAssert emp with "[State T]" as "_". { iApply (affine with "[State T]"); last iAccu. apply mpred_BiAffine. } @@ -548,15 +602,13 @@ Module custom_mutex. Lemma mymutex_lock_proof : verify[source] lock_spec. Proof using MOD HAS_THREADS. - have -> : lock_spec ⊣⊢ lock_spec_alt. - { apply (Spec.lock_spec_equiv_lock_spec_alt IR lock_state_gname). done. } + rewrite lock_spec_equiv_lock_spec_alt. exact mymutex_lock_alt_proof. Qed. Lemma mymutex_unlock_proof : verify[source] unlock_spec. Proof using MOD HAS_THREADS. - have -> : unlock_spec ⊣⊢ unlock_spec_alt. - { apply (Spec.unlock_spec_equiv_unlock_spec_alt IR lock_state_gname). done. } + rewrite unlock_spec_equiv_unlock_spec_alt. exact mymutex_unlock_alt_proof. Qed. From 745c7346de290cccf37a6478b790d2f4fa77e2b0 Mon Sep 17 00:00:00 2001 From: rinshankaihou Date: Thu, 17 Sep 2026 05:22:27 +0000 Subject: [PATCH 47/51] add double_incr example and proof from paper as a mutex client; add std::thread specs --- rocq-brick-libstdcpp/proof/lib/lock_ghost2.v | 5 + rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 1 + rocq-brick-libstdcpp/proof/thread/spec.v | 5 + .../test/mutex/custom_mutex_hpp_proof.v | 6 +- .../test/mutex/double_incr.cpp | 6 +- .../test/mutex/double_incr_cpp_proof.v | 189 ++++++++++++++++++ .../test/mutex/double_incr_ghost.v | 93 +++++++++ 7 files changed, 300 insertions(+), 5 deletions(-) create mode 100644 rocq-brick-libstdcpp/test/mutex/double_incr_cpp_proof.v create mode 100644 rocq-brick-libstdcpp/test/mutex/double_incr_ghost.v diff --git a/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v b/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v index 3739c0ba..2bc8f9dc 100644 --- a/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v +++ b/rocq-brick-libstdcpp/proof/lib/lock_ghost2.v @@ -38,6 +38,8 @@ Module Type MUTEX_SETS. `{Σ : cpp_logic, !G Σ} γ M : WeaklyObjective (mutex_set_map γ M). #[global] Declare Instance my_mutexes_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ th E : WeaklyObjective (my_mutexes γ th E). + #[global] Declare Instance my_mutexes_objective + `{Σ : cpp_logic, !G Σ} γ th E : Objective (my_mutexes γ th E). Parameter my_mutexes_exclusive : forall `{Σ : cpp_logic, !G Σ} γ th (E1 E2: coPset), E1 ∩ E2 <> ∅ -> @@ -199,6 +201,9 @@ Module MutexSets : MUTEX_SETS. #[global] Instance my_mutexes_WeaklyObjective `{Σ : cpp_logic, !G Σ} γ th E : WeaklyObjective (my_mutexes γ th E). Proof. rewrite /my_mutexes. apply _. Qed. + #[global] Instance my_mutexes_objective `{Σ : cpp_logic, !G Σ} γ th E : + Objective (my_mutexes γ th E). + Proof. rewrite /my_mutexes. apply _. Qed. Section theory. Context `{Σ : cpp_logic, !G Σ}. diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index 07a55b79..27860bbb 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -119,6 +119,7 @@ Module Type MUTEX_PREDS. WeaklyObjective P -> this |-> R old 1$m emp ** token old 1$m ** ▷P |-- (|={⊤}=> ∃ g, + [| pool_name g = pool |] ** this |-> R g 1$m P ** token g 1$m). (** Register a thread by consuming its handle for this mutex's namespace diff --git a/rocq-brick-libstdcpp/proof/thread/spec.v b/rocq-brick-libstdcpp/proof/thread/spec.v index fde75f0e..47caefca 100644 --- a/rocq-brick-libstdcpp/proof/thread/spec.v +++ b/rocq-brick-libstdcpp/proof/thread/spec.v @@ -37,6 +37,11 @@ Section with_cpp. Definition entry_type : type := Tfunction (FunctionType Tvoid []). + #[global] Declare Instance wp_fptr_objective (f : ptr) (Q : mpred) + `{!WeaklyObjective Q} : + ObjectiveWith threadTI + (wp_fptr (σ.(genv_tu).(types)) entry_type f [] (fun _ => Q)). + (** Passing a function lvalue binds a function reference directly, without an intermediate function-pointer object. The child receives its mutex namespace pool before running the entry point. Resources that the entry diff --git a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v index d9269494..44861130 100644 --- a/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v +++ b/rocq-brick-libstdcpp/test/mutex/custom_mutex_hpp_proof.v @@ -282,15 +282,17 @@ Module CustomMutexPreds <: MUTEX_PREDS. (pool : iprop.gname) (P : mpred) : WeaklyObjective P -> this |-> R old 1$m emp ** token old 1$m ** ▷P |-- - (|={⊤}=> ∃ g, this |-> R g 1$m P ** token g 1$m). + (|={⊤}=> ∃ g, [| pool_name g = pool |] ** + this |-> R g 1$m P ** token g 1$m). Proof. intros HP. iIntros "(HR & T & P)". iEval (rewrite /R _at_sep _at_as_Rep) in "HR". iDestruct "HR" as "(S & #CI & CO)". iMod (cinv_cancel with "CI CO") as "Inv"; [done..|]. - iMod (alloc_state pool) as (gs) "(_ & Tnew & Stnew)". + iMod (alloc_state pool) as (gs) "(%Hpool & Tnew & Stnew)". iMod (cinv_alloc with "[Inv P Stnew T]") as (gi) "[#CInew COnew]"; last first. - iModIntro. iExists (MkGname gs gi). + iSplit; first (iPureIntro; exact Hpool). rewrite /R _at_sep _at_as_Rep /token /mutex_inv /=. iFrame "CInew S COnew Tnew". - iNext. rewrite /mutex_inv. diff --git a/rocq-brick-libstdcpp/test/mutex/double_incr.cpp b/rocq-brick-libstdcpp/test/mutex/double_incr.cpp index 0d7a822f..8a909bc7 100644 --- a/rocq-brick-libstdcpp/test/mutex/double_incr.cpp +++ b/rocq-brick-libstdcpp/test/mutex/double_incr.cpp @@ -2,8 +2,8 @@ #include #include -unsigned int x = 0; -std::mutex m; +unsigned int x{0}; +std::mutex m{}; void double_incr() { m.lock(); @@ -19,6 +19,6 @@ int main() { t1.join(); t2.join(); - assert(x == 4); + assert(x % 2 == 0); return 0; } diff --git a/rocq-brick-libstdcpp/test/mutex/double_incr_cpp_proof.v b/rocq-brick-libstdcpp/test/mutex/double_incr_cpp_proof.v new file mode 100644 index 00000000..d22a4a25 --- /dev/null +++ b/rocq-brick-libstdcpp/test/mutex/double_incr_cpp_proof.v @@ -0,0 +1,189 @@ +Require Import skylabs.auto.cpp.proof. +Require Import skylabs.bi.tls_modalities. +Require Import skylabs.brick.libstdcpp.mutex.spec.mutex. +Require Import skylabs.brick.libstdcpp.thread.spec. +Require Import skylabs.brick.libstdcpp.lib.lock_ghost2. +Require Import skylabs.brick.libstdcpp.cassert.spec. +Require Import skylabs.brick.libstdcpp.test.mutex.double_incr_cpp. +Require Import skylabs.brick.libstdcpp.test.mutex.double_incr_ghost. + +#[local] Hint Opaque double_incr_protocol.frac double_incr_protocol.protected + double_incr_protocol.done double_incr_protocol.evenR : sl_opacity. + +Section with_cpp. + Context `{Σ : cpp_logic, σ : genv}. + Context {HAS_THREADS : HasStdThreads Σ}. + Context `{!mutex.G Σ, !double_incr_protocol.G Σ}. + + cpp.spec "double_incr()" as double_incr_spec_body from source with ( + \prepost{g q γ} _global "m" |-> mutex.R g q + (double_incr_protocol.protected γ (_global "x")) + \persist{thr} current_thread thr + \prepost{qt} mutex.not_locked (_global "m") g thr qt + \pre double_incr_protocol.frac γ (1 / 2) + \post double_incr_protocol.done γ (_global "x")). + + Lemma double_incr_ok : verify[source] "double_incr()". + Proof. + verify_spec; go. + iExists q, (mutex.locked (_global "m") g thr qt ** + double_incr_protocol.protected γ (_global "x"))%I, qt. + iFrame. iSplitR; first (iIntros "$"). + iIntros "[? [? ?]]". + iDestruct (double_incr_protocol.prepare with "[$]") as "[Hx Hfinish]". + iDestruct "Hx" as (n) "[? %Heven]". + go. + replace (n + 1 + 1)%Z with (n + 2)%Z by lia. + iDestruct select (_global "x" |-> uintR _ _) as "Hx". + iAssert (double_incr_protocol.evenR (_global "x")) with "[Hx]" as "Hx". + { iExists (trim 32 (n + 2)). iFrame. iPureIntro. + apply double_incr_protocol.trim_add_two_even. exact Heven. } + iDestruct ("Hfinish" with "Hx") as "[? ?]". + iExists q, (mutex.not_locked (_global "m") g thr qt), qt; go. + Qed. + + (** The verification below is conditional on these objectivity properties + of the thread model. They are explicit proof hypotheses. *) + Context `{worker_spec_objective : !ObjectiveWith threadTI double_incr_spec_body}. + Context `{even_weakly_objective : + !WeaklyObjective (double_incr_protocol.evenR (_global "x"))}. + Context `{shared_mutex_objective : ∀ g γ, + ObjectiveWith threadTI (_global "m" |-> mutex.R g (1 / 2)$m + (double_incr_protocol.protected γ (_global "x")))}. + Context `{shared_token_objective : ∀ g, + ObjectiveWith threadTI (mutex.token g (1 / 2)$m)}. + + #[local] Instance protected_weakly_objective γ : + WeaklyObjective (double_incr_protocol.protected γ (_global "x")). + Proof using Type even_weakly_objective. + rewrite /double_incr_protocol.protected /double_incr_protocol.auth + /double_incr_protocol.frac. apply _. + Qed. + + (** Each worker receives half of the mutex ownership and a completion + ticket. Its namespace handle comes from spawn. *) + Definition worker_start (g : mutex.gname) + (γ : double_incr_protocol.gname) : mpred := + _global "m" |-> mutex.R g (1 / 2)$m + (double_incr_protocol.protected γ (_global "x")) ** + mutex.token g (1 / 2)$m ** double_incr_protocol.frac γ (1 / 2). + + #[local] Instance worker_start_objective g γ : + ObjectiveWith threadTI (worker_start g γ). + Proof using Type shared_mutex_objective shared_token_objective. + rewrite /worker_start /double_incr_protocol.frac. + apply sep_objective_with; first apply _. + apply sep_objective_with; first apply _. + apply objective_objective_with. apply _. + Qed. + + #[local] Instance done_weakly_objective γ : + WeaklyObjective (double_incr_protocol.done γ (_global "x")). + Proof using Type even_weakly_objective. + rewrite /double_incr_protocol.done /double_incr_protocol.auth. apply _. + Qed. + + (** Register the child's mutex namespace, then invoke the verified worker + contract in that child's thread context. *) + Lemma worker_entry `{MOD : source ⊧ σ} g γ : + double_incr_spec_body ** worker_start g γ |-- + ∀ child, + MutexSets.my_mutexes (mutex.pool_name g) child (coPset.CoPset ⊤) -* + wp_fptr (σ.(genv_tu).(types)) thread.spec.entry_type + (_global "double_incr()") [] + (fun _ => double_incr_protocol.done γ (_global "x")). + Proof using Type worker_spec_objective even_weakly_objective + shared_mutex_objective shared_token_objective. + iIntros "[#Hcode Hstart]" (child) "Hset". + rewrite (objective_with_intro_exactly_at threadTI + (wp_fptr (σ.(genv_tu).(types)) thread.spec.entry_type + (_global "double_incr()") [] + (fun _ => double_incr_protocol.done γ (_global "x"))) child). + iDestruct (monPred_atleast_exactly_at threadTI child) as "HT". + iModIntro. + iDestruct "Hstart" as "(Hm & Htoken & Hfrac)". + iDestruct (MutexSets.my_mutexes_alloc_mutex_name (mutex.pool_name g) + child ⊤ (↑mutex.mutex_inv_namespace) ltac:(set_solver) + with "Hset") as "[Hrest Hname]". + iDestruct (mutex.register_thread with "[$Hm $Htoken $Hname]") + as "[Hm Hnotlocked]". + iEval (unfold double_incr_spec_body, specify, unmaterialized_specR) in "Hcode". + iApply (invoke.use_cptrR with "Hcode"). cbn. + iSplitR; first done. + iExists g, ((1 / 2)$m)%cQp, γ, child, ((1 / 2)$m)%cQp. + iSplitR; first done. iFrame. + iFrame "HT". + iIntros "[HR [HNL HD]]" (v) "HV". iExact "HD". + Qed. + + #[local] Hint Opaque worker_start thread.spec.spawned_threads_inv : sl_opacity. + + Definition thread_pool_namespace : namespace := + nroot .@@ "double_incr" .@ "threads". + + (** Global vars are given as preconditions. + Assume the mutex is initialized with an empty invariant (assocaited with + γold), which can later be updated to a new invariant with init_R. *) + cpp.spec "main()" as main_spec from source with ( + \pre _global "x" |-> uintR 1$m 0 + \pre{γold} _global "m" |-> mutex.R γold 1$m emp ** mutex.token γold 1$m + \post[Vint 0] double_incr_protocol.evenR (_global "x")). + + Lemma main_ok : verify[source] "main()". + Proof using Type worker_spec_objective even_weakly_objective + shared_mutex_objective shared_token_objective. + verify_spec. + let rec expose_globals := + first [iDestruct select (_global "x" |-> uintR 1$m 0) as "Hx" + | progress go1; expose_globals] in + expose_globals. + iAssert (double_incr_protocol.evenR (_global "x")) with "[Hx]" as "Hx". + { iExists 0. iFrame. done. } + iMod (double_incr_protocol.alloc with "Hx") as (γ) "(HP & Hf1 & Hf2)". + iDestruct select (_global "m" |-> mutex.R γold 1$m emp) as "Hm". + iDestruct select (mutex.token γold 1$m) as "Htoken". + iMod (thread.spec.spawned_threads_inv_alloc thread_pool_namespace) + as (pool) "#Hpool". + (* Logical invariant setup for the already initialized mutex. *) + iMod (mutex.init_R (_global "m") γold pool + (double_incr_protocol.protected γ (_global "x")) ltac:(apply _) + with "[Hm Htoken HP]") as (g) "(%Hpool_name & Hm & Htoken)". + { iFrame "Hm Htoken". iNext. done. } + subst pool. + iDestruct "Hm" as "[Hm1 Hm2]". + iEval (rewrite (cfractional_split_half (mutex.token g)) + cQp.scale_mut Qp.mul_1_r) in "Htoken". + iDestruct "Htoken" as "[Ht1 Ht2]". + iAssert (worker_start g γ ** worker_start g γ)%I + with "[Hm1 Hm2 Ht1 Ht2 Hf1 Hf2]" as "[Hstart1 Hstart2]". + { rewrite /worker_start. iFrame. } + go. + iDestruct select double_incr_spec_body as "#Hcode". + iExists thread_pool_namespace, (mutex.pool_name g), + (double_incr_protocol.done γ (_global "x")). + iFrame "#". iSplitR; first (iPureIntro; apply _). + iSplitL "Hstart1". + - iApply worker_entry. iFrame "Hcode Hstart1". + - iIntros "Hthread1". + iDestruct "Hthread1" as (child1) "[% HR1]". + iDestruct (observe (type_ptr "std::thread" t1_addr) with "HR1") as "#?". + iDestruct "HR1" as "?". go. + iExists thread_pool_namespace, (mutex.pool_name g), + (double_incr_protocol.done γ (_global "x")). + iFrame "#". iSplitR; first (iPureIntro; apply _). + iSplitL "Hstart2". + + iApply worker_entry. iFrame "Hcode Hstart2". + + iIntros "Hthread2". + iDestruct "Hthread2" as (child2) "[% HR2]". + iDestruct (observe (type_ptr "std::thread" t2_addr) with "HR2") as "#?". + iDestruct "HR2" as "?". go. + iExists child1, (double_incr_protocol.done γ (_global "x")). go. + iExists child2, (double_incr_protocol.done γ (_global "x")). go. + iDestruct (double_incr_protocol.join with "[$]") + as (n) "[Hx %Heven]". + go. + iExists (1$m)%cQp; go. + iFrame. + iExists n. iFrame. done. + Qed. +End with_cpp. diff --git a/rocq-brick-libstdcpp/test/mutex/double_incr_ghost.v b/rocq-brick-libstdcpp/test/mutex/double_incr_ghost.v new file mode 100644 index 00000000..8cd82526 --- /dev/null +++ b/rocq-brick-libstdcpp/test/mutex/double_incr_ghost.v @@ -0,0 +1,93 @@ +Require Import skylabs.auto.cpp.prelude.proof. +Require Import iris.algebra.lib.frac_auth. + +(** Each worker receives half of a permission to enter the critical section. + The first worker deposits its half and returns the exclusive authority; + the second gathers both halves and transfers ownership of the counter. + Only the counter's parity is tracked. Joining both workers recovers its + ownership because they cannot both return the exclusive authority. *) +Module double_incr_protocol. + Canonical Structure completionR : cmra := frac_authR unitUR. + + Class G `{Σ : cpp_logic} := { + #[local] completion_own :: HasOwn (iPropI _Σ) completionR; + #[local] completion_upd :: HasOwnUpd (iPropI _Σ) completionR; + #[local] completion_valid :: HasOwnValid (iPropI _Σ) completionR; + }. + #[global] Arguments G {_ _} Σ : assert. + + Definition gname := iprop.gname. + + Lemma trim_add_two_even (n : Z) : + (n mod 2 = 0)%Z -> (trim 32 (n + 2) mod 2 = 0)%Z. + Proof. + intros Hn. rewrite /trim Z.mod_mod_divide. + - rewrite Z.add_mod; last lia. rewrite Hn. reflexivity. + - exists (2 ^ 31)%Z. reflexivity. + Qed. + + Section proof. + Context `{Σ : cpp_logic, σ : genv, !G Σ}. + + Definition auth (γ : iprop.gname) : mpred := + own γ ((●F ()) : completionR). + Definition frac (γ : iprop.gname) (q : Qp) : mpred := + own γ ((◯F{q} ()) : completionR). + + Definition evenR (x : ptr) : mpred := + ∃ n : Z, x |-> uintR 1$m n ** [| (n mod 2 = 0)%Z |]. + + Definition protected (γ : gname) (x : ptr) : mpred := + (auth γ ** evenR x) ∨ + (frac γ (1 / 2) ** evenR x) ∨ frac γ 1. + + Definition done (γ : gname) (x : ptr) : mpred := + auth γ ∨ evenR x. + + Lemma alloc (x : ptr) : + evenR x |-- (|==> ∃ γ, + protected γ x ** frac γ (1 / 2) ** frac γ (1 / 2)). + Proof. + iIntros "Hx". + iMod (own_alloc (((●F ()) ⋅ (◯F ())) : completionR)) + as (γ) "[Ha Hf]"; first (apply frac_auth_valid; done). + have Hsplit : ((◯F ()) : completionR) ≡ + ((◯F{1 / 2} ()) ⋅ (◯F{1 / 2} ())). + { rewrite -frac_auth_frag_op Qp.half_half. done. } + iEval (rewrite Hsplit own_op) in "Hf". + iModIntro. iExists γ. rewrite /frac. iFrame "Hf". + rewrite /protected. iLeft. iFrame. + Qed. + + (** After the physical increments, the first worker deposits its half and + the second gathers both halves. The completed invariant keeps the full + fraction, preventing another worker from presenting an unused half. *) + Lemma prepare γ (x : ptr) : + protected γ x ** frac γ (1 / 2) |-- + evenR x ** (evenR x -* protected γ x ** done γ x). + Proof. + rewrite /protected /done /auth /frac. + iIntros "[[H | [H | H]] Hf]". + - iDestruct "H" as "[Ha Hx]". iFrame "Hx". iIntros "Hx". + iSplitL "Hf Hx". + + iRight. iLeft. iFrame. + + iLeft. done. + - iDestruct "H" as "[Hstored Hx]". iFrame "Hx". iIntros "Hx". + iCombine "Hstored Hf" as "Hfull". + iSplitL "Hfull". + + iRight. iRight. done. + + iRight. done. + - iDestruct (own_valid_2 with "H Hf") as %Hv. + move: Hv. rewrite -frac_auth_frag_op frac_auth_frag_valid. + move=> [Hfrac _]. exfalso. compute in Hfrac. done. + Qed. + + Lemma join γ (x : ptr) : done γ x ** done γ x |-- evenR x. + Proof. + rewrite /done. iIntros "[[H1 | H1] [H2 | H2]]"; try iAssumption. + rewrite /auth. + iDestruct (own_valid_2 with "H1 H2") as %Hv. + move: Hv. rewrite auth_auth_op_valid. done. + Qed. + End proof. +End double_incr_protocol. From bd4acfec70e8479d3c226409f15a9198207e6172 Mon Sep 17 00:00:00 2001 From: Simon Date: Thu, 17 Sep 2026 15:20:03 -0400 Subject: [PATCH 48/51] Apply suggestion from @simon-skylabs --- rocq-brick-libstdcpp/proof/thread/spec.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rocq-brick-libstdcpp/proof/thread/spec.v b/rocq-brick-libstdcpp/proof/thread/spec.v index 47caefca..911ebcfa 100644 --- a/rocq-brick-libstdcpp/proof/thread/spec.v +++ b/rocq-brick-libstdcpp/proof/thread/spec.v @@ -71,7 +71,7 @@ Section with_cpp. \require child <> parent \post this |-> R None ** Q). - cpp.spec "std::thread::thread, void>(void (*&)())" as ctor_spec from source with + cpp.spec "std::thread::thread, void>(void ( *&)())" as ctor_spec from source with (\exact Reduce spawn_spec_body). cpp.spec "std::thread::thread, void>(void (&)())" From 2f832e11664efb1e9f50baee52144e55246fc6d9 Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Fri, 18 Sep 2026 06:28:45 +0200 Subject: [PATCH 49/51] Update dune.inc --- rocq-brick-libstdcpp/proof/dune.inc | 12 ++++++++++++ rocq-brick-libstdcpp/test/dune.inc | 12 ++++++++++++ 2 files changed, 24 insertions(+) diff --git a/rocq-brick-libstdcpp/proof/dune.inc b/rocq-brick-libstdcpp/proof/dune.inc index 0abf4551..8f775f5a 100644 --- a/rocq-brick-libstdcpp/proof/dune.inc +++ b/rocq-brick-libstdcpp/proof/dune.inc @@ -215,6 +215,18 @@ (with-stderr-to inc_string_cpp.v.stderr (run cpp2v -v %{input} -o inc_string_cpp.v --no-elaborate --templates=inc_string_cpp_templates.v -- -std=c++20 -stdlib=libstdc++ )))) (alias (name srcs) (deps inc_string.cpp)) ) +(subdir thread + (rule + (targets thread_hpp.v.stderr thread_hpp.v thread_hpp_templates.v) + (alias test_ast) + (deps + (:input thread.hpp) + (env_var CPP2V_DOCKER_ENABLED) + (glob_files_rec ../*.hpp)) + (action + (with-stderr-to thread_hpp.v.stderr (run cpp2v -v %{input} -o thread_hpp.v --no-elaborate --templates=thread_hpp_templates.v -- -std=c++20 -stdlib=libstdc++ )))) + (alias (name srcs) (deps thread.hpp)) +) (subdir vector (rule (targets inc_vector_cpp.v.stderr inc_vector_cpp.v inc_vector_cpp_templates.v) diff --git a/rocq-brick-libstdcpp/test/dune.inc b/rocq-brick-libstdcpp/test/dune.inc index 57dae3f1..423b3d5c 100644 --- a/rocq-brick-libstdcpp/test/dune.inc +++ b/rocq-brick-libstdcpp/test/dune.inc @@ -251,6 +251,18 @@ (with-stderr-to custom_recursive_mutex_hpp.v.stderr (run cpp2v -v %{input} -o custom_recursive_mutex_hpp.v --no-elaborate -- -std=c++20 -stdlib=libstdc++ )))) (alias (name srcs) (deps custom_recursive_mutex.hpp)) ) +(subdir mutex + (rule + (targets double_incr_cpp.v.stderr double_incr_cpp.v) + (alias test_ast) + (deps + (:input double_incr.cpp) + (env_var CPP2V_DOCKER_ENABLED) + (glob_files_rec ../*.hpp)) + (action + (with-stderr-to double_incr_cpp.v.stderr (run cpp2v -v %{input} -o double_incr_cpp.v --no-elaborate -- -std=c++20 -stdlib=libstdc++ )))) + (alias (name srcs) (deps double_incr.cpp)) +) (subdir mutex (rule (targets guard_recursive_cpp.v.stderr guard_recursive_cpp.v) From 33e713c40746b571ac0005eb539b80ce2b8b4bce Mon Sep 17 00:00:00 2001 From: Ke Du <46699625+dkxb@users.noreply.github.com> Date: Fri, 18 Sep 2026 16:54:01 -0500 Subject: [PATCH 50/51] [mutex.v] use Axiom for assumptions in Prop. Co-authored-by: Paolo G. Giarrusso --- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index 27860bbb..edbc5a6c 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -114,7 +114,7 @@ Module Type MUTEX_PREDS. Initializing [this |-> R old 1$m emp] probably depends on the mutex implementation. *) - Parameter init_R : forall (this : ptr) (old : gname) + Axiom init_R : forall (this : ptr) (old : gname) (pool : iprop.gname) (P : mpred), WeaklyObjective P -> this |-> R old 1$m emp ** token old 1$m ** ▷P |-- From 34aa342f7035d0e27e6c96b0a8f019f663382779 Mon Sep 17 00:00:00 2001 From: Ke Du <46699625+dkxb@users.noreply.github.com> Date: Fri, 18 Sep 2026 16:54:45 -0500 Subject: [PATCH 51/51] [mutex.v] use Axiom for assumptions in Prop. Co-authored-by: Paolo G. Giarrusso --- rocq-brick-libstdcpp/proof/mutex/spec/mutex.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v index edbc5a6c..1b7e894e 100644 --- a/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v +++ b/rocq-brick-libstdcpp/proof/mutex/spec/mutex.v @@ -125,7 +125,7 @@ Module Type MUTEX_PREDS. (** Register a thread by consuming its handle for this mutex's namespace and its token share. [my_mutexes_alloc_mutex_name] splits this handle from the full namespace pool supplied when the thread is spawned. *) - Parameter register_thread : forall + Axiom register_thread : forall (this : ptr) (g : gname) (q : cQp.t) (P : mpred) (th : thread_idT) (qt : cQp.t), this |-> R g q P ** token g qt **