diff --git a/PORTING.md b/PORTING.md
index da5be018..83069c83 100644
--- a/PORTING.md
+++ b/PORTING.md
@@ -12,12 +12,12 @@ Some porting tasks will require other tasks as dependencies, the GitHub issues p
 - [ ] `agree.v`
   - [x] CMRA 
   - [x] Functors
-- [ ] `auth.v`
-  - [ ] CMRA
-  - [ ] Updates
-  - [ ] Functors
-- [ ] `big_op.v`
-  - TBD (Zongyuan?)
+- [x] `auth.v`
+  - [x] CMRA
+  - [x] Updates
+  - [x] Functors
+- [x] `big_op.v`
+  - [x] `bigOpL`, `bigOpM` definitions and lemmas
 - [ ] `cmra.v`
   - [x] Lemmas
   - [ ] Total CMRA construction
@@ -33,8 +33,8 @@ Some porting tasks will require other tasks as dependencies, the GitHub issues p
   - [x] Isomorphisms
 - [ ] `cmra_big_op.v` 
 - [ ] `coPset.v`
-  - [ ] coPset definition
-  - [ ] CMRA
+  - [x] coPset definition
+  - [x] CMRA
 - [x] `cofe_solver.v` 
 - [ ] `csum.v`
   - [ ] CMRA
@@ -54,15 +54,15 @@ Some porting tasks will require other tasks as dependencies, the GitHub issues p
 - [ ] `functions.v` (nb. contained in `CMRA.lean`)
   - [x] CMRA
   - [ ] Updates
-- [ ] `gmap.v` (nb. generalized in `Heap.lean`)
+- [x] `gmap.v` (nb. generalized in `Heap.lean`)
   - [x] CMRA
   - [ ] Updates
-  - [ ] Functors
+  - [x] Functors
 - [ ] `gmultiset.v` 
   - [ ] CMRA
   - [ ] Updates
 - [ ] `gset.v` 
-  - [ ] CMRA
+  - [x] CMRA
   - [ ] Updates
 - [ ] `list.v` 
   - Is this an instance of the `Heap` CMRA?
@@ -72,7 +72,7 @@ Some porting tasks will require other tasks as dependencies, the GitHub issues p
 - [ ] `max_prefix_list.v` 
   - [ ] Lemmas
   - [ ] Functors
-- [ ] `monoid.v`
+- [x] `monoid.v`
 - [ ] `mra.v`
 - [x] `numbers.v`
 - [ ]  `ofe.v`
@@ -111,10 +111,10 @@ Some porting tasks will require other tasks as dependencies, the GitHub issues p
 - [ ] `vector.v` 
   - [ ] CMRA
   - [ ] Functors
-- [ ] `view.v` 
+- [x] `view.v`
   - [x] CMRA
   - [x] Updates
-  - [ ] Functors
+  - [x] Functors
 - [ ] `lib/dfrac_agree.v` 
   - [ ] Lemmas
   - [ ] Updates
@@ -126,10 +126,10 @@ Some porting tasks will require other tasks as dependencies, the GitHub issues p
   - [ ] Lemmas
   - [ ] Updates
   - [ ] Functors
-- [ ] `lib/gmap_view.v` (nb. generalized in `HeapView.lean`)
+- [x] `lib/gmap_view.v` (nb. generalized in `HeapView.lean`)
   - [x] CMRA
   - [x] Updates
-  - [ ] Functors
+  - [x] Functors
 - [ ] `lib/gset_bij.v` 
 - [ ] `lib/mono_Z.v` (nb. generalize to `MonoNumbers.lean`)
 - [ ] `lib/mono_list.v` 
@@ -163,10 +163,10 @@ Some porting tasks will require other tasks as dependencies, the GitHub issues p
   - [x] Later lemmas
   - [x] Update lemmas
 - [ ] `lib/boxes.v`
-- [ ] `lib/cancelable_invariants.v`
+- [x] `lib/cancelable_invariants.v`
 - [ ] `lib/fancy_updates.v`
-  - [ ] FUpd instance
-  - [ ] Soundness
+  - [x] FUpd instance
+  - [x] Soundness
   - [ ] ProofMode instances
 - [ ] `lib/fancy_updates_from_vs.v`
 - [ ] `lib/gen_heap.v`
@@ -174,7 +174,7 @@ Some porting tasks will require other tasks as dependencies, the GitHub issues p
 - [ ] `lib/ghost_map.v`
 - [ ] `lib/ghost_var.v`
 - [ ] `lib/gset_bij.v`
-- [ ] `lib/invariants.v`
+- [x] `lib/invariants.v`
 - [ ] `lib/iprop.v`
   - [x] Definition
   - [ ] subG 
@@ -192,14 +192,15 @@ Some porting tasks will require other tasks as dependencies, the GitHub issues p
 - [ ] `lib/proph_map.v`
 - [ ] `lib/saved_prop.v`
 - [ ] `lib/token.v`
-- [ ] `lib/wsat.v`
+- [x] `lib/wsat.v`
 
 ## BI
 
 - [ ] `algebra.v`
 - `ascii.v`
 - [x] `bi.v`
-- [ ] `big_op.v`
+- [x] `big_op.v`
+  - [x] `big_sepL`, `big_sepM` definitions and lemmas
 - [ ] `cmra.v`
 - [x] `derived_connectives.v`
 - [ ] `derived_laws.v`
@@ -231,7 +232,7 @@ Some porting tasks will require other tasks as dependencies, the GitHub issues p
 - [ ] `updates.v`
   - [x] FUpd class
   - [ ] Big op lemmas
-- [ ] `weakestpre.v`
+- [x] `weakestpre.v`
 - [ ] `lib/atomic.v`
 - [ ] `lib/core.v`
 - [ ] `lib/counterexamples.v`
@@ -422,8 +423,7 @@ Some porting tasks will require other tasks as dependencies, the GitHub issues p
 
 - Program Logic
   - Final decisions about what to port from this folder have not been made yet.
-  - [ ] `language.v`
+  - [x] `language.v`
+  - [x] `adequacy.v`
   - [ ] `ectx_language.v`
   - [ ] `ectxi_language.v`
-
-
diff --git a/flake.nix b/flake.nix
new file mode 100644
index 00000000..f6e728ec
--- /dev/null
+++ b/flake.nix
@@ -0,0 +1,42 @@
+{
+  description = "Iris - Separation logic in Lean 4";
+
+  inputs = {
+    nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable";
+    flake-utils.url = "github:numtide/flake-utils";
+  };
+
+  outputs =
+    {
+      self,
+      nixpkgs,
+      flake-utils,
+    }:
+    flake-utils.lib.eachDefaultSystem (
+      system:
+      let
+        pkgs = import nixpkgs { inherit system; };
+
+        nativeBuildInputs = with pkgs; [
+          elan
+        ];
+
+        buildInputs =
+          with pkgs;
+          lib.optionals stdenv.isDarwin [
+            libiconv
+          ];
+
+      in
+      {
+        devShells.default = pkgs.mkShell {
+          inherit nativeBuildInputs buildInputs;
+
+          shellHook = ''
+            echo "Iris development environment"
+            echo "Lean: $(elan show 2>/dev/null | head -1 || echo 'not configured')"
+          '';
+        };
+      }
+    );
+}
diff --git a/src/Iris/Algebra.lean b/src/Iris/Algebra.lean
index 30043dc5..650be725 100644
--- a/src/Iris/Algebra.lean
+++ b/src/Iris/Algebra.lean
@@ -1,6 +1,7 @@
 import Iris.Algebra.Agree
 import Iris.Algebra.CMRA
 import Iris.Algebra.COFESolver
+import Iris.Algebra.CoPset
 import Iris.Algebra.DFrac
 import Iris.Algebra.Excl
 import Iris.Algebra.Frac
@@ -13,3 +14,6 @@ import Iris.Algebra.UPred
 import Iris.Algebra.Heap
 import Iris.Algebra.View
 import Iris.Algebra.HeapView
+import Iris.Algebra.Auth
+import Iris.Algebra.Monoid
+import Iris.Algebra.BigOp
diff --git a/src/Iris/Algebra/Agree.lean b/src/Iris/Algebra/Agree.lean
index 6a1c90e7..5d22ba2e 100644
--- a/src/Iris/Algebra/Agree.lean
+++ b/src/Iris/Algebra/Agree.lean
@@ -1,7 +1,7 @@
 /-
 Copyright (c) 2025 Leo Stefanesco. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Leo Stefanesco
+Authors: Leo Stefanesco, Puming Liu
 -/
 
 import Iris.Algebra.CMRA
@@ -349,7 +349,7 @@ section agree_map
 
 variable {α β} [OFE α] [OFE β] {f : α → β} [hne : OFE.NonExpansive f]
 
-local instance : OFE.NonExpansive (Agree.map' f) where
+instance : OFE.NonExpansive (Agree.map' f) where
   ne := by
     intro n x₁ x₂ h
     simp only [Agree.map', Agree.dist_def, Agree.dist, List.mem_map, forall_exists_index, and_imp,
@@ -411,7 +411,7 @@ abbrev AgreeRF (F : COFE.OFunctorPre) : COFE.OFunctorPre :=
 
 instance {F} [COFE.OFunctor F] : RFunctor (AgreeRF F) where
   map f g := Agree.map (COFE.OFunctor.map f g)
-  map_ne.ne _ _ _ Hx _ _ Hy  _ := Agree.map_ne <| COFE.OFunctor.map_ne.ne Hx Hy
+  map_ne.ne _ _ _ Hx _ _ Hy _ := Agree.map_ne <| COFE.OFunctor.map_ne.ne Hx Hy
   map_id x := by
     conv=> right; rw [<- (Agree.map_id x)]
     exact (Agree.map_id x) ▸ Agree.agree_map_ext COFE.OFunctor.map_id
diff --git a/src/Iris/Algebra/Auth.lean b/src/Iris/Algebra/Auth.lean
new file mode 100644
index 00000000..522d249a
--- /dev/null
+++ b/src/Iris/Algebra/Auth.lean
@@ -0,0 +1,485 @@
+/-
+Copyright (c) 2025 Alexander Bai. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Alexander Bai
+-/
+import Iris.Algebra.View
+import Iris.Algebra.LocalUpdates
+
+/-!
+# Authoritative Camera
+
+The authoritative camera has 2 types of elements:
+- the authoritative element `●{dq} a`
+-  and the fragment `◯ b`
+-/
+
+open Iris
+
+open OFE CMRA UCMRA
+
+/-!
+## Definition of the view relation for the authoritative camera.
+
+`auth_view_rel n a b` holds when `b ≼{n} a` and `✓{n} a`.
+
+Rocq: `auth_view_rel_raw`
+-/
+def authViewRel [UCMRA A] : ViewRel A A := fun n a b => b ≼{n} a ∧ ✓{n} a
+
+namespace authViewRel
+
+variable [UCMRA A]
+
+/-- Rocq: `auth_view_rel_raw_mono`, `auth_view_rel_raw_valid`, `auth_view_rel_raw_unit` -/
+instance : IsViewRel (authViewRel (A := A)) where
+  mono := by
+    intro n1 a1 b1 n2 a2 b2 ⟨Hinc, Hv⟩ Ha Hb Hn
+    constructor
+    · calc b2 ≼{n2} b1 := Hb
+           _ ≼{n2} a1 := incN_of_incN_le Hn Hinc
+           _ ≼{n2} a2 := Ha.to_incN
+    · exact validN_ne Ha (validN_of_le Hn Hv)
+  rel_validN n a b := by
+    intro ⟨Hinc, Hv⟩
+    exact validN_of_incN Hinc Hv
+  rel_unit n := by
+    exists unit
+    constructor
+    · exact incN_refl unit
+    · exact unit_valid.validN
+
+theorem auth_view_rel_unit {n : Nat} {a : A} : authViewRel n a unit ↔ ✓{n} a := by
+  constructor
+  · intro ⟨_, Hv⟩; exact Hv
+  · intro Hv; exact ⟨incN_unit, Hv⟩
+
+theorem auth_view_rel_exists {n : Nat} {b : A} : (∃ a, authViewRel n a b) ↔ ✓{n} b := by
+  constructor
+  · intro ⟨a, Hrel⟩; exact IsViewRel.rel_validN n a b Hrel
+  · intro Hv; exact ⟨b, incN_refl b, Hv⟩
+
+/-- Rocq: `auth_view_rel_discrete` -/
+instance [OFE.Discrete A] [CMRA.Discrete A] : IsViewRelDiscrete (authViewRel (A := A)) where
+  discrete n a b := by
+    intro ⟨Hinc, Hv⟩
+    constructor
+    · exact incN_of_inc n ((inc_iff_incN 0).mpr Hinc)
+    · exact (discrete_valid Hv).validN
+
+end authViewRel
+
+
+/-! ## Definition and operations on the authoritative camera -/
+
+abbrev Auth (F : Type _) (A : Type _) [UFraction F] [UCMRA A] := View F (authViewRel (A := A))
+
+namespace Auth
+variable [UFraction F] [UCMRA A]
+
+/-- Roc: `authO` -/
+instance : OFE (Auth F A) := View.instOFE
+/-- Rocq: `authR` -/
+instance : CMRA (Auth F A) := View.instCMRA
+/-- Rocq: `authUR` -/
+instance : UCMRA (Auth F A) := View.instUCMRA
+
+abbrev auth (dq : DFrac F) (a : A) : Auth F A := View.Auth dq a
+abbrev authFull (a : A) : Auth F A := View.Auth (DFrac.own One.one) a
+abbrev frag (b : A) : Auth F A := View.Frag b
+
+notation "●{" dq "} " a => auth dq a
+notation "● " a => authFull a
+notation "◯ " b => frag b
+
+instance auth_ne {dq : DFrac F} : NonExpansive (auth dq : A → Auth F A) := View.auth_ne
+instance frag_ne : NonExpansive (frag : A → Auth F A) := View.frag_ne
+
+theorem auth_dist_inj {n : Nat} {dq1 dq2 : DFrac F} {a1 a2 : A}
+    (H : (●{dq1} a1) ≡{n}≡ ●{dq2} a2) : dq1 = dq2 ∧ a1 ≡{n}≡ a2 :=
+  ⟨View.auth_inj_frac H, View.dist_of_auth_dist H⟩
+
+theorem auth_inj {dq1 dq2 : DFrac F} {a1 a2 : A}
+  (H : (●{dq1} a1) ≡ ●{dq2} a2) : dq1 = dq2 ∧ a1 ≡ a2 :=
+    ⟨H.1.1, equiv_dist.mpr fun _ => View.dist_of_auth_dist H.dist⟩
+
+theorem frag_dist_inj {n : Nat} {b1 b2 : A}
+    (H : (◯ b1 : Auth F A) ≡{n}≡ ◯ b2) : b1 ≡{n}≡ b2 :=
+  View.dist_of_frag_dist H
+
+theorem frag_inj {b1 b2 : A}
+    (H : (◯ b1 : Auth F A) ≡ ◯ b2) : b1 ≡ b2 :=
+  equiv_dist.mpr fun _ => View.dist_of_frag_dist H.dist
+
+
+theorem auth_discrete {dq : DFrac F} {a : A} (Ha : DiscreteE a) (Hu : DiscreteE (unit : A)) :
+    DiscreteE (●{dq} a) :=
+  View.auth_discrete Ha Hu
+
+theorem frag_discrete {a : A} (Hb : DiscreteE a) :
+    DiscreteE (◯ a : Auth F A) :=
+  View.frag_discrete Hb
+
+instance [OFE.Discrete A] : OFE.Discrete (Auth F A) := inferInstance
+instance [OFE.Discrete A] [CMRA.Discrete A] : CMRA.Discrete (Auth F A) := inferInstance
+
+
+/-! ## Operations -/
+theorem auth_dfrac_op {dq1 dq2 : DFrac F} {a : A} :
+    (●{dq1 • dq2} a) ≡ (●{dq1} a) • (●{dq2} a) :=
+  View.auth_op_auth_eqv
+
+-- TODO: auth_auth_dfrac_is_op
+
+theorem frag_op {b1 b2 : A} : (◯ (b1 • b2) : Auth F A) = ((◯ b1 : Auth F A) • ◯ b2) :=
+  View.frag_op_eq
+
+theorem frag_inc_of_inc {b1 b2 : A} (H : b1 ≼ b2) : (◯ b1 : Auth F A) ≼ ◯ b2 :=
+  View.frag_inc_of_inc H
+
+theorem frag_core {b : A} : core (◯ b : Auth F A) = ◯ (core b) :=
+  View.frag_core
+
+theorem auth_both_core_discarded :
+  core ((●{.discard} a) • ◯ b : Auth F A) ≡ (●{.discard} a) • ◯ (core b) :=
+  View.auth_discard_op_frag_core
+
+theorem auth_both_core_frac q a b :
+  core ((●{.own q} a) • ◯ b : Auth F A) ≡ ◯ (core b) :=
+  View.auth_own_op_frag_core
+
+/-- Rocq: `auth_auth_core_id` -/
+instance {a : A} : CoreId (●{.discard} a : Auth F A) := View.instCoreIdAuthDiscard
+
+/-- Rocq: `auth_frag_core_id` -/
+instance {b : A} [CoreId b] : CoreId (◯ b : Auth F A) := View.instCoreIdFrag
+
+/-- Rocq: `auth_both_core_id` -/
+instance {a : A} {b : A} [CoreId b] : CoreId ((●{.discard} a : Auth F A) • ◯ b) :=
+  View.instCoreIdOpAuthDiscardFrag
+
+-- TODO: auth_frag_is_op
+-- TODO: auth_frag_sep_homomorphism
+
+/- TODO: BigOPs
+    big_opL_auth_frag
+    big_opM_auth_frag
+    big_opS_auth_frag
+    big_opMS_auth_frag
+-/
+
+/-! ## Validity -/
+
+theorem auth_dfrac_op_invN {n : Nat} {dq1 dq2 : DFrac F} {a b : A}
+    (H : ✓{n} ((●{dq1} a) • ●{dq2} b)) : a ≡{n}≡ b :=
+  View.dist_of_validN_auth H
+
+theorem auth_dfrac_op_inv {dq1 dq2 : DFrac F} {a b : A}
+    (H : ✓ ((●{dq1} a) • ●{dq2} b)) : a ≡ b :=
+  View.eqv_of_valid_auth H
+
+theorem auth_dfrac_op_inv_L [Leibniz A] {dq1 dq2 : DFrac F} {a b : A}
+    (H : ✓ ((●{dq1} a) • ●{dq2} b)) : a = b :=
+  Leibniz.eq_of_eqv (auth_dfrac_op_inv H)
+
+
+theorem auth_dfrac_validN {n : Nat} {dq : DFrac F} {a : A} :
+    (✓{n} (●{dq} a)) ↔ (✓ dq ∧ ✓{n} a) := by
+  rw [View.auth_validN_iff]
+  simp only [authViewRel]
+  constructor
+  · intro ⟨Hdq, _, Hv⟩; exact ⟨Hdq, Hv⟩
+  · intro ⟨Hdq, Hv⟩; exact ⟨Hdq, incN_unit, Hv⟩
+
+theorem auth_validN {n : Nat} {a : A} :
+    (✓{n} (● a : Auth F A)) ↔ (✓{n} a) := by
+  rw [auth_dfrac_validN]
+  exact and_iff_right_iff_imp.mpr fun _ => DFrac.valid_own_one
+
+
+theorem auth_dfrac_op_validN {n : Nat} {dq1 dq2 : DFrac F} {a1 a2 : A} :
+    (✓{n} ((●{dq1} a1) • ●{dq2} a2)) ↔ (✓ (dq1 • dq2) ∧ a1 ≡{n}≡ a2 ∧ ✓{n} a1) := by
+  rw [View.auth_op_auth_validN_iff]
+  simp only [authViewRel]
+  constructor
+  · intro ⟨Hdq, Ha, ⟨_, Hv⟩⟩; exact ⟨Hdq, Ha, Hv⟩
+  · intro ⟨Hdq, Ha, Hv⟩; exact ⟨Hdq, Ha, incN_unit, Hv⟩
+
+theorem auth_op_validN {n : Nat} {a1 a2 : A} :
+    (✓{n} ((● a1 : Auth F A) • ● a2)) ↔ False :=
+  View.auth_one_op_auth_one_validN_iff
+
+
+theorem frag_validN {n : Nat} {b : A} :
+    (✓{n} (◯ b : Auth F A)) ↔ (✓{n} b) := by
+  rw [View.frag_validN_iff, authViewRel.auth_view_rel_exists]
+
+theorem frag_op_validN {n : Nat} {b1 b2 : A} :
+    (✓{n} ((◯ b1 : Auth F A) • ◯ b2)) ↔ (✓{n} (b1 • b2)) := by
+  rw [← frag_op]; exact frag_validN
+
+
+theorem both_dfrac_validN {n : Nat} {dq : DFrac F} {a b : A} :
+    (✓{n} ((●{dq} a) • ◯ b)) ↔ (✓ dq ∧ b ≼{n} a ∧ ✓{n} a) := by
+  rw [View.auth_op_frag_validN_iff]; simp only [authViewRel]
+
+theorem both_validN {n : Nat} {a b : A} :
+    (✓{n} ((● a : Auth F A) • ◯ b)) ↔ (b ≼{n} a ∧ ✓{n} a) := by
+  exact View.auth_one_op_frag_validN_iff
+
+theorem auth_dfrac_valid {dq : DFrac F} {a : A} :
+    (✓ (●{dq} a : Auth F A)) ↔ (✓ dq ∧ ✓ a) := by
+  rw [View.auth_valid_iff]
+  refine and_congr_right fun _ => ?_
+  rw [valid_iff_validN]
+  exact forall_congr' fun _ => authViewRel.auth_view_rel_unit
+
+theorem auth_valid {a : A} :
+    (✓ (● a : Auth F A)) ↔ (✓ a) := by
+  rw [auth_dfrac_valid]
+  exact and_iff_right_iff_imp.mpr fun _ => DFrac.valid_own_one
+
+/-- Rocq: `auth_dfrac_op_valid` -/
+theorem auth_dfrac_op_valid {dq1 dq2 : DFrac F} {a1 a2 : A} :
+    (✓ ((●{dq1} a1) • ●{dq2} a2)) ↔ (✓ (dq1 • dq2) ∧ a1 ≡ a2 ∧ ✓ a1) := by
+  rw [View.auth_op_auth_valid_iff]
+  simp only [authViewRel]
+  constructor
+  · intro ⟨Hdq, Ha, Hr⟩
+    refine ⟨Hdq, Ha, valid_iff_validN.mpr fun n => (Hr n).2⟩
+  · intro ⟨Hdq, Ha, Hv⟩
+    exact ⟨Hdq, Ha, fun n => ⟨incN_unit, Hv.validN⟩⟩
+
+theorem auth_op_valid {a1 a2 : A} :
+    (✓ ((● a1 : Auth F A) • ● a2)) ↔ False :=
+  View.auth_one_op_auth_one_valid_iff
+
+theorem frag_valid {b : A} :
+    (✓ (◯ b : Auth F A)) ↔ (✓ b) := by
+  simp only [valid_iff_validN]
+  exact forall_congr' fun _ => frag_validN
+
+theorem frag_op_valid {b1 b2 : A} :
+    (✓ ((◯ b1 : Auth F A) • ◯ b2)) ↔ (✓ (b1 • b2)) := by
+  rw [← frag_op]; exact frag_valid
+
+theorem both_dfrac_valid {dq : DFrac F} {a b : A} :
+    (✓ ((●{dq} a) • ◯ b)) ↔ (✓ dq ∧ (∀ n, b ≼{n} a) ∧ ✓ a) := by
+  simp only [valid_iff_validN]
+  constructor
+  · intro H
+    refine ⟨fun n => (both_dfrac_validN.mp (H n)).1, fun n => ?_, fun n => ?_⟩
+    · exact (both_dfrac_validN.mp (H n)).2.1
+    · exact (both_dfrac_validN.mp (H n)).2.2
+  · intro ⟨Hdq, Hinc, Hv⟩ n
+    exact both_dfrac_validN.mpr ⟨Hdq n, Hinc n, Hv n⟩
+
+theorem auth_both_valid {a b : A} :
+    (✓ ((● a : Auth F A) • ◯ b)) ↔ ((∀ n, b ≼{n} a) ∧ ✓ a) := by
+  rw [both_dfrac_valid]
+  constructor
+  · intro ⟨_, Hinc, Hv⟩; exact ⟨Hinc, Hv⟩
+  · intro ⟨Hinc, Hv⟩; exact ⟨DFrac.valid_own_one, Hinc, Hv⟩
+
+/-- Note: The reverse direction only holds if the camera is discrete. -/
+theorem auth_both_dfrac_valid_2 {dq : DFrac F} {a b : A}
+    (Hdq : ✓ dq) (Ha : ✓ a) (Hb : b ≼ a) : ✓ ((●{dq} a) • ◯ b) :=
+  both_dfrac_valid.mpr ⟨Hdq, fun n => incN_of_inc n Hb, Ha⟩
+
+theorem auth_both_valid_2 {a b : A}
+    (Ha : ✓ a) (Hb : b ≼ a) : ✓ ((● a : Auth F A) • ◯ b) :=
+  auth_both_dfrac_valid_2 DFrac.valid_own_one Ha Hb
+
+theorem both_dfrac_valid_discrete [CMRA.Discrete A] {dq : DFrac F} {a b : A} :
+    (✓ ((●{dq} a : Auth F A) • ◯ b)) ↔ (✓ dq ∧ b ≼ a ∧ ✓ a) := by
+  constructor
+  · intro H
+    have ⟨Hdq, Hinc, Hv⟩ := both_dfrac_valid.mp H
+    exact ⟨Hdq, (inc_iff_incN 0).mpr (Hinc 0), Hv⟩
+  · intro ⟨Hdq, Hinc, Hv⟩
+    exact auth_both_dfrac_valid_2 Hdq Hv Hinc
+
+theorem auth_both_valid_discrete [CMRA.Discrete A] {a b : A} :
+    (✓ ((● a : Auth F A) • ◯ b)) ↔ (b ≼ a ∧ ✓ a) := by
+  rw [both_dfrac_valid_discrete]
+  constructor
+  · intro ⟨_, Hinc, Hv⟩; exact ⟨Hinc, Hv⟩
+  · intro ⟨Hinc, Hv⟩; exact ⟨DFrac.valid_own_one, Hinc, Hv⟩
+
+/-! ## Inclusion -/
+
+theorem auth_dfrac_includedN {n : Nat} {dq1 dq2 : DFrac F} {a1 a2 b : A} :
+    ((●{dq1} a1) ≼{n} ((●{dq2} a2) • ◯ b)) ↔ ((dq1 ≼ dq2 ∨ dq1 = dq2) ∧ a1 ≡{n}≡ a2) :=
+  View.auth_incN_auth_op_frag_iff
+
+theorem auth_dfrac_included {dq1 dq2 : DFrac F} {a1 a2 b : A} :
+    ((●{dq1} a1) ≼ ((●{dq2} a2) • ◯ b)) ↔ ((dq1 ≼ dq2 ∨ dq1 = dq2) ∧ a1 ≡ a2) :=
+  View.auth_inc_auth_op_frag_iff
+
+theorem auth_includedN {n : Nat} {a1 a2 b : A} :
+    ((● a1 : Auth F A) ≼{n} ((● a2) • ◯ b)) ↔ (a1 ≡{n}≡ a2) :=
+  View.auth_one_incN_auth_one_op_frag_iff
+
+theorem auth_included {a1 a2 b : A} :
+    ((● a1 : Auth F A) ≼ ((● a2) • ◯ b)) ↔ (a1 ≡ a2) :=
+  View.auth_one_inc_auth_one_op_frag_iff
+
+
+theorem frag_includedN {n : Nat} {dq : DFrac F} {a b1 b2 : A} :
+    ((◯ b1) ≼{n} ((●{dq} a) • ◯ b2)) ↔ (b1 ≼{n} b2) :=
+  View.frag_incN_auth_op_frag_iff
+
+theorem frag_included {dq : DFrac F} {a b1 b2 : A} :
+    ((◯ b1) ≼ ((●{dq} a) • ◯ b2)) ↔ (b1 ≼ b2) :=
+  View.frag_inc_auth_op_frag_iff
+
+/-- The weaker `auth_both_included` lemmas below are a consequence of the
+    `auth_included` and `frag_included` lemmas above. -/
+theorem auth_both_dfrac_includedN {n : Nat} {dq1 dq2 : DFrac F} {a1 a2 b1 b2 : A} :
+    (((●{dq1} a1) • ◯ b1) ≼{n} ((●{dq2} a2) • ◯ b2)) ↔
+      ((dq1 ≼ dq2 ∨ dq1 = dq2) ∧ a1 ≡{n}≡ a2 ∧ b1 ≼{n} b2) :=
+  View.auth_op_frag_incN_auth_op_frag_iff
+
+theorem auth_both_dfrac_included {dq1 dq2 : DFrac F} {a1 a2 b1 b2 : A} :
+    (((●{dq1} a1) • ◯ b1) ≼ ((●{dq2} a2) • ◯ b2)) ↔
+      ((dq1 ≼ dq2 ∨ dq1 = dq2) ∧ a1 ≡ a2 ∧ b1 ≼ b2) :=
+  View.auth_op_frag_inc_auth_op_frag_iff
+
+theorem auth_both_includedN {n : Nat} {a1 a2 b1 b2 : A} :
+    (((● a1 : Auth F A) • ◯ b1) ≼{n} ((● a2) • ◯ b2)) ↔ (a1 ≡{n}≡ a2 ∧ b1 ≼{n} b2) :=
+  View.auth_one_op_frag_incN_auth_one_op_frag_iff
+
+theorem auth_both_included {a1 a2 b1 b2 : A} :
+    (((● a1 : Auth F A) • ◯ b1) ≼ ((● a2) • ◯ b2)) ↔ (a1 ≡ a2 ∧ b1 ≼ b2) :=
+  View.auth_one_op_frag_inc_auth_one_op_frag_iff
+
+/-! ## Updates -/
+
+theorem auth_update {a b a' b' : A}
+    (Hup : (a, b) ~l~> (a', b')) :
+    ((● a : Auth F A) • ◯ b) ~~> (● a') • ◯ b' := by
+  apply View.auth_one_op_frag_update
+  intro n bf ⟨⟨c, Hinc⟩, Hv⟩
+  have Ha_eq : a ≡{n}≡ b •? some (bf • c) := by
+    simp only [CMRA.op?]
+    calc a ≡{n}≡ (b • bf) • c := Hinc
+         _ ≡{n}≡ b • (bf • c) := assoc.symm.dist
+  have ⟨Hv', Ha'_eq⟩ := Hup n (some (bf • c)) Hv Ha_eq
+  simp only [CMRA.op?] at Ha'_eq
+  constructor
+  · exists c
+    calc a' ≡{n}≡ b' • (bf • c) := Ha'_eq
+         _ ≡{n}≡ (b' • bf) • c := assoc.dist
+  · exact Hv'
+
+
+theorem auth_update_alloc {a a' b' : A}
+    (Hup : (a, unit) ~l~> (a', b')) :
+    (● a : Auth F A) ~~> (● a') • ◯ b' :=
+  Update.equiv_left unit_right_id (auth_update Hup)
+
+theorem auth_update_dealloc {a b a' : A}
+    (Hup : (a, b) ~l~> (a', unit)) :
+    ((● a : Auth F A) • ◯ b) ~~> ● a' :=
+  Update.equiv_right unit_right_id (auth_update Hup)
+
+theorem auth_update_auth {a a' b' : A}
+    (Hup : (a, unit) ~l~> (a', b')) :
+    (● a : Auth F A) ~~> ● a' :=
+  Update.trans (auth_update_alloc Hup) Update.op_l
+
+
+theorem auth_update_auth_persist {dq : DFrac F} {a : A} :
+    (●{dq} a : Auth F A) ~~> ●{DFrac.discard} a :=
+  View.auth_discard
+theorem auth_updateP_auth_unpersist [IsSplitFraction F] {a : A} :
+    (●{DFrac.discard} a : Auth F A) ~~>: fun k => ∃ q, k = ●{DFrac.own q} a :=
+  View.auth_acquire
+
+theorem auth_updateP_both_unpersist [IsSplitFraction F] {a b : A} :
+    ((●{DFrac.discard} a : Auth F A) • ◯ b) ~~>:
+      fun k => ∃ q, k = ((●{DFrac.own q} a : Auth F A) • ◯ b) :=
+  View.auth_op_frag_acquire
+
+theorem auth_update_dfrac_alloc {dq : DFrac F} {a b : A} [CoreId b]
+    (Hb : b ≼ a) : (●{dq} a) ~~> (●{dq} a) • ◯ b :=
+  View.auth_alloc fun n bf ⟨Hinc, Hv⟩ => by
+    constructor
+    · have Hba : b • a ≡ a := comm.trans (op_core_left_of_inc Hb)
+      exact (incN_iff_right Hba.dist).mp (op_monoN_right b Hinc)
+    · exact Hv
+
+theorem auth_local_update {a b0 b1 a' b0' b1' : A}
+    (Hup : (b0, b1) ~l~> (b0', b1'))
+    (Hinc : b0' ≼ a') (Hv : ✓ a') :
+    ((● a : Auth F A) • ◯ b0, (● a) • ◯ b1) ~l~>
+    ((● a' : Auth F A) • ◯ b0', (● a') • ◯ b1') :=
+  View.view_local_update Hup fun n _ => ⟨incN_of_inc n Hinc, Hv.validN⟩
+
+/-! ## Functor -/
+
+/-- The authViewRel is preserved under CMRA homomorphisms. -/
+theorem authViewRel_map [UCMRA A'] [UCMRA B'] (g : A' -C> B') (n : Nat) (a : A') (b : A') :
+    authViewRel n a b → authViewRel n (g a) (g b) := by
+  intro ⟨Hinc, Hv⟩
+  constructor
+  · exact CMRA.Hom.monoN g n Hinc
+  · exact CMRA.Hom.validN g Hv
+
+abbrev AuthURF (T : COFE.OFunctorPre) [URFunctor T] : COFE.OFunctorPre :=
+  fun A B _ _ => Auth F (T A B)
+
+instance instURFunctorAuthURF {T : COFE.OFunctorPre} [URFunctor T] : URFunctor (AuthURF (F := F) T) where
+  map {A A'} {B B'} _ _ _ _ f g :=
+    View.mapC
+      (URFunctor.map (F := T) f g).toHom
+      (URFunctor.map (F := T) f g)
+      (authViewRel_map (URFunctor.map f g))
+  map_ne.ne a b c Hx d e Hy x := by
+    simp [View.mapC]
+    apply View.map_ne <;> intro y <;> exact URFunctor.map_ne.ne Hx Hy y
+  map_id x := by
+    simp only [View.mapC]
+    conv => rhs; rw [← View.map_id (R := authViewRel) x]
+    apply View.map_ext <;> apply URFunctor.map_id
+  map_comp f g f' g' x := by
+    simp only [View.mapC]
+    haveI : OFE.NonExpansive ((URFunctor.map (F := T) g g').f ∘ (URFunctor.map (F := T) f f').f) :=
+      (URFunctor.map (F := T) g g').toHom.comp (URFunctor.map (F := T) f f').toHom |>.ne
+    conv => rhs; rw [← View.map_compose (R' := authViewRel)]
+    apply View.map_ext <;> apply URFunctor.map_comp f g f' g'
+
+instance instURFunctorContractiveAuthURF {T : COFE.OFunctorPre} [URFunctorContractive T] :
+    URFunctorContractive (AuthURF (F := F) T) where
+  map_contractive.1 H x := by
+    apply View.map_ne <;> apply URFunctorContractive.map_contractive.1 H
+
+abbrev AuthRF (T : COFE.OFunctorPre) [URFunctor T] : COFE.OFunctorPre :=
+  fun A B _ _ => Auth F (T A B)
+
+instance instRFunctorAuthRF {T : COFE.OFunctorPre} [URFunctor T] : RFunctor (AuthRF (F := F) T) where
+  map {A A'} {B B'} _ _ _ _ f g :=
+    View.mapC
+      (URFunctor.map (F := T) f g).toHom
+      (URFunctor.map (F := T) f g)
+      (authViewRel_map (URFunctor.map f g))
+  map_ne.ne a b c Hx d e Hy x := by
+    simp [View.mapC]
+    apply View.map_ne <;> intro y <;> exact URFunctor.map_ne.ne Hx Hy y
+  map_id x := by
+    simp only [View.mapC]
+    conv => rhs; rw [← View.map_id (R := authViewRel) x]
+    apply View.map_ext <;> apply URFunctor.map_id
+  map_comp f g f' g' x := by
+    simp only [View.mapC]
+    haveI : OFE.NonExpansive ((URFunctor.map (F := T) g g').f ∘ (URFunctor.map (F := T) f f').f) :=
+      (URFunctor.map (F := T) g g').toHom.comp (URFunctor.map (F := T) f f').toHom |>.ne
+    conv => rhs; rw [← View.map_compose (R' := authViewRel)]
+    apply View.map_ext <;> apply URFunctor.map_comp f g f' g'
+
+instance instRFunctorContractiveAuthRF {T : COFE.OFunctorPre} [URFunctorContractive T] :
+    RFunctorContractive (AuthRF (F := F) T) where
+  map_contractive.1 H x := by
+    apply View.map_ne <;> apply URFunctorContractive.map_contractive.1 H
+
+end Auth
diff --git a/src/Iris/Algebra/BigOp.lean b/src/Iris/Algebra/BigOp.lean
new file mode 100644
index 00000000..97290bb8
--- /dev/null
+++ b/src/Iris/Algebra/BigOp.lean
@@ -0,0 +1,954 @@
+/-
+Copyright (c) 2026 Zongyuan Liu. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Zongyuan Liu
+-/
+import Iris.Algebra.Monoid
+import Iris.Std.List
+import Iris.Std.FiniteMap
+
+namespace Iris.Algebra
+
+/-! # Big Operators
+
+This file defines big operators (fold operations) at the abstract OFE level.
+These are parameterized by a monoid operation and include theorems about their properties.
+-/
+
+open OFE
+
+/-- Corresponds to Rocq's `big_opL`. -/
+def bigOpL {M : Type u} {A : Type v} (op : M → M → M) (unit : M)
+    (Φ : Nat → A → M) (l : List A) : M :=
+  match l with
+  | [] => unit
+  | x :: xs => op (Φ 0 x) (bigOpL op unit (fun n => Φ (n + 1)) xs)
+
+namespace BigOpL
+
+variable {M : Type _} {A : Type _} {op : M → M → M} {unit : M}
+
+/-- Corresponds to Rocq's `big_opL_nil`. -/
+@[simp] theorem nil (Φ : Nat → A → M) :
+    bigOpL op unit Φ ([] : List A) = unit := rfl
+
+/-- Corresponds to Rocq's `big_opL_cons`. -/
+@[simp] theorem cons (Φ : Nat → A → M) (x : A) (xs : List A) :
+    bigOpL op unit Φ (x :: xs) = op (Φ 0 x) (bigOpL op unit (fun n => Φ (n + 1)) xs) := rfl
+
+section
+
+variable [OFE M] [Monoid M op unit]
+
+/-- Corresponds to Rocq's `big_opL_singleton`. -/
+@[simp] theorem singleton (Φ : Nat → A → M) (x : A) :
+    bigOpL op unit Φ [x] ≡ Φ 0 x := by
+  simp only [cons, nil]
+  exact Monoid.op_right_id _
+
+/-- Corresponds to Rocq's `big_opL_proper`. -/
+theorem congr {Φ Ψ : Nat → A → M} {l : List A}
+    (h : ∀ i x, l[i]? = some x → Φ i x ≡ Ψ i x) :
+    bigOpL op unit Φ l ≡ bigOpL op unit Ψ l := by
+  induction l generalizing Φ Ψ with
+  | nil => exact Equiv.rfl
+  | cons y ys ih =>
+    simp only [cons]
+    have h0 : Φ 0 y ≡ Ψ 0 y := h 0 y rfl
+    have htail : ∀ i x, ys[i]? = some x → Φ (i + 1) x ≡ Ψ (i + 1) x := by
+      intro i x hget
+      exact h (i + 1) x hget
+    exact Monoid.op_proper h0 (ih htail)
+
+/-- Corresponds to Rocq's `big_opL_ne`. -/
+theorem congr_ne {Φ Ψ : Nat → A → M} {l : List A} {n : Nat}
+    (h : ∀ i x, l[i]? = some x → Φ i x ≡{n}≡ Ψ i x) :
+    bigOpL op unit Φ l ≡{n}≡ bigOpL op unit Ψ l := by
+  induction l generalizing Φ Ψ with
+  | nil => exact Dist.rfl
+  | cons y ys ih =>
+    simp only [cons]
+    have h0 : Φ 0 y ≡{n}≡ Ψ 0 y := h 0 y rfl
+    have htail : ∀ i x, ys[i]? = some x → Φ (i + 1) x ≡{n}≡ Ψ (i + 1) x := by
+      intro i x hget
+      exact h (i + 1) x hget
+    exact Monoid.op_ne_dist h0 (ih htail)
+
+/-- Congruence when the functions are equivalent on all indices. -/
+theorem congr' {Φ Ψ : Nat → A → M} {l : List A}
+    (h : ∀ i x, Φ i x ≡ Ψ i x) :
+    bigOpL op unit Φ l ≡ bigOpL op unit Ψ l :=
+  congr (fun i x _ => h i x)
+
+/-- Corresponds to Rocq's `big_opL_app`. -/
+theorem append (Φ : Nat → A → M) (l₁ l₂ : List A) :
+    bigOpL op unit Φ (l₁ ++ l₂) ≡
+      op (bigOpL op unit Φ l₁) (bigOpL op unit (fun n => Φ (n + l₁.length)) l₂) := by
+  induction l₁ generalizing Φ with
+  | nil => simp only [nil]; exact Equiv.symm (Monoid.op_left_id _)
+  | cons x xs ih =>
+    simp only [List.cons_append, cons, List.length_cons]
+    have ih' := ih (fun n => Φ (n + 1))
+    have heq : ∀ n, n + xs.length + 1 = n + (xs.length + 1) := fun n => by omega
+    calc op (Φ 0 x) (bigOpL op unit (fun n => Φ (n + 1)) (xs ++ l₂))
+        _ ≡ op (Φ 0 x) (op (bigOpL op unit (fun n => Φ (n + 1)) xs)
+              (bigOpL op unit (fun n => Φ (n + xs.length + 1)) l₂)) :=
+            Monoid.op_congr_r ih'
+        _ ≡ op (op (Φ 0 x) (bigOpL op unit (fun n => Φ (n + 1)) xs))
+              (bigOpL op unit (fun n => Φ (n + xs.length + 1)) l₂) :=
+            Equiv.symm (Monoid.op_assoc _ _ _)
+        _ ≡ op (op (Φ 0 x) (bigOpL op unit (fun n => Φ (n + 1)) xs))
+              (bigOpL op unit (fun n => Φ (n + (xs.length + 1))) l₂) := by
+            simp only [heq]; exact Equiv.rfl
+
+/-- Corresponds to Rocq's `big_opL_snoc`. -/
+theorem snoc (Φ : Nat → A → M) (l : List A) (x : A) :
+    bigOpL op unit Φ (l ++ [x]) ≡ op (bigOpL op unit Φ l) (Φ l.length x) := by
+  have h := append (M := M) (A := A) (op := op) (unit := unit) (Φ := Φ) l [x]
+  simp only [cons, nil, Nat.zero_add] at h
+  have hr : op (Φ l.length x) unit ≡ Φ l.length x := Monoid.op_right_id (Φ l.length x)
+  exact Monoid.op_congr_r hr |> Equiv.trans h
+
+/-- Corresponds to Rocq's `big_opL_unit`. -/
+theorem unit_const (l : List A) :
+    bigOpL op unit (fun _ _ => unit) l ≡ unit := by
+  induction l with
+  | nil => exact Equiv.rfl
+  | cons _ _ ih => simp only [cons]; exact Equiv.trans (Monoid.op_left_id _) ih
+
+/-- Corresponds to Rocq's `big_opL_op`. -/
+theorem op_distr (Φ Ψ : Nat → A → M) (l : List A) :
+    bigOpL op unit (fun i x => op (Φ i x) (Ψ i x)) l ≡
+      op (bigOpL op unit Φ l) (bigOpL op unit Ψ l) := by
+  induction l generalizing Φ Ψ with
+  | nil => simp only [nil]; exact Equiv.symm (Monoid.op_left_id _)
+  | cons x xs ih =>
+    simp only [cons]
+    exact Equiv.trans (Monoid.op_congr_r (ih _ _)) Monoid.op_op_swap
+
+/-- Corresponds to Rocq's `big_opL_fmap`. -/
+theorem map {B : Type v} (h : A → B) (Φ : Nat → B → M) (l : List A) :
+    bigOpL op unit Φ (l.map h) ≡ bigOpL op unit (fun i x => Φ i (h x)) l := by
+  induction l generalizing Φ with
+  | nil => exact Equiv.rfl
+  | cons x xs ih =>
+    simp only [List.map_cons, cons]
+    exact Monoid.op_proper Equiv.rfl (ih (fun n => Φ (n + 1)))
+
+/-- Corresponds to Rocq's `big_opL_permutation`. -/
+theorem perm (Φ : A → M) {l₁ l₂ : List A} (hp : l₁.Perm l₂) :
+    bigOpL op unit (fun _ => Φ) l₁ ≡ bigOpL op unit (fun _ => Φ) l₂ := by
+  induction hp with
+  | nil => exact Equiv.rfl
+  | cons _ _ ih => simp only [cons]; exact Monoid.op_congr_r ih
+  | swap _ _ _ => simp only [cons]; exact Monoid.op_swap_inner (unit := unit)
+  | trans _ _ ih1 ih2 => exact Equiv.trans ih1 ih2
+
+/-- Corresponds to Rocq's `big_opL_take_drop`. -/
+theorem take_drop (Φ : Nat → A → M) (l : List A) (n : Nat) :
+    bigOpL op unit Φ l ≡
+      op (bigOpL op unit Φ (l.take n)) (bigOpL op unit (fun k => Φ (n + k)) (l.drop n)) := by
+  by_cases hn : n ≤ l.length
+  · have h := append (M := M) (A := A) (op := op) (unit := unit) (Φ := Φ)
+      (l.take n) (l.drop n)
+    simp only [List.take_append_drop, List.length_take_of_le hn, Nat.add_comm] at h
+    exact h
+  · simp only [Nat.not_le] at hn
+    simp only [List.drop_eq_nil_of_le (Nat.le_of_lt hn), List.take_of_length_le (Nat.le_of_lt hn), nil]
+    exact Equiv.symm (Monoid.op_right_id _)
+
+/-- Corresponds to Rocq's `big_opL_omap`. -/
+theorem filter_map {B : Type v} (h : A → Option B) (Φ : B → M) (l : List A) :
+    bigOpL op unit (fun _ => Φ) (l.filterMap h) ≡
+      bigOpL op unit (fun _ x => (h x).elim unit Φ) l := by
+  induction l with
+  | nil => exact Equiv.rfl
+  | cons x xs ih =>
+    simp only [List.filterMap_cons]
+    cases hx : h x <;> simp only [hx, Option.elim, cons]
+    · exact Equiv.trans ih (Equiv.symm (Monoid.op_left_id _))
+    · exact Monoid.op_congr_r ih
+
+/-- Corresponds to Rocq's `big_opL_bind`. -/
+theorem bind {B : Type v} (h : A → List B) (Φ : B → M) (l : List A) :
+    bigOpL op unit (fun _ => Φ) (l.flatMap h) ≡
+      bigOpL op unit (fun _ x => bigOpL op unit (fun _ => Φ) (h x)) l := by
+  induction l with
+  | nil => exact Equiv.rfl
+  | cons x xs ih =>
+    simp only [List.flatMap_cons, cons]
+    exact Equiv.trans (append _ _ _) (Monoid.op_congr_r ih)
+
+end
+
+/-- Corresponds to Rocq's `big_opL_closed`. -/
+theorem closed (P : M → Prop) (Φ : Nat → A → M) (l : List A)
+    (hunit : P unit)
+    (hop : ∀ x y, P x → P y → P (op x y))
+    (hf : ∀ i x, l[i]? = some x → P (Φ i x)) :
+    P (bigOpL op unit Φ l) := by
+  induction l generalizing Φ with
+  | nil => exact hunit
+  | cons y ys ih =>
+    simp only [cons]
+    have h0 : P (Φ 0 y) := hf 0 y rfl
+    have htail : ∀ i x, ys[i]? = some x → P (Φ (i + 1) x) := fun i x hget => hf (i + 1) x hget
+    exact hop _ _ h0 (ih _ htail)
+
+/-- Corresponds to Rocq's `big_opL_gen_proper_2`. -/
+theorem gen_proper_2 {B : Type v} (R : M → M → Prop)
+    (Φ : Nat → A → M) (Ψ : Nat → B → M) (l₁ : List A) (l₂ : List B)
+    (hunit : R unit unit)
+    (hop : ∀ a a' b b', R a a' → R b b' → R (op a b) (op a' b'))
+    (hlen : l₁.length = l₂.length)
+    (hf : ∀ i, ∀ x y, l₁[i]? = some x → l₂[i]? = some y → R (Φ i x) (Ψ i y)) :
+    R (bigOpL op unit Φ l₁) (bigOpL op unit Ψ l₂) := by
+  induction l₁ generalizing l₂ Φ Ψ with
+  | nil =>
+    cases l₂ with
+    | nil => simp only [nil]; exact hunit
+    | cons _ _ => simp at hlen
+  | cons x xs ih =>
+    cases l₂ with
+    | nil => simp at hlen
+    | cons y ys =>
+      simp only [List.length_cons, Nat.add_right_cancel_iff] at hlen
+      simp only [cons]
+      have h0 : R (Φ 0 x) (Ψ 0 y) := hf 0 x y rfl rfl
+      have htail : ∀ i, ∀ a b, xs[i]? = some a → ys[i]? = some b →
+          R (Φ (i + 1) a) (Ψ (i + 1) b) := fun i a b ha hb => hf (i + 1) a b ha hb
+      exact hop _ _ _ _ h0 (ih (fun n => Φ (n + 1)) (fun n => Ψ (n + 1)) ys hlen htail)
+
+/-- Corresponds to Rocq's `big_opL_gen_proper`. -/
+theorem gen_proper (R : M → M → Prop)
+    (Φ Ψ : Nat → A → M) (l : List A)
+    (hR_refl : ∀ x, R x x)
+    (hR_op : ∀ a a' b b', R a a' → R b b' → R (op a b) (op a' b'))
+    (hf : ∀ k y, l[k]? = some y → R (Φ k y) (Ψ k y)) :
+    R (bigOpL op unit Φ l) (bigOpL op unit Ψ l) := by
+  apply gen_proper_2 (op := op) (unit := unit) R Φ Ψ l l
+  · exact hR_refl unit
+  · exact hR_op
+  · rfl
+  · intro k x y hx hy
+    cases hget : l[k]? with
+    | none =>
+      rw [hget] at hx
+      cases hx
+    | some z =>
+      have hxz : x = z := by rw [hget] at hx; cases hx; rfl
+      have hyz : y = z := by rw [hget] at hy; cases hy; rfl
+      rw [hxz, hyz]
+      exact hf k z hget
+
+/-- Corresponds to Rocq's `big_opL_ext`. -/
+theorem ext {Φ Ψ : Nat → A → M} {l : List A}
+    (h : ∀ i x, l[i]? = some x → Φ i x = Ψ i x) :
+    bigOpL op unit Φ l = bigOpL op unit Ψ l := by
+    apply gen_proper
+    · intro _
+      rfl
+    · intros _ _ _ _ ha hb
+      rw [ha, hb]
+    · apply h
+
+/-- Corresponds to Rocq's `big_opL_consZ_l`. -/
+theorem cons_int_l (Φ : Int → A → M) (x : A) (l : List A) :
+    bigOpL op unit (fun k => Φ k) (x :: l) =
+    op (Φ 0 x) (bigOpL op unit (fun k y => Φ (1 + (k : Int)) y) l) := by
+  simp only [cons]
+  apply congrArg
+  apply ext
+  intro i y hy
+  congr 1
+  omega
+
+/-- Corresponds to Rocq's `big_opL_consZ_r`. -/
+theorem cons_int_r (Φ : Int → A → M) (x : A) (l : List A) :
+    bigOpL op unit (fun k => Φ k) (x :: l) =
+    op (Φ 0 x) (bigOpL op unit (fun k y => Φ ((k : Int) + 1) y) l) := by
+  simp only [cons]
+  rfl
+
+section
+
+variable [OFE M] [Monoid M op unit]
+
+/-- Corresponds to Rocq's `big_opL_proper_2`. -/
+theorem proper_2 [OFE A] (Φ Ψ : Nat → A → M) (l₁ l₂ : List A)
+    (hlen : l₁.length = l₂.length)
+    (hf : ∀ (k : Nat) (y₁ y₂ : A), l₁[k]? = some y₁ → l₂[k]? = some y₂ → Φ k y₁ ≡ Ψ k y₂) :
+    bigOpL op unit Φ l₁ ≡ bigOpL op unit Ψ l₂ := by
+  apply gen_proper_2 (op := op) (unit := unit) (· ≡ ·) Φ Ψ l₁ l₂
+  · exact Equiv.rfl
+  · intros a a' b b' ha hb; exact Monoid.op_proper ha hb
+  · exact hlen
+  · intro k x y hx hy
+    cases hget1 : l₁[k]? with
+    | none =>
+      rw [hget1] at hx
+      cases hx
+    | some z₁ =>
+      cases hget2 : l₂[k]? with
+      | none =>
+        have h1 : k < l₁.length := by
+          cases h : l₁[k]? <;> simp_all
+        rw [hlen] at h1
+        have h2 : k < l₂.length := h1
+        have : l₂[k]? ≠ none := by
+          intro h
+          have : l₂[k]? = some l₂[k] := List.getElem?_eq_getElem h2
+          simp [h] at this
+        contradiction
+      | some z₂ =>
+        have hxz1 : x = z₁ := by rw [hget1] at hx; cases hx; rfl
+        have hyz2 : y = z₂ := by rw [hget2] at hy; cases hy; rfl
+        rw [hxz1, hyz2]
+        exact hf k z₁ z₂ hget1 hget2
+
+/-- Corresponds to Rocq's `big_opL_zip_seq`. -/
+theorem zip_idx (Φ : A × Nat → M) (n : Nat) (l : List A) :
+    bigOpL op unit (fun _ => Φ) (l.zipIdx n) ≡
+      bigOpL op unit (fun i x => Φ (x, n + i)) l := by
+  induction l generalizing n with
+  | nil => simp only [nil]; exact Equiv.rfl
+  | cons x xs ih =>
+    simp only [cons, Nat.add_zero]
+    refine Monoid.op_proper Equiv.rfl (Equiv.trans (ih (n + 1)) (congr' fun i _ => ?_))
+    simp only [Nat.add_assoc, Nat.add_comm 1 i]; exact Equiv.rfl
+
+/-- Corresponds to Rocq's `big_opL_zip_seqZ`. -/
+theorem zip_idx_int (Φ : A × Int → M) (n : Int) (l : List A) :
+    bigOpL op unit (fun _ => Φ) (Std.List.zipIdxInt l n) ≡
+      bigOpL op unit (fun i x => Φ (x, n + (i : Int))) l := by
+  unfold Std.List.zipIdxInt
+  suffices ∀ m, bigOpL op unit (fun _ => Φ) (l.mapIdx (fun i v => (v, (i : Int) + m))) ≡
+                bigOpL op unit (fun i x => Φ (x, m + (i : Int))) l by exact this n
+  intro m
+  induction l generalizing m with
+  | nil => simp only [List.mapIdx, nil]; exact Equiv.rfl
+  | cons x xs ih =>
+    simp only [List.mapIdx_cons, cons]
+    apply Monoid.op_proper
+    · show Φ (x, (0 : Int) + m) ≡ Φ (x, m + (0 : Int))
+      rw [Int.zero_add, Int.add_zero]
+    · have h_shift : ∀ i, ((i + 1 : Nat) : Int) + m = (i : Int) + (m + 1) := by
+        intro i; omega
+      have list_eq : (List.mapIdx (fun i v => (v, ↑(i + 1) + m)) xs) =
+                     (List.mapIdx (fun i v => (v, ↑i + (m + 1))) xs) := by
+        apply List.ext_getElem
+        · simp only [List.length_mapIdx]
+        · intro n hn1 hn2
+          simp only [List.getElem_mapIdx]
+          congr 1
+          exact h_shift n
+      rw [list_eq]
+      have h_ih := ih (m + 1)
+      refine Equiv.trans h_ih (congr' fun i _ => ?_)
+      have : m + 1 + (i : Int) = m + ((i + 1 : Nat) : Int) := by omega
+      rw [this]
+
+/-- Corresponds to Rocq's `big_opL_sep_zip_with`. -/
+theorem sep_zip_with {B C : Type _}
+    (f : A → B → C) (g1 : C → A) (g2 : C → B)
+    (Φ : Nat → A → M) (Ψ : Nat → B → M) (l₁ : List A) (l₂ : List B)
+    (hg1 : ∀ x y, g1 (f x y) = x)
+    (hg2 : ∀ x y, g2 (f x y) = y)
+    (hlen : l₁.length = l₂.length) :
+    bigOpL op unit (fun i c => op (Φ i (g1 c)) (Ψ i (g2 c))) (List.zipWith f l₁ l₂) ≡
+      op (bigOpL op unit Φ l₁) (bigOpL op unit Ψ l₂) := by
+  induction l₁ generalizing l₂ Φ Ψ with
+  | nil =>
+    cases l₂ with
+    | nil => simp only [List.zipWith_nil_left, nil]; exact Equiv.symm (Monoid.op_left_id _)
+    | cons _ _ => simp at hlen
+  | cons x xs ih =>
+    cases l₂ with
+    | nil => simp at hlen
+    | cons y ys =>
+      simp only [List.length_cons, Nat.add_right_cancel_iff] at hlen
+      simp only [List.zipWith_cons_cons, cons, hg1, hg2]
+      exact Equiv.trans (Monoid.op_congr_r (ih (fun n => Φ (n + 1)) (fun n => Ψ (n + 1)) ys hlen)) Monoid.op_op_swap
+
+/-- Big op over zipped list with separated functions. -/
+theorem sep_zip {B : Type v} (Φ : Nat → A → M) (Ψ : Nat → B → M) (l₁ : List A) (l₂ : List B)
+    (hlen : l₁.length = l₂.length) :
+    bigOpL op unit (fun i xy => op (Φ i xy.1) (Ψ i xy.2)) (l₁.zip l₂) ≡
+      op (bigOpL op unit Φ l₁) (bigOpL op unit Ψ l₂) := by
+  simp [List.zip]
+  apply sep_zip_with (op := op)
+  · intro _ _
+    trivial
+  · intro _ _
+    trivial
+  · apply hlen
+
+variable {M₁ : Type u} {M₂ : Type v} [OFE M₁] [OFE M₂]
+variable {op₁ : M₁ → M₁ → M₁} {op₂ : M₂ → M₂ → M₂} {unit₁ : M₁} {unit₂ : M₂}
+variable [Monoid M₁ op₁ unit₁] [Monoid M₂ op₂ unit₂]
+variable {B : Type w}
+
+/-- Monoid homomorphisms distribute over big ops. -/
+theorem commute {R : M₂ → M₂ → Prop} {f : M₁ → M₂}
+    (hom : MonoidHomomorphism op₁ op₂ unit₁ unit₂ R f)
+    (Φ : Nat → B → M₁) (l : List B) :
+    R (f (bigOpL op₁ unit₁ Φ l)) (bigOpL op₂ unit₂ (fun i x => f (Φ i x)) l) := by
+  induction l generalizing Φ with
+  | nil => simp only [nil]; exact hom.map_unit
+  | cons x xs ih =>
+    simp only [cons]
+    have hhom := hom.homomorphism (Φ 0 x) (bigOpL op₁ unit₁ (fun n => Φ (n + 1)) xs)
+    have hih := ih (fun n => Φ (n + 1))
+    exact hom.rel_trans hhom (hom.op_proper (hom.rel_refl _) hih)
+
+/-- Weak monoid homomorphisms distribute over non-empty big ops. -/
+theorem commute_weak {R : M₂ → M₂ → Prop} {f : M₁ → M₂}
+    (hom : WeakMonoidHomomorphism op₁ op₂ unit₁ unit₂ R f)
+    (Φ : Nat → B → M₁) (l : List B) (hne : l ≠ []) :
+    R (f (bigOpL op₁ unit₁ Φ l)) (bigOpL op₂ unit₂ (fun i x => f (Φ i x)) l) := by
+  induction l generalizing Φ with
+  | nil => exact absurd rfl hne
+  | cons x xs ih =>
+    simp only [cons]
+    cases xs with
+    | nil =>
+      simp only [nil]
+      haveI : NonExpansive f := hom.f_ne
+      have hlhs : f (op₁ (Φ 0 x) unit₁) ≡ f (Φ 0 x) :=
+        NonExpansive.eqv (Monoid.op_right_id (Φ 0 x))
+      have hrhs : op₂ (f (Φ 0 x)) unit₂ ≡ f (Φ 0 x) :=
+        Monoid.op_right_id (f (Φ 0 x))
+      exact hom.rel_proper hlhs hrhs |>.mpr (hom.rel_refl _)
+    | cons y ys =>
+      have hhom := hom.homomorphism (Φ 0 x) (bigOpL op₁ unit₁ (fun n => Φ (n + 1)) (y :: ys))
+      have hih := ih (fun n => Φ (n + 1)) (List.cons_ne_nil y ys)
+      exact hom.rel_trans hhom (hom.op_proper (hom.rel_refl _) hih)
+
+end
+
+end BigOpL
+
+namespace BigOpM
+
+open Iris.Std
+
+variable {M : Type u} {op : M → M → M} {unit : M}
+variable {M' : Type _ → Type _} {K : Type _} {V : Type _}
+
+section
+variable [FiniteMap K M']
+
+/-- Corresponds to Rocq's `big_opM`. -/
+def bigOpM (Φ : K → V → M) (m : M' V) : M :=
+  bigOpL op unit (fun _ kv => Φ kv.1 kv.2) (FiniteMap.toList m)
+
+end
+
+section
+variable [OFE M] [FiniteMap K M']
+
+/-- Corresponds to Rocq's `big_opM_map_to_list`. -/
+theorem to_list (Φ : K → V → M) (m : M' V) :
+    bigOpM (op := op) (unit := unit) Φ m ≡
+    bigOpL op unit (fun _ kx => Φ kx.1 kx.2) (FiniteMap.toList m) := by
+  simp only [bigOpM]
+  rfl
+
+end
+
+section
+variable [FiniteMap K M'] [OFE M] [Monoid M op unit]
+
+/-- Corresponds to Rocq's `big_opM_op`. -/
+theorem op_distr (Φ Ψ : K → V → M) (m : M' V) :
+    bigOpM (op := op) (unit := unit) (fun k x => op (Φ k x) (Ψ k x)) m ≡
+    op (bigOpM (op := op) (unit := unit) Φ m) (bigOpM (op := op) (unit := unit) Ψ m) := by
+  simp only [bigOpM]
+  have h := BigOpL.op_distr (op := op) (unit := unit)
+    (fun _ kv => Φ kv.1 kv.2) (fun _ kv => Ψ kv.1 kv.2) (FiniteMap.toList m)
+  exact h
+
+end
+
+section
+variable [OFE M] [Monoid M op unit]
+
+private theorem filter_list_aux (Φ : K × V → M) (φ : K → V → Bool) (l : List (K × V)) :
+    bigOpL op unit (fun _ kv => Φ kv) (l.filter (fun kv => φ kv.1 kv.2)) ≡
+    bigOpL op unit (fun _ kv => if φ kv.1 kv.2 then Φ kv else unit) l := by
+  induction l with
+  | nil => simp only [List.filter, BigOpL.nil]; exact Equiv.rfl
+  | cons kv kvs ih =>
+    simp only [List.filter]
+    cases hp : φ kv.1 kv.2 with
+    | false =>
+      simp only [BigOpL.cons, hp]
+      exact Equiv.trans ih (Equiv.symm (Monoid.op_left_id _))
+    | true =>
+      simp only [BigOpL.cons, hp]
+      exact Monoid.op_congr_r ih
+
+end
+
+section
+variable [DecidableEq K] [FiniteMap K M'] [FiniteMapLaws K M']
+
+/-- Corresponds to Rocq's `big_opM_empty`. -/
+@[simp] theorem empty (Φ : K → V → M) :
+    bigOpM (op := op) (unit := unit) Φ (∅ : M' V) = unit := by
+  simp only [bigOpM, FiniteMapLaws.toList_empty, BigOpL.nil]
+
+section
+variable [OFE M] [Monoid M op unit]
+
+/-- Corresponds to Rocq's `big_opM_insert`. -/
+theorem insert [DecidableEq V] (Φ : K → V → M) (m : M' V) (i : K) (x : V) :
+    FiniteMap.get? m i = none →
+    bigOpM (op := op) (unit := unit) Φ (FiniteMap.insert m i x) ≡
+      op (Φ i x) (bigOpM (op := op) (unit := unit) Φ m) := by
+  intro hi
+  simp only [bigOpM]
+  have hperm := FiniteMapLaws.toList_insert m i x hi
+  have heq : bigOpL op unit (fun _ kv => Φ kv.1 kv.2) (FiniteMap.toList (FiniteMap.insert m i x)) ≡
+             bigOpL op unit (fun _ kv => Φ kv.1 kv.2) ((i, x) :: FiniteMap.toList m) :=
+    BigOpL.perm _ hperm
+  simp only [BigOpL.cons] at heq
+  exact heq
+
+/-- Corresponds to Rocq's `big_opM_delete`. -/
+theorem delete [DecidableEq V] (Φ : K → V → M) (m : M' V) (i : K) (x : V) :
+    FiniteMap.get? m i = some x →
+    bigOpM (op := op) (unit := unit) Φ m ≡
+      op (Φ i x) (bigOpM (op := op) (unit := unit) Φ (FiniteMap.delete m i)) := by
+  intro hi
+  have heq := FiniteMapLaws.insert_delete_cancel m i x hi
+  have : bigOpM (op := op) (unit := unit) Φ m = bigOpM (op := op) (unit := unit) Φ (FiniteMap.insert (FiniteMap.delete m i) i x) := by
+    rw [heq]
+  rw [this]
+  have hdelete := FiniteMapLaws.get?_delete_same m i
+  exact insert Φ (FiniteMap.delete m i) i x hdelete
+
+variable {A : Type w} [DecidableEq A]
+
+/-- Corresponds to Rocq's `big_opM_gen_proper_2`. -/
+theorem gen_proper_2 {B : Type w} [DecidableEq B] (R : M → M → Prop)
+    (Φ : K → A → M) (Ψ : K → B → M) (m1 : M' A) (m2 : M' B)
+    (hR_sub : ∀ x y, x ≡ y → R x y)
+    (hR_equiv : Equivalence R)
+    (hR_op : ∀ a a' b b', R a a' → R b b' → R (op a b) (op a' b'))
+    (hfg : ∀ k,
+      match FiniteMap.get? m1 k, FiniteMap.get? m2 k with
+      | some y1, some y2 => R (Φ k y1) (Ψ k y2)
+      | none, none => True
+      | _, _ => False) :
+    R (bigOpM (op := op) (unit := unit) Φ m1) (bigOpM (op := op) (unit := unit) Ψ m2) := by
+  refine FiniteMapLaws.induction_on (P := fun m1' => ∀ m2' Φ' Ψ',
+      (∀ k, match FiniteMap.get? m1' k, FiniteMap.get? m2' k with
+        | some y1, some y2 => R (Φ' k y1) (Ψ' k y2)
+        | none, none => True
+        | _, _ => False) →
+      R (bigOpM (op := op) (unit := unit) Φ' m1') (bigOpM (op := op) (unit := unit) Ψ' m2'))
+    ?hemp ?hins m1 m2 Φ Ψ hfg
+  case hemp =>
+    intro m2' Φ' Ψ' hfg'
+    refine FiniteMapLaws.induction_on (P := fun m2'' => ∀ Φ'' Ψ'',
+        (∀ k, match FiniteMap.get? (∅ : M' A) k, FiniteMap.get? m2'' k with
+          | some y1, some y2 => R (Φ'' k y1) (Ψ'' k y2)
+          | none, none => True
+          | _, _ => False) →
+        R (bigOpM (op := op) (unit := unit) Φ'' (∅ : M' A)) (bigOpM (op := op) (unit := unit) Ψ'' m2''))
+      ?hemp2 ?hins2 m2' Φ' Ψ' hfg'
+    case hemp2 => intro _ _ _; rw [empty, empty]; exact hR_sub unit unit Equiv.rfl
+    case hins2 =>
+      intro k x2 _ _ _ _ _ hfg''
+      have := hfg'' k
+      rw [FiniteMapLaws.get?_empty, FiniteMapLaws.get?_insert_same] at this
+      cases this
+  case hins =>
+    intro k x1 m1' hm1'k IH m2' Φ' Ψ' hfg'
+    have hfg_k := hfg' k
+    rw [FiniteMapLaws.get?_insert_same] at hfg_k
+    cases hm2k : FiniteMap.get? m2' k with
+    | none => rw [hm2k] at hfg_k; cases hfg_k
+    | some x2 =>
+      rw [hm2k] at hfg_k
+      have h_IH : R (bigOpM (op := op) (unit := unit) Φ' m1')
+                    (bigOpM (op := op) (unit := unit) Ψ' (FiniteMap.delete m2' k)) := by
+        refine IH _ _ _ fun k' => ?_
+        by_cases hkk' : k = k'
+        · subst hkk'; rw [FiniteMapLaws.get?_delete_same, hm1'k]; trivial
+        · have h1 := FiniteMapLaws.get?_insert_ne m1' k k' x1 hkk'
+          have h2 := FiniteMapLaws.get?_delete_ne m2' k k' hkk'
+          rw [← h1, h2]; exact hfg' k'
+      exact hR_equiv.trans (hR_sub _ _ (insert Φ' m1' k x1 hm1'k))
+        (hR_equiv.trans (hR_op _ _ _ _ hfg_k h_IH) (hR_sub _ _ (Equiv.symm (delete Ψ' m2' k x2 hm2k))))
+
+end
+
+/-- Corresponds to Rocq's `big_opM_gen_proper`. -/
+theorem gen_proper {M : Type u} {op : M → M → M} {unit : M} (R : M → M → Prop)
+    (Φ Ψ : K → V → M) (m : M' V)
+    (hR_refl : ∀ x, R x x)
+    (hR_op : ∀ a a' b b', R a a' → R b b' → R (op a b) (op a' b'))
+    (hf : ∀ k x, FiniteMap.get? m k = some x → R (Φ k x) (Ψ k x)) :
+    R (bigOpM (op := op) (unit := unit) Φ m) (bigOpM (op := op) (unit := unit) Ψ m) := by
+  simp only [bigOpM]
+  apply BigOpL.gen_proper_2 (op := op) (unit := unit) R
+  · exact hR_refl unit
+  · exact hR_op
+  · rfl
+  · intro i x y hx hy
+    rw [hx] at hy
+    cases hy
+    have : (x.1, x.2) ∈ FiniteMap.toList m := by
+      rw [List.mem_iff_getElem?]
+      exact ⟨i, hx⟩
+    have := FiniteMapLaws.mem_toList m x.1 x.2 |>.mp this
+    exact hf x.1 x.2 this
+
+/-- Corresponds to Rocq's `big_opM_ext`. -/
+theorem ext {M : Type u} (op : M → M → M) (unit : M) (Φ Ψ : K → V → M) (m : M' V)
+    (hf : ∀ k x, FiniteMap.get? m k = some x → Φ k x = Ψ k x) :
+    bigOpM (op := op) (unit := unit) Φ m = bigOpM (op := op) (unit := unit) Ψ m := by
+  apply gen_proper (R := (· = ·))
+  · intro _; rfl
+  · intros _ _ _ _ ha hb; rw [ha, hb]
+  · exact hf
+
+section
+variable [OFE M] [Monoid M op unit]
+
+/-- Corresponds to Rocq's `big_opM_ne`. -/
+theorem ne (Φ Ψ : K → V → M) (m : M' V) (n : Nat)
+    (hf : ∀ k x, FiniteMap.get? m k = some x → Φ k x ≡{n}≡ Ψ k x) :
+    bigOpM (op := op) (unit := unit) Φ m ≡{n}≡ bigOpM (op := op) (unit := unit) Ψ m := by
+  apply gen_proper (R := (· ≡{n}≡ ·))
+  · intro _; exact Dist.rfl
+  · intros a a' b b' ha hb; exact Monoid.op_ne_dist ha hb
+  · exact hf
+
+/-- Corresponds to Rocq's `big_opM_proper`. -/
+theorem proper (Φ Ψ : K → V → M) (m : M' V)
+    (hf : ∀ k x, FiniteMap.get? m k = some x → Φ k x ≡ Ψ k x) :
+    bigOpM (op := op) (unit := unit) Φ m ≡ bigOpM (op := op) (unit := unit) Ψ m := by
+  apply gen_proper (R := (· ≡ ·))
+  · intro _; exact Equiv.rfl
+  · intros a a' b b' ha hb; exact Monoid.op_proper ha hb
+  · exact hf
+
+/-- Corresponds to Rocq's `big_opM_proper_2`. -/
+theorem proper_2 [OFE A] [DecidableEq A] (Φ : K → A → M) (Ψ : K → A → M) (m1 m2 : M' A)
+    (hm : ∀ k, FiniteMap.get? m1 k = FiniteMap.get? m2 k)
+    (hf : ∀ k y1 y2,
+      FiniteMap.get? m1 k = some y1 →
+      FiniteMap.get? m2 k = some y2 →
+      y1 ≡ y2 →
+      Φ k y1 ≡ Ψ k y2) :
+    bigOpM (op := op) (unit := unit) Φ m1 ≡ bigOpM (op := op) (unit := unit) Ψ m2 := by
+  apply gen_proper_2 (R := (· ≡ ·))
+  · intros _ _ h; exact h
+  · exact equiv_eqv
+  · intros a a' b b' ha hb; exact Monoid.op_proper ha hb
+  · intro k
+    have hlk := hm k
+    cases hm1k : FiniteMap.get? m1 k with
+    | none =>
+      rw [hm1k] at hlk
+      rw [← hlk]
+      trivial
+    | some y1 =>
+      rw [hm1k] at hlk
+      cases hm2k : FiniteMap.get? m2 k with
+      | none => rw [hm2k] at hlk; cases hlk
+      | some y2 =>
+        rw [hm2k] at hlk
+        cases hlk
+        exact hf k y1 y1 hm1k hm2k Equiv.rfl
+
+/-- Corresponds to Rocq's `big_opM_ne'` instance. -/
+theorem ne_pointwise (Φ Ψ : K → V → M) (m : M' V) (n : Nat)
+    (hf : ∀ k x, Φ k x ≡{n}≡ Ψ k x) :
+    bigOpM (op := op) (unit := unit) Φ m ≡{n}≡ bigOpM (op := op) (unit := unit) Ψ m := by
+  apply ne
+  intros k x _
+  exact hf k x
+
+/-- Corresponds to Rocq's `big_opM_proper'` instance. -/
+theorem proper_pointwise (Φ Ψ : K → V → M) (m : M' V)
+    (hf : ∀ k x, Φ k x ≡ Ψ k x) :
+    bigOpM (op := op) (unit := unit) Φ m ≡ bigOpM (op := op) (unit := unit) Ψ m := by
+  apply proper
+  intros k x _
+  exact hf k x
+
+/-- Corresponds to Rocq's `big_opM_list_to_map`. -/
+theorem of_list [DecidableEq V] (Φ : K → V → M) (l : List (K × V))
+    (hnodup : (l.map Prod.fst).Nodup) :
+    bigOpM (op := op) (unit := unit) Φ (FiniteMap.ofList l : M' V) ≡
+    bigOpL op unit (fun _ kx => Φ kx.1 kx.2) l := by
+  have h1 := to_list (op := op) (unit := unit) Φ (FiniteMap.ofList l : M' V)
+  apply Equiv.trans h1
+  apply BigOpL.perm
+  exact FiniteMapLaws.toList_ofList l hnodup
+
+/-- Corresponds to Rocq's `big_opM_singleton`. -/
+theorem singleton [DecidableEq V] (Φ : K → V → M) (i : K) (x : V) :
+    bigOpM (op := op) (unit := unit) Φ (FiniteMap.singleton (M := M') i x) ≡ Φ i x := by
+  have : FiniteMap.get? (∅ : M' V) i = none := FiniteMapLaws.get?_empty i
+  have := insert (op := op) (unit := unit) Φ (∅ : M' V) i x this
+  rw [empty] at this
+  exact Equiv.trans this (Monoid.op_right_id (Φ i x))
+
+/-- Corresponds to Rocq's `big_opM_unit`. -/
+theorem unit_const [DecidableEq V] (m : M' V) :
+    bigOpM (op := op) (unit := unit) (fun _ _ => unit) m ≡ unit := by
+  refine FiniteMapLaws.induction_on
+    (P := fun (m' : M' V) => bigOpM (op := op) (unit := unit) (fun _ _ => unit) m' ≡ unit)
+    ?hemp ?hins m
+  case hemp =>
+    show bigOpM (op := op) (unit := unit) (fun _ _ => unit) ∅ ≡ unit
+    rw [empty]
+  case hins =>
+    intro i x m' hm' IH
+    show bigOpM (op := op) (unit := unit) (fun _ _ => unit) (FiniteMap.insert m' i x) ≡ unit
+    have h_ins := insert (op := op) (unit := unit) (fun _ _ => unit) m' i x hm'
+    exact Equiv.trans h_ins (Equiv.trans (Monoid.op_proper Equiv.rfl IH) (Monoid.op_left_id unit))
+
+/-- Corresponds to Rocq's `big_opM_fmap`. -/
+theorem map {B : Type w} [DecidableEq B] (h : V → B) (Φ : K → B → M) (m : M' V) :
+    bigOpM (op := op) (unit := unit) Φ (FiniteMap.map h m) ≡
+    bigOpM (op := op) (unit := unit) (fun k v => Φ k (h v)) m := by
+  simp only [bigOpM]
+  have h1 : bigOpL op unit (fun _ kv => Φ kv.1 kv.2) (FiniteMap.toList (FiniteMap.map h m)) ≡
+            bigOpL op unit (fun _ kv => Φ kv.1 kv.2) ((FiniteMap.toList m).map (fun kv => (kv.1, h kv.2))) := by
+    apply BigOpL.perm
+    exact FiniteMapLaws.toList_map m h
+  apply Equiv.trans h1
+  exact BigOpL.map (op := op) (unit := unit) (fun kv => (kv.1, h kv.2)) (fun _ kv => Φ kv.1 kv.2) (FiniteMap.toList m)
+
+/-- Corresponds to Rocq's `big_opM_omap`. -/
+theorem filter_map [FiniteMapLawsSelf K M'] (h : V → Option V) (Φ : K → V → M) (m : M' V) :
+    bigOpM (op := op) (unit := unit) Φ (FiniteMap.filterMap h m) ≡
+    bigOpM (op := op) (unit := unit) (fun k v => (h v).elim unit (Φ k)) m := by
+  simp only [bigOpM, FiniteMap.filterMap]
+  -- Use toList_filterMap to relate toList of filterMap to filterMap of toList
+  have h1 : bigOpL op unit (fun _ kv => Φ kv.1 kv.2)
+              (FiniteMap.toList (FiniteMap.ofList ((FiniteMap.toList m).filterMap (fun (k, v) => (h v).map (k, ·))) : M' V)) ≡
+            bigOpL op unit (fun _ kv => Φ kv.1 kv.2)
+              ((FiniteMap.toList m).filterMap (fun (k, v) => (h v).map (k, ·))) := by
+    apply BigOpL.perm
+    have hperm := toList_filterMap m h
+    exact hperm
+  refine Equiv.trans h1 ?_
+  -- Now use BigOpL.filter_map
+  have h2 : bigOpL op unit (fun _ kv => Φ kv.1 kv.2)
+              ((FiniteMap.toList m).filterMap (fun (k, v) => (h v).map (k, ·))) ≡
+            bigOpL op unit (fun _ kv => ((h kv.2).map (kv.1, ·)).elim unit (fun kv' => Φ kv'.1 kv'.2))
+              (FiniteMap.toList m) := by
+    exact BigOpL.filter_map (op := op) (unit := unit) (fun kv => (h kv.2).map (kv.1, ·)) (fun kv => Φ kv.1 kv.2) (FiniteMap.toList m)
+  refine Equiv.trans h2 ?_
+  -- Simplify the function
+  apply BigOpL.congr'
+  intro i kv
+  cases hkv : h kv.2 <;> simp [Option.elim, Option.map]
+
+/-- Corresponds to Rocq's `big_opM_insert_delete`. -/
+theorem insert_delete [DecidableEq V] (Φ : K → V → M) (m : M' V) (i : K) (x : V) :
+    bigOpM (op := op) (unit := unit) Φ (FiniteMap.insert m i x) ≡
+      op (Φ i x) (bigOpM (op := op) (unit := unit) Φ (FiniteMap.delete m i)) := by
+  rw [← FiniteMapLaws.insert_delete m i x]
+  exact insert Φ (FiniteMap.delete m i) i x (FiniteMapLaws.get?_delete_same m i)
+
+/-- Corresponds to Rocq's `big_opM_insert_override`. -/
+theorem insert_override [DecidableEq A] (Φ : K → A → M) (m : M' A) (i : K) (x x' : A) :
+    FiniteMap.get? m i = some x → Φ i x ≡ Φ i x' →
+    bigOpM (op := op) (unit := unit) Φ (FiniteMap.insert m i x') ≡
+      bigOpM (op := op) (unit := unit) Φ m := by
+  intro hi hΦ
+  rw [← FiniteMapLaws.insert_delete m i x']
+  refine Equiv.trans (insert Φ (FiniteMap.delete m i) i x' (FiniteMapLaws.get?_delete_same m i)) ?_
+  refine Equiv.trans (Monoid.op_proper (Equiv.symm hΦ) Equiv.rfl) ?_
+  exact Equiv.symm (delete Φ m i x hi)
+
+/-- Corresponds to Rocq's `big_opM_fn_insert`. -/
+theorem fn_insert [DecidableEq V] {B : Type w} [DecidableEq B] (g : K → V → B → M) (f : K → B) (m : M' V)
+    (i : K) (x : V) (b : B) (hi : FiniteMap.get? m i = none) :
+    bigOpM (op := op) (unit := unit) (fun k y => g k y (if k = i then b else f k))
+      (FiniteMap.insert m i x) ≡
+    op (g i x b) (bigOpM (op := op) (unit := unit) (fun k y => g k y (f k)) m) := by
+  have h1 := insert (op := op) (unit := unit) (fun k y => g k y (if k = i then b else f k)) m i x hi
+  refine Equiv.trans h1 ?_
+  apply Monoid.op_proper
+  · simp
+  · apply proper (op := op) (unit := unit)
+    intros k y hk
+    have hne : k ≠ i := fun heq => by rw [heq] at hk; rw [hi] at hk; cases hk
+    simp [hne]
+
+/-- Corresponds to Rocq's `big_opM_fn_insert'`. -/
+theorem fn_insert' [DecidableEq V] (f : K → M) (m : M' V) (i : K) (x : V) (P : M)
+    (hi : FiniteMap.get? m i = none) :
+    bigOpM (op := op) (unit := unit) (fun k _ => if k = i then P else f k)
+      (FiniteMap.insert m i x) ≡
+    op P (bigOpM (op := op) (unit := unit) (fun k _ => f k) m) := by
+  have h1 := insert (op := op) (unit := unit) (fun k _ => if k = i then P else f k) m i x hi
+  refine Equiv.trans h1 ?_
+  apply Monoid.op_proper
+  · simp
+  · apply proper (op := op) (unit := unit)
+    intros k y hk
+    have hne : k ≠ i := fun heq => by rw [heq] at hk; rw [hi] at hk; cases hk
+    simp [hne]
+
+
+/-- Corresponds to Rocq's `big_opM_filter'`. -/
+theorem filter' [FiniteMapLawsSelf K M'] (φ : K → V → Bool) (Φ : K → V → M) (m : M' V) :
+    bigOpM (op := op) (unit := unit) Φ (FiniteMap.filter φ m) ≡
+    bigOpM (op := op) (unit := unit) (fun k x => if φ k x then Φ k x else unit) m := by
+  unfold bigOpM
+  have hperm := toList_filter m φ
+  have heq : bigOpL op unit (fun _ kv => Φ kv.1 kv.2)
+               (FiniteMap.toList (FiniteMap.filter φ m)) ≡
+             bigOpL op unit (fun _ kv => Φ kv.1 kv.2)
+               ((FiniteMap.toList m).filter (fun kv => φ kv.1 kv.2)) :=
+    BigOpL.perm _ hperm
+  refine Equiv.trans heq ?_
+  exact filter_list_aux (fun kv => Φ kv.1 kv.2) φ (FiniteMap.toList m)
+
+/-- Corresponds to Rocq's `big_opM_union`. -/
+theorem union [DecidableEq V] (Φ : K → V → M) (m1 m2 : M' V) (hdisj : m1 ##ₘ m2) :
+    bigOpM (op := op) (unit := unit) Φ (m1 ∪ m2) ≡
+    op (bigOpM (op := op) (unit := unit) Φ m1) (bigOpM (op := op) (unit := unit) Φ m2) := by
+  apply FiniteMapLaws.induction_on (P := fun m1 =>
+    m1 ##ₘ m2 →
+    bigOpM (op := op) (unit := unit) Φ (m1 ∪ m2) ≡
+    op (bigOpM (op := op) (unit := unit) Φ m1) (bigOpM (op := op) (unit := unit) Φ m2))
+  · intro _
+    rw [FiniteMapLaws.ext (∅ ∪ m2) m2 fun k => by simp [FiniteMapLaws.get?_union, FiniteMapLaws.get?_empty], empty]
+    exact (Monoid.op_left_id _).symm
+  · intro i x m hi_none IH hdisj'
+    have hi_m2 : get? m2 i = none := by simpa [FiniteMapLaws.get?_insert_same] using FiniteMapLaws.disjoint_iff (Std.insert m i x) m2 |>.mp hdisj' i
+    have hm_disj : m ##ₘ m2 := fun k ⟨hk1, hk2⟩ => hdisj' k ⟨by
+      by_cases h : i = k <;> simp [FiniteMapLaws.get?_insert_same, FiniteMapLaws.get?_insert_ne, *], hk2⟩
+    rw [← FiniteMapLaws.ext (Std.insert (m ∪ m2) i x) (Std.insert m i x ∪ m2) fun k => congrFun (FiniteMapLaws.union_insert_left m m2 i x) k]
+    refine (insert Φ (m ∪ m2) i x (by simp [FiniteMapLaws.get?_union_none, hi_none, hi_m2])).trans ?_
+    refine (Monoid.op_congr_r (IH hm_disj)).trans ?_
+    refine (Monoid.op_assoc _ _ _).symm.trans ?_
+    exact Monoid.op_congr_l (insert Φ m i x hi_none).symm
+  · exact hdisj
+
+private theorem closed_aux [DecidableEq V] (P : M → Prop) (Φ : K → V → M)
+    (hproper : ∀ x y, x ≡ y → (P x ↔ P y))
+    (hunit : P unit)
+    (hop : ∀ x y, P x → P y → P (op x y)) :
+    ∀ (m' : M' V), (∀ k' x', FiniteMap.get? m' k' = some x' → P (Φ k' x')) →
+        P (bigOpM (op := op) (unit := unit) Φ m') := by
+  intro m' hf'
+  refine FiniteMapLaws.induction_on
+    (P := fun m'' => (∀ k x, FiniteMap.get? m'' k = some x → P (Φ k x)) →
+                     P (bigOpM (op := op) (unit := unit) Φ m''))
+    ?hemp ?hins m' hf'
+  case hemp =>
+    intro _
+    simp only [empty]
+    exact hunit
+  case hins =>
+    intro k x m'' hm'' IH hf''
+    have h_ins := insert (op := op) (unit := unit) Φ m'' k x hm''
+    apply (hproper _ _ h_ins) |>.mpr
+    apply hop
+    · apply hf''
+      exact FiniteMapLaws.get?_insert_same m'' k x
+    · apply IH
+      intro k' x' hget'
+      apply hf''
+      rw [FiniteMapLaws.get?_insert_ne m'' k k' x]
+      · exact hget'
+      · intro heq
+        subst heq
+        rw [hget'] at hm''
+        exact Option.noConfusion hm''
+
+/-- Corresponds to Rocq's `big_opM_closed`. -/
+theorem closed [DecidableEq V] (P : M → Prop) (Φ : K → V → M) (m : M' V)
+    (hproper : ∀ x y, x ≡ y → (P x ↔ P y))
+    (hunit : P unit)
+    (hop : ∀ x y, P x → P y → P (op x y))
+    (hf : ∀ k x, FiniteMap.get? m k = some x → P (Φ k x)) :
+    P (bigOpM (op := op) (unit := unit) Φ m) :=
+  closed_aux P Φ hproper hunit hop m hf
+
+/-- Corresponds to Rocq's `big_opM_kmap`. -/
+theorem kmap {M'' : Type _ → Type _} {K' : Type _} [DecidableEq K'] [FiniteMap K' M'']
+    [FiniteMapLaws K' M''] [FiniteMapKmapLaws K K' M' M'']
+    (h : K → K') (hinj : ∀ {x y}, h x = h y → x = y) (Φ : K' → V → M) (m : M' V) :
+    bigOpM (op := op) (unit := unit) Φ (FiniteMap.kmap (M' := M'') h m : M'' V) ≡
+    bigOpM (op := op) (unit := unit) (fun k v => Φ (h k) v) m := by
+  simp only [bigOpM]
+  have h1 : bigOpL op unit (fun _ kv => Φ kv.1 kv.2) (FiniteMap.toList (FiniteMap.kmap (M' := M'') h m : M'' V)) ≡
+            bigOpL op unit (fun _ kv => Φ kv.1 kv.2) ((FiniteMap.toList m).map (fun kv => (h kv.1, kv.2))) := by
+    apply BigOpL.perm
+    exact FiniteMapKmapLaws.toList_kmap h m hinj
+  apply Equiv.trans h1
+  exact BigOpL.map (op := op) (unit := unit) (fun kv => (h kv.1, kv.2)) (fun _ kv => Φ kv.1 kv.2) (FiniteMap.toList m)
+
+/-- Corresponds to Rocq's `big_opM_map_seq`. -/
+theorem map_seq {M'' : Type w → Type _} [FiniteMap Nat M''] [FiniteMapLaws Nat M'']
+    [FiniteMapSeqLaws M'']
+    (Φ : Nat → V → M) (start : Nat) (l : List V) :
+    bigOpM (op := op) (unit := unit) Φ (FiniteMap.map_seq (M := M'') start l : M'' V) ≡
+    bigOpL op unit (fun i x => Φ (start + i) x) l := by
+  simp only [bigOpM]
+  refine Equiv.trans (BigOpL.perm _ (FiniteMapSeqLaws.toList_map_seq start l)) ?_
+  induction l generalizing start with
+  | nil => simp
+  | cons x xs ih =>
+    simp only [List.mapIdx_cons, BigOpL.cons, Nat.zero_add, Nat.add_zero]
+    have : xs.mapIdx (fun i v => (i + 1 + start, v)) = xs.mapIdx (fun i v => (i + (start + 1), v)) := by
+      congr 1; funext i v; rw [Nat.add_assoc, Nat.add_comm 1 start]
+    rw [this]
+    exact Monoid.op_proper Equiv.rfl (Equiv.trans (ih (start + 1)) (BigOpL.congr' fun i _ => by simp [Nat.add_assoc, Nat.add_comm 1]))
+
+/-- Corresponds to Rocq's `big_opM_sep_zip_with`. -/
+theorem sep_zip_with {A : Type _} {B : Type _} {C : Type _}
+    [DecidableEq A] [DecidableEq B] [DecidableEq C]
+    (f : A → B → C) (g1 : C → A) (g2 : C → B)
+    (h1 : K → A → M) (h2 : K → B → M) (m1 : M' A) (m2 : M' B)
+    (hg1 : ∀ x y, g1 (f x y) = x)
+    (hg2 : ∀ x y, g2 (f x y) = y)
+    (hdom : ∀ k, (FiniteMap.get? m1 k).isSome ↔ (FiniteMap.get? m2 k).isSome) :
+    bigOpM (op := op) (unit := unit) (fun k xy => op (h1 k (g1 xy)) (h2 k (g2 xy)))
+      (FiniteMap.zipWith f m1 m2) ≡
+    op (bigOpM (op := op) (unit := unit) h1 m1) (bigOpM (op := op) (unit := unit) h2 m2) := by
+  have h_op := op_distr (op := op) (unit := unit)
+    (fun k xy => h1 k (g1 xy)) (fun k xy => h2 k (g2 xy)) (FiniteMap.zipWith f m1 m2)
+  apply Equiv.trans h_op
+  apply Monoid.op_proper
+  · have h1_fmap := map (op := op) (unit := unit) g1 h1 (FiniteMap.zipWith f m1 m2)
+    apply Equiv.trans (Equiv.symm h1_fmap)
+    have heq := FiniteMapLaws.map_zipWith_right f g1 m1 m2 hg1 hdom
+    rw [heq]
+  · have h2_fmap := map (op := op) (unit := unit) g2 h2 (FiniteMap.zipWith f m1 m2)
+    apply Equiv.trans (Equiv.symm h2_fmap)
+    have heq := FiniteMapLaws.map_zipWith_left f g2 m1 m2 hg2 hdom
+    rw [heq]
+
+/-- Corresponds to Rocq's `big_opM_sep_zip`. -/
+theorem sep_zip {A : Type _} {B : Type _}
+    [DecidableEq A] [DecidableEq B]
+    (h1 : K → A → M) (h2 : K → B → M) (m1 : M' A) (m2 : M' B)
+    (hdom : ∀ k, (FiniteMap.get? m1 k).isSome ↔ (FiniteMap.get? m2 k).isSome) :
+    bigOpM (op := op) (unit := unit) (fun k xy => op (h1 k xy.1) (h2 k xy.2))
+      (FiniteMap.zip m1 m2) ≡
+    op (bigOpM (op := op) (unit := unit) h1 m1) (bigOpM (op := op) (unit := unit) h2 m2) := by
+  simp only [FiniteMap.zip]
+  exact sep_zip_with (op := op) (unit := unit) Prod.mk Prod.fst Prod.snd h1 h2 m1 m2
+    (fun _ _ => rfl) (fun _ _ => rfl) hdom
+
+end
+
+end
+
+end BigOpM
+
+end Iris.Algebra
diff --git a/src/Iris/Algebra/CMRA.lean b/src/Iris/Algebra/CMRA.lean
index d8c1efbf..5423677a 100644
--- a/src/Iris/Algebra/CMRA.lean
+++ b/src/Iris/Algebra/CMRA.lean
@@ -1,7 +1,7 @@
 /-
 Copyright (c) 2025 Mario Carneiro. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Mario Carneiro, Сухарик (@suhr), Markus de Medeiros
+Authors: Mario Carneiro, Сухарик (@suhr), Markus de Medeiros, Puming Liu
 -/
 import Iris.Algebra.OFE
 
@@ -1365,6 +1365,16 @@ theorem valid_snd {x : α × β} (h : ✓ x) : ✓ x.snd := h.right
 theorem validN_fst {n} {x : α × β} (h : ✓{n} x) : ✓{n} x.fst := h.left
 theorem validN_snd {n} {x : α × β} (h : ✓{n} x) : ✓{n} x.snd := h.right
 
+theorem incN_iff {n} (a a' : α) (b b' : β) :
+    a ≼{n} a' ∧ b ≼{n} b' ↔ (a, b) ≼{n} (a', b') := by
+  constructor <;>simp [CMRA.IncludedN]
+  · rintro x ha y hb
+    exists x, y
+  · rintro x y ⟨ha, hb⟩
+    constructor
+    exists x
+    exists y
+
 instance [CMRA.Discrete α] [CMRA.Discrete β]: CMRA.Discrete (α × β) where
   discrete_valid := by
     rintro ⟨_, _⟩
@@ -1373,6 +1383,72 @@ instance [CMRA.Discrete α] [CMRA.Discrete β]: CMRA.Discrete (α × β) where
 
 end Prod
 
+section ProdOF
+
+variable [OFE A] [OFE A'] [OFE B] [OFE B']
+
+instance (f : A → A') (g : B → B') [NonExpansive f] [NonExpansive g] : NonExpansive (Prod.map f g) where
+  ne := by
+    rintro _ _ _ ⟨_, _⟩
+    constructor <;> simp <;>
+    apply (inferInstance : NonExpansive _).ne <;>
+    assumption
+
+theorem Prod.map_ne (f f' : A → A') (g g' : B → B') [NonExpansive f] [NonExpansive f'] [NonExpansive g] [NonExpansive g'] :
+    (∀ a, f a ≡{n}≡ f' a) → (∀ a, g a ≡{n}≡ g' a) → Prod.map f g x ≡{n}≡ Prod.map f' g' x := by
+  intros
+  cases x
+  constructor <;> simp_all
+
+instance Prod.mapO (f : A -n> A') (g : B -n> B') : A × B -n> A' × B' where
+  f := Prod.map f g
+  ne := inferInstance
+
+abbrev ProdOF (F1 : COFE.OFunctorPre) (F2 : COFE.OFunctorPre) : COFE.OFunctorPre :=
+  fun A B => (F1 A B) × (F2 A B)
+
+instance [OF1: COFE.OFunctor F1] [OF2: COFE.OFunctor F2] : COFE.OFunctor (ProdOF F1 F2) where
+  cofe := inferInstance
+  map f g := Prod.mapO (OF1.map f g) (OF2.map f g)
+  map_ne.ne _ _ _ Hx _ _ Hy _ := by
+    constructor <;> apply COFE.OFunctor.map_ne.ne <;> assumption
+  map_id x := by
+    constructor <;> apply COFE.OFunctor.map_id
+  map_comp f g f' g' x := by
+    constructor <;> apply COFE.OFunctor.map_comp
+
+instance [COFE.OFunctorContractive F1] [COFE.OFunctorContractive F2] : COFE.OFunctorContractive (ProdOF F1 F2) where
+  map_contractive.1 H _ := by
+    apply Prod.map_ne <;> intro <;> apply COFE.OFunctorContractive.map_contractive.1 <;> assumption
+
+end ProdOF
+
+section ProdMorph
+
+variable [CMRA A] [CMRA A'] [CMRA B] [CMRA B']
+
+instance Prod.mapC (f : A -C> A') (g : B -C> B') : A × B -C> A' × B' where
+  f := Prod.map f g
+  ne := inferInstance
+  validN {n x} hval := by
+    simp [CMRA.ValidN, ValidN] at hval ⊢
+    cases hval
+    constructor <;> apply CMRA.Hom.validN <;> assumption
+  pcore x := by
+    simp [Option.map, Prod.map, CMRA.pcore, pcore]
+    have h2 := CMRA.Hom.pcore g x.snd
+    have h1 := CMRA.Hom.pcore f x.fst
+    rcases h : (CMRA.pcore x.fst) with _ | x1
+    · rcases _ : CMRA.pcore (f.f x.fst) <;> simp_all
+    · rcases h' : (CMRA.pcore x.snd) with _ | x2 <;>
+      rcases _ : CMRA.pcore (f.f x.fst) <;>
+      rcases _ : CMRA.pcore (g.f x.snd) <;> simp_all
+      constructor <;> simp_all
+  op x y := by
+    constructor <;> apply CMRA.Hom.op
+
+end ProdMorph
+
 section optionOF
 
 variable (F : COFE.OFunctorPre)
diff --git a/src/Iris/Algebra/CoPset.lean b/src/Iris/Algebra/CoPset.lean
new file mode 100644
index 00000000..9ea38063
--- /dev/null
+++ b/src/Iris/Algebra/CoPset.lean
@@ -0,0 +1,455 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.Algebra.CMRA
+import Iris.Algebra.OFE
+import Iris.Algebra.Updates
+import Iris.Algebra.LocalUpdates
+import Iris.Std.CoPset
+import Iris.Std.GSet
+
+/-! # CoPset and GSet Resource Algebras
+
+Reference: `iris/algebra/coPset.v`, `iris/algebra/gset.v`
+
+Resource algebra (CMRA) instances for invariant mask sets, used by world
+satisfaction to track enabled and disabled invariants.
+
+Three CMRAs are defined:
+
+- **`CoPset` union CMRA** — composition is set union, everything is valid, and every
+  element is its own core. Used where masks combine freely (e.g. `ownI` tokens).
+- **`CoPsetDisj` disjoint union CMRA** — composition requires disjointness and
+  produces `invalid` otherwise. Used for `ownE` (enabled invariant tokens) where
+  double-opening must be prevented: `ownE {[i]} ∗ ownE {[i]}` is invalid.
+- **`GSetDisj` disjoint union CMRA** — same disjointness-enforcing pattern for
+  finite sets. Used for `ownD` (disabled invariant tokens).
+-/
+
+namespace Iris
+
+open OFE CMRA
+
+/-! ## CoPset OFE + Union CMRA -/
+
+instance : OFE CoPset := OFE.ofDiscrete (· = ·) ⟨fun _ => rfl, Eq.symm, Eq.trans⟩
+instance : OFE.Discrete CoPset where discrete_0 := id
+instance : OFE.Leibniz CoPset where eq_of_eqv := id
+
+/-- Union-based CMRA on `CoPset`. Always valid, idempotent core, unit is `∅`. -/
+instance : CMRA CoPset where
+  pcore := some
+  op := (· ∪ ·)
+  ValidN _ _ := True
+  Valid _ := True
+  op_ne.ne _ _ _ h := Dist.of_eq (eq_of_eqv (discrete h) ▸ rfl)
+  pcore_ne {_ y _ _} h := by
+    -- core respects discrete equality
+    rintro ⟨rfl⟩
+    exact ⟨y, congrArg _ (eq_of_eqv (discrete h.symm)), .rfl⟩
+  validN_ne _ _ := .intro
+  valid_iff_validN := .symm <| forall_const Nat
+  validN_succ := (·)
+  validN_op_left := id
+  assoc {x y z} := .of_eq (CoPset.union_assoc x y z).symm
+  comm {x y} := .of_eq (CoPset.union_comm x y)
+  pcore_op_left {_ _} := by
+    -- core of union collapses by idempotence
+    rintro ⟨rfl⟩
+    exact .of_eq (CoPset.union_idem _)
+  pcore_idem := by
+    -- core is identity for union CMRA
+    simp
+  pcore_op_mono {_ _} := by
+    -- monotonicity follows from unit core
+    rintro ⟨rfl⟩ z
+    exact ⟨z, .rfl⟩
+  extend _ h := ⟨_, _, discrete h, .rfl, .rfl⟩
+
+instance : CMRA.Discrete CoPset where discrete_valid := id
+
+instance : UCMRA CoPset where
+  unit := ∅
+  unit_valid := trivial
+  unit_left_id {x} := .of_eq (CoPset.empty_union x)
+  pcore_unit := .symm .rfl
+
+/-- CMRA inclusion coincides with subset for the union-based `CoPset` CMRA. -/
+theorem coPset_included {x y : CoPset} : x ≼ y ↔ x ⊆ y := by
+  -- inclusion matches subset for union-based CMRA
+  constructor
+  · rintro ⟨z, hz⟩; have := eq_of_eqv hz
+    intro n hn; rw [this]; exact Or.inl hn
+  · intro h
+    obtain ⟨z, hz, _⟩ := CoPset.subseteq_disjoint_union h
+    exact ⟨z, .of_eq hz⟩
+
+/-- All frame-preserving updates are valid since `CoPset` validity is trivial. -/
+theorem coPset_update (x y : CoPset) : x ~~> y := by
+  -- all updates are valid since validity is trivial
+  intro _ _ _; trivial
+
+instance (x : CoPset) : CMRA.CoreId x where
+  core_id := by
+    -- core is identity for coPset
+    simp [pcore]
+
+/-! ## CoPset Disjoint Union CMRA -/
+
+/-- Disjoint union wrapper for `CoPset`. Composing overlapping sets yields `invalid`. -/
+inductive CoPsetDisj where
+  | coPset : CoPset → CoPsetDisj
+  | invalid : CoPsetDisj
+
+instance : OFE CoPsetDisj := OFE.ofDiscrete (· = ·) ⟨fun _ => rfl, Eq.symm, Eq.trans⟩
+instance : OFE.Discrete CoPsetDisj where discrete_0 := id
+instance : OFE.Leibniz CoPsetDisj where eq_of_eqv := id
+
+/-- Helper: the disjoint op on CoPsetDisj. -/
+noncomputable def CoPsetDisj.op' : CoPsetDisj → CoPsetDisj → CoPsetDisj
+  | .coPset x, .coPset y =>
+    if CoPset.Disjoint x y then .coPset (x ∪ y) else .invalid
+  | _, _ => .invalid
+
+private theorem CoPsetDisj.assoc_aux (x y z : CoPsetDisj) :
+    op' (op' x y) z = op' x (op' y z) := by
+  -- case split on validity and disjointness
+  cases x <;> cases y <;> cases z <;> simp [op']
+  rename_i x y z
+  by_cases hxy : CoPset.Disjoint x y
+  · by_cases hyz : CoPset.Disjoint y z
+    · -- both disjoint, reduce to associativity of union
+      by_cases hxyz : CoPset.Disjoint (x ∪ y) z
+      · have hxyz' : CoPset.Disjoint x (y ∪ z) :=
+          fun n ⟨hx, hyz'⟩ => hyz'.elim (hxy n ⟨hx, ·⟩) (hxyz n ⟨.inl hx, ·⟩)
+        simp [hxy, hyz, hxyz, hxyz', CoPset.union_assoc]
+      · have hxyz' : ¬CoPset.Disjoint x (y ∪ z) := by
+          -- contradiction from disjointness transfer
+          intro h; exact hxyz fun n ⟨hxy', hz⟩ =>
+            hxy'.elim (fun hx => h n ⟨hx, .inr hz⟩) (hyz n ⟨·, hz⟩)
+        simp [hxy, hyz, hxyz, hxyz']
+    · -- right side is invalid; show left side invalid using subset
+      have hxyz : ¬CoPset.Disjoint (x ∪ y) z := by
+        -- if (x ∪ y) disjoint z, then y disjoint z
+        intro h; apply hyz; intro n hn
+        exact h n ⟨Or.inr hn.1, hn.2⟩
+      simp [hxy, hyz, hxyz]
+  · by_cases hyz : CoPset.Disjoint y z
+    · -- left side invalid; show right side invalid using subset
+      have hxyz : ¬CoPset.Disjoint x (y ∪ z) := by
+        -- if x disjoint (y ∪ z), then x disjoint y
+        intro h; apply hxy; intro n hn
+        exact h n ⟨hn.1, Or.inl hn.2⟩
+      simp [hxy, hyz, hxyz]
+    · -- both sides are invalid
+      simp [hxy, hyz]
+
+private theorem CoPsetDisj.comm_aux (x y : CoPsetDisj) : op' x y = op' y x := by
+  -- symmetry of disjoint union
+  cases x <;> cases y <;> simp [op']
+  rename_i x y
+  by_cases hxy : CoPset.Disjoint x y
+  · simp [hxy, CoPset.disjoint_comm.mp hxy, CoPset.union_comm]
+  · have hyx : ¬CoPset.Disjoint y x := by
+      -- disjointness is symmetric
+      intro h; exact hxy (CoPset.disjoint_comm.mp h)
+    simp [hxy, hyx]
+
+/-- Disjoint union CMRA on `CoPsetDisj`. Valid when the composed sets are disjoint. -/
+noncomputable instance : CMRA CoPsetDisj where
+  pcore _ := some (.coPset ∅)
+  op := CoPsetDisj.op'
+  ValidN _ x := match x with | .coPset _ => True | .invalid => False
+  Valid x := match x with | .coPset _ => True | .invalid => False
+  op_ne.ne _ _ _ h := Dist.of_eq (eq_of_eqv (discrete h) ▸ rfl)
+  pcore_ne _ := by
+    -- core is the unit element
+    rintro ⟨rfl⟩
+    exact ⟨_, rfl, .rfl⟩
+  validN_ne {_ x y} h hv := by
+    -- validity respects discrete equality
+    have := eq_of_eqv (discrete h); subst this; exact hv
+  valid_iff_validN := .symm <| forall_const Nat
+  validN_succ := (·)
+  validN_op_left {x y} h := by
+    -- op validity implies left validity by case analysis
+    cases x <;> cases y <;> simp [CoPsetDisj.op'] at h ⊢
+  assoc {x y z} := .of_eq (CoPsetDisj.assoc_aux x y z).symm
+  comm {x y} := .of_eq (CoPsetDisj.comm_aux x y)
+  pcore_op_left {x _} := by
+    -- unit core acts as left identity
+    rintro ⟨rfl⟩
+    cases x with
+    | coPset x =>
+      -- disjoint union with empty yields the original element
+      exact .of_eq (by
+        -- reduce op' with empty and union identity
+        simp [CoPsetDisj.op', CoPset.disjoint_empty_left, CoPset.empty_union])
+    | invalid =>
+      -- invalid absorbs the operation
+      exact .of_eq (by
+        -- op' with invalid collapses to invalid
+        simp [CoPsetDisj.op'])
+  pcore_idem := by
+    -- idempotence of the core
+    simp
+  pcore_op_mono {_ _} := by
+    -- core monotonicity follows from unit core
+    rintro ⟨rfl⟩ _
+    refine ⟨.coPset ∅, ?_⟩
+    -- compute the core of the op and the op of cores
+    apply Equiv.of_eq
+    simp [CoPsetDisj.op', CoPset.disjoint_empty_left, CoPset.empty_union]
+  extend _ h := ⟨_, _, discrete h, .rfl, .rfl⟩
+
+instance : CMRA.Discrete CoPsetDisj where discrete_valid := id
+
+noncomputable instance : UCMRA CoPsetDisj where
+  unit := .coPset ∅
+  unit_valid := trivial
+  unit_left_id {x} := by
+    -- unit acts as left identity
+    change CoPsetDisj.op' (.coPset ∅) x ≡ x
+    cases x with
+    | coPset x =>
+      -- disjoint union with empty yields the original element
+      exact .of_eq (by
+        -- simplify by disjointness with empty
+        have hdisj : CoPset.Disjoint ∅ x := CoPset.disjoint_empty_left x
+        simp [CoPsetDisj.op', hdisj, CoPset.empty_union])
+    | invalid =>
+      -- invalid absorbs the operation
+      exact .of_eq (by
+        -- op' with invalid collapses to invalid
+        simp [CoPsetDisj.op'])
+  pcore_unit := .symm .rfl
+
+/-! ### CoPsetDisj Key Lemmas -/
+
+/-- Composing disjoint sets produces their union. -/
+theorem coPset_disj_union {x y : CoPset} (h : CoPset.Disjoint x y) :
+    (CoPsetDisj.coPset x : CoPsetDisj) • CoPsetDisj.coPset y = CoPsetDisj.coPset (x ∪ y) := by
+  -- unfold the disjoint op
+  show CoPsetDisj.op' _ _ = _
+  simp [CoPsetDisj.op', h]
+
+/-- A composition of two `CoPsetDisj` values is valid iff the underlying sets are disjoint. -/
+theorem coPset_disj_valid_op {x y : CoPset} :
+    ✓ ((CoPsetDisj.coPset x : CoPsetDisj) • CoPsetDisj.coPset y) ↔ CoPset.Disjoint x y := by
+  -- validity reduces to disjointness by case split
+  change ✓ (CoPsetDisj.op' (CoPsetDisj.coPset x) (CoPsetDisj.coPset y)) ↔ _
+  by_cases h : CoPset.Disjoint x y <;> simp [CoPsetDisj.op', h, CMRA.Valid]
+
+/-- CMRA inclusion coincides with subset for the disjoint `CoPsetDisj` CMRA. -/
+theorem coPset_disj_included {x y : CoPset} :
+    (CoPsetDisj.coPset x : CoPsetDisj) ≼ CoPsetDisj.coPset y ↔ x ⊆ y := by
+  -- inclusion matches subset for disjoint union CMRA
+  constructor
+  · rintro ⟨z, hz⟩
+    have heq := eq_of_eqv hz
+    -- heq : .coPset y = CoPsetDisj.op' (.coPset x) z
+    change CoPsetDisj.coPset y = CoPsetDisj.op' (CoPsetDisj.coPset x) z at heq
+    cases z with
+    | coPset z =>
+      -- reduce the op' equation by disjointness
+      by_cases hd : CoPset.Disjoint x z
+      · simp [CoPsetDisj.op', hd] at heq
+        cases heq
+        intro n hn; exact Or.inl hn
+      · have : False := by
+          -- contradiction: op' becomes invalid
+          simp [CoPsetDisj.op', hd] at heq
+        exact False.elim this
+    | invalid =>
+      -- invalid case contradicts the constructor equation
+      have : False := by
+        -- simplify to impossible constructor equality
+        simp [CoPsetDisj.op'] at heq
+      exact False.elim this
+  · intro h
+    obtain ⟨z, hz, hdisj⟩ := CoPset.subseteq_disjoint_union h
+    exact ⟨.coPset z, .of_eq (by
+      -- rewrite with the disjoint union decomposition
+      rw [hz]; exact (coPset_disj_union hdisj).symm)⟩
+
+/-! ## GSet Disjoint Union CMRA -/
+
+/-- Disjoint union wrapper for `GSet`. Composing overlapping sets yields `invalid`. -/
+inductive GSetDisj where
+  | gset : GSet → GSetDisj
+  | invalid : GSetDisj
+
+instance : OFE GSetDisj := OFE.ofDiscrete (· = ·) ⟨fun _ => rfl, Eq.symm, Eq.trans⟩
+instance : OFE.Discrete GSetDisj where discrete_0 := id
+instance : OFE.Leibniz GSetDisj where eq_of_eqv := id
+
+/-- Helper: the disjoint op on GSetDisj. -/
+noncomputable def GSetDisj.op' : GSetDisj → GSetDisj → GSetDisj
+  | .gset x, .gset y =>
+    if GSet.Disjoint x y then .gset (x ∪ y) else .invalid
+  | _, _ => .invalid
+
+private theorem GSetDisj.assoc_aux (x y z : GSetDisj) :
+    op' (op' x y) z = op' x (op' y z) := by
+  -- case split on disjointness flags
+  cases x <;> cases y <;> cases z <;> simp [op']
+  rename_i x y z
+  by_cases hxy : GSet.Disjoint x y
+  · by_cases hyz : GSet.Disjoint y z
+    · -- both disjoint, reduce to associativity of union
+      by_cases hxyz : GSet.Disjoint (x ∪ y) z
+      · have hxyz' : GSet.Disjoint x (y ∪ z) :=
+          fun n ⟨hx, hyz'⟩ => hyz'.elim (hxy n ⟨hx, ·⟩) (hxyz n ⟨.inl hx, ·⟩)
+        simp [hxy, hyz, hxyz, hxyz', GSet.union_assoc]
+      · have hxyz' : ¬GSet.Disjoint x (y ∪ z) := by
+          -- contradiction from disjointness transfer
+          intro h; exact hxyz fun n ⟨hxy', hz⟩ =>
+            hxy'.elim (fun hx => h n ⟨hx, .inr hz⟩) (hyz n ⟨·, hz⟩)
+        simp [hxy, hyz, hxyz, hxyz']
+    · -- right side is invalid; show left side invalid using subset
+      have hxyz : ¬GSet.Disjoint (x ∪ y) z := by
+        -- if (x ∪ y) disjoint z, then y disjoint z
+        intro h; apply hyz; intro n hn
+        exact h n ⟨Or.inr hn.1, hn.2⟩
+      simp [hxy, hyz, hxyz]
+  · by_cases hyz : GSet.Disjoint y z
+    · -- left side invalid; show right side invalid using subset
+      have hxyz : ¬GSet.Disjoint x (y ∪ z) := by
+        -- if x disjoint (y ∪ z), then x disjoint y
+        intro h; apply hxy; intro n hn
+        exact h n ⟨hn.1, Or.inl hn.2⟩
+      simp [hxy, hyz, hxyz]
+    · -- both sides are invalid
+      simp [hxy, hyz]
+
+private theorem GSetDisj.comm_aux (x y : GSetDisj) : op' x y = op' y x := by
+  -- symmetry of disjoint union on GSet
+  cases x <;> cases y <;> simp [op']
+  rename_i x y
+  by_cases hxy : GSet.Disjoint x y
+  · simp [hxy, GSet.disjoint_comm.mp hxy, GSet.union_comm]
+  · have hyx : ¬GSet.Disjoint y x := by
+      -- disjointness is symmetric
+      intro h; exact hxy (GSet.disjoint_comm.mp h)
+    simp [hxy, hyx]
+
+/-- Disjoint union CMRA on `GSetDisj`. Valid when the composed sets are disjoint. -/
+noncomputable instance : CMRA GSetDisj where
+  pcore _ := some (.gset ∅)
+  op := GSetDisj.op'
+  ValidN _ x := match x with | .gset _ => True | .invalid => False
+  Valid x := match x with | .gset _ => True | .invalid => False
+  op_ne.ne _ _ _ h := Dist.of_eq (eq_of_eqv (discrete h) ▸ rfl)
+  pcore_ne _ := by
+    -- core is the unit element
+    rintro ⟨rfl⟩
+    exact ⟨_, rfl, .rfl⟩
+  validN_ne {_ x y} h hv := by
+    -- validity respects discrete equality
+    have := eq_of_eqv (discrete h); subst this; exact hv
+  valid_iff_validN := .symm <| forall_const Nat
+  validN_succ := (·)
+  validN_op_left {x y} h := by
+    -- op validity implies left validity by case analysis
+    cases x <;> cases y <;> simp [GSetDisj.op'] at h ⊢
+  assoc {x y z} := .of_eq (GSetDisj.assoc_aux x y z).symm
+  comm {x y} := .of_eq (GSetDisj.comm_aux x y)
+  pcore_op_left {x _} := by
+    -- unit core acts as left identity
+    rintro ⟨rfl⟩
+    cases x with
+    | gset x =>
+      -- disjoint union with empty yields the original element
+      exact .of_eq (by
+        -- reduce op' with empty and union identity
+        simp [GSetDisj.op', GSet.disjoint_empty_left, GSet.empty_union])
+    | invalid =>
+      -- invalid absorbs the operation
+      exact .of_eq (by
+        -- op' with invalid collapses to invalid
+        simp [GSetDisj.op'])
+  pcore_idem := by
+    -- idempotence of the core
+    simp
+  pcore_op_mono {_ _} := by
+    -- core monotonicity follows from unit core
+    rintro ⟨rfl⟩ _
+    refine ⟨.gset ∅, ?_⟩
+    -- compute the core of the op and the op of cores
+    apply Equiv.of_eq
+    simp [GSetDisj.op', GSet.disjoint_empty_left, GSet.empty_union]
+  extend _ h := ⟨_, _, discrete h, .rfl, .rfl⟩
+
+instance : CMRA.Discrete GSetDisj where discrete_valid := id
+
+noncomputable instance : UCMRA GSetDisj where
+  unit := .gset ∅
+  unit_valid := trivial
+  unit_left_id {x} := by
+    -- unit acts as left identity
+    change GSetDisj.op' (.gset ∅) x ≡ x
+    cases x with
+    | gset x =>
+      -- disjoint union with empty yields the original element
+      exact .of_eq (by
+        -- simplify by disjointness with empty
+        have hdisj : GSet.Disjoint ∅ x := GSet.disjoint_empty_left x
+        simp [GSetDisj.op', hdisj, GSet.empty_union])
+    | invalid =>
+      -- invalid absorbs the operation
+      exact .of_eq (by
+        -- op' with invalid collapses to invalid
+        simp [GSetDisj.op'])
+  pcore_unit := .symm .rfl
+
+/-! ### GSetDisj Key Lemmas -/
+
+/-- Composing disjoint sets produces their union. -/
+theorem gset_disj_union {x y : GSet} (h : GSet.Disjoint x y) :
+    (GSetDisj.gset x : GSetDisj) • GSetDisj.gset y = GSetDisj.gset (x ∪ y) := by
+  -- unfold the disjoint op
+  show GSetDisj.op' _ _ = _
+  simp [GSetDisj.op', h]
+
+/-- A composition of two `GSetDisj` values is valid iff the underlying sets are disjoint. -/
+theorem gset_disj_valid_op {x y : GSet} :
+    ✓ ((GSetDisj.gset x : GSetDisj) • GSetDisj.gset y) ↔ GSet.Disjoint x y := by
+  -- validity reduces to disjointness by case split
+  change ✓ (GSetDisj.op' (GSetDisj.gset x) (GSetDisj.gset y)) ↔ _
+  by_cases h : GSet.Disjoint x y <;> simp [GSetDisj.op', h, CMRA.Valid]
+
+/-- CMRA inclusion coincides with subset for the disjoint `GSetDisj` CMRA. -/
+theorem gset_disj_included {x y : GSet} :
+    (GSetDisj.gset x : GSetDisj) ≼ GSetDisj.gset y ↔ x ⊆ y := by
+  -- inclusion matches subset for disjoint union CMRA
+  constructor
+  · rintro ⟨z, hz⟩
+    have heq := eq_of_eqv hz
+    -- rewrite the op in the equality to the disjoint op'
+    change GSetDisj.gset y = GSetDisj.op' (GSetDisj.gset x) z at heq
+    cases z with
+    | gset z =>
+      -- reduce the op' equation by disjointness
+      by_cases hd : GSet.Disjoint x z
+      · simp [GSetDisj.op', hd] at heq
+        cases heq
+        intro n hn; exact Or.inl hn
+      · have : False := by
+          -- contradiction: op' becomes invalid
+          simp [GSetDisj.op', hd] at heq
+        exact False.elim this
+    | invalid =>
+      -- invalid case contradicts the constructor equation
+      have : False := by
+        -- simplify to impossible constructor equality
+        simp [GSetDisj.op'] at heq
+      exact False.elim this
+  · intro h
+    obtain ⟨z, hz, hdisj⟩ := GSet.subseteq_disjoint_union h
+    exact ⟨.gset z, .of_eq (by
+      -- rewrite with the disjoint union decomposition
+      rw [hz]; exact (gset_disj_union hdisj).symm)⟩
+
+end Iris
diff --git a/src/Iris/Algebra/Heap.lean b/src/Iris/Algebra/Heap.lean
index c081105a..e989e5df 100644
--- a/src/Iris/Algebra/Heap.lean
+++ b/src/Iris/Algebra/Heap.lean
@@ -1,7 +1,7 @@
 /-
 Copyright (c) 2025 Markus de Medeiros. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Markus de Medeiros
+Authors: Markus de Medeiros, Puming Liu
 -/
 
 import Iris.Algebra.CMRA
@@ -462,3 +462,124 @@ nonrec instance [HD : CMRA.Discrete V] [Heap T K V] : Discrete T where
   discrete_valid {_} := (CMRA.Discrete.discrete_valid <| · ·)
 
 end Heap
+
+section HeapFunctor
+
+variable {K} (H : Type _ → Type _) [∀ V, Heap (H V) K V] [∀ α β, HasHeapMap (H α) (H β) K α β]
+
+section HeapMap
+
+def Heap.map' [OFE α] [OFE β] (f : α → β) : H α → H β:= HasHeapMap.hhmap (fun _ a => some (f a))
+
+local instance [OFE α] [OFE β] {f : α → β} [hne : OFE.NonExpansive f] : OFE.NonExpansive (Heap.map' H f) where
+  ne := by
+    simp only [OFE.Dist, Option.Forall₂, Heap.map', hhmap_get]
+    intro n m1 m2
+    apply forall_imp
+    intro k
+    cases Store.get m1 k <;> cases Store.get m2 k <;> simp
+    apply OFE.NonExpansive.ne
+
+def Heap.mapO [OFE α] [OFE β] (f : α -n> β) : OFE.Hom (H α) (H β) where
+  f := Heap.map' H f
+  ne := inferInstance
+
+def Heap.map_ne [OFE α] [OFE β] (f g : α -n> β) (heq: f ≡{n}≡ g) :
+    Heap.mapO H f ≡{n}≡ Heap.mapO H g := by
+  simp [OFE.Dist, mapO, Option.Forall₂, map', hhmap_get]
+  intro m k
+  cases Store.get m k <;> simp
+  expose_names; exact heq val
+
+def Heap.map_compose [OFE α] [OFE β] [OFE γ] (f : α -n> β) (g : β -n> γ) m :
+    Heap.mapO H (g.comp f) m ≡ Heap.mapO H g (Heap.mapO H f m) := by
+  intro k
+  simp [mapO, map', hhmap_get]
+  cases Store.get m k <;> simp
+
+def Heap.mapC [CMRA α] [CMRA β] (f : α -C> β) : CMRA.Hom (H α) (H β) where
+  f := Heap.map' H f
+  ne := inferInstance
+  validN {n x} := by
+    simp only [map', CMRA.ValidN, Store.validN, optionValidN]
+    apply forall_imp
+    intro k
+    rw [hhmap_get]
+    cases (Store.get x k) <;> simp
+    apply CMRA.Hom.validN
+  pcore m := by
+    -- Reduce the core law to pointwise heaps and apply the CMRA core law on values.
+    intro k
+    simp [Heap.map', hhmap_get, get_hmap]
+    cases h : Store.get m k with
+    | none => simp
+    | some v =>
+        simp
+        cases hpcore : CMRA.pcore v <;>
+          simpa [Option.map, Option.bind, hpcore] using (CMRA.Hom.pcore f v)
+  op m1 m2 := by
+    -- Preserve the heap op by a key-wise case split and CMRA hom op.
+    intro k
+    simp [Heap.map', hhmap_get, get_merge, CMRA.op]
+    cases h1 : Store.get m1 k with
+    | none =>
+        cases h2 : Store.get m2 k <;> simp
+    | some v1 =>
+        cases h2 : Store.get m2 k with
+        | none => simp
+        | some v2 =>
+            simp
+            simpa using (CMRA.Hom.op f v1 v2)
+
+end HeapMap
+
+abbrev HeapOF (F : COFE.OFunctorPre) : COFE.OFunctorPre :=
+  fun A B _ _ => H (F A B)
+
+instance {F} [COFE.OFunctor F] : COFE.OFunctor (HeapOF H F) where
+  cofe := inferInstance
+  map f g := Heap.mapO H (COFE.OFunctor.map f g)
+  map_ne := by
+    intros
+    constructor
+    intros
+    apply Heap.map_ne
+    apply COFE.OFunctor.map_ne.ne <;> simp_all
+  map_comp f g f' g' x := by
+    -- Pointwise reasoning: reduce to the underlying functor map_comp.
+    intro k
+    simp [Heap.mapO, Heap.map', hhmap_get]
+    cases h : Store.get x k <;> simp [COFE.OFunctor.map_comp]
+  map_id x := by
+    -- Pointwise reasoning: reduce to the underlying functor map_id.
+    intro k
+    simp [Heap.mapO, Heap.map', hhmap_get]
+    cases h : Store.get x k <;> simp [COFE.OFunctor.map_id]
+
+instance {F} [RFunctor F] : URFunctor (HeapOF H F) where
+  map f g := Heap.mapC H (RFunctor.map f g)
+  map_ne := by
+    -- Non-expansiveness follows from the underlying functor map_ne.
+    intros
+    constructor
+    intros
+    apply Heap.map_ne
+    apply RFunctor.map_ne.ne <;> simp_all
+  map_comp f g f' g' x := by
+    -- Pointwise reasoning: reduce to the underlying functor map_comp.
+    intro k
+    simp [Heap.mapC, Heap.map', hhmap_get]
+    cases h : Store.get x k <;> simp [RFunctor.map_comp]
+  map_id x := by
+    -- Pointwise reasoning: reduce to the underlying functor map_id.
+    intro k
+    simp [Heap.mapC, Heap.map', hhmap_get]
+    cases h : Store.get x k <;> simp [RFunctor.map_id]
+
+instance {F} [RFunctorContractive F] : URFunctorContractive (HeapOF H F) where
+  map_contractive.1 H m := by
+    -- Contractiveness lifts through heap mapping.
+    apply Heap.map_ne _ _
+    apply (RFunctorContractive.map_contractive.1 H)
+
+end HeapFunctor
diff --git a/src/Iris/Algebra/HeapView.lean b/src/Iris/Algebra/HeapView.lean
index ade9d024..147c4ce8 100644
--- a/src/Iris/Algebra/HeapView.lean
+++ b/src/Iris/Algebra/HeapView.lean
@@ -1,7 +1,7 @@
 /-
 Copyright (c) 2025 Markus de Medeiros. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Markus de Medeiros
+Authors: Markus de Medeiros, Puming Liu
 -/
 import Iris.Algebra.Heap
 import Iris.Algebra.View
@@ -467,6 +467,122 @@ theorem update_frag_acquire [IsSplitFraction F] :
 
 end heapUpdates
 
--- TODO: Port functors
+section heapViewFunctor
+
+variable [∀ α β, HasHeapMap (H α) (H β) K α β]
+
+theorem heapR_map_eq [OFE A] [OFE B] [OFE A'] [OFE B'] [RFunctor T] (f : A' -n> A) (g : B -n> B') (n : Nat) (m : H (T A B)) (mv : H (DFrac F × T A B)) :
+    HeapR F K (T A B) H n m mv →
+    HeapR F K (T A' B') H n ((Heap.mapO H (RFunctor.map f g).toHom).f m) ((Heap.mapC H (Prod.mapC (CMRA.Hom.id (α := DFrac F)) (RFunctor.map (F:=T) f g))).f mv) := by
+  simp [HeapR, Heap.mapC, Heap.mapO, Heap.map', CMRA.Hom.id, OFE.Hom.id, Prod.mapC, hhmap_get]
+  intros hr k a b
+  rcases h : Store.get mv k with _ | ⟨a,b⟩ <;> simp
+  rintro rfl rfl
+  obtain ⟨v, hq, ⟨fr, ⟨hv1, hv2⟩, ho⟩⟩ := hr k a b h
+  exists (RFunctor.map f g).f v
+  constructor
+  simp [hq]
+  exists fr
+  constructor
+  · constructor <;> simp_all
+    exact (Hom.validN _ hv2)
+  · rw [Option.incN_iff] at ho ⊢
+    rcases ho with _ | he <;> simp_all
+    rcases he with ⟨he1, he2⟩ | he
+    · left
+      constructor <;> simp_all
+      exact (NonExpansive.ne he2)
+    · right
+      rw [<-Prod.incN_iff] at *
+      rcases he with ⟨_ , he⟩
+      constructor
+      simp_all
+      apply (Hom.monoN _ _ he)
+
+abbrev HeapViewURF T [RFunctor T] : COFE.OFunctorPre :=
+  fun A B _ _ => HeapView F K (T A B) H
+
+instance {T} [RFunctor T] : URFunctor (HeapViewURF (F := F) (H := H) T) where
+  map {A A'} {B B'} _ _ _ _ f g := View.mapC (Heap.mapO H (RFunctor.map (F:=T) f g).toHom) (Heap.mapC H (Prod.mapC Hom.id (RFunctor.map (F:=T) f g))) (heapR_map_eq f g)
+  map_ne.ne a b c Hx d e Hy mv := by
+    simp [View.mapC]
+    apply View.map_ne
+    · intro
+      apply Heap.map_ne
+      apply RFunctor.map_ne.ne <;> simp_all
+    · intro m
+      apply Heap.map_ne
+      intro a
+      apply Prod.map_ne
+      simp
+      apply RFunctor.map_ne.ne <;> simp_all
+  map_id x := by
+    -- Reduce to View.map and show both components are the identity.
+    simp only [View.mapC]
+    conv => rhs; rw [← View.map_id (R := HeapR F K (T _ _) H) x]
+    apply View.map_ext
+    · intro m
+      -- Auth part: heap map over id is identity.
+      intro k
+      simp [Heap.mapO, Heap.map', hhmap_get]
+      cases h : Store.get m k <;> simp [RFunctor.map_id]
+    · intro m
+      -- Frag part: heap map over Prod.mapC id is identity.
+      intro k
+      simp [Heap.mapC, Heap.map', hhmap_get, Prod.mapC, Prod.map]
+      cases h : Store.get m k with
+      | none => simp
+      | some v =>
+          cases v with
+          | mk dq v =>
+              constructor
+              · rfl
+              · simpa using (RFunctor.map_id (F := T) (x := v))
+  map_comp f g f' g' x := by
+    -- Reduce to View.map and compare component maps via map_comp.
+    simp only [View.mapC]
+    haveI :
+        OFE.NonExpansive
+          ((Heap.mapO H (RFunctor.map (F := T) g g').toHom).f ∘
+            (Heap.mapO H (RFunctor.map (F := T) f f').toHom).f) :=
+      (OFE.Hom.comp
+        (Heap.mapO H (RFunctor.map (F := T) g g').toHom)
+        (Heap.mapO H (RFunctor.map (F := T) f f').toHom)) |>.ne
+    conv => rhs; rw [← View.map_compose (R' := HeapR F K (T _ _) H)]
+    apply View.map_ext
+    · intro m
+      -- Auth part: heap map composition follows RFunctor.map_comp.
+      intro k
+      simp [Heap.mapO, Heap.map', hhmap_get]
+      cases h : Store.get m k <;> simp [RFunctor.map_comp]
+    · intro m
+      -- Frag part: heap map composition follows RFunctor.map_comp.
+      intro k
+      simp [Heap.mapC, Heap.map', hhmap_get, Prod.mapC, Prod.map]
+      cases h : Store.get m k with
+      | none => simp
+      | some v =>
+          cases v with
+          | mk dq v =>
+              constructor
+              · rfl
+              · simpa using (RFunctor.map_comp (F := T) f g f' g' (x := v))
+
+instance {T} [RFunctorContractive T] : URFunctorContractive (HeapViewURF (F := F) (H := H) T) where
+  map_contractive.1 H _ := by
+    -- Contractiveness lifts through View.map and heap mapping.
+    simp
+    apply View.map_ne
+    · intro m
+      apply Heap.map_ne
+      exact (RFunctorContractive.map_contractive.1 H)
+    · intro m
+      apply Heap.map_ne
+      intro a
+      apply Prod.map_ne
+      · intro _; simp
+      · intro v; exact (RFunctorContractive.map_contractive.1 H) v
+
+end heapViewFunctor
 
 end HeapView
diff --git a/src/Iris/Algebra/Monoid.lean b/src/Iris/Algebra/Monoid.lean
new file mode 100644
index 00000000..03fe3007
--- /dev/null
+++ b/src/Iris/Algebra/Monoid.lean
@@ -0,0 +1,109 @@
+/-
+Copyright (c) 2026 Zongyuan Liu. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Zongyuan Liu
+-/
+import Iris.Algebra.OFE
+
+namespace Iris.Algebra
+
+/-! # Monoids for Big Operators
+
+- `Monoid` contains the laws and requires an OFE structure
+- Use explicit `op` and `unit` parameters to support multiple monoids on the same type
+-/
+
+open OFE
+
+/-- A commutative monoid on an OFE, used for big operators.
+The operation must be non-expansive, associative, commutative, and have a left identity. -/
+class Monoid (M : Type u) [OFE M] (op : M → M → M) (unit : outParam M) where
+  /-- The operation is non-expansive in both arguments -/
+  op_ne : NonExpansive₂ op
+  /-- Associativity up to equivalence -/
+  op_assoc : ∀ a b c : M, op (op a b) c ≡ op a (op b c)
+  /-- Commutativity up to equivalence -/
+  op_comm : ∀ a b : M, op a b ≡ op b a
+  /-- Left identity up to equivalence -/
+  op_left_id : ∀ a : M, op unit a ≡ a
+
+namespace Monoid
+
+attribute [simp] op_left_id
+
+variable {M : Type u} [OFE M] {op : M → M → M}
+
+/-- The operation is proper with respect to equivalence. -/
+theorem op_proper {unit : M} [Monoid M op unit] {a a' b b' : M}
+    (ha : a ≡ a') (hb : b ≡ b') : op a b ≡ op a' b' := by
+  haveI : NonExpansive₂ op := op_ne
+  exact NonExpansive₂.eqv ha hb
+
+/-- Right identity follows from commutativity and left identity. -/
+@[simp] theorem op_right_id {unit : M} [Monoid M op unit] (a : M) : op a unit ≡ a :=
+  Equiv.trans (op_comm (unit := unit) a unit) (op_left_id a)
+
+/-- Congruence on the left argument. -/
+theorem op_congr_l {unit : M} [Monoid M op unit] {a a' b : M} (h : a ≡ a') : op a b ≡ op a' b :=
+  op_proper (unit := unit) h Equiv.rfl
+
+/-- Congruence on the right argument. -/
+theorem op_congr_r {unit : M} [Monoid M op unit] {a b b' : M} (h : b ≡ b') : op a b ≡ op a b' :=
+  op_proper (unit := unit) Equiv.rfl h
+
+/-- Rearrange `(a * b) * (c * d)` to `(a * c) * (b * d)`. -/
+theorem op_op_swap {unit : M} [Monoid M op unit] {a b c d : M} :
+    op (op a b) (op c d) ≡ op (op a c) (op b d) :=
+  calc op (op a b) (op c d)
+      _ ≡ op a (op b (op c d)) := op_assoc a b (op c d)
+      _ ≡ op a (op (op b c) d) := op_congr_r (Equiv.symm (op_assoc b c d))
+      _ ≡ op a (op (op c b) d) := op_congr_r (op_congr_l (op_comm b c))
+      _ ≡ op a (op c (op b d)) := op_congr_r (op_assoc c b d)
+      _ ≡ op (op a c) (op b d) := Equiv.symm (op_assoc a c (op b d))
+
+/-- Swap inner elements: `a * (b * c)` to `b * (a * c)`. -/
+theorem op_swap_inner {unit : M} [Monoid M op unit] {a b c : M} :
+    op a (op b c) ≡ op b (op a c) :=
+  calc op a (op b c)
+      _ ≡ op (op a b) c := Equiv.symm (op_assoc a b c)
+      _ ≡ op (op b a) c := op_congr_l (op_comm a b)
+      _ ≡ op b (op a c) := op_assoc b a c
+
+/-- Non-expansiveness for dist. -/
+theorem op_ne_dist {unit : M} [Monoid M op unit] {n : Nat} {a a' b b' : M}
+    (ha : a ≡{n}≡ a') (hb : b ≡{n}≡ b') : op a b ≡{n}≡ op a' b' := by
+  haveI : NonExpansive₂ op := op_ne
+  exact NonExpansive₂.ne ha hb
+
+end Monoid
+
+/-! ## Monoid Homomorphisms -/
+
+/-- A weak monoid homomorphism preserves the operation but not necessarily the unit. -/
+class WeakMonoidHomomorphism {M₁ : Type u} {M₂ : Type v} [OFE M₁] [OFE M₂]
+    (op₁ : M₁ → M₁ → M₁) (op₂ : M₂ → M₂ → M₂) (unit₁ : M₁) (unit₂ : M₂)
+    [Monoid M₁ op₁ unit₁] [Monoid M₂ op₂ unit₂]
+    (R : M₂ → M₂ → Prop) (f : M₁ → M₂) where
+  /-- The relation is reflexive -/
+  rel_refl : ∀ a : M₂, R a a
+  /-- The relation is transitive -/
+  rel_trans : ∀ {a b c : M₂}, R a b → R b c → R a c
+  /-- The relation is proper with respect to equivalence -/
+  rel_proper : ∀ {a a' b b' : M₂}, a ≡ a' → b ≡ b' → (R a b ↔ R a' b')
+  /-- The operation is proper with respect to R -/
+  op_proper : ∀ {a a' b b' : M₂}, R a a' → R b b' → R (op₂ a b) (op₂ a' b')
+  /-- The function is non-expansive -/
+  f_ne : NonExpansive f
+  /-- The homomorphism property -/
+  homomorphism : ∀ x y, R (f (op₁ x y)) (op₂ (f x) (f y))
+
+/-- A monoid homomorphism preserves both the operation and the unit. -/
+class MonoidHomomorphism {M₁ : Type u} {M₂ : Type v} [OFE M₁] [OFE M₂]
+    (op₁ : M₁ → M₁ → M₁) (op₂ : M₂ → M₂ → M₂) (unit₁ : M₁) (unit₂ : M₂)
+    [Monoid M₁ op₁ unit₁] [Monoid M₂ op₂ unit₂]
+    (R : M₂ → M₂ → Prop) (f : M₁ → M₂)
+    extends WeakMonoidHomomorphism op₁ op₂ unit₁ unit₂ R f where
+  /-- The unit is preserved -/
+  map_unit : R (f unit₁) unit₂
+
+end Iris.Algebra
diff --git a/src/Iris/Algebra/View.lean b/src/Iris/Algebra/View.lean
index 5ad7cf60..30110135 100644
--- a/src/Iris/Algebra/View.lean
+++ b/src/Iris/Algebra/View.lean
@@ -1,7 +1,7 @@
 /-
 Copyright (c) 2025 Markus de Medeiros. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Markus de Medeiros
+Authors: Markus de Medeiros, Puming Liu
 -/
 import Iris.Algebra.CMRA
 import Iris.Algebra.OFE
@@ -641,7 +641,120 @@ theorem auth_alloc (Hup : ∀ n bf, R n a bf → R n a (b • bf)) :
     refine CMRA.op_ne.ne ?_
     exact (CMRA.unit_left_id_dist _)
 
--- TODO: Local update lemma
+theorem view_local_update {a a' : A} {b0 b1 b0' b1' : B}
+    (Hup : (b0, b1) ~l~> (b0', b1'))
+    (Hrel : ∀ n, R n a b0 → R n a' b0') :
+    ((●V a : View F R) • ◯V b0, (●V a) • ◯V b1) ~l~>
+    ((●V a') • ◯V b0', (●V a') • ◯V b1') := by
+  rw [local_update_unital]
+  intro n ⟨ag, bf⟩ Hv Heq
+  rw [auth_one_op_frag_validN_iff] at Hv
+  obtain (_|⟨dq, ag'⟩) := ag
+  · have Hb0_eq : b0 ≡{n}≡ b1 • bf := by
+      calc b0 ≡{n}≡ unit • b0 := (unit_left_id_dist b0).symm
+           _ ≡{n}≡ (unit • b1) • bf := Heq.2
+           _ ≡{n}≡ b1 • bf := (unit_left_id_dist b1).op_l
+    have Hvb0 : ✓{n} b0 := IsViewRel.rel_validN n a b0 Hv
+    have ⟨_, Hb0'⟩ := local_update_unital.mp Hup n bf Hvb0 Hb0_eq
+    constructor
+    · rw [auth_one_op_frag_validN_iff]
+      exact Hrel n Hv
+    · refine ⟨.rfl, ?_⟩
+      calc (unit • b0') ≡{n}≡ b0' := unit_left_id_dist b0'
+           _ ≡{n}≡ b1' • bf := Hb0'
+           _ ≡{n}≡ (unit • b1') • bf := (unit_left_id_dist b1').symm.op_l
+  · have Hvalid_frame : ✓{n} ((((●V a) • ◯V b1 : View F R)) • mk (some (dq, ag')) bf) :=
+      validN_ne Heq (auth_one_op_frag_validN_iff.mpr Hv)
+    exact ((UFraction.one_whole (α := F)).2 (DFrac.valid_own_op Hvalid_frame.1)).elim
 
 end Updates
+
+section ViewMap
+
+def map  {R : ViewRel A B} (R' : ViewRel A' B') (f : A → A') (g : B → B') (v : View F R) : View F R' where
+  auth := match v.auth with
+    | none => none
+    | some (fr, a) => (fr, a.map' f)
+  frag := g v.frag
+
+theorem map_id {R : ViewRel A B} (v : View F R) :
+    View.map R id id v = v := by
+  simp [View.map, Agree.map']
+  rcases v with ⟨a, b⟩
+  cases a <;> simp
+
+theorem map_compose {R : ViewRel A B} {R' : ViewRel A' B'} {R'' : ViewRel A'' B''} f g (f' : A' → A'') (g' : B' → B'') (v : View F R) :
+    View.map R'' (f' ∘ f) (g' ∘ g) v = View.map R'' f' g' (View.map R' f g v) := by
+  simp [View.map, Agree.map']
+  rcases v with ⟨a, b⟩
+  cases a <;> simp
+
+theorem map_ext [OFE A] [OFE B] [OFE A'] [OFE B'] {R : ViewRel A B} {R' : ViewRel A' B'} (f1 f2 : A → A') (g1 g2 : B → B') [OFE.NonExpansive f1] [OFE.NonExpansive f2] (v : View F R) :
+    (∀ a, f1 a ≡ f2 a) → (∀ b, g1 b ≡ g2 b) →
+    View.map R' f1 g1 v ≡ View.map R' f2 g2 v := by
+  intro h1 h2
+  simp [View.map]
+  constructor <;> simp only
+  · split <;> constructor <;> simp
+    apply Agree.agree_map_ext h1
+  · apply h2
+
+theorem map_ne [OFE A] [OFE B] [OFE A'] [OFE B'] {R : ViewRel A B} {R' : ViewRel A' B'} (f1 f2 : A → A') (g1 g2 : B → B') [OFE.NonExpansive f1] [OFE.NonExpansive f2] (v : View F R) :
+    (∀ a, f1 a ≡{n}≡ f2 a) → (∀ b, g1 b ≡{n}≡ g2 b) →
+    View.map R' f1 g1 v ≡{n}≡ View.map R' f2 g2 v := by
+  intro h1 h2
+  simp [View.map]
+  constructor <;> simp only
+  · split <;> constructor <;> simp
+    apply Agree.map_ne h1
+  · apply h2
+
+instance [OFE A] [OFE B] [OFE A'] [OFE B'] {R : ViewRel A B} {R' : ViewRel A' B'} (f : A → A') (g : B → B') [OFE.NonExpansive f] [hne : OFE.NonExpansive g] : OFE.NonExpansive (View.map R' f g : (View F R → _)) where
+  ne := by
+    rintro n ⟨a1, b1⟩ ⟨a2, b2⟩ ⟨h1, h2⟩
+    constructor <;> simp [map]
+    · split <;> split <;> simp_all
+      cases h1
+      constructor <;> simp_all
+      apply (Agree.map f).ne.ne
+      simp_all only
+    · apply hne.ne
+      simp_all only [instCOFEDFrac]
+
+instance mapO [OFE A] [OFE B] [OFE A'] [OFE B'] (R : ViewRel A B) (R' : ViewRel A' B') (f : A -n> A') (g : B -n> B') : View F R -n> View F R' where
+  f := View.map R' f g
+  ne := inferInstance
+
+instance mapC [UFraction F] [OFE A] [UCMRA B] [OFE A'] [UCMRA B'] {R : ViewRel A B} [IsViewRel R] {R' : ViewRel A' B'} [IsViewRel R'] (f : A -n> A') (g : B -C> B') (H : ∀ n a b, R n a b → R' n (f a) (g b)) : View F R -C> View F R' where
+  f := View.map R' f g
+  ne := inferInstance
+  validN {n x} hval := by
+    simp [CMRA.ValidN, map] at *
+    rcases x with ⟨_ | ⟨fr,a⟩, b⟩ <;> simp_all
+    · obtain ⟨a, hr⟩ := hval
+      exists f a
+      exact (H n a b hr)
+    · rcases hval with ⟨hfr, a1, ha, hr⟩
+      exists f a1
+      constructor <;> try exact (H n a1 b hr)
+      apply (OFE.Dist.trans (OFE.NonExpansive.ne ha))
+      simp [toAgree, Agree.map']
+  pcore x := by
+    simp [CMRA.pcore, map, CMRA.core, Option.getD]
+    constructor
+    · rcases x.auth with _|⟨fr, a⟩ <;> simp [Prod.pcore]
+      rcases (CMRA.pcore fr) <;> simp
+      rcases h : (CMRA.pcore a) <;> cases h <;> simp [CMRA.pcore]
+    · have _ := CMRA.Hom.pcore g x.frag
+      rcases _ : (CMRA.pcore x.frag) <;>
+      rcases _ : (CMRA.pcore (g.f x.frag)) <;> simp_all
+  op x y := by
+    simp [CMRA.op, map]
+    constructor <;> simp [CMRA.Hom.op]
+    rcases x.auth <;> rcases y.auth <;> simp [Prod.op]
+    constructor <;> simp
+    apply (Agree.map _).op
+
+end ViewMap
+
 end View
diff --git a/src/Iris/BI.lean b/src/Iris/BI.lean
index 3bea992c..7af46a4d 100644
--- a/src/Iris/BI.lean
+++ b/src/Iris/BI.lean
@@ -6,3 +6,4 @@ import Iris.BI.Instances
 import Iris.BI.BI
 import Iris.BI.Notation
 import Iris.BI.Updates
+import Iris.BI.BigOp
diff --git a/src/Iris/BI/BigOp.lean b/src/Iris/BI/BigOp.lean
new file mode 100644
index 00000000..b16b81aa
--- /dev/null
+++ b/src/Iris/BI/BigOp.lean
@@ -0,0 +1,327 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.BI.BI
+import Iris.BI.DerivedLaws
+import Iris.BI.DerivedLawsLater
+import Iris.Algebra.BigOp
+import Iris.Std.FiniteMap
+
+/-! # BI-Level Big Operators
+
+Reference: `iris/bi/big_op.v`
+
+Iterated separating conjunction over lists and finite maps, specialized from the
+algebra-level `bigOpL` and `bigOpM` to the BI separation connective `∗` with
+unit `emp`.
+
+The list version `big_sepL Φ l` computes:
+
+    Φ 0 x₀ ∗ Φ 1 x₁ ∗ ⋯ ∗ Φ (n-1) xₙ₋₁
+
+The map version `big_sepM Φ m` computes the same over the key-value pairs of `m`,
+in the order given by `toList`. Since `∗` is commutative and associative, the
+result is independent of enumeration order (up to `⊣⊢`).
+
+These are the main iteration primitives used throughout the Iris base logic:
+- `wsat` uses `[∗ map]` to assert that every registered invariant is either
+  open or closed
+- Proof mode tactics decompose `[∗ list]` and `[∗ map]` goals via
+  `big_sepM_insert`, `big_sepM_delete`, etc.
+
+## Main Definitions
+
+- `big_sepL` — iterated `∗` over a list with index: `[∗ list] i ↦ x ∈ l, Φ i x`
+- `big_sepM` — iterated `∗` over a finite map: `[∗ map] k ↦ v ∈ m, Φ k v`
+
+## Main Results
+
+- `big_sepL_nil`, `big_sepL_cons` — computation rules
+- `big_sepL_mono` — pointwise entailment lifts to the big sep
+- `big_sepM_empty`, `big_sepM_insert`, `big_sepM_delete` — map operations
+- `big_sepM_lookup_acc` — extract one entry with a restoration wand
+- `big_sepM_sep` — distribute `∗` over `[∗ map]`
+-/
+
+namespace Iris.BI
+
+open Iris.Algebra Iris.Std
+
+variable {PROP : Type _} [BI PROP]
+
+/-! ## Separating Conjunction Monoid -/
+
+/-- `sep` / `emp` form a monoid on any BI, enabling use of `bigOpL` and `bigOpM`. -/
+instance sepMonoid : Monoid PROP BIBase.sep (BIBase.emp : PROP) where
+  op_ne := by
+    -- non-expansiveness is inherited from the BI structure
+    simpa using (BI.sep_ne (PROP := PROP))
+  op_assoc := by
+    -- associativity follows from the derived bi-entailment
+    intro a b c
+    exact equiv_iff.mpr (sep_assoc (P := a) (Q := b) (R := c))
+  op_comm := by
+    -- commutativity follows from the derived bi-entailment
+    intro a b
+    exact equiv_iff.mpr (sep_comm (P := a) (Q := b))
+  op_left_id := by
+    -- left identity is `emp_sep` as a bi-entailment
+    intro a
+    exact equiv_iff.mpr (emp_sep (P := a))
+
+/-! ## List Big Sep -/
+
+/-- Iterated separating conjunction over a list with index.
+    `big_sepL Φ l = Φ 0 x₀ ∗ Φ 1 x₁ ∗ ⋯ ∗ Φ (n-1) xₙ₋₁` -/
+def big_sepL {A : Type _} (Φ : Nat → A → PROP) (l : List A) : PROP :=
+  bigOpL BIBase.sep BIBase.emp Φ l
+
+/-! ### List Computation Rules -/
+
+/-- Empty list gives `emp`. -/
+@[simp] theorem big_sepL_nil {A : Type _} (Φ : Nat → A → PROP) :
+    big_sepL Φ ([] : List A) = (BIBase.emp : PROP) := rfl
+
+/-- Cons unfolds to head `∗` tail. -/
+@[simp] theorem big_sepL_cons {A : Type _} (Φ : Nat → A → PROP) (x : A) (l : List A) :
+    big_sepL Φ (x :: l) = BIBase.sep (Φ 0 x) (big_sepL (fun n => Φ (n + 1)) l) := rfl
+
+/-- Singleton list gives just the element. -/
+theorem big_sepL_singleton {A : Type _} (Φ : Nat → A → PROP) (x : A) :
+    big_sepL Φ [x] ⊣⊢ Φ 0 x := by
+  -- reduce to the algebraic singleton lemma and translate equivalence
+  have h : big_sepL Φ [x] ≡ Φ 0 x := by
+    -- unfold and use the singleton simplification
+    simp [big_sepL]
+  exact (equiv_iff (P := big_sepL Φ [x]) (Q := Φ 0 x)).1 h
+
+/-! ### List Structural Lemmas -/
+
+/-- Pointwise entailment lifts to the iterated separating conjunction. -/
+theorem big_sepL_mono {A : Type _} {Φ Ψ : Nat → A → PROP} {l : List A}
+    (h : ∀ i x, l[i]? = some x → Φ i x ⊢ Ψ i x) :
+    big_sepL Φ l ⊢ big_sepL Ψ l := by
+  -- prove by list induction using `sep_mono`
+  induction l generalizing Φ Ψ with
+  | nil =>
+    -- both sides are `emp`
+    simp [big_sepL_nil]
+  | cons x xs ih =>
+    -- use monotonicity for head and tail
+    have hhead : Φ 0 x ⊢ Ψ 0 x := h 0 x rfl
+    have htail : ∀ i y, xs[i]? = some y → Φ (i + 1) y ⊢ Ψ (i + 1) y := by
+      -- shift indices for the tail
+      intro i y hget
+      exact h (i + 1) y hget
+    have ht : big_sepL (fun n => Φ (n + 1)) xs ⊢ big_sepL (fun n => Ψ (n + 1)) xs := ih htail
+    -- unfold the head and apply `sep_mono`
+    simpa [big_sepL_cons] using sep_mono hhead ht
+
+/-- Non-expansiveness of `big_sepL` in its predicate.
+Coq: `big_sepL_ne` in `bi/big_op.v`. -/
+theorem big_sepL_ne {A : Type _} {Φ Ψ : Nat → A → PROP} {l : List A}
+    (h : ∀ i x, l[i]? = some x → Φ i x ≡{n}≡ Ψ i x) :
+    big_sepL Φ l ≡{n}≡ big_sepL Ψ l := by
+  -- induct on the list and use `sep_ne` at each step
+  induction l generalizing Φ Ψ with
+  | nil =>
+      -- both sides are `emp`
+      simp [big_sepL_nil]
+  | cons x xs ih =>
+      have hhead : Φ 0 x ≡{n}≡ Ψ 0 x := h 0 x rfl
+      have htail : ∀ i y, xs[i]? = some y → Φ (i + 1) y ≡{n}≡ Ψ (i + 1) y := by
+        -- shift indices for the tail
+        intro i y hget
+        exact h (i + 1) y hget
+      have ht : big_sepL (fun k => Φ (k + 1)) xs ≡{n}≡
+          big_sepL (fun k => Ψ (k + 1)) xs := ih htail
+      simpa [big_sepL_cons] using (BI.sep_ne (PROP := PROP)).ne hhead ht
+
+/-- Append distributes: `[∗ list](l₁ ++ l₂) ⊣⊢ [∗ list]l₁ ∗ [∗ list]l₂`. -/
+theorem big_sepL_app {A : Type _} (Φ : Nat → A → PROP) (l₁ l₂ : List A) :
+    big_sepL Φ (l₁ ++ l₂) ⊣⊢
+      BIBase.sep (big_sepL Φ l₁) (big_sepL (fun i => Φ (i + l₁.length)) l₂) := by
+  -- use the algebraic append lemma and translate equivalence
+  have h : big_sepL Φ (l₁ ++ l₂) ≡
+      BIBase.sep (big_sepL Φ l₁) (big_sepL (fun n => Φ (n + l₁.length)) l₂) := by
+    simpa [big_sepL] using
+      (BigOpL.append (op := BIBase.sep) (unit := (BIBase.emp : PROP)) Φ l₁ l₂)
+  exact equiv_iff.mp h
+
+/-- Distribute `∗` inside: `[∗ list](Φ ∗ Ψ) ⊣⊢ [∗ list]Φ ∗ [∗ list]Ψ`. -/
+theorem big_sepL_sep {A : Type _} (Φ Ψ : Nat → A → PROP) (l : List A) :
+    big_sepL (fun i x => BIBase.sep (Φ i x) (Ψ i x)) l ⊣⊢
+      BIBase.sep (big_sepL Φ l) (big_sepL Ψ l) := by
+  -- use the algebraic distributivity lemma and translate equivalence
+  have h : big_sepL (fun i x => BIBase.sep (Φ i x) (Ψ i x)) l ≡
+      BIBase.sep (big_sepL Φ l) (big_sepL Ψ l) := by
+    simpa [big_sepL] using
+      (BigOpL.op_distr (op := BIBase.sep) (unit := (BIBase.emp : PROP)) Φ Ψ l)
+  exact equiv_iff.mp h
+
+/-! ## Map Big Sep -/
+
+variable {K : Type _} {V : Type _}
+variable {M' : Type _ → Type _} [FiniteMap K M']
+
+/-- Iterated separating conjunction over a finite map.
+    `big_sepM Φ m = ∗_{(k,v) ∈ m} Φ k v` -/
+def big_sepM (Φ : K → V → PROP) (m : M' V) : PROP :=
+  BigOpM.bigOpM (op := BIBase.sep) (unit := (BIBase.emp : PROP)) Φ m
+
+/-! ## Notation -/
+
+syntax "[∗" "list]" ident " ↦ " ident " ∈ " term ", " term : term
+syntax "[∗" "map]" ident " ↦ " ident " ∈ " term ", " term : term
+
+macro_rules
+  | `(iprop([∗ list] $i ↦ $x ∈ $l, $P)) =>
+      ``(big_sepL (fun $i $x => iprop($P)) $l)
+  | `(iprop([∗ map] $k ↦ $v ∈ $m, $P)) =>
+      ``(big_sepM (fun $k $v => iprop($P)) $m)
+
+/-! ### Map Structural Lemmas -/
+
+/-- Distribute `∗` inside: `[∗ map](Φ ∗ Ψ) ⊣⊢ [∗ map]Φ ∗ [∗ map]Ψ`. -/
+theorem big_sepM_sep (Φ Ψ : K → V → PROP) (m : M' V) :
+    big_sepM (fun k v => BIBase.sep (Φ k v) (Ψ k v)) m ⊣⊢
+      BIBase.sep (big_sepM Φ m) (big_sepM Ψ m) := by
+  -- use the algebraic distributivity lemma and translate equivalence
+  have h : big_sepM (fun k v => BIBase.sep (Φ k v) (Ψ k v)) m ≡
+      BIBase.sep (big_sepM Φ m) (big_sepM Ψ m) := by
+    simpa [big_sepM] using
+      (BigOpM.op_distr (op := BIBase.sep) (unit := (BIBase.emp : PROP)) Φ Ψ m)
+  exact equiv_iff.mp h
+
+section
+variable [DecidableEq K] [FiniteMapLaws K M']
+
+/-! ### Map Computation Rules -/
+
+/-- Empty map gives `emp`. -/
+@[simp] theorem big_sepM_empty (Φ : K → V → PROP) :
+    big_sepM Φ (∅ : M' V) = (BIBase.emp : PROP) := by
+  -- unfold to the algebraic empty lemma
+  simp [big_sepM]
+
+section
+variable [DecidableEq V]
+
+/-- Insert into a map with a fresh key unfolds to entry `∗` rest. -/
+theorem big_sepM_insert (Φ : K → V → PROP) (m : M' V) (i : K) (x : V)
+    (h : get? m i = none) :
+    big_sepM Φ (insert m i x) ⊣⊢
+      BIBase.sep (Φ i x) (big_sepM Φ m) := by
+  -- use the algebraic insert lemma and translate equivalence
+  have h' : big_sepM Φ (insert m i x) ≡
+      BIBase.sep (Φ i x) (big_sepM Φ m) := by
+    simpa [big_sepM] using
+      (BigOpM.insert (op := BIBase.sep) (unit := (BIBase.emp : PROP)) Φ m i x h)
+  exact equiv_iff.mp h'
+
+/-- Delete from a map: `big_sepM m ⊣⊢ Φ k v ∗ big_sepM (delete k m)`. -/
+theorem big_sepM_delete (Φ : K → V → PROP) (m : M' V) (i : K) (x : V)
+    (h : get? m i = some x) :
+    big_sepM Φ m ⊣⊢ BIBase.sep (Φ i x) (big_sepM Φ (delete m i)) := by
+  -- use the algebraic delete lemma and translate equivalence
+  have h' : big_sepM Φ m ≡
+      BIBase.sep (Φ i x) (big_sepM Φ (delete m i)) := by
+    simpa [big_sepM] using
+      (BigOpM.delete (op := BIBase.sep) (unit := (BIBase.emp : PROP)) Φ m i x h)
+  exact equiv_iff.mp h'
+
+/-- Pointwise entailment lifts to the iterated map conjunction. -/
+theorem big_sepM_mono {Φ Ψ : K → V → PROP} {m : M' V}
+    (h : ∀ k v, get? m k = some v → Φ k v ⊢ Ψ k v) :
+    big_sepM Φ m ⊢ big_sepM Ψ m := by
+  -- strengthen induction to carry pointwise entailments
+  refine FiniteMapLaws.induction_on
+    (P := fun m' => (∀ k v, get? m' k = some v → Φ k v ⊢ Ψ k v) →
+      big_sepM Φ m' ⊢ big_sepM Ψ m') ?hemp ?hins m h
+  case hemp =>
+    -- empty map: both sides are `emp`
+    intro _
+    simp [big_sepM_empty]
+  case hins =>
+    intro i x m' hnone IH hmap
+    -- split the inserted map into head and tail
+    have hhead : Φ i x ⊢ Ψ i x := by
+      -- apply the pointwise hypothesis at the new key
+      exact hmap i x (by simp [FiniteMapLaws.get?_insert_same])
+    have htail : ∀ k v, get? m' k = some v → Φ k v ⊢ Ψ k v := by
+      -- restrict the pointwise hypothesis to the tail map
+      intro k v hk
+      by_cases hki : k = i
+      · subst hki; rw [hnone] at hk; cases hk
+      · have hne : i ≠ k := Ne.symm hki
+        have hk' : get? (insert m' i x) k = some v := by
+          simpa [FiniteMapLaws.get?_insert_ne m' i k x hne] using hk
+        exact hmap k v hk'
+    have ht : big_sepM Φ m' ⊢ big_sepM Ψ m' := IH htail
+    -- reassemble with `sep_mono`
+    refine (big_sepM_insert Φ m' i x hnone).1.trans ?_
+    refine (sep_mono hhead ht).trans ?_
+    exact (big_sepM_insert Ψ m' i x hnone).2
+
+/-- Extract one entry from the big sep and get a wand to put it back.
+    This is the key lemma for opening/closing invariants in `wsat`. -/
+theorem big_sepM_lookup_acc {Φ : K → V → PROP} {m : M' V} {i : K} {x : V}
+    (h : get? m i = some x) :
+    big_sepM Φ m ⊢ BIBase.sep (Φ i x) (BIBase.wand (Φ i x) (big_sepM Φ m)) := by
+  -- peel out the entry and repackage with a wand
+  have hdelete := big_sepM_delete Φ m i x h
+  refine hdelete.1.trans ?_
+  have hwand : big_sepM Φ (delete m i) ⊢ BIBase.wand (Φ i x) (big_sepM Φ m) := by
+    -- derive the wand from the reversed delete lemma
+    refine wand_intro ?_
+    exact sep_symm.trans hdelete.2
+  -- combine head and wand
+  exact sep_mono .rfl hwand
+
+/-- Distribute `▷` over the map big sep. -/
+theorem big_sepM_later {Φ : K → V → PROP} {m : M' V} [BIAffine PROP] :
+    BIBase.later (big_sepM Φ m) ⊢ big_sepM (fun k v => BIBase.later (Φ k v)) m := by
+  -- prove by map induction using `later_sep`
+  refine FiniteMapLaws.induction_on
+    (P := fun m' => BIBase.later (big_sepM Φ m') ⊢
+      big_sepM (fun k v => BIBase.later (Φ k v)) m') ?hemp ?hins m
+  case hemp =>
+    -- empty map: `▷ emp ⊢ emp`
+    simpa [big_sepM_empty] using (later_emp (PROP := PROP)).1
+  case hins =>
+    intro i x m' hnone IH
+    -- rewrite both sides using insertion and push `later` through `∗`
+    have hinsΦ := big_sepM_insert Φ m' i x hnone
+    have hinsΨ := big_sepM_insert (fun k v => BIBase.later (Φ k v)) m' i x hnone
+    refine (later_congr hinsΦ).1.trans ?_
+    refine (later_sep).1.trans ?_
+    refine (sep_mono .rfl IH).trans ?_
+    exact hinsΨ.2
+
+/-- Singleton map. -/
+theorem big_sepM_singleton (Φ : K → V → PROP) (i : K) (x : V) :
+    big_sepM Φ (FiniteMap.singleton i x : M' V) ⊣⊢ Φ i x := by
+  -- use the algebraic singleton lemma and translate equivalence
+  have h : big_sepM Φ (FiniteMap.singleton i x : M' V) ≡ Φ i x := by
+    simpa [big_sepM] using
+      (BigOpM.singleton (op := BIBase.sep) (unit := (BIBase.emp : PROP)) Φ i x)
+  exact equiv_iff.mp h
+
+/-- Union of disjoint maps. -/
+theorem big_sepM_union (Φ : K → V → PROP) (m₁ m₂ : M' V)
+    (h : m₁ ##ₘ m₂) :
+    big_sepM Φ (m₁ ∪ m₂) ⊣⊢
+      BIBase.sep (big_sepM Φ m₁) (big_sepM Φ m₂) := by
+  -- use the algebraic union lemma and translate equivalence
+  have h' : big_sepM Φ (m₁ ∪ m₂) ≡
+      BIBase.sep (big_sepM Φ m₁) (big_sepM Φ m₂) := by
+    simpa [big_sepM] using
+      (BigOpM.union (op := BIBase.sep) (unit := (BIBase.emp : PROP)) Φ m₁ m₂ h)
+  exact equiv_iff.mp h'
+
+end
+end
+
+end Iris.BI
diff --git a/src/Iris/BI/Updates.lean b/src/Iris/BI/Updates.lean
index bb78296b..1be088c1 100644
--- a/src/Iris/BI/Updates.lean
+++ b/src/Iris/BI/Updates.lean
@@ -8,6 +8,7 @@ import Iris.BI.BI
 import Iris.BI.BIBase
 import Iris.BI.Classes
 import Iris.BI.DerivedLaws
+import Iris.BI.DerivedLawsLater
 import Iris.Algebra
 import Iris.BI.Plainly
 
@@ -67,13 +68,19 @@ macro_rules
 
 -- Delab rules
 
+/-- Iterated step-fancy update. -/
+def step_fupdN {PROP MASK : Type _} [BIBase PROP] [FUpd PROP MASK]
+    (Eo Ei : Set MASK) (n : Nat) (P : PROP) : PROP :=
+  -- unfold to a chain of step-fupd updates
+  Nat.rec P (fun _ Q => iprop(|={Eo}[Ei]▷=> Q)) n
+
 syntax "|={ " term " }[ " term " ]▷^" term "=> " term : term
 syntax term "={ " term " }[ " term " ]▷^" term "=∗ " term : term
 syntax "|={ " term " }▷^" term "=> " term : term
 syntax term "={ " term " }▷^" term "=∗ " term : term
 
 macro_rules
-  | `(iprop(|={ $E1 }[ $E2 ]▷^$n=> $P))  => ``(iprop(|={$E1, $E2}=> ▷^[$n] (|={ $E2, $E1 }=> iprop($P))))
+  | `(iprop(|={ $E1 }[ $E2 ]▷^$n=> $P))  => ``(step_fupdN (Eo := $E1) (Ei := $E2) $n iprop($P))
   | `(iprop($P ={ $E1 }[ $E2 ]▷^$n=∗ $Q))  => ``(iprop(iprop($P) -∗ |={$E1}[$E2]▷^$n=> iprop($Q)))
   | `(iprop(|={ $E1 }▷^$n=> $P))  => ``(iprop(|={$E1}[$E1]▷^$n=> iprop($P)))
   | `(iprop($P ={ $E1 }▷^$n=∗ $Q))  => ``(iprop(iprop($P) ={$E1}[$E1]▷^$n=∗ iprop($Q)))
@@ -91,6 +98,8 @@ class BIFUpdate (PROP MASK : Type _) [BI PROP] extends FUpd PROP MASK where
   [ne {E1 E2 : Set MASK} : OFE.NonExpansive (FUpd.fupd E1 E2 (PROP := PROP))]
   subset {E1 E2 : Set MASK} : Subset E2 E1 → ⊢ |={E1, E2}=> |={E2, E1}=> (emp : PROP)
   except0 {E1 E2 : Set MASK} (P : PROP) : (◇ |={E1, E2}=> P) ⊢ |={E1, E2}=> P
+  mono {E1 E2 : Set MASK} {P Q : PROP} :
+    (P ⊢ Q) → (FUpd.fupd (PROP := PROP) E1 E2 P ⊢ FUpd.fupd (PROP := PROP) E1 E2 Q)
   trans {E1 E2 E3 : Set MASK} (P : PROP) : (|={E1, E2}=> |={E2, E3}=> P) ⊢ |={E1, E3}=> P
   mask_frame_r' {E1 E2 Ef : Set MASK} (P : PROP) :
     Disjoint E1 Ef → (|={E1,E2}=> ⌜Disjoint E2 Ef⌝ → P) ⊢ |={union E1 Ef, union E2 Ef}=> P
@@ -104,8 +113,10 @@ class BIBUpdatePlainly (PROP : Type _) [BI PROP] [BIUpdate PROP] [BIPlainly PROP
   bupd_plainly {P : PROP} : iprop((|==> ■ P)) ⊢ P
 
 class BIFUpdatePlainly (PROP MASK : Type _) [BI PROP] [BIFUpdate PROP MASK] [BIPlainly PROP] where
-  fupd_plainly_keep_l (E E' : Set MASK) (P R : PROP) : (R ={E,E'}=∗ ■ P) ∗ R ⊢ |={E}=> P ∗ R
-  fupd_plainly_later (E : Set MASK) (P : PROP) : (▷ |={E}=> ■ P) ⊢ |={E}=> ▷ ◇ P
+  fupd_plainly_keep_l (E E' : Set MASK) (P R : PROP) :
+    iprop((R ={E,E'}=∗ ■ P) ∗ R ⊢ |={E}=> P ∗ R)
+  fupd_plainly_later (E : Set MASK) (P : PROP) :
+    iprop((▷ |={E}=> ■ P) ⊢ |={E}=> ▷ ◇ P)
   fupd_plainly_sForall_2 (E : Set MASK) (Φ : PROP → Prop) :
     (∀ p, ⌜Φ p⌝ → |={E}=> ■ p) ⊢ |={E}=> sForall Φ
 
@@ -170,3 +181,360 @@ instance {P : PROP} [Plain P] : Plain iprop(|==> P) :=
 
 end BUpdPlainlyLaws
 end BUpdLaws
+
+/-! ## FUpd Laws -/
+
+section FUpdLaws
+
+variable [BI PROP] [BIFUpdate PROP MASK]
+
+open BIFUpdate
+
+/-- Mask subset introduction for fancy updates.
+
+Coq: `fupd_mask_subseteq` in `updates.v`. -/
+theorem fupd_mask_subseteq {E1 E2 : Set MASK} (h : Subset E2 E1) :
+    ⊢ |={E1, E2}=> |={E2, E1}=> (emp : PROP) :=
+  -- just expose the mixin field
+  subset (E1 := E1) (E2 := E2) h
+
+/-- Monotonicity of fancy updates.
+
+Coq: `fupd_mono` in `updates.v`. -/
+theorem fupd_mono {E1 E2 : Set MASK} {P Q : PROP} (h : P ⊢ Q) :
+    (|={E1, E2}=> P) ⊢ |={E1, E2}=> Q :=
+  -- delegate to the mixin field
+  mono (E1 := E1) (E2 := E2) (P := P) (Q := Q) h
+
+/-- Transitivity of fancy updates.
+
+Coq: `fupd_trans` in `updates.v`. -/
+theorem fupd_trans {E1 E2 E3 : Set MASK} (P : PROP) :
+    (|={E1, E2}=> |={E2, E3}=> P) ⊢ |={E1, E3}=> P :=
+  -- use the mixin field
+  trans (E1 := E1) (E2 := E2) (E3 := E3) (P := P)
+
+/-- Frame rule for fancy updates (right).
+
+Coq: `fupd_frame_r` in `updates.v`. -/
+theorem fupd_frame_r {E1 E2 : Set MASK} (P R : PROP) :
+    iprop((|={E1, E2}=> P) ∗ R ⊢ |={E1, E2}=> P ∗ R) :=
+  -- use the mixin field
+  frame_r (E1 := E1) (E2 := E2) (P := P) (R := R)
+
+/-- Mask introduction using a subset.
+
+Coq: `fupd_mask_intro_subseteq` in `updates.v`. -/
+theorem fupd_mask_intro_subseteq {E1 E2 : Set MASK} (P : PROP) (h : Subset E2 E1) :
+    P ⊢ |={E1, E2}=> |={E2, E1}=> P := by
+  -- insert the mask update and frame `P` through both updates
+  have hmask : ⊢ |={E1, E2}=> |={E2, E1}=> (emp : PROP) :=
+    fupd_mask_subseteq (E1 := E1) (E2 := E2) h
+  have hframe : P ⊢ (|={E1, E2}=> |={E2, E1}=> emp) ∗ P := by
+    -- add `emp` on the left and use monotonicity of `∗`
+    refine (emp_sep.2).trans ?_
+    exact sep_mono hmask .rfl
+  have hinner : (|={E2, E1}=> emp) ∗ P ⊢ |={E2, E1}=> P := by
+    -- frame inside the inner update and drop the `emp`
+    refine (fupd_frame_r (E1 := E2) (E2 := E1) (P := emp) (R := P)).trans ?_
+    exact fupd_mono (E1 := E2) (E2 := E1) (by simpa using (emp_sep.1 : emp ∗ P ⊢ P))
+  have houter :
+      (|={E1, E2}=> |={E2, E1}=> emp) ∗ P ⊢ |={E1, E2}=> |={E2, E1}=> P := by
+    -- move `P` under the outer update, then apply the inner step
+    refine (fupd_frame_r (E1 := E1) (E2 := E2) (P := iprop(|={E2, E1}=> emp)) (R := P)).trans ?_
+    exact fupd_mono (E1 := E1) (E2 := E2) hinner
+  exact hframe.trans houter
+
+/-- Basic fupd introduction.
+
+Coq: `fupd_intro` in `updates.v`. -/
+theorem fupd_intro (E : Set MASK) (P : PROP) : P ⊢ |={E}=> P := by
+  -- specialize mask intro and collapse nested updates
+  have h := fupd_mask_intro_subseteq (E1 := E) (E2 := E) (P := P) (fun _ hE => hE)
+  exact h.trans (fupd_trans (E1 := E) (E2 := E) (E3 := E) (P := P))
+
+/-- Eliminate a fupd into another fupd.
+
+Coq: `fupd_elim` in `updates.v`. -/
+theorem fupd_elim {E1 E2 E3 : Set MASK} {P Q : PROP}
+    (h : Q ⊢ |={E2, E3}=> P) : (|={E1, E2}=> Q) ⊢ |={E1, E3}=> P := by
+  -- rewrite and compose the updates
+  exact (fupd_mono (E1 := E1) (E2 := E2) h).trans
+    (fupd_trans (E1 := E1) (E2 := E2) (E3 := E3) (P := P))
+
+/-- Frame rule for fancy updates (left).
+
+Coq: `fupd_frame_l` in `updates.v`. -/
+theorem fupd_frame_l {E1 E2 : Set MASK} (R Q : PROP) :
+    (R ∗ |={E1, E2}=> Q) ⊢ |={E1, E2}=> R ∗ Q := by
+  -- commute the frame, apply the right rule, then commute inside
+  refine (sep_comm.1).trans ?_
+  refine (fupd_frame_r (E1 := E1) (E2 := E2) (P := Q) (R := R)).trans ?_
+  exact fupd_mono (E1 := E1) (E2 := E2) (sep_comm.1)
+
+/-- Wand rule for fancy updates (left).
+
+Coq: `fupd_wand_l` in `updates.v`. -/
+theorem fupd_wand_l {E1 E2 : Set MASK} (P Q : PROP) :
+    iprop((P -∗ Q) ∗ (|={E1, E2}=> P) ⊢ |={E1, E2}=> Q) := by
+  -- frame and eliminate the wand
+  exact (fupd_frame_l (E1 := E1) (E2 := E2) (R := iprop(P -∗ Q)) (Q := P)).trans
+    (fupd_mono (E1 := E1) (E2 := E2) (wand_elim_l (PROP := PROP)))
+
+/-- Wand rule for fancy updates (right).
+
+Coq: `fupd_wand_r` in `updates.v`. -/
+theorem fupd_wand_r {E1 E2 : Set MASK} (P Q : PROP) :
+    iprop((|={E1, E2}=> P) ∗ (P -∗ Q) ⊢ |={E1, E2}=> Q) := by
+  -- swap and use the left wand rule
+  exact (sep_comm.1).trans (fupd_wand_l (E1 := E1) (E2 := E2) (P := P) (Q := Q))
+
+end FUpdLaws
+
+/-! ## Plain Laws -/
+
+section PlainLaws
+
+variable [BI PROP] [BIPlainly PROP]
+
+/-- Plainness is preserved by the later modality.
+
+Coq: `later_plain` in `bi/plainly.v`. -/
+theorem plain_later (P : PROP) [Plain P] : ▷ P ⊢ ■ ▷ P := by
+  -- push plainness under `▷` and commute `■` outward
+  have hplain : P ⊢ ■ P := Plain.plain (P := P)
+  have hlater : ▷ P ⊢ ▷ ■ P := later_mono (PROP := PROP) hplain
+  exact hlater.trans (later_plainly (P := P)).1
+
+/-- Plainness is preserved by iterated later.
+
+Coq: `laterN_plain` in `bi/plainly.v`. -/
+theorem plain_laterN (P : PROP) (n : Nat) [Plain P] :
+    BIBase.laterN (PROP := PROP) n P ⊢ ■ BIBase.laterN (PROP := PROP) n P := by
+  -- follow the `laterN` recursion
+  induction n with
+  | zero =>
+      -- base: `laterN 0 P` is `P`
+      simpa [BIBase.laterN] using (Plain.plain (P := P))
+  | succ n ih =>
+      -- step: build a plain instance for `▷^n P`, then apply `plain_later`
+      haveI : Plain (BIBase.laterN (PROP := PROP) n P) := ⟨ih⟩
+      simpa [BIBase.laterN] using (plain_later (P := BIBase.laterN (PROP := PROP) n P))
+
+/-- Plainness is preserved by except-0.
+
+Coq: `except_0_plain` in `bi/plainly.v`. -/
+theorem plain_except0 (P : PROP) [Plain P] : ◇ P ⊢ ■ ◇ P := by
+  -- move plainness under `◇`, then distribute `■` over the disjunction
+  have hplain : P ⊢ ■ P := Plain.plain (P := P)
+  have hmono : ◇ P ⊢ ◇ ■ P := except0_mono (PROP := PROP) hplain
+  have hfalse :
+      ▷ (BIBase.pure (PROP := PROP) False) ⊢ ■ ▷ (BIBase.pure (PROP := PROP) False) := by
+    -- `False` is pure, so `■` commutes with `▷` after `later_mono`
+    have hpure : BIBase.pure (PROP := PROP) False ⊢ ■ BIBase.pure (PROP := PROP) False := by
+      simpa using (plainly_pure (PROP := PROP) (φ := False)).2
+    have hlater :
+        ▷ BIBase.pure (PROP := PROP) False ⊢ ▷ ■ BIBase.pure (PROP := PROP) False :=
+      later_mono (PROP := PROP) hpure
+    exact hlater.trans (later_plainly (P := BIBase.pure (PROP := PROP) False)).1
+  have hdisj : ◇ ■ P ⊢ ■ ◇ P := by
+    -- rewrite `◇` and apply `plainly_or_2`
+    have hor :
+        ▷ BIBase.pure (PROP := PROP) False ∨ ■ P ⊢ ■ ▷ BIBase.pure (PROP := PROP) False ∨ ■ P := by
+      refine or_elim ?hleft ?hright
+      · exact hfalse.trans or_intro_l
+      · exact or_intro_r
+    have hplain_or : ■ ▷ False ∨ ■ P ⊢ ■ (▷ False ∨ P) :=
+      plainly_or_2
+        (P := BIBase.later (PROP := PROP) (BIBase.pure (PROP := PROP) False))
+        (Q := P)
+    simpa [BIBase.except0] using hor.trans hplain_or
+  exact hmono.trans hdisj
+
+end PlainLaws
+
+/-! ## Step FUpd Laws -/
+
+section StepFUpdLaws
+
+variable [BI PROP] [BIFUpdate PROP MASK]
+
+/-- Monotonicity of the step-fupd modality.
+
+Coq: derived from `fupd_mono` in `updates.v`. -/
+theorem step_fupd_mono {Eo Ei : Set MASK} {P Q : PROP} (h : P ⊢ Q) :
+    (|={Eo}[Ei]▷=> P) ⊢ |={Eo}[Ei]▷=> Q := by
+  -- push the entailment through the inner and outer fancy updates
+  have hinner : (|={Ei, Eo}=> P) ⊢ |={Ei, Eo}=> Q :=
+    fupd_mono (E1 := Ei) (E2 := Eo) h
+  have hlater :
+      BIBase.later (PROP := PROP) (fupd Ei Eo P) ⊢
+        BIBase.later (PROP := PROP) (fupd Ei Eo Q) :=
+    later_mono (PROP := PROP) hinner
+  exact fupd_mono (E1 := Eo) (E2 := Ei) hlater
+
+/-- Step-fupd commutes with an outer fupd.
+
+Coq: `step_fupd_fupd` in `updates.v`. -/
+theorem step_fupd_fupd (Eo Ei : Set MASK) (P : PROP) :
+    (|={Eo}[Ei]▷=> P) ⊣⊢ (|={Eo}[Ei]▷=> |={Eo}=> P) := by
+  refine ⟨?_, ?_⟩
+  · -- introduce the outer fupd and lift it through step-fupd
+    exact step_fupd_mono (Eo := Eo) (Ei := Ei) (fupd_intro (E := Eo) (P := P))
+  · -- eliminate the nested fupd via transitivity
+    have hinner : (|={Ei, Eo}=> |={Eo}=> P) ⊢ |={Ei, Eo}=> P :=
+      fupd_trans (E1 := Ei) (E2 := Eo) (E3 := Eo) (P := P)
+    have hlater :
+        BIBase.later (PROP := PROP) (fupd Ei Eo (fupd Eo Eo P)) ⊢
+          BIBase.later (PROP := PROP) (fupd Ei Eo P) :=
+      later_mono (PROP := PROP) hinner
+    exact fupd_mono (E1 := Eo) (E2 := Ei) hlater
+
+end StepFUpdLaws
+
+/-! ## Plain FUpd Laws -/
+
+section FUpdPlainlyLaws
+
+variable [BI PROP] [BIFUpdate PROP MASK] [BIPlainly PROP] [BIFUpdatePlainly PROP MASK]
+
+/-- Plainly keep-left rule for fancy updates.
+
+Coq: `fupd_plainly_keep_l` in `updates.v`. -/
+theorem fupd_plainly_keep_l (E E' : Set MASK) (P R : PROP) :
+    iprop((R ={E, E'}=∗ ■ P) ∗ R ⊢ |={E}=> P ∗ R) :=
+  -- delegate to the mixin
+  BIFUpdatePlainly.fupd_plainly_keep_l (E := E) (E' := E') (P := P) (R := R)
+
+/-- Plainly later rule for fancy updates.
+
+Coq: `fupd_plainly_later` in `updates.v`. -/
+theorem fupd_plainly_later (E : Set MASK) (P : PROP) :
+    iprop((▷ |={E}=> ■ P) ⊢ |={E}=> ▷ ◇ P) :=
+  -- delegate to the mixin
+  BIFUpdatePlainly.fupd_plainly_later (E := E) (P := P)
+
+/-- Plainly mask elimination for fancy updates.
+
+Coq: `fupd_plainly_mask` in `updates.v`. -/
+theorem fupd_plainly_mask (E E' : Set MASK) (P : PROP) :
+    (|={E, E'}=> ■ P) ⊢ |={E}=> P := by
+  -- use the keep-left rule with the empty frame, then drop `emp`
+  have hkeep :
+      (emp ={E, E'}=∗ ■ P) ∗ emp ⊢ |={E}=> P ∗ emp :=
+    fupd_plainly_keep_l (E := E) (E' := E') (P := P) (R := emp)
+  have hwand : (emp -∗ |={E, E'}=> ■ P) ⊣⊢ |={E, E'}=> ■ P := by
+    -- `emp` is the unit for the separating implication
+    refine ⟨?_, ?_⟩
+    · exact (emp_sep.2).trans (wand_elim_r (P := emp) (Q := iprop(|={E, E'}=> ■ P)))
+    · exact wand_intro (sep_emp.1 :
+        (|={E, E'}=> ■ P) ∗ emp ⊢ |={E, E'}=> ■ P)
+  have hpre : (|={E, E'}=> ■ P) ⊢ (emp -∗ |={E, E'}=> ■ P) ∗ emp := by
+    -- introduce the wand and frame `emp`
+    refine (sep_emp.2).trans ?_
+    exact sep_mono hwand.2 .rfl
+  have hpost : (|={E}=> P ∗ emp) ⊢ |={E}=> P :=
+    fupd_mono (E1 := E) (E2 := E) (sep_emp.1)
+  exact hpre.trans (hkeep.trans hpost)
+
+end FUpdPlainlyLaws
+
+section FUpdPlainLaws
+
+variable [BI PROP] [BIFUpdate PROP MASK] [BIPlainly PROP]
+variable [BIFUpdatePlainly PROP MASK]
+
+/-- Plain mask elimination for fancy updates.
+
+Coq: `fupd_plain_mask` in `updates.v`. -/
+theorem fupd_plain_mask (E E' : Set MASK) (P : PROP) [Plain P] :
+    (|={E, E'}=> P) ⊢ |={E}=> P := by
+  -- convert to a plainly statement and use the plainly mask lemma
+  have hplain : P ⊢ ■ P := Plain.plain (P := P)
+  exact (fupd_mono (E1 := E) (E2 := E') hplain).trans
+    (fupd_plainly_mask (E := E) (E' := E') (P := P))
+
+/-- Plain later rule for fancy updates.
+
+Coq: `fupd_plain_later` in `updates.v`. -/
+theorem fupd_plain_later (E : Set MASK) (P : PROP) [Plain P] :
+    iprop((▷ |={E}=> P) ⊢ |={E}=> ▷ ◇ P) := by
+  -- reduce to the plainly version
+  have hplain : P ⊢ ■ P := Plain.plain (P := P)
+  have hmono :
+      (▷ |={E}=> P) ⊢ ▷ |={E}=> ■ P :=
+    later_mono (PROP := PROP) (fupd_mono (E1 := E) (E2 := E) hplain)
+  exact hmono.trans (fupd_plainly_later (E := E) (P := P))
+
+/-- One-step plain step-fupd.
+
+Coq: `step_fupd_plain` in `updates.v`. -/
+theorem step_fupd_plain (Eo Ei : Set MASK) (P : PROP) [Plain P] :
+    (|={Eo}[Ei]▷=> P) ⊢ |={Eo}=> ▷ ◇ P := by
+  -- build plainness for `▷ ◇ P` to remove the mask
+  haveI : Plain (BIBase.except0 (PROP := PROP) P) := ⟨plain_except0 (P := P)⟩
+  haveI :
+      Plain (BIBase.later (PROP := PROP) (BIBase.except0 (PROP := PROP) P)) :=
+    ⟨plain_later (P := BIBase.except0 (PROP := PROP) P)⟩
+  -- shrink the inner mask and apply the plainly-later rule
+  have hmask : (|={Ei, Eo}=> P) ⊢ |={Ei}=> P :=
+    fupd_plain_mask (E := Ei) (E' := Eo) (P := P)
+  have hlater :
+      BIBase.later (PROP := PROP) (fupd Ei Eo P) ⊢
+        BIBase.later (PROP := PROP) (fupd Ei Ei P) :=
+    later_mono (PROP := PROP) hmask
+  have hinner :
+      BIBase.later (PROP := PROP) (fupd Ei Eo P) ⊢
+        fupd Ei Ei (BIBase.later (PROP := PROP) (BIBase.except0 (PROP := PROP) P)) :=
+    hlater.trans (fupd_plain_later (E := Ei) (P := P))
+  have hstep :
+      (|={Eo, Ei}=> BIBase.later (PROP := PROP) (fupd Ei Eo P)) ⊢
+        |={Eo, Ei}=> BIBase.later (PROP := PROP) (BIBase.except0 (PROP := PROP) P) :=
+    fupd_elim (E1 := Eo) (E2 := Ei) (E3 := Ei)
+      (Q := BIBase.later (PROP := PROP) (fupd Ei Eo P)) hinner
+  exact hstep.trans <|
+    fupd_plain_mask (E := Eo) (E' := Ei)
+      (P := BIBase.later (PROP := PROP) (BIBase.except0 (PROP := PROP) P))
+
+/-- Iterated plain step-fupd.
+
+Coq: `step_fupdN_plain` in `updates.v`. -/
+theorem step_fupdN_plain (Eo Ei : Set MASK) (n : Nat) (P : PROP) [Plain P] :
+    (|={Eo}[Ei]▷^n=> P) ⊢ |={Eo}=> ▷^[n] ◇ P := by
+  -- follow the iterated step-fupd recursion
+  induction n with
+  | zero =>
+      -- base: `step_fupdN` is the identity
+      exact (fupd_intro (E := Eo) (P := P)).trans
+        (fupd_mono (E1 := Eo) (E2 := Eo) except0_intro)
+  | succ n ih =>
+      -- step: insert and remove `|={Eo}=>`, then use `step_fupd_plain`
+      haveI : Plain (BIBase.except0 (PROP := PROP) P) := ⟨plain_except0 (P := P)⟩
+      haveI :
+          Plain (BIBase.laterN (PROP := PROP) n (BIBase.except0 (PROP := PROP) P)) :=
+        ⟨plain_laterN (P := BIBase.except0 (PROP := PROP) P) n⟩
+      have hmono :
+          (|={Eo}=> |={Eo}=> ▷^[n] ◇ P) ⊢ |={Eo}=> ▷^[n] ◇ P :=
+        fupd_trans (E1 := Eo) (E2 := Eo) (E3 := Eo)
+          (P := BIBase.laterN (PROP := PROP) n (BIBase.except0 (PROP := PROP) P))
+      have hstep_mono :
+          (|={Eo}=> step_fupdN (Eo := Eo) (Ei := Ei) n P) ⊢ |={Eo}=> ▷^[n] ◇ P :=
+        (fupd_mono (E1 := Eo) (E2 := Eo) ih).trans hmono
+      have hstep :
+          (|={Eo}[Ei]▷=> step_fupdN (Eo := Eo) (Ei := Ei) n P) ⊢ |={Eo}[Ei]▷=> ▷^[n] ◇ P :=
+        (step_fupd_fupd (Eo := Eo) (Ei := Ei) (P := step_fupdN (Eo := Eo) (Ei := Ei) n P)).1.trans
+          ((step_fupd_mono (Eo := Eo) (Ei := Ei) hstep_mono).trans
+            (step_fupd_fupd (Eo := Eo) (Ei := Ei)
+              (P := BIBase.laterN (PROP := PROP) n (BIBase.except0 (PROP := PROP) P))).2)
+      have hdrop : ▷ ◇ ▷^[n] ◇ P ⊢ ▷^[n.succ] ◇ P := by
+        -- simplify the nested `◇` under a `▷`
+        have hcore : ◇ ▷^[n] ◇ P ⊢ ▷^[n] ◇ P := by
+          refine (except0_laterN (n := n) (P := BIBase.except0 (PROP := PROP) P)).trans ?_
+          exact laterN_mono (PROP := PROP) n (except0_idemp.1)
+        simpa [BIBase.laterN] using (later_mono (PROP := PROP) hcore)
+      exact hstep.trans
+        ((step_fupd_plain (Eo := Eo) (Ei := Ei)
+          (P := BIBase.laterN (PROP := PROP) n (BIBase.except0 (PROP := PROP) P))).trans
+          (fupd_mono (E1 := Eo) (E2 := Eo) hdrop))
+
+end FUpdPlainLaws
diff --git a/src/Iris/BaseLogic/Lib/CancelableInvariants.lean b/src/Iris/BaseLogic/Lib/CancelableInvariants.lean
new file mode 100644
index 00000000..fddb31fe
--- /dev/null
+++ b/src/Iris/BaseLogic/Lib/CancelableInvariants.lean
@@ -0,0 +1,1213 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.Algebra.Excl
+import Iris.Algebra.Frac
+import Iris.BaseLogic.Lib.Invariants
+
+/-! # Cancelable Invariants
+
+Port of `iris/base_logic/lib/cancelable_invariants.v`.
+
+Cancelable invariants extend standard invariants with a fractional ownership
+ token that can permanently cancel the invariant and extract its body.
+
+## Main definitions
+- `cinv_own` — fractional token for cancelation
+- `cinv` — cancelable invariant
+
+## Main results
+- `cinv_alloc`, `cinv_acc`, `cinv_cancel`
+- proof mode instances `IntoInv`, `IntoAcc`
+-/
+
+namespace Iris.BaseLogic
+
+open _root_.Iris _root_.Iris.Algebra _root_.Iris.Std _root_.Iris.BI
+
+/-- Ghost state carrier for cancelable invariants. -/
+abbrev CinvR (F : Type _) : Type _ :=
+  Option (Excl (LeibnizO Unit)) × Option (Frac F)
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M]
+variable [FiniteMapLaws Positive M] [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+variable [ElemG GF (COFE.constOF (CinvR F))]
+
+private abbrev maskDiff (E : Iris.Set Positive) (N : Namespace) : Iris.Set Positive :=
+  fun x => E x ∧ ¬(nclose N).mem x
+
+/-- Keep IProp entailments opaque for proof mode (avoid unfolding to `holds`). -/
+private structure IPropEntails (P Q : IProp GF) : Prop where
+  toEntails : P ⊢ Q
+
+private def wrapEntails {P Q : IProp GF} (h : P ⊢ Q) :
+    IPropEntails (GF := GF) P Q :=
+  ⟨h⟩
+
+local instance asEmpValid_IPropEntails_cinv (d : Iris.ProofMode.AsEmpValid.Direction)
+    (P Q : IProp GF) :
+    Iris.ProofMode.AsEmpValid d (IPropEntails (GF := GF) P Q) iprop(P -∗ Q) := by
+  -- reuse the proof mode instance for entailments
+  have hEntails :
+      Iris.ProofMode.AsEmpValid d (P ⊢ Q) iprop(P -∗ Q) := by infer_instance
+  refine ⟨?_, ?_⟩
+  · intro hd h
+    exact (hEntails.as_emp_valid.1 hd) h.toEntails
+  · intro hd h
+    exact ⟨(hEntails.as_emp_valid.2 hd) h⟩
+
+/-! ## Definitions -/
+
+/-- Fractional ownership token for a cancelable invariant.
+Coq: `cinv_own` in `cancelable_invariants.v`. -/
+noncomputable def cinv_own (_W : WsatGS GF) (γ : GName) (p : F) : IProp GF :=
+  -- store the fractional token in the right component
+  iOwn (GF := GF) (F := COFE.constOF (CinvR F)) γ (none, some ((p : F) : Frac F))
+
+/-- Internal exclusive token for cancelable invariant proofs.
+Coq: `cinv_excl` in `cancelable_invariants.v`. -/
+noncomputable def cinv_excl (_W : WsatGS GF) (γ : GName) : IProp GF :=
+  -- store the exclusive token in the left component
+  iOwn (GF := GF) (F := COFE.constOF (CinvR F)) γ
+    (some (Excl.excl (LeibnizO.mk ())), none)
+
+/-- Internal body of a cancelable invariant. -/
+private abbrev cinv_body (W : WsatGS GF) (γ : GName) (P : IProp GF) : IProp GF :=
+  BIBase.or (BIBase.sep P (cinv_excl (F := F) W γ)) (cinv_own (F := F) W γ (1 : F))
+
+/-- Cancelable invariant.
+Coq: `cinv` in `cancelable_invariants.v`. -/
+noncomputable def cinv (W : WsatGS GF) (N : Namespace) (γ : GName) (P : IProp GF) : IProp GF :=
+  -- invariant body: `P ∗ cinv_excl γ` or the full token
+  inv (GF := GF) (M := M) (F := F) W N (cinv_body (F := F) W γ P)
+
+/-! ## Properties -/
+
+omit [FiniteMapLaws Positive M] in
+/-- `cinv` is persistent (inherits from `inv`).
+Coq: `cinv_persistent`. -/
+theorem cinv_persistent (W : WsatGS GF) (N : Namespace) (γ : GName) (P : IProp GF) :
+    Persistent (cinv (M := M) (F := F) W N γ P) := by
+  -- reuse persistence of `inv`
+  refine ⟨?_⟩
+  simpa [cinv, cinv_body] using
+    (inv_persistent (GF := GF) (M := M) (F := F) (W := W) (N := N)
+      (P := cinv_body (F := F) W γ P))
+
+omit [FiniteMapLaws Positive M] in
+/-- `cinv` is persistent (instance). -/
+instance cinv_persistent_inst {W : WsatGS GF} (N : Namespace) (γ : GName) (P : IProp GF) :
+    Persistent (cinv (M := M) (F := F) W N γ P) :=
+  cinv_persistent (M := M) (F := F) (W := W) (N := N) (γ := γ) (P := P)
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)]
+  [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Split a fractional ownership token.
+Coq: `cinv_own_fractional`. -/
+theorem cinv_own_fractional (W : WsatGS GF) (γ : GName) (p q : F) :
+    cinv_own (F := F) W γ (p + q) ⊣⊢
+      BIBase.sep (cinv_own (F := F) W γ p) (cinv_own (F := F) W γ q) := by
+  -- split the underlying ghost ownership
+  simpa [cinv_own, CMRA.op, Prod.op, optionOp] using
+    (iOwn_op (GF := GF) (F := COFE.constOF (CinvR F)) (γ := γ)
+      (a1 := (none, some ((p : F) : Frac F)))
+      (a2 := (none, some ((q : F) : Frac F))))
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)]
+  [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Validity of combined fractional tokens.
+Coq: `cinv_own_valid`. -/
+theorem cinv_own_valid (W : WsatGS GF) (γ : GName) (q1 q2 : F) :
+    cinv_own (F := F) W γ q1 ⊢
+      BIBase.wand (cinv_own (F := F) W γ q2)
+        (BIBase.pure (Fraction.Proper (q1 + q2)) : IProp GF) := by
+  -- validity of the combined token yields `Proper (q1 + q2)`
+  refine (wand_intro (PROP := IProp GF) ?_)
+  refine (iOwn_cmraValid_op (GF := GF) (F := COFE.constOF (CinvR F)) (γ := γ)
+    (a1 := (none, some ((q1 : F) : Frac F)))
+    (a2 := (none, some ((q2 : F) : Frac F)))).trans ?_
+  refine (UPred.cmraValid_elim
+    (a := ((none, some ((q1 : F) : Frac F)) : CinvR F) •
+      (none, some ((q2 : F) : Frac F)))).trans ?_
+  refine BI.pure_mono ?_
+  intro hvalid0
+  simpa [CMRA.Valid, CMRA.ValidN, Prod.ValidN, CMRA.op, Prod.op, optionOp, optionValid] using
+    hvalid0
+
+omit [FiniteMapLaws Positive M] in
+/-- `cinv N γ` is contractive in its body.
+Coq: `cinv_contractive`. -/
+instance cinv_contractive {W : WsatGS GF} (N : Namespace) (γ : GName) :
+    OFE.Contractive (fun P => cinv (M := M) (F := F) W N γ P) := by
+  -- combine the contractive `inv` with non-expansiveness of `cinv_body`
+  refine ⟨?_⟩
+  intro n P Q hPQ
+  have hbody :
+      OFE.DistLater n (cinv_body (F := F) W γ P) (cinv_body (F := F) W γ Q) := by
+    cases n with
+    | zero =>
+        exact OFE.distLater_zero
+    | succ n' =>
+        have hPQ' : P ≡{n'}≡ Q := (OFE.distLater_succ).1 hPQ
+        have hsep :
+            BIBase.sep P (cinv_excl (F := F) W γ) ≡{n'}≡
+              BIBase.sep Q (cinv_excl (F := F) W γ) :=
+          (BI.sep_ne (PROP := IProp GF)).ne hPQ' .rfl
+        have hor :
+            BIBase.or (BIBase.sep P (cinv_excl (F := F) W γ))
+              (cinv_own (F := F) W γ (1 : F)) ≡{n'}≡
+              BIBase.or (BIBase.sep Q (cinv_excl (F := F) W γ))
+                (cinv_own (F := F) W γ (1 : F)) :=
+          (BI.or_ne (PROP := IProp GF)).ne hsep .rfl
+        exact (OFE.distLater_succ).2 (by simpa [cinv_body] using hor)
+  have h :=
+    (OFE.Contractive.distLater_dist
+      (f := fun P => inv (GF := GF) (M := M) (F := F) W N P) hbody)
+  simpa [cinv] using h
+
+/-- `cinv N γ` is non-expansive in its body.
+Coq: `cinv_ne`. -/
+instance cinv_ne {W : WsatGS GF} (N : Namespace) (γ : GName) :
+    OFE.NonExpansive (fun P => cinv (M := M) (F := F) W N γ P) := by
+  infer_instance
+
+omit [FiniteMapLaws Positive M] in
+/-- `cinv` respects equivalence of its body.
+Coq: `cinv_proper`. -/
+theorem cinv_proper {W : WsatGS GF} (N : Namespace) (γ : GName) {P Q : IProp GF}
+    (h : P ≡ Q) : cinv (M := M) (F := F) W N γ P ≡
+      cinv (M := M) (F := F) W N γ Q := by
+  exact OFE.NonExpansive.eqv
+    (f := fun P => cinv (M := M) (F := F) W N γ P) h
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)]
+  [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Two full ownership tokens are contradictory.
+Coq: `cinv_own_1_l`. -/
+theorem cinv_own_1_l (W : WsatGS GF) (γ : GName) (q : F) :
+    cinv_own (F := F) W γ (1 : F) ⊢
+    BIBase.wand (cinv_own (F := F) W γ q) (BIBase.pure False : IProp GF) := by
+  -- validity of the combined token contradicts `one_whole`
+  refine wand_intro ?_
+  refine (iOwn_cmraValid_op (GF := GF) (F := COFE.constOF (CinvR F)) (γ := γ)
+    (a1 := (none, some ((1 : F) : Frac F))) (a2 := (none, some ((q : F) : Frac F)))).trans ?_
+  refine (UPred.cmraValid_elim
+    (a := ((none, some ((1 : F) : Frac F)) : CinvR F) •
+      (none, some ((q : F) : Frac F)))).trans ?_
+  refine BI.pure_mono ?_
+  intro hvalid0
+  have hproper : Fraction.Proper ((1 : F) + q) := by
+    -- validity reduces to the fractional component
+    simpa [CMRA.ValidN, Prod.ValidN, CMRA.op, Prod.op, optionOp] using hvalid0
+  exact (UFraction.one_whole (α := F)).2 ⟨q, hproper⟩
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)]
+  [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Two exclusive tokens are contradictory.
+Coq: `cinv_excl_excl`. -/
+theorem cinv_excl_excl (W : WsatGS GF) (γ : GName) :
+    cinv_excl (F := F) W γ ⊢
+    BIBase.wand (cinv_excl (F := F) W γ) (BIBase.pure False : IProp GF) := by
+  -- exclusive tokens cannot be combined
+  refine wand_intro ?_
+  refine (iOwn_cmraValid_op (GF := GF) (F := COFE.constOF (CinvR F)) (γ := γ)
+    (a1 := (some (Excl.excl (LeibnizO.mk ())), none))
+    (a2 := (some (Excl.excl (LeibnizO.mk ())), none))).trans ?_
+  refine (UPred.cmraValid_elim
+    (a := ((some (Excl.excl (LeibnizO.mk ())), none) : CinvR F) •
+      (some (Excl.excl (LeibnizO.mk ())), none))).trans ?_
+  refine BI.pure_mono ?_
+  intro hvalid0
+  have hleft : ✓{0} (Excl.excl (LeibnizO.mk ()) • Excl.excl (LeibnizO.mk ())) := by
+    -- reduce to validity of the excl component
+    simp [CMRA.ValidN, Prod.ValidN, CMRA.op, Prod.op, optionOp, optionValidN] at hvalid0
+  exact (_root_.Iris.CMRA.not_valid_exclN_op_left (n := 0)
+    (x := Excl.excl (LeibnizO.mk ())) (y := Excl.excl (LeibnizO.mk ())) hleft)
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)]
+  [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem cinv_body_wand_intuitionistic (W : WsatGS GF) (γ : GName) (P Q : IProp GF) :
+    BIBase.intuitionistically (BIBase.wand P Q) ⊢
+      BIBase.wand (cinv_body (F := F) W γ P) (cinv_body (F := F) W γ Q) := by
+  -- split the invariant body, consume the wand on the left branch, drop it on the right
+  refine wand_intro ?_
+  refine (sep_or_l (P := BIBase.intuitionistically (BIBase.wand P Q))
+    (Q := BIBase.sep P (cinv_excl (F := F) W γ))
+    (R := cinv_own (F := F) W γ (1 : F))).1.trans ?_
+  have hleft :
+      BIBase.sep (BIBase.intuitionistically (BIBase.wand P Q))
+        (BIBase.sep P (cinv_excl (F := F) W γ)) ⊢
+      cinv_body (F := F) W γ Q := by
+    have hwand :
+        BIBase.sep (BIBase.intuitionistically (BIBase.wand P Q)) P ⊢ Q := by
+      -- eliminate the intuitionistic wand and apply it to `P`
+      refine (sep_mono_l (intuitionistically_elim (P := BIBase.wand P Q))).trans ?_
+      exact wand_elim_l (P := P) (Q := Q)
+    have hsep :
+        BIBase.sep (BIBase.intuitionistically (BIBase.wand P Q))
+          (BIBase.sep P (cinv_excl (F := F) W γ)) ⊢
+        BIBase.sep Q (cinv_excl (F := F) W γ) := by
+      -- reassociate and rewrite the left component using `hwand`
+      refine (sep_assoc (P := BIBase.intuitionistically (BIBase.wand P Q))
+        (Q := P) (R := cinv_excl (F := F) W γ)).2.trans ?_
+      exact sep_mono hwand .rfl
+    exact hsep.trans
+      (or_intro_l (P := BIBase.sep Q (cinv_excl (F := F) W γ))
+        (Q := cinv_own (F := F) W γ (1 : F)))
+  have hright :
+      BIBase.sep (BIBase.intuitionistically (BIBase.wand P Q))
+        (cinv_own (F := F) W γ (1 : F)) ⊢
+      cinv_body (F := F) W γ Q := by
+    have hown :
+        BIBase.sep (BIBase.intuitionistically (BIBase.wand P Q))
+          (cinv_own (F := F) W γ (1 : F)) ⊢
+        cinv_own (F := F) W γ (1 : F) := by
+      -- drop the affine intuitionistic wand
+      simpa using
+        (sep_elim_r (P := BIBase.intuitionistically (BIBase.wand P Q))
+          (Q := cinv_own (F := F) W γ (1 : F)))
+    exact hown.trans
+      (or_intro_r (P := BIBase.sep Q (cinv_excl (F := F) W γ))
+        (Q := cinv_own (F := F) W γ (1 : F)))
+  exact or_elim hleft hright
+
+omit [FiniteMapLaws Positive M] in
+/-- Cancelable invariant content equivalence.
+Coq: `cinv_iff`. -/
+theorem cinv_iff {W : WsatGS GF}
+    (N : Namespace) (γ : GName) (P Q : IProp GF) :
+    cinv (M := M) (F := F) W N γ P ⊢
+      BIBase.wand (BIBase.later (BIBase.intuitionistically
+        (BIBase.and (BIBase.wand P Q) (BIBase.wand Q P))))
+        (cinv (M := M) (F := F) W N γ Q) := by
+  -- lift the equivalence through `cinv_body` and reuse `inv_iff`
+  iintro Hinv
+  iintro Hpq
+  have hcore :
+      BIBase.intuitionistically (BIBase.and (BIBase.wand P Q) (BIBase.wand Q P)) ⊢
+        BIBase.and
+          (BIBase.wand (cinv_body (F := F) W γ P) (cinv_body (F := F) W γ Q))
+          (BIBase.wand (cinv_body (F := F) W γ Q) (cinv_body (F := F) W γ P)) := by
+    have hsplit :
+        BIBase.intuitionistically (BIBase.and (BIBase.wand P Q) (BIBase.wand Q P)) ⊢
+          BIBase.and (BIBase.intuitionistically (BIBase.wand P Q))
+            (BIBase.intuitionistically (BIBase.wand Q P)) :=
+      (intuitionistically_and (P := BIBase.wand P Q) (Q := BIBase.wand Q P)).1
+    have hleft :
+        BIBase.intuitionistically (BIBase.and (BIBase.wand P Q) (BIBase.wand Q P)) ⊢
+          BIBase.wand (cinv_body (F := F) W γ P) (cinv_body (F := F) W γ Q) := by
+      refine hsplit.trans ?_
+      refine (and_elim_l (P := BIBase.intuitionistically (BIBase.wand P Q))
+        (Q := BIBase.intuitionistically (BIBase.wand Q P))).trans ?_
+      exact cinv_body_wand_intuitionistic (W := W) (F := F) (γ := γ) (P := P) (Q := Q)
+    have hright :
+        BIBase.intuitionistically (BIBase.and (BIBase.wand P Q) (BIBase.wand Q P)) ⊢
+          BIBase.wand (cinv_body (F := F) W γ Q) (cinv_body (F := F) W γ P) := by
+      refine hsplit.trans ?_
+      refine (and_elim_r (P := BIBase.intuitionistically (BIBase.wand P Q))
+        (Q := BIBase.intuitionistically (BIBase.wand Q P))).trans ?_
+      exact cinv_body_wand_intuitionistic (W := W) (F := F) (γ := γ) (P := Q) (Q := P)
+    exact and_intro hleft hright
+  have hbody :=
+    intuitionistically_intro' (P := BIBase.and (BIBase.wand P Q) (BIBase.wand Q P))
+      (Q := BIBase.and
+        (BIBase.wand (cinv_body (F := F) W γ P) (cinv_body (F := F) W γ Q))
+        (BIBase.wand (cinv_body (F := F) W γ Q) (cinv_body (F := F) W γ P))) hcore
+  have hmono :=
+    later_mono
+      (P := BIBase.intuitionistically (BIBase.and (BIBase.wand P Q) (BIBase.wand Q P)))
+      (Q := BIBase.intuitionistically
+        (BIBase.and
+          (BIBase.wand (cinv_body (F := F) W γ P) (cinv_body (F := F) W γ Q))
+          (BIBase.wand (cinv_body (F := F) W γ Q) (cinv_body (F := F) W γ P))))
+      hbody
+  ihave Hpq' := (wrapEntails (GF := GF) hmono) $$ Hpq
+  have hiff :=
+    inv_iff (W := W) (M := M) (F := F) (N := N)
+      (P := cinv_body (F := F) W γ P) (Q := cinv_body (F := F) W γ Q)
+  have hiff' :
+      (BIBase.emp : IProp GF) ⊢
+        BIBase.wand (cinv (M := M) (F := F) W N γ P)
+          (BIBase.wand (BIBase.later (BIBase.intuitionistically
+            (BIBase.and
+              (BIBase.wand (cinv_body (F := F) W γ P) (cinv_body (F := F) W γ Q))
+              (BIBase.wand (cinv_body (F := F) W γ Q) (cinv_body (F := F) W γ P)))))
+            (cinv (M := M) (F := F) W N γ Q)) := by
+    simpa [cinv] using hiff
+  iintuitionistic Hinv
+  iapply (wrapEntails (GF := GF) hiff')
+  · iemp_intro
+  · iexact Hinv
+  · iexact Hpq'
+
+/-! ## Allocation -/
+
+/-- Validity of the combined ghost token. -/
+private theorem cinv_token_valid :
+    ✓ ((some (Excl.excl (LeibnizO.mk ())), some ((1 : F) : Frac F)) : CinvR F) := by
+  -- validity is componentwise for the product/option CMRA
+  refine And.intro ?_ ?_
+  · simp [CMRA.Valid, optionValid]
+  · simpa [CMRA.Valid, optionValid] using
+      (UFraction.one_whole (α := F)).1
+
+omit [FiniteMapLaws Positive M] in
+/-- Allocate an exclusive token together with the full fractional token. -/
+private theorem cinv_own_excl_alloc (W : WsatGS GF) (E : Iris.Set Positive) :
+    (BIBase.emp : IProp GF) ⊢
+      uPred_fupd (M := M) (F := F) W E E
+        (BIBase.exists fun (γ : GName) =>
+          BIBase.sep (cinv_excl (F := F) W γ) (cinv_own (F := F) W γ (1 : F)) : IProp GF) := by
+  -- allocate the combined element and split ownership
+  have hvalid := (cinv_token_valid (F := F))
+  have halloc :
+      (BIBase.emp : IProp GF) ⊢
+        BUpd.bupd (BIBase.exists fun γ =>
+          iOwn (GF := GF) (F := COFE.constOF (CinvR F)) γ
+            ((some (Excl.excl (LeibnizO.mk ())), some ((1 : F) : Frac F)) : CinvR F)) :=
+    iOwn_alloc (GF := GF) (F := COFE.constOF (CinvR F)) _ hvalid
+  have halloc' :
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W E E
+          (BIBase.exists fun γ =>
+            iOwn (GF := GF) (F := COFE.constOF (CinvR F)) γ
+              ((some (Excl.excl (LeibnizO.mk ())), some ((1 : F) : Frac F)) : CinvR F)) :=
+    halloc.trans (bupd_fupd (W := W) (M := M) (F := F) (E := E)
+      (P := BIBase.exists fun γ =>
+        iOwn (GF := GF) (F := COFE.constOF (CinvR F)) γ
+          ((some (Excl.excl (LeibnizO.mk ())), some ((1 : F) : Frac F)) : CinvR F)))
+  have hsplit :
+      BIBase.exists (fun γ =>
+        iOwn (GF := GF) (F := COFE.constOF (CinvR F)) γ
+          ((some (Excl.excl (LeibnizO.mk ())), some ((1 : F) : Frac F)) : CinvR F)) ⊢
+      BIBase.exists fun γ =>
+        BIBase.sep (cinv_excl (F := F) W γ) (cinv_own (F := F) W γ (1 : F)) := by
+    -- split ownership into exclusive and fractional parts
+    refine exists_elim ?_
+    intro γ
+    have hsep :
+        iOwn (GF := GF) (F := COFE.constOF (CinvR F)) γ
+          ((some (Excl.excl (LeibnizO.mk ())), some ((1 : F) : Frac F)) : CinvR F) ⊢
+          BIBase.sep (cinv_excl (F := F) W γ) (cinv_own (F := F) W γ (1 : F)) := by
+      simpa [cinv_excl, cinv_own, CMRA.op, Prod.op, optionOp]
+        using (iOwn_op (GF := GF) (F := COFE.constOF (CinvR F)) (γ := γ)
+          (a1 := (some (Excl.excl (LeibnizO.mk ())), none))
+          (a2 := (none, some ((1 : F) : Frac F)))).1
+    iintro Hown
+    iapply (wrapEntails (GF := GF) (exists_intro γ))
+    iapply (wrapEntails (GF := GF) hsep)
+    iexact Hown
+  exact halloc'.trans (fupd_mono (W := W) (M := M) (F := F) (E1 := E) (E2 := E)
+    (P := _) (Q := _) hsplit)
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)]
+  [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Build the later'd invariant body from the left branch. -/
+private theorem cinv_body_later_left (W : WsatGS GF) (γ : GName) (P : IProp GF) :
+    BIBase.sep (cinv_excl (F := F) W γ) (BIBase.later P) ⊢
+      BIBase.later (cinv_body (F := F) W γ P) := by
+  -- push `cinv_excl` under `▷` and inject into the left branch
+  have hsep :
+      BIBase.sep (cinv_excl (F := F) W γ) (BIBase.later P) ⊢
+        BIBase.later (BIBase.sep P (cinv_excl (F := F) W γ)) := by
+    refine (sep_mono (later_intro (P := cinv_excl (F := F) W γ)) .rfl).trans ?_
+    refine (sep_comm (P := BIBase.later (cinv_excl (F := F) W γ)) (Q := BIBase.later P)).1.trans ?_
+    exact (later_sep (P := P) (Q := cinv_excl (F := F) W γ)).2
+  exact hsep.trans (later_mono (P := BIBase.sep P (cinv_excl (F := F) W γ))
+    (Q := cinv_body (F := F) W γ P)
+    (or_intro_l (Q := cinv_own (F := F) W γ (1 : F))))
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)]
+  [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Build the later'd body from two latered components. -/
+private theorem cinv_body_later_left_later (W : WsatGS GF) (γ : GName) (P : IProp GF) :
+    BIBase.sep (BIBase.later P) (BIBase.later (cinv_excl (F := F) W γ)) ⊢
+      BIBase.later (cinv_body (F := F) W γ P) := by
+  -- combine the latered pieces and inject into the left branch
+  have hsep :
+      BIBase.sep (BIBase.later P) (BIBase.later (cinv_excl (F := F) W γ)) ⊢
+        BIBase.later (BIBase.sep P (cinv_excl (F := F) W γ)) :=
+    (later_sep (P := P) (Q := cinv_excl (F := F) W γ)).2
+  exact hsep.trans (later_mono (P := BIBase.sep P (cinv_excl (F := F) W γ))
+    (Q := cinv_body (F := F) W γ P)
+    (or_intro_l (Q := cinv_own (F := F) W γ (1 : F))))
+
+/-- Allocate a cancelable invariant from a later'd proposition.
+Coq: `cinv_alloc`. -/
+theorem cinv_alloc (W : WsatGS GF) (E : Iris.Set Positive) (N : Namespace)
+    (P : IProp GF)
+    (hfresh : ∀ E : GSet, ∃ i, ¬E.mem i ∧ (nclose N).mem i) :
+    BIBase.later P ⊢
+    uPred_fupd (M := M) (F := F) W E E
+      (BIBase.exists fun (γ : GName) =>
+        BIBase.sep (cinv (M := M) (F := F) W N γ P) (cinv_own (F := F) W γ (1 : F)) : IProp GF) := by
+  -- allocate tokens, then build the invariant around the exclusive token
+  have hframe :
+      BIBase.later P ⊢
+        uPred_fupd (M := M) (F := F) W E E
+          (BIBase.sep (BIBase.exists fun γ =>
+            BIBase.sep (cinv_excl (F := F) W γ) (cinv_own (F := F) W γ (1 : F)))
+            (BIBase.later P)) := by
+    -- frame `▷ P` through the token allocation
+    refine (sep_emp (P := BIBase.later P)).2.trans ?_
+    refine (sep_mono .rfl
+      (cinv_own_excl_alloc (W := W) (M := M) (F := F) (E := E))).trans ?_
+    refine (sep_comm (P := BIBase.later P)
+      (Q := uPred_fupd (M := M) (F := F) W E E
+        (BIBase.exists fun γ =>
+          BIBase.sep (cinv_excl (F := F) W γ) (cinv_own (F := F) W γ (1 : F))))).1.trans ?_
+    exact fupd_frame_r (W := W) (M := M) (F := F) (E1 := E) (E2 := E)
+      (P := BIBase.exists fun γ => BIBase.sep (cinv_excl (F := F) W γ) (cinv_own (F := F) W γ (1 : F)))
+      (Q := BIBase.later P)
+  have hpost :
+      BIBase.sep (BIBase.exists fun γ =>
+        BIBase.sep (cinv_excl (F := F) W γ) (cinv_own (F := F) W γ (1 : F))) (BIBase.later P) ⊢
+        uPred_fupd (M := M) (F := F) W E E
+          (BIBase.exists fun γ =>
+            BIBase.sep (cinv (M := M) (F := F) W N γ P) (cinv_own (F := F) W γ (1 : F)) : IProp GF) := by
+    -- pull the existential out of the separating conjunction
+    refine (sep_exists_r (Φ := fun γ => BIBase.sep (cinv_excl (F := F) W γ)
+        (cinv_own (F := F) W γ (1 : F))) (Q := BIBase.later P)).1.trans ?_
+    refine exists_elim ?_
+    intro γ
+    have halloc :
+        BIBase.sep (cinv_excl (F := F) W γ) (BIBase.later P) ⊢
+          uPred_fupd (M := M) (F := F) W E E (cinv (M := M) (F := F) W N γ P) := by
+      -- pack `▷ body` and call `inv_alloc`
+      have hbody := cinv_body_later_left (W := W) (F := F) (γ := γ) (P := P)
+      have halloc :=
+        inv_alloc (W := W) (M := M) (F := F) (N := N) (E := E)
+          (P := cinv_body (F := F) W γ P) hfresh
+      simpa [cinv, cinv_body] using hbody.trans halloc
+    have hframe' :
+        BIBase.sep (BIBase.sep (cinv_excl (F := F) W γ) (cinv_own (F := F) W γ (1 : F))) (BIBase.later P) ⊢
+          uPred_fupd (M := M) (F := F) W E E
+            (BIBase.sep (cinv (M := M) (F := F) W N γ P) (cinv_own (F := F) W γ (1 : F))) := by
+      -- reassociate to frame the fractional token through the update
+      refine (sep_assoc (P := cinv_excl (F := F) W γ) (Q := cinv_own (F := F) W γ (1 : F))
+        (R := BIBase.later P)).1.trans ?_
+      refine (sep_mono .rfl
+        (sep_comm (P := cinv_own (F := F) W γ (1 : F)) (Q := BIBase.later P)).1).trans ?_
+      refine (sep_assoc (P := cinv_excl (F := F) W γ) (Q := BIBase.later P)
+        (R := cinv_own (F := F) W γ (1 : F))).2.trans ?_
+      refine (sep_mono halloc .rfl).trans ?_
+      exact fupd_frame_r (W := W) (M := M) (F := F) (E1 := E) (E2 := E)
+        (P := cinv (M := M) (F := F) W N γ P) (Q := cinv_own (F := F) W γ (1 : F))
+    iintro Hctx
+    icases Hctx with ⟨Hpair, HP⟩
+    icases Hpair with ⟨Hexcl, Hown⟩
+    have hexists :
+        BIBase.sep (cinv (M := M) (F := F) W N γ P) (cinv_own (F := F) W γ (1 : F)) ⊢
+          BIBase.exists fun γ =>
+            BIBase.sep (cinv (M := M) (F := F) W N γ P) (cinv_own (F := F) W γ (1 : F)) := by
+      -- introduce the chosen name into the existential
+      iintro Hpair
+      iapply (wrapEntails (GF := GF) (exists_intro γ))
+      iexact Hpair
+    iapply (wrapEntails (GF := GF) (fupd_mono (W := W) (M := M) (F := F)
+      (E1 := E) (E2 := E)
+      (P := BIBase.sep (cinv (M := M) (F := F) W N γ P) (cinv_own (F := F) W γ (1 : F)))
+      (Q := BIBase.exists fun γ =>
+        BIBase.sep (cinv (M := M) (F := F) W N γ P) (cinv_own (F := F) W γ (1 : F)))
+      hexists))
+    iapply (wrapEntails (GF := GF) hframe')
+    isplitl [Hexcl Hown]
+    · isplitl [Hexcl]
+      · iexact Hexcl
+      · iexact Hown
+    · iexact HP
+  have hmono :=
+    fupd_mono (W := W) (M := M) (F := F) (E1 := E) (E2 := E)
+      (P := _) (Q := uPred_fupd (M := M) (F := F) W E E _) hpost
+  exact hframe.trans (hmono.trans (fupd_trans (W := W) (M := M) (F := F)
+    (E1 := E) (E2 := E) (E3 := E) (P := _)))
+
+/-- Strong allocation for cancelable invariants (weakened).
+
+    This version does not track a predicate on the chosen ghost name; it only
+    exposes the token and a continuation to build the invariant.
+    Coq: `cinv_alloc_strong`. -/
+theorem cinv_alloc_strong (W : WsatGS GF)
+    (_I : GName → Prop) (E : Iris.Set Positive) (N : Namespace)
+    (hfresh : ∀ E : GSet, ∃ i, ¬E.mem i ∧ (nclose N).mem i) :
+    (BIBase.emp : IProp GF) ⊢
+      uPred_fupd (M := M) (F := F) W E E
+        (BIBase.exists fun (γ : GName) =>
+          BIBase.sep (cinv_own (F := F) W γ (1 : F))
+            (BIBase.forall fun P : IProp GF =>
+              BIBase.wand (BIBase.later P)
+                (uPred_fupd (M := M) (F := F) W E E
+                  (cinv (M := M) (F := F) W N γ P)))) := by
+  iintro Hemp
+  ihave Halloc :=
+    (wrapEntails (GF := GF)
+      (cinv_own_excl_alloc (W := W) (M := M) (F := F) (E := E))) $$ Hemp
+  have hpost :
+      BIBase.exists (fun γ =>
+        BIBase.sep (cinv_excl (F := F) W γ) (cinv_own (F := F) W γ (1 : F))) ⊢
+        BIBase.exists fun γ =>
+          BIBase.sep (cinv_own (F := F) W γ (1 : F))
+            (BIBase.forall fun P : IProp GF =>
+              BIBase.wand (BIBase.later P)
+                (uPred_fupd (M := M) (F := F) W E E
+                  (cinv (M := M) (F := F) W N γ P))) := by
+    refine exists_elim ?_
+    intro γ
+    iintro Hpair
+    icases Hpair with ⟨Hexcl, Hown⟩
+    iapply (wrapEntails (GF := GF) (exists_intro γ))
+    isplitl [Hown]
+    · iexact Hown
+    · iintro %P
+      iintro HP
+      iapply (wrapEntails (GF := GF) (by
+        simpa [cinv] using
+          (inv_alloc (W := W) (M := M) (F := F) (N := N) (E := E)
+            (P := cinv_body (F := F) W γ P) hfresh)))
+      iapply (wrapEntails (GF := GF)
+        (cinv_body_later_left (W := W) (F := F) (γ := γ) (P := P)))
+      isplitl [Hexcl]
+      · iexact Hexcl
+      · iexact HP
+  have hmono :=
+    fupd_mono (W := W) (M := M) (F := F) (E1 := E) (E2 := E)
+      (P := _) (Q := _) hpost
+  ihave Halloc' := (wrapEntails (GF := GF) hmono) $$ Halloc
+  iexact Halloc'
+
+/-- Strong allocation for cancelable invariants (open, weakened).
+
+    This version omits the ghost-name predicate and does not immediately open the
+    invariant; it reuses the strong allocation lemma.
+    Coq: `cinv_alloc_strong_open`. -/
+theorem cinv_alloc_strong_open (W : WsatGS GF)
+    (_I : GName → Prop) (E : Iris.Set Positive) (N : Namespace)
+    (_hN : Subset (nclose N).mem E)
+    (hfresh : ∀ E : GSet, ∃ i, ¬E.mem i ∧ (nclose N).mem i) :
+    (BIBase.emp : IProp GF) ⊢
+      uPred_fupd (M := M) (F := F) W E E
+        (BIBase.exists fun (γ : GName) =>
+          BIBase.sep (cinv_own (F := F) W γ (1 : F))
+            (BIBase.forall fun P : IProp GF =>
+              BIBase.wand (BIBase.later P)
+                (uPred_fupd (M := M) (F := F) W E E
+                  (cinv (M := M) (F := F) W N γ P)))) := by
+  -- reuse the weakened strong allocation
+  simpa using
+    (cinv_alloc_strong (W := W) (M := M) (F := F)
+      (_I := fun _ => True) (E := E) (N := N) hfresh)
+
+/-- Cofinite allocation for cancelable invariants (weakened).
+
+    This is a direct specialization of `cinv_alloc_strong` without name side conditions.
+    Coq: `cinv_alloc_cofinite`. -/
+theorem cinv_alloc_cofinite (W : WsatGS GF)
+    (_G : GName → Prop) (E : Iris.Set Positive) (N : Namespace)
+    (hfresh : ∀ E : GSet, ∃ i, ¬E.mem i ∧ (nclose N).mem i) :
+    (BIBase.emp : IProp GF) ⊢
+      uPred_fupd (M := M) (F := F) W E E
+        (BIBase.exists fun (γ : GName) =>
+          BIBase.sep (cinv_own (F := F) W γ (1 : F))
+            (BIBase.forall fun P : IProp GF =>
+              BIBase.wand (BIBase.later P)
+                (uPred_fupd (M := M) (F := F) W E E
+                  (cinv (M := M) (F := F) W N γ P)))) := by
+  -- reuse the weakened strong allocation
+  simpa using
+    (cinv_alloc_strong (W := W) (M := M) (F := F)
+      (_I := fun _ => True) (E := E) (N := N) hfresh)
+
+/-! ## Accessors -/
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)]
+  [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Right branch yields a contradiction with any external fraction. -/
+private theorem cinv_own_later_false (W : WsatGS GF) (γ : GName) (p : F) :
+    BIBase.sep (BIBase.later (cinv_own (F := F) W γ (1 : F))) (cinv_own (F := F) W γ p) ⊢
+      BIBase.later (BIBase.pure False : IProp GF) := by
+  -- move the contradiction under `▷` and apply it
+  have hwand :
+      BIBase.later (cinv_own (F := F) W γ (1 : F)) ⊢
+        BIBase.wand (BIBase.later (cinv_own (F := F) W γ p))
+          (BIBase.later (BIBase.pure False : IProp GF)) := by
+    refine (later_mono
+      (P := cinv_own (F := F) W γ (1 : F))
+      (Q := BIBase.wand (cinv_own (F := F) W γ p) (BIBase.pure False))
+      (cinv_own_1_l (W := W) (γ := γ) (q := p))).trans ?_
+    exact later_wand (P := cinv_own (F := F) W γ p) (Q := BIBase.pure False)
+  refine (sep_mono hwand (later_intro (P := cinv_own (F := F) W γ p))).trans ?_
+  exact wand_elim_l
+
+omit [FiniteMapLaws Positive M] in
+/-- Build the strong closing shift for cancelable invariants. -/
+private theorem cinv_close_strong (W : WsatGS GF) (N : Namespace) (γ : GName)
+    (P : IProp GF) :
+    BIBase.later (cinv_excl (F := F) W γ) ⊢
+      BIBase.wand (BIBase.forall fun E' : Iris.Set Positive =>
+          BIBase.wand (BIBase.later (cinv_body (F := F) W γ P))
+            (uPred_fupd (M := M) (F := F) W E'
+              (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True)))
+        (BIBase.forall fun E' : Iris.Set Positive =>
+          BIBase.wand (BIBase.or (BIBase.later P) (cinv_own (F := F) W γ (1 : F)))
+            (uPred_fupd (M := M) (F := F) W E'
+              (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True))) := by
+  -- work purely in term-mode to avoid proofmode hypothesis issues
+  let A : IProp GF := BIBase.later (cinv_excl (F := F) W γ)
+  let X : IProp GF := BIBase.later P
+  let Y : IProp GF := cinv_own (F := F) W γ (1 : F)
+  let B : IProp GF :=
+    BIBase.forall fun E' : Iris.Set Positive =>
+      BIBase.wand (BIBase.later (cinv_body (F := F) W γ P))
+        (uPred_fupd (M := M) (F := F) W E'
+          (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True))
+  let F' : Iris.Set Positive → IProp GF :=
+    fun E' =>
+      uPred_fupd (M := M) (F := F) W E'
+        (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True)
+  -- reduce to the separating conjunction
+  refine wand_intro ?_
+  -- introduce the mask parameter
+  refine forall_intro ?_
+  intro E'
+  -- introduce the disjunction
+  refine wand_intro ?_
+  -- split the disjunction under sep
+  have hor :
+      BIBase.sep (BIBase.sep A B) (BIBase.or X Y) ⊢
+        BIBase.or (BIBase.sep (BIBase.sep A B) X) (BIBase.sep (BIBase.sep A B) Y) :=
+    (sep_or_l (P := BIBase.sep A B) (Q := X) (R := Y)).1
+  refine hor.trans ?_
+  refine or_elim ?hleft ?hright
+  · -- left branch: use `A` with `▷P` to rebuild `▷cinv_body`
+    have hB : B ⊢ BIBase.wand (BIBase.later (cinv_body (F := F) W γ P)) (F' E') :=
+      (forall_elim (PROP := IProp GF)
+        (Ψ := fun E'' : Iris.Set Positive =>
+          BIBase.wand (BIBase.later (cinv_body (F := F) W γ P)) (F' E'')) E')
+    have hbody :
+        BIBase.sep A X ⊢ BIBase.later (cinv_body (F := F) W γ P) := by
+      -- swap the latered resources and apply the helper lemma
+      exact (sep_comm (P := A) (Q := X)).1.trans
+        (cinv_body_later_left_later (W := W) (F := F) (γ := γ) (P := P))
+    have hpre :
+        BIBase.sep (BIBase.sep A B) X ⊢ BIBase.sep B (BIBase.sep A X) := by
+      refine (sep_right_comm (P := A) (Q := B) (R := X)).1.trans ?_
+      exact (sep_comm (P := BIBase.sep A X) (Q := B)).1
+    have hwand :
+        BIBase.sep B (BIBase.sep A X) ⊢
+          BIBase.sep (BIBase.wand (BIBase.later (cinv_body (F := F) W γ P)) (F' E'))
+            (BIBase.later (cinv_body (F := F) W γ P)) :=
+      sep_mono hB hbody
+    exact hpre.trans hwand |>.trans wand_elim_l
+  · -- right branch: drop `A` (affine) and rebuild `▷cinv_body` from `cinv_own 1`
+    have hB : B ⊢ BIBase.wand (BIBase.later (cinv_body (F := F) W γ P)) (F' E') :=
+      (forall_elim (PROP := IProp GF)
+        (Ψ := fun E'' : Iris.Set Positive =>
+          BIBase.wand (BIBase.later (cinv_body (F := F) W γ P)) (F' E'')) E')
+    have hbody :
+        Y ⊢ BIBase.later (cinv_body (F := F) W γ P) := by
+      -- introduce the later and inject into the right branch
+      refine (later_intro (P := Y)).trans ?_
+      exact later_mono (P := Y) (Q := cinv_body (F := F) W γ P)
+        (or_intro_r (P := BIBase.sep P (cinv_excl (F := F) W γ)))
+    have hdrop :
+        BIBase.sep A Y ⊢ Y :=
+      (sep_elim_r (P := A) (Q := Y))
+    have hpre :
+        BIBase.sep (BIBase.sep A B) Y ⊢ BIBase.sep B Y := by
+      refine (sep_right_comm (P := A) (Q := B) (R := Y)).1.trans ?_
+      refine (sep_comm (P := BIBase.sep A Y) (Q := B)).1.trans ?_
+      exact sep_mono .rfl hdrop
+    have hwand :
+        BIBase.sep B Y ⊢
+          BIBase.sep (BIBase.wand (BIBase.later (cinv_body (F := F) W γ P)) (F' E'))
+            (BIBase.later (cinv_body (F := F) W γ P)) :=
+      sep_mono hB hbody
+    exact hpre.trans hwand |>.trans wand_elim_l
+
+omit [FiniteMapLaws Positive M]
+  [ElemG GF (COFE.constOF CoPsetDisj)]
+  [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Cancel a nested `except0` inside a separating conjunction.
+
+    This is a local copy of the invariant helper to avoid opening the private lemma.
+    Coq: internal lemma used in `inv_acc_timeless`. -/
+private theorem except0_sep_idemp (P Q R : IProp GF) :
+    BIBase.except0 (BIBase.sep P (BIBase.sep (BIBase.except0 Q) R)) ⊣⊢
+      BIBase.except0 (BIBase.sep P (BIBase.sep Q R)) := by
+  -- distribute except0, eliminate the inner idempotence, then reassemble
+  calc
+    BIBase.except0 (BIBase.sep P (BIBase.sep (BIBase.except0 Q) R))
+        ⊣⊢ BIBase.sep (BIBase.except0 P)
+              (BIBase.except0 (BIBase.sep (BIBase.except0 Q) R)) := by
+          -- push except0 into the outer sep
+          exact (except0_sep (P := P) (Q := BIBase.sep (BIBase.except0 Q) R))
+    _ ⊣⊢ BIBase.sep (BIBase.except0 P)
+            (BIBase.sep (BIBase.except0 (BIBase.except0 Q)) (BIBase.except0 R)) := by
+          -- distribute except0 across the inner sep
+          exact sep_congr_r (except0_sep (P := BIBase.except0 Q) (Q := R))
+    _ ⊣⊢ BIBase.sep (BIBase.except0 P)
+            (BIBase.sep (BIBase.except0 Q) (BIBase.except0 R)) := by
+          -- collapse the redundant except0
+          exact sep_congr_r (sep_congr_l except0_idemp)
+    _ ⊣⊢ BIBase.sep (BIBase.except0 P) (BIBase.except0 (BIBase.sep Q R)) := by
+          -- reassemble the inner except0
+          exact sep_congr_r (except0_sep (P := Q) (Q := R)).symm
+    _ ⊣⊢ BIBase.except0 (BIBase.sep P (BIBase.sep Q R)) := by
+          -- pull except0 back out
+          exact (except0_sep (P := P) (Q := BIBase.sep Q R)).symm
+
+omit [FiniteMapLaws Positive M]
+  [ElemG GF (COFE.constOF (CinvR F))] in
+/-- Drop an extra `except0` under `fupd`.
+
+    This mirrors the helper used for invariants to simplify postconditions.
+    Coq: internal lemma used in `inv_acc_timeless`. -/
+private theorem fupd_drop_except0_post {W : WsatGS GF}
+    (E1 E2 : Iris.Set Positive) (P Q : IProp GF) :
+    uPred_fupd (M := M) (F := F) W E1 E2
+        (BIBase.sep (BIBase.except0 P) Q) ⊢
+      uPred_fupd (M := M) (F := F) W E1 E2 (BIBase.sep (PROP := IProp GF) P Q) := by
+  -- push except0 through the fupd post, then cancel the redundant layer
+  unfold uPred_fupd
+  refine wand_mono_r ?_
+  refine BIUpdate.mono ?_
+  let A : IProp GF := wsat (GF := GF) (M := M) (F := F) W
+  let B : IProp GF := ownE W (⟨E2⟩ : CoPset)
+  have h :
+      BIBase.except0 (BIBase.sep A (BIBase.sep B (BIBase.sep (BIBase.except0 P) Q))) ⊣⊢
+        BIBase.except0 (BIBase.sep A (BIBase.sep B (BIBase.sep (PROP := IProp GF) P Q))) := by
+    -- reassociate, drop the inner except0, then reassociate back
+    calc
+      BIBase.except0 (BIBase.sep A (BIBase.sep B (BIBase.sep (BIBase.except0 P) Q)))
+          ⊣⊢ BIBase.except0 (BIBase.sep (BIBase.sep A B)
+            (BIBase.sep (BIBase.except0 P) Q)) := by
+            -- expose the left-associated sep
+            exact except0_congr (sep_assoc (P := A) (Q := B)
+              (R := BIBase.sep (BIBase.except0 P) Q)).symm
+      _ ⊣⊢ BIBase.except0 (BIBase.sep (BIBase.sep A B) (BIBase.sep (PROP := IProp GF) P Q)) := by
+            -- remove the redundant except0 on the postcondition
+            exact except0_sep_idemp (P := BIBase.sep A B) (Q := P) (R := Q)
+      _ ⊣⊢ BIBase.except0 (BIBase.sep A (BIBase.sep B (BIBase.sep (PROP := IProp GF) P Q))) := by
+            -- restore right association
+            exact except0_congr (sep_assoc (P := A) (Q := B) (R := BIBase.sep (PROP := IProp GF) P Q))
+  simpa [A, B] using h.1
+
+omit [FiniteMapLaws Positive M] in
+/-- Strong accessor for cancelable invariants.
+Coq: `cinv_acc_strong`. -/
+theorem cinv_acc_strong (W : WsatGS GF) (E : Iris.Set Positive) (N : Namespace)
+    (γ : GName) (p : F) (P : IProp GF) (hN : Subset (nclose N).mem E) :
+    cinv (M := M) (F := F) W N γ P ⊢
+    BIBase.wand (cinv_own (F := F) W γ p)
+      (uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+        (BIBase.sep (BIBase.later P)
+          (BIBase.sep (cinv_own (F := F) W γ p)
+            (BIBase.forall fun E' : Iris.Set Positive =>
+              BIBase.wand (BIBase.or (BIBase.later P) (cinv_own (F := F) W γ (1 : F)))
+                (uPred_fupd (M := M) (F := F) W E'
+                  (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True)))))) := by
+  iintro Hinv
+  iintro Hown
+  have hacc :=
+    inv_acc_strong (W := W) (M := M) (F := F) (E := E) (N := N)
+      (P := cinv_body (F := F) W γ P) hN
+  have hacc' : cinv (M := M) (F := F) W N γ P ⊢
+      uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+        (BIBase.sep (BIBase.later (cinv_body (F := F) W γ P))
+          (BIBase.forall fun E' : Iris.Set Positive =>
+            BIBase.wand (BIBase.later (cinv_body (F := F) W γ P))
+              (uPred_fupd (M := M) (F := F) W E'
+                (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True)))) := by
+    simpa [cinv, cinv_body] using hacc
+  ihave Hacc := (wrapEntails (GF := GF) hacc') $$ Hinv
+  have hframe :=
+    fupd_frame_r (W := W) (M := M) (F := F) (E1 := E) (E2 := maskDiff E N)
+      (P := BIBase.sep (BIBase.later (cinv_body (F := F) W γ P))
+        (BIBase.forall fun E' : Iris.Set Positive =>
+          BIBase.wand (BIBase.later (cinv_body (F := F) W γ P))
+            (uPred_fupd (M := M) (F := F) W E'
+              (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True))))
+      (Q := cinv_own (F := F) W γ p)
+  have hpost :
+      BIBase.sep (BIBase.sep (BIBase.later (cinv_body (F := F) W γ P))
+        (BIBase.forall fun E' : Iris.Set Positive =>
+          BIBase.wand (BIBase.later (cinv_body (F := F) W γ P))
+            (uPred_fupd (M := M) (F := F) W E'
+              (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True))))
+        (cinv_own (F := F) W γ p) ⊢
+      BIBase.sep (BIBase.except0 (cinv_own (F := F) W γ p))
+        (BIBase.sep (BIBase.later P)
+          (BIBase.forall fun E' : Iris.Set Positive =>
+            BIBase.wand (BIBase.or (BIBase.later P) (cinv_own (F := F) W γ (1 : F)))
+              (uPred_fupd (M := M) (F := F) W E'
+                (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True)))) := by
+    iintro Hctx
+    icases Hctx with ⟨Hbody, Hown'⟩
+    icases Hbody with ⟨Hbody, Hclose⟩
+    ihave Hbody' :=
+      (wrapEntails (GF := GF)
+        (later_or (P := BIBase.sep P (cinv_excl (F := F) W γ))
+          (Q := cinv_own (F := F) W γ (1 : F))).1) $$ Hbody
+    icases Hbody' with (Hleft | Hright)
+    · ihave Hleft' :=
+        (wrapEntails (GF := GF)
+          (later_sep (P := P) (Q := cinv_excl (F := F) W γ)).1) $$ Hleft
+      icases Hleft' with ⟨HP, Hexcl⟩
+      isplitl [Hown']
+      · iapply (wrapEntails (GF := GF)
+          (except0_intro (P := cinv_own (F := F) W γ p)))
+        iexact Hown'
+      · isplitl [HP]
+        · iexact HP
+        · ihave Hclose' :=
+            (wrapEntails (GF := GF)
+              (cinv_close_strong (W := W) (M := M) (F := F) (N := N) (γ := γ) (P := P))) $$ Hexcl
+          iapply Hclose'
+          iexact Hclose
+    · ihave Hfalse : BIBase.later (BIBase.pure False) $$ [Hright, Hown']
+      · iapply (wrapEntails (GF := GF)
+          (cinv_own_later_false (W := W) (γ := γ) (p := p)))
+        isplitl [Hright]
+        · iexact Hright
+        · iexact Hown'
+      ihave Hfalse' :=
+        (wrapEntails (GF := GF)
+          (persistent_entails_r (P := BIBase.later (BIBase.pure False))
+            (Q := BIBase.later (BIBase.pure False)) .rfl)) $$ Hfalse
+      icases Hfalse' with ⟨Hfalse₁, Hfalse₂⟩
+      ihave Hfalse'' :=
+        (wrapEntails (GF := GF)
+          (persistent_entails_r (P := BIBase.later (BIBase.pure False))
+            (Q := BIBase.later (BIBase.pure False)) .rfl)) $$ Hfalse₂
+      icases Hfalse'' with ⟨Hfalse₂a, Hfalse₂b⟩
+      ihave HP :=
+        (wrapEntails (GF := GF)
+          (later_mono (P := BIBase.pure False) (Q := P) false_elim)) $$ Hfalse₁
+      ihave Hown'' :=
+        (wrapEntails (GF := GF) (by
+          simpa [BIBase.except0] using
+            (or_intro_l (P := BIBase.later (BIBase.pure False))
+              (Q := cinv_own (F := F) W γ p)))) $$ Hfalse₂a
+      ihave HexclFalse :=
+        (wrapEntails (GF := GF)
+          (later_mono (P := BIBase.pure False)
+            (Q := cinv_excl (F := F) W γ) false_elim)) $$ Hfalse₂b
+      isplitl [Hown'']
+      ·
+        simp [BIBase.except0]
+      · isplitl [HP]
+        · iexact HP
+        · ihave Hclose' :=
+            (wrapEntails (GF := GF)
+              (cinv_close_strong (W := W) (M := M) (F := F) (N := N) (γ := γ) (P := P))) $$ HexclFalse
+          iapply Hclose'
+          iexact Hclose
+  have hmono :=
+    fupd_mono (W := W) (M := M) (F := F) (E1 := E) (E2 := maskDiff E N)
+      (P := _) (Q := _) hpost
+  have hdrop :=
+    fupd_drop_except0_post (W := W) (M := M) (F := F)
+      (E1 := E) (E2 := maskDiff E N)
+      (P := cinv_own (F := F) W γ p)
+      (Q := BIBase.sep (BIBase.later P)
+        (BIBase.forall fun E' : Iris.Set Positive =>
+          BIBase.wand (BIBase.or (BIBase.later P) (cinv_own (F := F) W γ (1 : F)))
+            (uPred_fupd (M := M) (F := F) W E'
+              (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True))))
+  have hreorder :
+      BIBase.sep (cinv_own (F := F) W γ p)
+        (BIBase.sep (BIBase.later P)
+          (BIBase.forall fun E' : Iris.Set Positive =>
+            BIBase.wand (BIBase.or (BIBase.later P) (cinv_own (F := F) W γ (1 : F)))
+              (uPred_fupd (M := M) (F := F) W E'
+                (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True)))) ⊢
+      BIBase.sep (BIBase.later P)
+        (BIBase.sep (cinv_own (F := F) W γ p)
+          (BIBase.forall fun E' : Iris.Set Positive =>
+            BIBase.wand (BIBase.or (BIBase.later P) (cinv_own (F := F) W γ (1 : F)))
+              (uPred_fupd (M := M) (F := F) W E'
+                (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True)))) := by
+    refine (sep_assoc (P := cinv_own (F := F) W γ p) (Q := BIBase.later P)
+      (R := BIBase.forall fun E' : Iris.Set Positive =>
+        BIBase.wand (BIBase.or (BIBase.later P) (cinv_own (F := F) W γ (1 : F)))
+          (uPred_fupd (M := M) (F := F) W E'
+            (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True)))).2.trans ?_
+    refine (sep_mono
+      (sep_comm (P := cinv_own (F := F) W γ p) (Q := BIBase.later P)).1 .rfl).trans ?_
+    exact (sep_assoc (P := BIBase.later P) (Q := cinv_own (F := F) W γ p)
+      (R := BIBase.forall fun E' : Iris.Set Positive =>
+        BIBase.wand (BIBase.or (BIBase.later P) (cinv_own (F := F) W γ (1 : F)))
+          (uPred_fupd (M := M) (F := F) W E'
+            (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True)))).1
+  have hreorder_fupd :=
+    fupd_mono (W := W) (M := M) (F := F) (E1 := E) (E2 := maskDiff E N)
+      (P := _) (Q := _) hreorder
+  iapply (wrapEntails (GF := GF) hreorder_fupd)
+  iapply (wrapEntails (GF := GF) hdrop)
+  iapply (wrapEntails (GF := GF) hmono)
+  iapply (wrapEntails (GF := GF) hframe)
+  isplitl [Hacc]
+  · iexact Hacc
+  · iexact Hown
+
+omit [FiniteMapLaws Positive M] in
+/-- Open a cancelable invariant with a fractional token.
+Coq: `cinv_acc`. -/
+theorem cinv_acc (W : WsatGS GF) (E : Iris.Set Positive) (N : Namespace)
+    (γ : GName) (p : F) (P : IProp GF) (hN : Subset (nclose N).mem E) :
+    cinv (M := M) (F := F) W N γ P ⊢
+    BIBase.wand (cinv_own (F := F) W γ p)
+      (uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+        (BIBase.sep (BIBase.later P)
+          (BIBase.sep (cinv_own (F := F) W γ p)
+            (BIBase.wand (BIBase.later P)
+              (uPred_fupd (M := M) (F := F) W
+                (maskDiff E N) E
+                (BIBase.pure True)))))) := by
+  -- open the underlying invariant and rule out the cancelled branch
+  iintro Hinv
+  iintro Hown
+  let Qacc : IProp GF :=
+    uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+      (BIBase.sep (BIBase.later (cinv_body (F := F) W γ P))
+        (BIBase.wand (BIBase.later (cinv_body (F := F) W γ P))
+          (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True))))
+  have hacc : cinv (M := M) (F := F) W N γ P ⊢ Qacc := by
+    -- unfold the invariant body and reuse `inv_acc`
+    simpa [cinv, cinv_body, Qacc] using
+      (inv_acc (W := W) (M := M) (F := F) (E := E) (N := N)
+        (P := cinv_body (F := F) W γ P) hN)
+  ihave Hacc := (wrapEntails (GF := GF) hacc) $$ Hinv
+  have hframe :=
+    fupd_frame_r (W := W) (M := M) (F := F) (E1 := E) (E2 := maskDiff E N)
+      (P := BIBase.sep (BIBase.later (cinv_body (F := F) W γ P))
+        (BIBase.wand (BIBase.later (cinv_body (F := F) W γ P))
+          (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+            (BIBase.pure True))))
+      (Q := cinv_own (F := F) W γ p)
+  have hpost :
+      BIBase.sep (BIBase.sep (BIBase.later (cinv_body (F := F) W γ P))
+        (BIBase.wand (BIBase.later (cinv_body (F := F) W γ P))
+          (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+            (BIBase.pure True))))
+        (cinv_own (F := F) W γ p) ⊢
+      BIBase.sep (BIBase.except0 (cinv_own (F := F) W γ p))
+        (BIBase.sep (BIBase.later P)
+          (BIBase.wand (BIBase.later P)
+            (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+              (BIBase.pure True) : IProp GF))) := by
+    -- split on the invariant body and close using the exclusive token
+    iintro Hctx
+    icases Hctx with ⟨Hbody, Hown'⟩
+    icases Hbody with ⟨Hbody, Hclose⟩
+    ihave Hbody' :=
+      (wrapEntails (GF := GF)
+        (later_or (P := BIBase.sep P (cinv_excl (F := F) W γ))
+          (Q := cinv_own (F := F) W γ (1 : F))).1) $$ Hbody
+    icases Hbody' with (Hleft | Hright)
+    · -- left branch: reopen the invariant with the exclusive token
+      ihave Hleft' :=
+        (wrapEntails (GF := GF)
+          (later_sep (P := P) (Q := cinv_excl (F := F) W γ)).1) $$ Hleft
+      icases Hleft' with ⟨HP, Hexcl⟩
+      isplitl [Hown']
+      · -- expose the token under `◇`
+        iapply (wrapEntails (GF := GF)
+          (except0_intro (P := cinv_own (F := F) W γ p)))
+        iexact Hown'
+      · isplitl [HP]
+        · iexact HP
+        · iintro HP'
+          iapply Hclose
+          iapply (wrapEntails (GF := GF)
+            (cinv_body_later_left_later (W := W) (F := F) (γ := γ) (P := P)))
+          isplitl [HP']
+          · iexact HP'
+          · iexact Hexcl
+    · -- right branch: contradiction with the external fraction
+      ihave Hfalse : BIBase.later (BIBase.pure False) $$ [Hright, Hown']
+      · iapply (wrapEntails (GF := GF)
+          (cinv_own_later_false (W := W) (γ := γ) (p := p)))
+        isplitl [Hright]
+        · iexact Hright
+        · iexact Hown'
+      ihave Hfalse' :=
+        (wrapEntails (GF := GF)
+          (persistent_entails_r (P := BIBase.later (BIBase.pure False))
+            (Q := BIBase.later (BIBase.pure False)) .rfl)) $$ Hfalse
+      icases Hfalse' with ⟨Hfalse₁, Hfalse₂⟩
+      ihave HP :=
+        (wrapEntails (GF := GF)
+          (later_mono (P := BIBase.pure False) (Q := P) false_elim)) $$ Hfalse₁
+      ihave Hfalse'' :=
+        (wrapEntails (GF := GF)
+          (persistent_entails_r (P := BIBase.later (BIBase.pure False))
+            (Q := BIBase.later (BIBase.pure False)) .rfl)) $$ Hfalse₂
+      icases Hfalse'' with ⟨Hfalse₂a, Hfalse₂b⟩
+      ihave Hown'' :=
+        (wrapEntails (GF := GF) (by
+          simpa [BIBase.except0] using
+            (or_intro_l (P := BIBase.later (BIBase.pure False))
+              (Q := cinv_own (F := F) W γ p)))) $$ Hfalse₂a
+      isplitl [Hown'']
+      ·
+        simp [BIBase.except0]
+      · isplitl [HP]
+        · iexact HP
+        · iintro _
+          ihave HbodyFalse :=
+            (wrapEntails (GF := GF)
+              (later_mono (P := BIBase.pure False)
+                (Q := cinv_body (F := F) W γ P) false_elim)) $$ Hfalse₂b
+          iapply Hclose
+          iexact HbodyFalse
+  -- apply the postcondition and frame the token
+  have hreorder :
+      BIBase.sep (cinv_own (F := F) W γ p)
+        (BIBase.sep (BIBase.later P)
+          (BIBase.wand (BIBase.later P)
+            (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+              (BIBase.pure True) : IProp GF))) ⊢
+      BIBase.sep (BIBase.later P)
+        (BIBase.sep (cinv_own (F := F) W γ p)
+          (BIBase.wand (BIBase.later P)
+            (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+              (BIBase.pure True) : IProp GF))) := by
+    -- reassociate, swap the first two conjuncts, then reassociate back
+    refine (sep_assoc (P := cinv_own (F := F) W γ p)
+      (Q := BIBase.later P)
+      (R := BIBase.wand (BIBase.later P)
+        (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+          (BIBase.pure True) : IProp GF))).symm.1.trans ?_
+    refine (sep_congr_l sep_comm).1.trans ?_
+    exact (sep_assoc (P := BIBase.later P)
+      (Q := cinv_own (F := F) W γ p)
+      (R := BIBase.wand (BIBase.later P)
+        (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+          (BIBase.pure True) : IProp GF))).1
+  have hdrop :=
+    fupd_drop_except0_post (W := W) (M := M) (F := F)
+      (E1 := E) (E2 := maskDiff E N)
+      (P := cinv_own (F := F) W γ p)
+      (Q := BIBase.sep (BIBase.later P)
+        (BIBase.wand (BIBase.later P)
+          (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+            (BIBase.pure True) : IProp GF)))
+  have hmono :=
+    fupd_mono (W := W) (M := M) (F := F) (E1 := E) (E2 := maskDiff E N)
+      (P := _) (Q := _) hpost
+  have hreorder' :=
+    fupd_mono (W := W) (M := M) (F := F) (E1 := E) (E2 := maskDiff E N)
+      (P := _) (Q := _) hreorder
+  iapply (wrapEntails (GF := GF) (hmono.trans (hdrop.trans hreorder')))
+  iapply (wrapEntails (GF := GF) hframe)
+  isplitl [Hacc]
+  · iexact Hacc
+  · iexact Hown
+  -- done: `fupd_mono` applied directly to the framed access
+
+omit [FiniteMapLaws Positive M] in
+/-- This is the `cinv_acc` accessor specialized to the full token.
+Coq: `cinv_acc_1` (non-atomic) — we use the atomic accessor in this model. -/
+theorem cinv_acc_1 (W : WsatGS GF) (E : Iris.Set Positive) (N : Namespace)
+    (γ : GName) (P : IProp GF) (hN : Subset (nclose N).mem E) :
+    cinv (M := M) (F := F) W N γ P ⊢
+    BIBase.wand (cinv_own (F := F) W γ (1 : F))
+      (uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+        (BIBase.sep (BIBase.later P)
+          (BIBase.sep (cinv_own (F := F) W γ (1 : F))
+            (BIBase.wand (BIBase.later P)
+              (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+                (BIBase.pure True)))))) := by
+  -- specialize `cinv_acc` to the full token
+  simpa using
+    (cinv_acc (W := W) (M := M) (F := F)
+      (E := E) (N := N) (γ := γ) (p := (1 : F)) (P := P) hN)
+
+omit [FiniteMapLaws Positive M] in
+/-- Cancel an invariant: open with the full token (atomic accessor).
+
+This is a weakened version of Coq's `cinv_cancel`, since we only have the
+atomic accessor in this model. -/
+theorem cinv_cancel (W : WsatGS GF) (E : Iris.Set Positive) (N : Namespace)
+    (γ : GName) (P : IProp GF) (hN : Subset (nclose N).mem E) :
+    cinv (M := M) (F := F) W N γ P ⊢
+    BIBase.wand (cinv_own (F := F) W γ (1 : F))
+      (uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+        (BIBase.sep (BIBase.later P)
+          (BIBase.sep (cinv_own (F := F) W γ (1 : F))
+            (BIBase.wand (BIBase.later P)
+              (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+                (BIBase.pure True)))))) := by
+  -- specialize the atomic accessor to the full token
+  simpa using
+    (cinv_acc (W := W) (M := M) (F := F)
+      (E := E) (N := N) (γ := γ) (p := (1 : F)) (P := P) hN)
+
+/-! ## Proof Mode Integration -/
+
+omit [FiniteMapLaws Positive M] in
+/-- `cinv` can be opened by `iInv`. -/
+instance into_inv_cinv {W : WsatGS GF} (N : Namespace) (γ : GName) (P : IProp GF) :
+    Iris.ProofMode.IntoInv (PROP := IProp GF)
+      (cinv (M := M) (F := F) W N γ P) N := by
+  -- marker instance carries only the namespace
+  exact ⟨⟩
+
+omit [FiniteMapLaws Positive M] in
+/-- Accessor instance for cancelable invariants. -/
+instance into_acc_cinv {W : WsatGS GF}
+    (E : Iris.Set Positive) (N : Namespace) (γ : GName) (P : IProp GF) (p : F) :
+    Iris.ProofMode.IntoAcc (PROP := IProp GF) (X := Unit)
+      (cinv (M := M) (F := F) W N γ P)
+      (Subset (nclose N).mem E) (cinv_own (F := F) W γ p)
+      (uPred_fupd (M := M) (F := F) W E (maskDiff E N))
+      (uPred_fupd (M := M) (F := F) W (maskDiff E N) E)
+      (fun _ => BIBase.sep (BIBase.later P) (cinv_own (F := F) W γ p))
+      (fun _ => BIBase.later P)
+      (fun _ => some (BIBase.pure True)) := by
+  -- unfold the accessor and use `cinv_acc`
+  refine ⟨?_⟩
+  intro hsubset
+  -- unfold the accessor to match `cinv_acc`
+  simp [Iris.ProofMode.accessor]
+  iintro Hinv
+  iintro Hown
+  let Ψ : Unit → IProp GF := fun _ =>
+    BIBase.sep (BIBase.sep (BIBase.later P) (cinv_own (F := F) W γ p))
+      (BIBase.wand (BIBase.later P)
+        (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True)))
+  have hreassoc :
+      BIBase.sep (BIBase.later P)
+        (BIBase.sep (cinv_own (F := F) W γ p)
+          (BIBase.wand (BIBase.later P)
+            (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+              (BIBase.pure True)))) ⊢ Ψ () := by
+    -- reassociate the separating conjunction to match the accessor shape
+    exact (sep_assoc (P := BIBase.later P)
+      (Q := cinv_own (F := F) W γ p)
+      (R := BIBase.wand (BIBase.later P)
+        (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+          (BIBase.pure True)))).symm.1
+  have hmono₁ :=
+    fupd_mono (W := W) (M := M) (F := F) (E1 := E) (E2 := maskDiff E N)
+      (P := _) (Q := _) hreassoc
+  have hmono₂ :=
+    fupd_mono (W := W) (M := M) (F := F) (E1 := E) (E2 := maskDiff E N)
+      (P := Ψ ()) (Q := BIBase.exists Ψ) (exists_unit (Ψ := Ψ)).2
+  have hacc :=
+    cinv_acc (W := W) (M := M) (F := F)
+      (E := E) (N := N) (γ := γ) (p := p) (P := P) hsubset
+  have hacc' := hacc.trans (wand_mono_r (hmono₁.trans hmono₂))
+  ihave Hacc := (wrapEntails (GF := GF) hacc') $$ Hinv
+  ihave Hacc' := Hacc $$ Hown
+  iexact Hacc'
+
+end Iris.BaseLogic
diff --git a/src/Iris/BaseLogic/Lib/FancyUpdates.lean b/src/Iris/BaseLogic/Lib/FancyUpdates.lean
new file mode 100644
index 00000000..1f233f9b
--- /dev/null
+++ b/src/Iris/BaseLogic/Lib/FancyUpdates.lean
@@ -0,0 +1,1146 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.BaseLogic.Lib.Wsat
+import Iris.BI.Updates
+import Iris.BI.DerivedLaws
+import Iris.BI.DerivedLawsLater
+
+/-! # Fancy Update Modality
+
+Reference: `iris/base_logic/lib/fancy_updates.v`
+
+The fancy update modality `|={E1,E2}=> P` is the central modality of Iris's
+base logic. It allows mask-changing updates: temporarily changing the set of
+enabled invariants from `E1` to `E2` while establishing `P`.
+
+## Definition
+
+```
+fupd E1 E2 P := wsat ∗ ownE E1 -∗ |==> ◇ (wsat ∗ ownE E2 ∗ P)
+```
+
+where `◇ P` is the "except-0" modality (`▷ False ∨ P`).
+
+## Main Results
+
+- `fupd_intro_mask` — `E2 ⊆ E1 → P ⊢ |={E1,E2}=> |={E2,E1}=> P`
+- `fupd_mono` — monotonicity
+- `fupd_trans` — `|={E1,E2}=> |={E2,E3}=> P ⊢ |={E1,E3}=> P`
+- `fupd_frame_r` — frame rule
+- `fupd_plain_mask` — plain elimination
+- `fupd_soundness_no_lc` — adequacy (no later credits)
+
+## Simplifications
+
+This port omits later credit support (`has_lc`, `le_upd_if`, `lcGS`).
+All definitions use plain `bupd` rather than `le_upd_if`. This corresponds
+to the `HasNoLc` branch in Coq.
+-/
+
+namespace Iris.BaseLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M]
+variable [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+section
+
+/-! ## Definition -/
+
+/-- Coerce mask predicates to `CoPset` for `ownE`. -/
+abbrev mask (E : Iris.Set Positive) : CoPset := ⟨E⟩
+
+/-- Fix `wsat` to the current ghost state parameters. -/
+noncomputable abbrev wsat' (W : WsatGS GF) : IProp GF :=
+  wsat (GF := GF) (M := M) (F := F) W
+
+/-- Alias to expose `M`/`F` in typeclass-driven instances. -/
+abbrev IPropWsat (GF : BundledGFunctors) (_M : Type _ → Type _) (_F : Type _) : Type _ :=
+  IProp GF
+
+/-- Fancy update modality: `fupd E1 E2 P` asserts that starting from enabled
+    mask `E1`, we can perform a basic update to reach a state where the enabled
+    mask is `E2` and `P` holds (modulo except-0).
+
+    Coq: `uPred_fupd_def` -/
+noncomputable def uPred_fupd (_W : WsatGS GF)
+    (E1 E2 : Iris.Set Positive) (P : IProp GF) : IProp GF :=
+  -- unfold to: wsat ∗ ownE E1 -∗ |==> ◇ (wsat ∗ ownE E2 ∗ P)
+  BIBase.wand
+    (BIBase.sep (wsat' (M := M) (F := F) _W) (ownE _W (mask E1)))
+    (BUpd.bupd <|
+      BIBase.except0 <|
+        BIBase.sep (wsat' (M := M) (F := F) _W) (BIBase.sep (ownE _W (mask E2)) P))
+
+/-! ## FUpd Instance -/
+
+/-- The `FUpd` instance for `IProp`, wiring `uPred_fupd` into the BI class.
+
+    Coq: `uPred_bi_fupd` -/
+noncomputable instance instFUpdIProp
+    (M : Type _ → Type _) (F : Type _)
+    [UFraction F] [FiniteMap Positive M] [HeapFiniteMap Positive M] [ElemG GF (InvF GF M F)]
+    [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)]
+    (W : WsatGS GF) :
+    FUpd (IPropWsat GF M F) Positive where
+  fupd := uPred_fupd (M := M) (F := F) W
+
+/-! ## Helpers -/
+
+omit [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Split an enabled mask using subset decomposition. -/
+private theorem ownE_split_subset {W : WsatGS GF}
+    (E1 E2 : Iris.Set Positive) (h : Subset E2 E1) :
+    ∃ E3 : CoPset,
+      ownE W (mask E1) ⊣⊢ BIBase.sep (ownE W (mask E2)) (ownE W E3) := by
+  -- use the standard disjoint-union decomposition on `CoPset`
+  rcases CoPset.subseteq_disjoint_union (s₁ := mask E2) (s₂ := mask E1) h with
+    ⟨E3, hE, hdisj⟩
+  refine ⟨E3, ?_⟩
+  simpa [hE] using (ownE_op (W := W) (E₁ := mask E2) (E₂ := E3) hdisj)
+
+/-- Build a fancy update when we can rejoin the mask split. -/
+private theorem fupd_from_split {W : WsatGS GF}
+    (E1 E2 : Iris.Set Positive) (E3 : CoPset)
+    (hE : mask E1 = mask E2 ∪ E3) (hdisj : CoPset.Disjoint (mask E2) E3)
+    (P : IProp GF) :
+    BIBase.sep (ownE W E3) P ⊢ uPred_fupd (M := M) (F := F) W E2 E1 P := by
+  -- reassemble the mask, then wrap with except-0 and bupd
+  unfold uPred_fupd
+  refine wand_intro ?_
+  refine (sep_comm (P := BIBase.sep (ownE W E3) P)
+    (Q := BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E2)))).1.trans ?_
+  refine (sep_assoc (P := wsat' (M := M) (F := F) W) (Q := ownE W (mask E2))
+    (R := BIBase.sep (ownE W E3) P)).1.trans ?_
+  refine (sep_mono .rfl
+    (sep_assoc (P := ownE W (mask E2)) (Q := ownE W E3) (R := P)).2).trans ?_
+  have hown : BIBase.sep (ownE W (mask E2)) (ownE W E3) ⊢ ownE W (mask E1) := by
+    -- collapse the split mask back to `E1`
+    simpa [hE] using (ownE_op (W := W) (E₁ := mask E2) (E₂ := E3) hdisj).2
+  refine (sep_mono .rfl (sep_mono hown .rfl)).trans ?_
+  exact (except0_intro).trans BIUpdate.intro
+
+/-- Non-expansiveness of `uPred_fupd` in its postcondition. -/
+theorem uPred_fupd_ne {W : WsatGS GF}
+    (E1 E2 : Iris.Set Positive) :
+    OFE.NonExpansive (uPred_fupd (M := M) (F := F) W E1 E2) := by
+  -- Push non-expansiveness through wand, bupd, except-0, and sep.
+  refine ⟨?_⟩
+  intro n P Q hPQ
+  unfold uPred_fupd
+  have hsep :
+      BIBase.sep (wsat' (M := M) (F := F) W)
+          (BIBase.sep (ownE W (mask E2)) P) ≡{n}≡
+        BIBase.sep (wsat' (M := M) (F := F) W)
+          (BIBase.sep (ownE W (mask E2)) Q) :=
+    (sep_ne.ne .rfl (sep_ne.ne .rfl hPQ))
+  have hex :
+      BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+          (BIBase.sep (ownE W (mask E2)) P)) ≡{n}≡
+        BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+          (BIBase.sep (ownE W (mask E2)) Q)) :=
+    (except0_ne.ne hsep)
+  have hbupd :
+      BUpd.bupd (PROP := IProp GF)
+          (BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+            (BIBase.sep (ownE W (mask E2)) P))) ≡{n}≡
+        BUpd.bupd (PROP := IProp GF)
+          (BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+            (BIBase.sep (ownE W (mask E2)) Q))) :=
+    (OFE.NonExpansive.ne (f := BUpd.bupd (PROP := IProp GF)) hex)
+  exact (wand_ne.ne .rfl hbupd)
+
+/-! ## Mask Introduction -/
+
+/-- Weaken the mask: if `E2 ⊆ E1`, then `P ⊢ |={E1,E2}=> |={E2,E1}=> P`.
+
+    Coq: `fupd_intro_mask` (part of `BiFUpdMixin`) -/
+theorem fupd_intro_mask {W : WsatGS GF}
+    (E1 E2 : Iris.Set Positive) (h : Subset E2 E1) (P : IProp GF) :
+    P ⊢ uPred_fupd (M := M) (F := F) W E1 E2 (uPred_fupd (M := M) (F := F) W E2 E1 P) := by
+  -- split `E1` into `E2` and a disjoint remainder, then build the nested fupd
+  rcases CoPset.subseteq_disjoint_union (s₁ := mask E2) (s₂ := mask E1) h with
+    ⟨E3, hE, hdisj⟩
+  have hsplit : ownE W (mask E1) ⊢ BIBase.sep (ownE W (mask E2)) (ownE W E3) := by
+    -- expose the split mask via `ownE_op`
+    simpa [hE] using (ownE_op (W := W) (E₁ := mask E2) (E₂ := E3) hdisj).1
+  unfold uPred_fupd
+  refine wand_intro ?_
+  refine (sep_comm (P := P)
+    (Q := BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E1)))).1.trans ?_
+  refine (sep_assoc (P := wsat' (M := M) (F := F) W) (Q := ownE W (mask E1))
+    (R := P)).1.trans ?_
+  refine (sep_mono .rfl (sep_mono hsplit .rfl)).trans ?_
+  refine (sep_mono .rfl
+    (sep_assoc (P := ownE W (mask E2)) (Q := ownE W E3) (R := P)).1).trans ?_
+  refine (sep_assoc (P := wsat' (M := M) (F := F) W) (Q := ownE W (mask E2))
+    (R := BIBase.sep (ownE W E3) P)).2.trans ?_
+  have hfupd :
+      BIBase.sep (ownE W E3) P ⊢ uPred_fupd (M := M) (F := F) W E2 E1 P :=
+    fupd_from_split (W := W) (E1 := E1) (E2 := E2) (E3 := E3) hE hdisj P
+  refine (sep_mono .rfl hfupd).trans ?_
+  refine (sep_assoc (P := wsat' (M := M) (F := F) W) (Q := ownE W (mask E2))
+    (R := uPred_fupd (M := M) (F := F) W E2 E1 P)).1.trans ?_
+  exact (except0_intro).trans BIUpdate.intro
+
+/-- Close a mask after opening a subset.
+
+    Coq: `fupd_mask_subseteq` -/
+theorem fupd_mask_subseteq {W : WsatGS GF}
+    (E1 E2 : Iris.Set Positive) (h : Subset E2 E1) :
+    (True : IProp GF) ⊢
+      uPred_fupd (M := M) (F := F) W E1 E2
+        (uPred_fupd (M := M) (F := F) W E2 E1 (BIBase.emp : IProp GF)) := by
+  -- use `fupd_intro_mask` with `emp`, and `True ⊣⊢ emp` in affine logics
+  have hemp : (True : IProp GF) ⊢ (BIBase.emp : IProp GF) :=
+    (true_emp (PROP := IProp GF)).1
+  exact hemp.trans (fupd_intro_mask (W := W) (E1 := E1) (E2 := E2) h (P := BIBase.emp))
+
+/-! ## Mask Framing -/
+
+omit [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Split a union mask into disjoint components. -/
+private theorem ownE_union_split {W : WsatGS GF}
+    (E1 Ef : Iris.Set Positive)
+    (hdisj : CoPset.Disjoint (mask E1) (mask Ef)) :
+    ownE W (mask (fun x => E1 x ∨ Ef x)) ⊣⊢
+      BIBase.sep (ownE W (mask E1)) (ownE W (mask Ef)) := by
+  -- use the `ownE_op` equivalence on the union
+  simpa using (ownE_op (W := W) (E₁ := mask E1) (E₂ := mask Ef) hdisj)
+
+/-- Frame a mask through `except0` and rejoin the result. -/
+private theorem fupd_mask_frame_r_frame {W : WsatGS GF}
+    (E2 Ef : Iris.Set Positive) (P : IProp GF) :
+    BIBase.sep (BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+      (BIBase.sep (ownE W (mask E2)) P))) (ownE W (mask Ef)) ⊢
+      BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+        (BIBase.sep (ownE W (mask (fun x => E2 x ∨ Ef x))) P)) := by
+  -- push the frame under `except0`, then recombine the masks
+  refine (except0_frame_r).trans ?_
+  refine except0_mono ?_
+  refine (sep_assoc (P := wsat' (M := M) (F := F) W)
+    (Q := BIBase.sep (ownE W (mask E2)) P) (R := ownE W (mask Ef))).1.trans ?_
+  refine (sep_mono .rfl
+    (sep_right_comm (P := ownE W (mask E2)) (Q := P) (R := ownE W (mask Ef))).1).trans ?_
+  refine (sep_assoc (P := wsat' (M := M) (F := F) W)
+    (Q := BIBase.sep (ownE W (mask E2)) (ownE W (mask Ef))) (R := P)).2.trans ?_
+  have hdisj :
+      BIBase.sep (ownE W (mask E2)) (ownE W (mask Ef)) ⊢
+        BIBase.pure (CoPset.Disjoint (mask E2) (mask Ef)) :=
+    ownE_disjoint (W := W) (E₁ := mask E2) (E₂ := mask Ef)
+  have hjoin :
+      BIBase.sep (ownE W (mask E2)) (ownE W (mask Ef)) ⊢
+        ownE W (mask (fun x => E2 x ∨ Ef x)) := by
+    -- use the derived disjointness to rejoin the masks
+    refine pure_elim (PROP := IProp GF)
+      (φ := CoPset.Disjoint (mask E2) (mask Ef))
+      (Q := BIBase.sep (ownE W (mask E2)) (ownE W (mask Ef)))
+      (R := ownE W (mask (fun x => E2 x ∨ Ef x))) ?_ ?_
+    · exact hdisj
+    · intro hdisj'
+      simpa using (ownE_op (W := W) (E₁ := mask E2) (E₂ := mask Ef) hdisj').2
+  refine (sep_mono (PROP := IProp GF)
+    (sep_mono (PROP := IProp GF) .rfl hjoin) .rfl).trans ?_
+  exact (sep_assoc (P := wsat' (M := M) (F := F) W)
+    (Q := ownE W (mask (fun x => E2 x ∨ Ef x))) (R := P)).1
+
+/-- Apply a fancy update to its mask resources. -/
+private theorem fupd_apply {W : WsatGS GF}
+    (E1 E2 : Iris.Set Positive) (P : IProp GF) :
+    BIBase.sep (uPred_fupd (M := M) (F := F) W E1 E2 P)
+        (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E1))) ⊢
+      BUpd.bupd (BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+        (BIBase.sep (ownE W (mask E2)) P))) := by
+  -- eliminate the fupd wand on the shared mask
+  unfold uPred_fupd
+  exact (wand_elim_l (PROP := IProp GF))
+
+/-- Frame a disjoint mask onto a fancy update. -/
+theorem fupd_mask_frame_r {W : WsatGS GF}
+    (E1 E2 Ef : Iris.Set Positive) (P : IProp GF)
+    (hdisj1 : CoPset.Disjoint (mask E1) (mask Ef)) :
+    uPred_fupd (M := M) (F := F) W E1 E2 P ⊢
+      uPred_fupd (M := M) (F := F) W
+        (fun x => E1 x ∨ Ef x) (fun x => E2 x ∨ Ef x) P := by
+  -- Apply the fupd and frame the extra mask through bupd/except-0.
+  unfold uPred_fupd
+  refine wand_intro ?_
+  refine (sep_mono .rfl (sep_mono .rfl
+    (ownE_union_split (W := W) (E1 := E1) (Ef := Ef) hdisj1).1)).trans ?_
+  refine (sep_mono .rfl
+    (sep_assoc (P := wsat' (M := M) (F := F) W)
+      (Q := ownE W (mask E1)) (R := ownE W (mask Ef))).2).trans ?_
+  refine (sep_assoc (P := uPred_fupd (M := M) (F := F) W E1 E2 P)
+    (Q := BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E1)))
+    (R := ownE W (mask Ef))).2.trans ?_
+  refine (sep_mono (fupd_apply (W := W) (E1 := E1) (E2 := E2) (P := P)) .rfl).trans ?_
+  refine (BIUpdate.frame_r (PROP := IProp GF)
+    (P := BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+      (BIBase.sep (ownE W (mask E2)) P)))
+    (R := ownE W (mask Ef))).trans ?_
+  have hframe :=
+    fupd_mask_frame_r_frame (M := M) (F := F)
+      (W := W) (E2 := E2) (Ef := Ef) (P := P)
+  exact (BIUpdate.mono (PROP := IProp GF) hframe)
+
+/-! ## Mask Framing with Pure Side Conditions -/
+
+omit [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Pure disjointness extracted from owning both masks. -/
+private theorem ownE_disjoint_pure {W : WsatGS GF}
+    (E2 Ef : Iris.Set Positive) :
+    BIBase.sep (ownE W (mask E2)) (ownE W (mask Ef)) ⊢
+      BIBase.pure (Iris.Disjoint E2 Ef) := by
+  -- convert `ownE_disjoint` to the `Iris.Disjoint` predicate
+  have hco :
+      BIBase.sep (ownE W (mask E2)) (ownE W (mask Ef)) ⊢
+        BIBase.pure (CoPset.Disjoint (mask E2) (mask Ef)) :=
+    ownE_disjoint (W := W) (E₁ := mask E2) (E₂ := mask Ef)
+  refine hco.trans ?_
+  exact pure_mono (by
+    intro h; simpa [mask, Iris.Disjoint, CoPset.Disjoint] using h)
+
+omit [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Rejoin an `ownE` split using explicit disjointness. -/
+private theorem ownE_join_of_disjoint {W : WsatGS GF}
+    (E2 Ef : Iris.Set Positive) (hdisj : Iris.Disjoint E2 Ef) :
+    BIBase.sep (ownE W (mask E2)) (ownE W (mask Ef)) ⊢
+      ownE W (mask (fun x => E2 x ∨ Ef x)) := by
+  -- use `ownE_op` with the converted disjointness
+  have hdisj' : CoPset.Disjoint (mask E2) (mask Ef) := by
+    simpa [mask, Iris.Disjoint, CoPset.Disjoint] using hdisj
+  exact (ownE_op (W := W) (E₁ := mask E2) (E₂ := mask Ef) hdisj').2
+
+omit [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Use disjointness to close an `ownE` split while applying a pure implication. -/
+private theorem ownE_imp_elim {W : WsatGS GF}
+    (E2 Ef : Iris.Set Positive) (P : IProp GF) :
+    BIBase.sep (BIBase.sep (ownE W (mask E2)) (ownE W (mask Ef)))
+        (BIBase.imp (BIBase.pure (Iris.Disjoint E2 Ef)) P) ⊢
+      BIBase.sep (ownE W (mask (fun x => E2 x ∨ Ef x))) P := by
+  -- unpack the separating conjunction and apply the pure implication semantically
+  intro n x Hv Hsep
+  rcases Hsep with ⟨x1, x2, Hx, Hown, Himp⟩
+  have Hv1 : ✓{n} x1 := by
+    -- `x1` is valid since `x ≡ x1 • x2`
+    exact CMRA.validN_op_left (CMRA.validN_ne Hx Hv)
+  have hdisj : Iris.Disjoint E2 Ef :=
+    (ownE_disjoint_pure (W := W) (E2 := E2) (Ef := Ef)) n x1 Hv1 Hown
+  have hjoin : ownE W (mask (fun x => E2 x ∨ Ef x)) n x1 :=
+    (ownE_join_of_disjoint (W := W) (E2 := E2) (Ef := Ef) hdisj) n x1 Hv1 Hown
+  have Hv2 : ✓{n} x2 := by
+    -- `x2` is valid since `x ≡ x1 • x2`
+    exact CMRA.validN_op_right (CMRA.validN_ne Hx Hv)
+  have hP : P n x2 := by
+    -- apply the implication at the current resource
+    exact Himp n x2 CMRA.Included.rfl (Nat.le_refl _) Hv2 hdisj
+  exact ⟨x1, x2, Hx, hjoin, hP⟩
+
+/-- Frame a mask through `except0`, applying the pure disjointness implication. -/
+private theorem fupd_mask_frame_r_pure {W : WsatGS GF}
+    (E2 Ef : Iris.Set Positive) (P : IProp GF) :
+    BIBase.sep (BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+      (BIBase.sep (ownE W (mask E2))
+        (BIBase.imp (BIBase.pure (Iris.Disjoint E2 Ef)) P))))
+      (ownE W (mask Ef)) ⊢
+      BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+        (BIBase.sep (ownE W (mask (fun x => E2 x ∨ Ef x))) P)) := by
+  -- push the frame under `◇`, then apply `ownE_imp_elim`
+  refine (except0_frame_r).trans ?_
+  refine except0_mono ?_
+  -- regroup the spatial part to expose the `ownE` pair
+  refine (sep_assoc (P := wsat' (M := M) (F := F) W)
+    (Q := BIBase.sep (ownE W (mask E2))
+      (BIBase.imp (BIBase.pure (Iris.Disjoint E2 Ef)) P))
+    (R := ownE W (mask Ef))).1.trans ?_
+  -- solve the right component using `ownE_imp_elim`
+  have hswap :
+      BIBase.sep (BIBase.sep (ownE W (mask E2))
+          (BIBase.imp (BIBase.pure (Iris.Disjoint E2 Ef)) P))
+        (ownE W (mask Ef)) ⊢
+        BIBase.sep (BIBase.sep (ownE W (mask E2)) (ownE W (mask Ef)))
+          (BIBase.imp (BIBase.pure (Iris.Disjoint E2 Ef)) P) := by
+    -- swap the implication with the framed mask token
+    refine (sep_assoc (P := ownE W (mask E2))
+      (Q := BIBase.imp (BIBase.pure (Iris.Disjoint E2 Ef)) P)
+      (R := ownE W (mask Ef))).1.trans ?_
+    refine (sep_mono .rfl (sep_comm (P := BIBase.imp (BIBase.pure (Iris.Disjoint E2 Ef)) P)
+      (Q := ownE W (mask Ef))).1).trans ?_
+    exact (sep_assoc (P := ownE W (mask E2)) (Q := ownE W (mask Ef))
+      (R := BIBase.imp (BIBase.pure (Iris.Disjoint E2 Ef)) P)).2
+  have hinner :
+      BIBase.sep (BIBase.sep (ownE W (mask E2))
+          (BIBase.imp (BIBase.pure (Iris.Disjoint E2 Ef)) P))
+        (ownE W (mask Ef)) ⊢
+        BIBase.sep (ownE W (mask (fun x => E2 x ∨ Ef x))) P := by
+    -- apply `ownE_imp_elim` after regrouping
+    exact hswap.trans (ownE_imp_elim (W := W) (E2 := E2) (Ef := Ef) (P := P))
+  -- the right component has been rewritten, so we can finish directly
+  exact sep_mono_r (PROP := IProp GF) hinner
+
+/-- Frame a mask with a pure disjointness postcondition.
+
+    Coq: `mask_frame_r'` in `fancy_updates.v`. -/
+private theorem fupd_mask_frame_r' {W : WsatGS GF}
+    (E1 E2 Ef : Iris.Set Positive) (P : IProp GF)
+    (hdisj1 : Iris.Disjoint E1 Ef) :
+    uPred_fupd (M := M) (F := F) W E1 E2 (BIBase.imp (BIBase.pure (Iris.Disjoint E2 Ef)) P) ⊢
+      uPred_fupd (M := M) (F := F) W
+        (fun x => E1 x ∨ Ef x) (fun x => E2 x ∨ Ef x) P := by
+  -- follow the `fupd_mask_frame_r` proof, then apply the pure implication
+  unfold uPred_fupd
+  refine wand_intro ?_
+  have hdisj1' : CoPset.Disjoint (mask E1) (mask Ef) := by
+    -- convert disjointness to the `CoPset` form
+    simpa [mask, Iris.Disjoint, CoPset.Disjoint] using hdisj1
+  refine (sep_mono .rfl (sep_mono .rfl
+    (ownE_union_split (W := W) (E1 := E1) (Ef := Ef) hdisj1').1)).trans ?_
+  refine (sep_mono .rfl
+    (sep_assoc (P := wsat' (M := M) (F := F) W)
+      (Q := ownE W (mask E1)) (R := ownE W (mask Ef))).2).trans ?_
+  refine (sep_assoc (P := uPred_fupd (M := M) (F := F) W E1 E2
+    (BIBase.imp (BIBase.pure (Iris.Disjoint E2 Ef)) P))
+    (Q := BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E1)))
+    (R := ownE W (mask Ef))).2.trans ?_
+  refine (sep_mono (fupd_apply (W := W) (E1 := E1) (E2 := E2)
+    (P := BIBase.imp (BIBase.pure (Iris.Disjoint E2 Ef)) P)) .rfl).trans ?_
+  refine (BIUpdate.frame_r (PROP := IProp GF)
+    (P := BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+      (BIBase.sep (ownE W (mask E2))
+        (BIBase.imp (BIBase.pure (Iris.Disjoint E2 Ef)) P))))
+    (R := ownE W (mask Ef))).trans ?_
+  exact BIUpdate.mono (PROP := IProp GF)
+    (fupd_mask_frame_r_pure (W := W) (E2 := E2) (Ef := Ef) (P := P))
+
+/-! ## Monotonicity and Composition -/
+
+/-- Monotonicity of fancy updates.
+
+    Coq: `fupd_mono` (part of `BiFUpdMixin`) -/
+theorem fupd_mono {W : WsatGS GF}
+    (E1 E2 : Iris.Set Positive) {P Q : IProp GF} (h : P ⊢ Q) :
+    uPred_fupd (M := M) (F := F) W E1 E2 P ⊢ uPred_fupd (M := M) (F := F) W E1 E2 Q := by
+  -- push monotonicity through wand, bupd, and except-0
+  unfold uPred_fupd
+  refine wand_mono_r ?_
+  refine BIUpdate.mono ?_
+  refine except0_mono ?_
+  exact sep_mono .rfl (sep_mono .rfl h)
+
+/-- Apply a nested fancy update under except-0. -/
+private theorem fupd_except0_bind {W : WsatGS GF}
+    (E2 E3 : Iris.Set Positive) (P : IProp GF) :
+    BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+      (BIBase.sep (ownE W (mask E2)) (uPred_fupd (M := M) (F := F) W E2 E3 P))) ⊢
+      BUpd.bupd (BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+        (BIBase.sep (ownE W (mask E3)) P))) := by
+  -- use the inner wand, then commute bupd with except-0 and collapse
+  have happly :
+      BIBase.sep (wsat' (M := M) (F := F) W)
+          (BIBase.sep (ownE W (mask E2)) (uPred_fupd (M := M) (F := F) W E2 E3 P)) ⊢
+        BUpd.bupd (BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+          (BIBase.sep (ownE W (mask E3)) P))) := by
+    -- reorder to apply the wand
+    refine (sep_assoc (P := wsat' (M := M) (F := F) W) (Q := ownE W (mask E2))
+      (R := uPred_fupd (M := M) (F := F) W E2 E3 P)).2.trans ?_
+    refine (sep_comm (P := BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E2)))
+      (Q := uPred_fupd (M := M) (F := F) W E2 E3 P)).1.trans ?_
+    -- unfold the wand and eliminate it
+    unfold uPred_fupd
+    exact (wand_elim_l (PROP := IProp GF))
+  have hstep :
+      BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+        (BIBase.sep (ownE W (mask E2)) (uPred_fupd (M := M) (F := F) W E2 E3 P))) ⊢
+        BUpd.bupd (BIBase.except0 (BIBase.except0 (BIBase.sep
+          (wsat' (M := M) (F := F) W) (BIBase.sep (ownE W (mask E3)) P)))) := by
+    -- push `happly` under except-0, then move bupd outward
+    refine (except0_mono happly).trans ?_
+    simpa using (bupd_except0 (P := BIBase.except0 (BIBase.sep
+      (wsat' (M := M) (F := F) W) (BIBase.sep (ownE W (mask E3)) P))))
+  exact hstep.trans (BIUpdate.mono except0_idemp.1)
+
+omit [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Shrink a top mask to any subset (dropping the remainder). -/
+private theorem ownE_from_top {W : WsatGS GF}
+    (E : Iris.Set Positive) :
+    ownE W (mask Iris.Set.univ) ⊢ ownE W (mask E) := by
+  -- split `⊤` into `E` and the disjoint remainder, then drop it
+  have hsubset : Subset E Iris.Set.univ := by
+    intro _ _; trivial
+  rcases ownE_split_subset (W := W) (E1 := Iris.Set.univ) (E2 := E) hsubset with
+    ⟨E3, hsplit⟩
+  refine (hsplit.1).trans ?_
+  exact (sep_elim_l (P := ownE W (mask E)) (Q := ownE W E3))
+
+omit [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Shrink a mask along subset by discarding the remainder. -/
+private theorem ownE_shrink {W : WsatGS GF}
+    (E1 E2 : Iris.Set Positive) (h : Subset E1 E2) :
+    ownE W (mask E2) ⊢ ownE W (mask E1) := by
+  -- decompose `E2` into `E1` and the remainder, then drop the remainder
+  rcases ownE_split_subset (W := W) (E1 := E2) (E2 := E1) h with
+    ⟨E3, hsplit⟩
+  refine (hsplit.1).trans ?_
+  exact (sep_elim_l (P := ownE W (mask E1)) (Q := ownE W E3))
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Plainness is preserved by the later modality. -/
+private theorem later_plain {P : IProp GF} [Plain P] :
+    Plain (BIBase.later P) := by
+  -- move plainness under later using `later_plainly`
+  refine ⟨(later_mono (Plain.plain (P := P))).trans ?_⟩
+  exact (later_plainly (P := P)).1
+
+/-- Transitivity of fancy updates.
+
+    Coq: `fupd_trans` (part of `BiFUpdMixin`) -/
+theorem fupd_trans {W : WsatGS GF}
+    (E1 E2 E3 : Iris.Set Positive) (P : IProp GF) :
+    uPred_fupd (M := M) (F := F) W E1 E2 (uPred_fupd (M := M) (F := F) W E2 E3 P) ⊢ uPred_fupd (M := M) (F := F) W E1 E3 P := by
+  -- apply the outer wand, then bind the inner update
+  unfold uPred_fupd
+  refine wand_intro ?_
+  have houter :
+      BIBase.sep (uPred_fupd (M := M) (F := F) W E1 E2 (uPred_fupd (M := M) (F := F) W E2 E3 P))
+        (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E1))) ⊢
+        BUpd.bupd (BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+          (BIBase.sep (ownE W (mask E2)) (uPred_fupd (M := M) (F := F) W E2 E3 P)))) := by
+    -- eliminate the outer wand
+    unfold uPred_fupd
+    exact (wand_elim_l (PROP := IProp GF))
+  refine houter.trans ?_
+  refine (BIUpdate.mono (PROP := IProp GF)
+    (fupd_except0_bind (W := W) (E2 := E2) (E3 := E3) (P := P))).trans ?_
+  exact (BIUpdate.trans (PROP := IProp GF))
+
+/-! ## Frame Rule -/
+
+/-- Frame rule for fancy updates: framing preserves disjointness of masks.
+
+    Coq: `fupd_frame_r` (part of `BiFUpdMixin`) -/
+theorem fupd_frame_r {W : WsatGS GF}
+    (E1 E2 : Iris.Set Positive) (P Q : IProp GF) :
+    BIBase.sep (uPred_fupd (M := M) (F := F) W E1 E2 P) Q ⊢
+      uPred_fupd (M := M) (F := F) W E1 E2 (BIBase.sep P Q) := by
+  -- frame `Q` through the bupd and except-0 layers
+  unfold uPred_fupd
+  refine wand_intro ?_
+  refine (sep_right_comm (P := uPred_fupd (M := M) (F := F) W E1 E2 P) (Q := Q)
+    (R := BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E1)))).1.trans ?_
+  have happly :
+      BIBase.sep (uPred_fupd (M := M) (F := F) W E1 E2 P) (BIBase.sep (wsat' (M := M) (F := F) W)
+        (ownE W (mask E1))) ⊢
+        BUpd.bupd (BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+          (BIBase.sep (ownE W (mask E2)) P))) := by
+    -- eliminate the wand of the outer fupd
+    unfold uPred_fupd
+    exact (wand_elim_l (PROP := IProp GF))
+  refine (sep_mono happly .rfl).trans ?_
+  refine (BIUpdate.frame_r (PROP := IProp GF)
+    (P := BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+      (BIBase.sep (ownE W (mask E2)) P)))
+    (R := Q)).trans ?_
+  have hframe :
+      BIBase.sep (BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+        (BIBase.sep (ownE W (mask E2)) P))) Q ⊢
+        BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+          (BIBase.sep (ownE W (mask E2)) (BIBase.sep P Q))) := by
+    -- move the frame inside except-0, then reassociate
+    refine (except0_frame_r).trans ?_
+    refine except0_mono ?_
+    refine (sep_assoc (P := wsat' (M := M) (F := F) W)
+      (Q := BIBase.sep (ownE W (mask E2)) P) (R := Q)).1.trans ?_
+    exact (sep_mono .rfl
+      (sep_assoc (P := ownE W (mask E2)) (Q := P) (R := Q)).1)
+  exact (BIUpdate.mono (PROP := IProp GF) hframe)
+
+/-! ## Except-0 -/
+
+/-- Except-0 elimination for fancy updates.
+
+    Coq: `except_0_fupd`. -/
+theorem fupd_except0 {W : WsatGS GF}
+    (E1 E2 : Iris.Set Positive) (P : IProp GF) :
+    BIBase.except0 (uPred_fupd (M := M) (F := F) W E1 E2 P) ⊢
+      uPred_fupd (M := M) (F := F) W E1 E2 P := by
+  -- unfold the wand and push `◇` through the update structure
+  unfold uPred_fupd
+  refine wand_intro ?_
+  let A : IProp GF :=
+    BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E1))
+  let S : IProp GF :=
+    BIBase.sep (wsat' (M := M) (F := F) W) (BIBase.sep (ownE W (mask E2)) P)
+  have hframe :
+      BIBase.sep (BIBase.except0 (BIBase.wand A (BUpd.bupd (BIBase.except0 S)))) A ⊢
+        BIBase.except0 (BIBase.sep (BIBase.wand A (BUpd.bupd (BIBase.except0 S))) A) := by
+    -- frame the mask resources under except-0
+    exact except0_frame_r
+  have hwand :
+      BIBase.except0 (BIBase.sep (BIBase.wand A (BUpd.bupd (BIBase.except0 S))) A) ⊢
+        BIBase.except0 (BUpd.bupd (BIBase.except0 S)) := by
+    -- eliminate the wand inside except-0
+    exact except0_mono (wand_elim_l (PROP := IProp GF))
+  have hbupd :
+      BIBase.except0 (BUpd.bupd (BIBase.except0 S)) ⊢
+        BUpd.bupd (BIBase.except0 (BIBase.except0 S)) := by
+    -- commute except-0 across the basic update
+    exact bupd_except0 (PROP := IProp GF)
+  have hcollapse :
+      BUpd.bupd (BIBase.except0 (BIBase.except0 S)) ⊢
+        BUpd.bupd (BIBase.except0 S) := by
+    -- collapse nested except-0
+    exact BIUpdate.mono (PROP := IProp GF) (except0_idemp.1)
+  exact hframe.trans (hwand.trans (hbupd.trans hcollapse))
+
+/-! ## BUpd / FUpd Interaction -/
+
+/-- Basic updates lift to fancy updates.
+
+    Coq: `uPred_bi_bupd_fupd` -/
+theorem bupd_fupd {W : WsatGS GF}
+    (E : Iris.Set Positive) (P : IProp GF) :
+    BUpd.bupd P ⊢ uPred_fupd (M := M) (F := F) W E E P := by
+  -- frame the current mask through the basic update
+  unfold uPred_fupd
+  refine wand_intro ?_
+  refine (sep_comm (P := BUpd.bupd P)
+    (Q := BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E)))).1.trans ?_
+  refine (bupd_frame_l (P := BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E)))
+    (Q := P)).trans ?_
+  have hassoc :
+      BIBase.sep (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))) P ⊢
+        BIBase.sep (wsat' (M := M) (F := F) W) (BIBase.sep (ownE W (mask E)) P) :=
+    (sep_assoc (P := wsat' (M := M) (F := F) W) (Q := ownE W (mask E)) (R := P)).1
+  exact (BIUpdate.mono (PROP := IProp GF) (hassoc.trans except0_intro))
+
+/-! ## Mask Weakening -/
+
+/-- Mask shrinking for fancy updates: if `E1 ⊆ E2`, we can weaken to `E1`.
+
+    Coq: `fupd_plain_mask` (from `BiFUpdSbi`) -/
+theorem fupd_plain_mask {W : WsatGS GF}
+    (E1 E2 : Iris.Set Positive) (h : Subset E1 E2) (P : IProp GF) :
+    uPred_fupd (M := M) (F := F) W E1 E2 P ⊢ uPred_fupd (M := M) (F := F) W E1 E1 P := by
+  -- shrink the mask in the postcondition using subset monotonicity
+  unfold uPred_fupd
+  refine wand_mono_r ?_
+  refine BIUpdate.mono ?_
+  refine except0_mono ?_
+  exact sep_mono .rfl (sep_mono (ownE_shrink (W := W) (E1 := E1) (E2 := E2) h) .rfl)
+
+/-! ## BIFUpdate Instances -/
+
+/-- The `BIFUpdate` instance for fancy updates on `IProp`.
+
+    Coq: `uPred_bi_fupd` (mixin fields). -/
+noncomputable instance instBIFUpdateIProp
+    (M : Type _ → Type _) (F : Type _)
+    [UFraction F] [FiniteMap Positive M] [HeapFiniteMap Positive M] [ElemG GF (InvF GF M F)]
+    [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)]
+    (W : WsatGS GF) :
+    BIFUpdate (IPropWsat GF M F) Positive where
+  fupd := uPred_fupd (M := M) (F := F) W
+  ne := by
+    -- expose the non-expansiveness for each mask pair
+    intro E1 E2
+    exact uPred_fupd_ne (M := M) (F := F) (W := W) (E1 := E1) (E2 := E2)
+  subset := by
+    -- derive the empty close rule from `fupd_mask_subseteq`
+    intro E1 E2 h
+    have htrue : (BIBase.emp : IProp GF) ⊢ (True : IProp GF) := true_intro
+    exact htrue.trans (fupd_mask_subseteq (W := W) (M := M) (F := F) (E1 := E1) (E2 := E2) h)
+  except0 := by
+    -- specialize the except-0 rule to the chosen masks
+    intro E1 E2 P
+    exact fupd_except0 (W := W) (M := M) (F := F) (E1 := E1) (E2 := E2) (P := P)
+  mono := by
+    -- push entailment through the fancy update
+    intro E1 E2 P Q h
+    exact fupd_mono (W := W) (M := M) (F := F) (E1 := E1) (E2 := E2) (P := P) (Q := Q) h
+  trans := by
+    -- specialize the transitivity rule to the chosen masks
+    intro E1 E2 E3 P
+    exact fupd_trans (W := W) (M := M) (F := F) (E1 := E1) (E2 := E2) (E3 := E3) (P := P)
+  mask_frame_r' := by
+    -- use the pure-side-condition framing lemma
+    intro E1 E2 Ef P hdisj
+    exact fupd_mask_frame_r' (W := W) (M := M) (F := F) (E1 := E1) (E2 := E2)
+      (Ef := Ef) (P := P) hdisj
+  frame_r := by
+    -- specialize the frame rule to the chosen masks
+    intro E1 E2 P R
+    exact fupd_frame_r (W := W) (M := M) (F := F) (E1 := E1) (E2 := E2) (P := P) (Q := R)
+
+/-! ## BIFUpdatePlainly Instances -/
+
+section
+
+variable [BIAffine (IProp GF)]
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Keep a plain fact while retaining the original context. -/
+private theorem keep_plain {P Q : IProp GF} [Plain Q] (h : P ⊢ Q) :
+    P ⊢ BIBase.sep Q P := by
+  -- upgrade to a plain fact and frame it back
+  have hplain : P ⊢ plainly Q := h.trans (Plain.plain (P := Q))
+  have hkeep : P ⊢ BIBase.sep (plainly Q) P := plainly_entails_l (P := P) (Q := Q) hplain
+  exact hkeep.trans (sep_mono (plainly_elim (P := Q)) .rfl)
+
+/-- Extract `◇ ■ P` from a fancy update, dropping the mask frame. -/
+private theorem fupd_plainly_extract {W : WsatGS GF}
+    (E E' : Iris.Set Positive) (P : IProp GF) :
+    BIBase.sep (uPred_fupd (M := M) (F := F) W E E' (plainly P))
+        (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))) ⊢
+      BIBase.except0 (plainly P) := by
+  -- apply the update and drop the `wsat`/`ownE` frame
+  have happly :
+      BIBase.sep (uPred_fupd (M := M) (F := F) W E E' (plainly P))
+          (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))) ⊢
+        BUpd.bupd (BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+          (BIBase.sep (ownE W (mask E')) (plainly P)))) := by
+    -- run the fancy update
+    exact fupd_apply (W := W) (M := M) (F := F) (E1 := E) (E2 := E') (P := plainly P)
+  have hdrop :
+      BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+          (BIBase.sep (ownE W (mask E')) (plainly P))) ⊢
+        BIBase.except0 (plainly P) := by
+    -- drop the mask resources inside `◇`
+    refine except0_mono ?_
+    refine (sep_assoc (P := wsat' (M := M) (F := F) W)
+      (Q := ownE W (mask E')) (R := plainly P)).2.trans ?_
+    exact sep_elim_r (PROP := IProp GF)
+  haveI : Plain (BIBase.except0 (PROP := IProp GF) (plainly P)) :=
+    ⟨plain_except0 (P := plainly P)⟩
+  -- map the update and eliminate it using plainness
+  exact happly.trans ((BIUpdate.mono (PROP := IProp GF) hdrop).trans
+    (bupd_elim (PROP := IProp GF) (P := BIBase.except0 (PROP := IProp GF) (plainly P))))
+
+omit [BIAffine (IProp GF)] in
+/-- Build a fancy-update postcondition from a framed `◇`. -/
+private theorem fupd_plainly_post {W : WsatGS GF}
+    (E : Iris.Set Positive) (Q : IProp GF) :
+    BIBase.sep (BIBase.except0 Q)
+        (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))) ⊢
+      BUpd.bupd (BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+        (BIBase.sep (ownE W (mask E)) Q))) := by
+  -- move the frame under `◇` and introduce `bupd`
+  have hframe :
+      BIBase.sep (BIBase.except0 Q)
+          (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))) ⊢
+        BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+          (BIBase.sep (ownE W (mask E)) Q)) := by
+    -- push `wsat`/`ownE` under `◇` and re-associate
+    refine (except0_frame_r (PROP := IProp GF)).trans ?_
+    refine except0_mono (PROP := IProp GF) ?_
+    refine (sep_comm (P := Q)
+      (Q := BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E)))).1.trans ?_
+    exact (sep_assoc (P := wsat' (M := M) (F := F) W) (Q := ownE W (mask E)) (R := Q)).1
+  exact hframe.trans (BIUpdate.intro (PROP := IProp GF)
+    (P := BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+      (BIBase.sep (ownE W (mask E)) Q))))
+
+/-- Context rewrite for `fupd_plainly_keep_l`. -/
+private theorem fupd_plainly_keep_ctx {W : WsatGS GF}
+    (E E' : Iris.Set Positive) (P R : IProp GF) :
+    BIBase.sep (BIBase.sep (BIBase.wand R (uPred_fupd (M := M) (F := F) W E E' (plainly P))) R)
+        (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))) ⊢
+      BIBase.sep (BIBase.except0 (plainly P))
+        (BIBase.sep R (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E)))) := by
+  -- extract the plain fact, keep the context, then drop the wand
+  have hplain :
+      BIBase.sep (BIBase.sep (BIBase.wand R (uPred_fupd (M := M) (F := F) W E E' (plainly P))) R)
+          (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))) ⊢
+        BIBase.except0 (plainly P) := by
+    -- eliminate the wand and extract `◇ ■ P`
+    have hwand :
+        BIBase.sep (BIBase.wand R (uPred_fupd (M := M) (F := F) W E E' (plainly P))) R ⊢
+          uPred_fupd (M := M) (F := F) W E E' (plainly P) := by
+      -- the wand is already in the correct order
+      exact wand_elim_l (PROP := IProp GF)
+    exact (sep_mono hwand .rfl).trans
+      (fupd_plainly_extract (W := W) (M := M) (F := F) (E := E) (E' := E') (P := P))
+  haveI : Plain (BIBase.except0 (PROP := IProp GF) (plainly P)) :=
+    ⟨plain_except0 (P := plainly P)⟩
+  have hkeep := keep_plain
+    (P := BIBase.sep (BIBase.sep (BIBase.wand R (uPred_fupd (M := M) (F := F) W E E' (plainly P))) R)
+      (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))))
+    (Q := BIBase.except0 (plainly P)) hplain
+  refine (hkeep.trans ?_)
+  refine sep_mono .rfl ?_
+  have hdrop :
+      BIBase.sep (BIBase.wand R (uPred_fupd (M := M) (F := F) W E E' (plainly P))) R ⊢ R := by
+    -- discard the wand by affinity
+    exact sep_elim_r (PROP := IProp GF)
+  refine (sep_mono hdrop .rfl).trans ?_
+  exact .rfl
+
+/-- Plain version of the keep-left rule for fancy updates. -/
+private theorem fupd_plainly_keep_l_plain {W : WsatGS GF}
+    (E E' : Iris.Set Positive) (P R : IProp GF) :
+    BIBase.sep (BIBase.wand R (uPred_fupd (M := M) (F := F) W E E' (plainly P))) R ⊢
+      uPred_fupd (M := M) (F := F) W E E (BIBase.sep (plainly P) R) := by
+  -- build the fupd with a plain postcondition
+  unfold uPred_fupd
+  refine wand_intro ?_
+  have hctx := fupd_plainly_keep_ctx (W := W) (M := M) (F := F)
+    (E := E) (E' := E') (P := P) (R := R)
+  refine (hctx.trans ?_)
+  refine (sep_assoc (P := BIBase.except0 (plainly P)) (Q := R)
+    (R := BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E)))).2.trans ?_
+  have hframe :
+      BIBase.sep (BIBase.except0 (plainly P)) R ⊢
+        BIBase.except0 (BIBase.sep (plainly P) R) :=
+    except0_frame_r (PROP := IProp GF)
+  refine (sep_mono hframe .rfl).trans ?_
+  exact fupd_plainly_post (W := W) (M := M) (F := F) (E := E)
+    (Q := BIBase.sep (plainly P) R)
+
+/-- Plainly keep-left rule for fancy updates.
+
+    Coq: `fupd_plainly_keep_l` (via `BiFUpdSbi`). -/
+private theorem fupd_plainly_keep_l {W : WsatGS GF}
+    (E E' : Iris.Set Positive) (P R : IProp GF) :
+    BIBase.sep (BIBase.wand R (uPred_fupd (M := M) (F := F) W E E' (plainly P))) R ⊢
+      uPred_fupd (M := M) (F := F) W E E (BIBase.sep P R) := by
+  -- eliminate `plainly` in the postcondition
+  refine (fupd_plainly_keep_l_plain (W := W) (M := M) (F := F)
+    (E := E) (E' := E') (P := P) (R := R)).trans ?_
+  exact fupd_mono (W := W) (M := M) (F := F) (E1 := E) (E2 := E)
+    (P := BIBase.sep (plainly P) R) (Q := BIBase.sep P R)
+    (sep_mono (plainly_elim (P := P)) .rfl)
+
+/-- Context rewrite for `fupd_plainly_later`. -/
+private theorem fupd_plainly_later_ctx {W : WsatGS GF}
+    (E : Iris.Set Positive) (P : IProp GF) :
+    BIBase.sep (BIBase.later (uPred_fupd (M := M) (F := F) W E E (plainly P)))
+        (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))) ⊢
+      BIBase.sep (BIBase.later (BIBase.except0 (plainly P)))
+        (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))) := by
+  -- derive a later plain fact and keep the mask frame
+  have hplain :
+      BIBase.sep (BIBase.later (uPred_fupd (M := M) (F := F) W E E (plainly P)))
+          (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))) ⊢
+        BIBase.later (BIBase.except0 (plainly P)) := by
+    -- move `later` across the frame and extract `◇ ■ P`
+    refine (sep_mono (PROP := IProp GF) .rfl later_intro).trans ?_
+    refine (later_sep (PROP := IProp GF)).2.trans ?_
+    exact later_mono (PROP := IProp GF)
+      (fupd_plainly_extract (W := W) (M := M) (F := F) (E := E) (E' := E) (P := P))
+  haveI : Plain (BIBase.except0 (PROP := IProp GF) (plainly P)) :=
+    ⟨plain_except0 (P := plainly P)⟩
+  haveI : Plain (BIBase.later (PROP := IProp GF) (BIBase.except0 (PROP := IProp GF) (plainly P))) :=
+    ⟨plain_later (P := BIBase.except0 (PROP := IProp GF) (plainly P))⟩
+  have hkeep := keep_plain
+    (P := BIBase.sep (BIBase.later (uPred_fupd (M := M) (F := F) W E E (plainly P)))
+      (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))))
+    (Q := BIBase.later (BIBase.except0 (plainly P))) hplain
+  refine (hkeep.trans ?_)
+  exact sep_mono .rfl (sep_elim_r (PROP := IProp GF))
+
+/-- Plain version of the later rule for fancy updates. -/
+private theorem fupd_plainly_later_plain {W : WsatGS GF}
+    (E : Iris.Set Positive) (P : IProp GF) :
+    BIBase.later (uPred_fupd (M := M) (F := F) W E E (plainly P)) ⊢
+      uPred_fupd (M := M) (F := F) W E E (BIBase.later (BIBase.except0 (plainly P))) := by
+  -- lift the latered plain fact through the fupd
+  unfold uPred_fupd
+  refine wand_intro ?_
+  have hctx := fupd_plainly_later_ctx (W := W) (M := M) (F := F) (E := E) (P := P)
+  refine (hctx.trans ?_)
+  refine (sep_mono (PROP := IProp GF) (except0_intro (PROP := IProp GF)) .rfl).trans ?_
+  exact fupd_plainly_post (W := W) (M := M) (F := F) (E := E)
+    (Q := BIBase.later (BIBase.except0 (plainly P)))
+
+/-- Plainly later rule for fancy updates.
+
+    Coq: `fupd_plainly_later` (via `BiFUpdSbi`). -/
+private theorem fupd_plainly_later {W : WsatGS GF}
+    (E : Iris.Set Positive) (P : IProp GF) :
+    BIBase.later (uPred_fupd (M := M) (F := F) W E E (plainly P)) ⊢
+      uPred_fupd (M := M) (F := F) W E E (BIBase.later (BIBase.except0 P)) := by
+  -- eliminate `plainly` under later/except-0
+  refine (fupd_plainly_later_plain (W := W) (M := M) (F := F) (E := E) (P := P)).trans ?_
+  exact fupd_mono (W := W) (M := M) (F := F) (E1 := E) (E2 := E)
+    (P := BIBase.later (BIBase.except0 (plainly P)))
+    (Q := BIBase.later (BIBase.except0 P))
+    (later_mono (PROP := IProp GF)
+      (except0_mono (PROP := IProp GF) (plainly_elim (P := P))))
+
+/-- Context rewrite for `fupd_plainly_sForall_2`. -/
+private theorem fupd_plainly_sForall_ctx {W : WsatGS GF}
+    (E : Iris.Set Positive) (Φ : IProp GF → Prop) :
+    BIBase.sep (BIBase.«forall» fun p => BIBase.imp (BIBase.pure (Φ p))
+      (uPred_fupd (M := M) (F := F) W E E (plainly p)))
+        (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))) ⊢
+      BIBase.«forall» fun p => BIBase.imp (BIBase.pure (Φ p)) (BIBase.except0 (plainly p)) := by
+  -- specialize the hypothesis and extract `◇ ■ p`
+  refine forall_intro ?_
+  intro p
+  refine imp_intro <| pure_elim_r ?_
+  intro hΦ
+  have hspec :
+      BIBase.«forall» (fun q => BIBase.imp (BIBase.pure (Φ q))
+        (uPred_fupd (M := M) (F := F) W E E (plainly q))) ⊢
+        BIBase.imp (BIBase.pure (Φ p)) (uPred_fupd (M := M) (F := F) W E E (plainly p)) :=
+    forall_elim (a := p)
+  have hpure :
+      BIBase.«forall» (fun q => BIBase.imp (BIBase.pure (Φ q))
+        (uPred_fupd (M := M) (F := F) W E E (plainly q))) ⊢
+      BIBase.pure (Φ p) :=
+    pure_intro hΦ
+  have hfp :
+      BIBase.«forall» (fun q => BIBase.imp (BIBase.pure (Φ q))
+        (uPred_fupd (M := M) (F := F) W E E (plainly q))) ⊢
+      uPred_fupd (M := M) (F := F) W E E (plainly p) :=
+    mp hspec hpure
+  refine (sep_mono (PROP := IProp GF) hfp .rfl).trans ?_
+  exact fupd_plainly_extract (W := W) (M := M) (F := F) (E := E) (E' := E) (P := p)
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)]
+    [ElemG GF (COFE.constOF GSetDisj)] [BIAffine (IProp GF)] in
+/-- Move `◇` across a pure implication when the antecedent holds. -/
+private theorem except0_imp_pure_true {φ : Prop} (hφ : φ) {P : IProp GF} :
+    BIBase.imp (BIBase.pure φ) (BIBase.except0 (plainly P)) ⊢
+      BIBase.except0 (BIBase.imp (BIBase.pure φ) (plainly P)) := by
+  -- rewrite `⌜φ⌝` to `True` and discharge with `true_imp`
+  have hpure : BIBase.pure (PROP := IProp GF) φ ⊣⊢ (True : IProp GF) := pure_true hφ
+  have hleft :
+      BIBase.imp (BIBase.pure φ) (BIBase.except0 (plainly P)) ⊢
+        BIBase.except0 (plainly P) :=
+    (imp_mono (PROP := IProp GF) hpure.2 .rfl).trans
+      (true_imp (P := BIBase.except0 (plainly P))).1
+  have hright :
+      BIBase.except0 (plainly P) ⊢
+        BIBase.except0 (BIBase.imp (BIBase.pure φ) (plainly P)) := by
+    refine (except0_mono (PROP := IProp GF) (true_imp (P := plainly P)).2).trans ?_
+    exact except0_mono (PROP := IProp GF) (imp_mono (PROP := IProp GF) hpure.1 .rfl)
+  exact hleft.trans hright
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)]
+    [ElemG GF (COFE.constOF GSetDisj)] [BIAffine (IProp GF)] in
+/-- Move `◇` across a pure implication when the antecedent is false. -/
+private theorem except0_imp_pure_false {φ : Prop} (hφ : ¬ φ) {P : IProp GF} :
+    BIBase.imp (BIBase.pure φ) (BIBase.except0 (plainly P)) ⊢
+      BIBase.except0 (BIBase.imp (BIBase.pure φ) (plainly P)) := by
+  -- rewrite `⌜φ⌝` to `False` and discharge with `false_imp`
+  have hpure :
+      BIBase.pure (PROP := IProp GF) φ ⊣⊢ BIBase.pure (PROP := IProp GF) False :=
+    pure_congr ⟨hφ, False.elim⟩
+  have hleft :
+      BIBase.imp (BIBase.pure φ) (BIBase.except0 (plainly P)) ⊢ (True : IProp GF) :=
+    (imp_congr_l hpure).1.trans (false_imp (P := BIBase.except0 (plainly P))).1
+  have hright :
+      (True : IProp GF) ⊢ BIBase.except0 (BIBase.imp (BIBase.pure φ) (plainly P)) := by
+    have hfalse :
+        (True : IProp GF) ⊢
+          BIBase.imp (BIBase.pure (PROP := IProp GF) False) (plainly P) :=
+      (false_imp (P := plainly P)).2
+    have hpure' :
+        BIBase.imp (BIBase.pure (PROP := IProp GF) False) (plainly P) ⊢
+          BIBase.imp (BIBase.pure φ) (plainly P) :=
+      (imp_congr_l hpure).2
+    exact (hfalse.trans hpure').trans (except0_intro (PROP := IProp GF))
+  exact hleft.trans hright
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)]
+    [ElemG GF (COFE.constOF GSetDisj)] [BIAffine (IProp GF)] in
+/-- Move `◇` across a pure implication. -/
+private theorem except0_imp_pure {φ : Prop} {P : IProp GF} :
+    BIBase.imp (BIBase.pure φ) (BIBase.except0 (plainly P)) ⊢
+      BIBase.except0 (BIBase.imp (BIBase.pure φ) (plainly P)) := by
+  -- split on the pure proposition
+  classical
+  by_cases hφ : φ
+  · exact except0_imp_pure_true (φ := φ) (P := P) hφ
+  · exact except0_imp_pure_false (φ := φ) (P := P) hφ
+
+/-- Extract `◇ ■ sForall Φ` from the fupd hypothesis. -/
+private theorem fupd_plainly_sForall_plain {W : WsatGS GF}
+    (E : Iris.Set Positive) (Φ : IProp GF → Prop) :
+    BIBase.sep (BIBase.«forall» fun p => BIBase.imp (BIBase.pure (Φ p))
+      (uPred_fupd (M := M) (F := F) W E E (plainly p)))
+        (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))) ⊢
+      BIBase.except0 (plainly (BIBase.sForall Φ)) := by
+  -- pull out `◇ ■ p`, then commute `◇` and `sForall`
+  have hctx := fupd_plainly_sForall_ctx (W := W) (M := M) (F := F) (E := E) (Φ := Φ)
+  have himp :
+      BIBase.«forall» (fun p => BIBase.imp (BIBase.pure (Φ p))
+        (BIBase.except0 (plainly p))) ⊢
+        BIBase.«forall» fun p =>
+          BIBase.except0 (BIBase.imp (BIBase.pure (Φ p)) (plainly p)) := by
+    refine forall_mono ?_
+    intro p
+    exact except0_imp_pure (φ := Φ p) (P := p)
+  have hforall :
+      BIBase.«forall» (fun p =>
+        BIBase.except0 (BIBase.imp (BIBase.pure (Φ p)) (plainly p))) ⊢
+        BIBase.except0 (BIBase.«forall» fun p => BIBase.imp (BIBase.pure (Φ p)) (plainly p)) := by
+    exact (except0_forall (Φ := fun p => BIBase.imp (BIBase.pure (Φ p)) (plainly p))).2
+  have hplain :
+      BIBase.except0 (BIBase.«forall» fun p => BIBase.imp (BIBase.pure (Φ p)) (plainly p)) ⊢
+        BIBase.except0 (plainly (BIBase.sForall Φ)) :=
+    except0_mono (PROP := IProp GF) (plainly_sForall_2 (Φ := Φ))
+  exact hctx.trans (himp.trans (hforall.trans hplain))
+
+/-- Frame `◇ sForall Φ` next to the mask resources. -/
+private theorem fupd_plainly_sForall_frame {W : WsatGS GF}
+    (E : Iris.Set Positive) (Φ : IProp GF → Prop) :
+    BIBase.sep (BIBase.«forall» fun p => BIBase.imp (BIBase.pure (Φ p))
+      (uPred_fupd (M := M) (F := F) W E E (plainly p)))
+        (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))) ⊢
+      BIBase.sep (BIBase.except0 (BIBase.sForall Φ))
+        (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))) := by
+  -- keep the plain fact and discard the hypothesis
+  have hplain := fupd_plainly_sForall_plain (W := W) (M := M) (F := F) (E := E) (Φ := Φ)
+  haveI : Plain (BIBase.except0 (PROP := IProp GF) (plainly (BIBase.sForall Φ))) :=
+    ⟨plain_except0 (P := plainly (BIBase.sForall Φ))⟩
+  have hkeep :=
+    keep_plain (P := BIBase.sep (BIBase.«forall» fun p => BIBase.imp (BIBase.pure (Φ p))
+      (uPred_fupd (M := M) (F := F) W E E (plainly p)))
+      (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))))
+      (Q := BIBase.except0 (plainly (BIBase.sForall Φ))) hplain
+  have hdrop :
+      BIBase.sep (BIBase.«forall» fun p => BIBase.imp (BIBase.pure (Φ p))
+        (uPred_fupd (M := M) (F := F) W E E (plainly p)))
+        (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E))) ⊢
+      BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E)) := by
+    exact sep_elim_r (PROP := IProp GF)
+  refine (hkeep.trans ?_)
+  exact sep_mono (PROP := IProp GF)
+    (except0_mono (PROP := IProp GF) (plainly_elim (P := BIBase.sForall Φ))) hdrop
+
+/-- Plainly forall rule for fancy updates.
+
+    Coq: `fupd_plainly_sForall_2` (via `BiFUpdSbi`). -/
+private theorem fupd_plainly_sForall_2 {W : WsatGS GF}
+    (E : Iris.Set Positive) (Φ : IProp GF → Prop) :
+    (BIBase.«forall» fun p => BIBase.imp (BIBase.pure (Φ p))
+      (uPred_fupd (M := M) (F := F) W E E (plainly p))) ⊢
+      uPred_fupd (M := M) (F := F) W E E (BIBase.sForall Φ) := by
+  -- derive `◇ sForall Φ` and feed it to the postcondition builder
+  unfold uPred_fupd
+  refine wand_intro ?_
+  have hframe := fupd_plainly_sForall_frame (W := W) (M := M) (F := F) (E := E) (Φ := Φ)
+  exact hframe.trans (fupd_plainly_post (W := W) (M := M) (F := F)
+    (E := E) (Q := BIBase.sForall Φ))
+
+end
+
+noncomputable instance instBIFUpdatePlainlyIProp
+    (M : Type _ → Type _) (F : Type _)
+    [UFraction F] [FiniteMap Positive M] [HeapFiniteMap Positive M] [ElemG GF (InvF GF M F)]
+    [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)]
+    (W : WsatGS GF) :
+    @BIFUpdatePlainly (IPropWsat GF M F) Positive _
+      (instBIFUpdateIProp (GF := GF) (M := M) (F := F) (W := W)) _ := by
+  -- reuse the `BIFUpdate` instance tied to the same world
+  refine (@BIFUpdatePlainly.mk (IPropWsat GF M F) Positive _
+    (instBIFUpdateIProp (GF := GF) (M := M) (F := F) (W := W)) _ ?_ ?_ ?_)
+  · -- use the semantic lemma for keep-left
+    intro E E' P R
+    exact fupd_plainly_keep_l (W := W) (M := M) (F := F) (E := E) (E' := E') (P := P) (R := R)
+  · -- use the semantic lemma for later
+    intro E P
+    exact fupd_plainly_later (W := W) (M := M) (F := F) (E := E) (P := P)
+  · -- use the semantic lemma for sForall
+    intro E Φ
+    exact fupd_plainly_sForall_2 (W := W) (M := M) (F := F) (E := E) (Φ := Φ)
+
+/-! ## Soundness -/
+
+section
+
+variable [FiniteMapLaws Positive M]
+
+/-- Soundness of the fancy update (no later credits): if for any world
+    satisfaction we can establish `P` via a fancy update, then `P` holds
+    unconditionally.
+
+    Proof strategy: allocate initial `wsat ∗ ownE ⊤` via `wsat_alloc`,
+    unfold `fupd` to basic update, use `bupd_soundness` and
+    `later_soundness` to strip modalities.
+
+    Coq: `fupd_soundness_no_lc` -/
+theorem fupd_soundness_no_lc
+    (E1 E2 : Iris.Set Positive) (P : IProp GF) [Plain P]
+    (h : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢ uPred_fupd (M := M) (F := F) W E1 E2 P) :
+    (BIBase.emp : IProp GF) ⊢ P := by
+  -- allocate the initial world, run the fupd, then strip bupd/except-0/later
+  have hstep' :
+      BIBase.exists (fun W' : WsatGS GF =>
+        BIBase.sep (wsat' (M := M) (F := F) W') (ownE W' (mask Iris.Set.univ))) ⊢
+        BUpd.bupd (BIBase.later P) := by
+    -- pick the world, apply the fancy update, and map to `▷ P`
+    refine exists_elim ?_
+    intro W'
+    have hmask :
+        BIBase.sep (wsat' (M := M) (F := F) W') (ownE W' (mask Iris.Set.univ)) ⊢
+          BIBase.sep (wsat' (M := M) (F := F) W') (ownE W' (mask E1)) := by
+      -- shrink the top mask to `E1`
+      exact sep_mono .rfl (ownE_from_top (W := W') E1)
+    have happly :
+        BIBase.sep (wsat' (M := M) (F := F) W') (ownE W' (mask E1)) ⊢
+          BIBase.sep (uPred_fupd (M := M) (F := F) W' E1 E2 P)
+            (BIBase.sep (wsat' (M := M) (F := F) W') (ownE W' (mask E1))) := by
+      -- obtain the fupd from `emp` and frame the current resources
+      refine (emp_sep.2).trans ?_
+      exact sep_mono (h W') .rfl
+    have hupd :
+        BIBase.sep (wsat' (M := M) (F := F) W') (ownE W' (mask E1)) ⊢
+          BUpd.bupd (BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W')
+            (BIBase.sep (ownE W' (mask E2)) P))) := by
+      -- apply the wand of the fancy update
+      refine happly.trans ?_
+      unfold uPred_fupd
+      exact (wand_elim_l (PROP := IProp GF))
+    have hstrip :
+        BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W')
+          (BIBase.sep (ownE W' (mask E2)) P)) ⊢ BIBase.later P := by
+      -- drop `wsat`/`ownE` and turn except-0 into later
+      refine (except0_into_later (PROP := IProp GF)).trans ?_
+      refine later_mono ?_
+      refine (sep_assoc (P := wsat' (M := M) (F := F) W') (Q := ownE W' (mask E2))
+        (R := P)).2.trans ?_
+      exact sep_elim_r (P := BIBase.sep (wsat' (M := M) (F := F) W')
+        (ownE W' (mask E2))) (Q := P)
+    refine (hmask.trans hupd).trans ?_
+    exact BIUpdate.mono hstrip
+  have hstep :
+      (BIBase.emp : IProp GF) ⊢ BUpd.bupd (BIBase.later P) := by
+    -- allocate the world under bupd, then collapse nested updates
+    refine (wsat_alloc (GF := GF) (M := M) (F := F)).trans ?_
+    refine (BIUpdate.mono hstep').trans ?_
+    exact BIUpdate.trans
+  haveI : Plain (BIBase.later P) := later_plain (P := P)
+  have hlate : (BIBase.emp : IProp GF) ⊢ BIBase.later P := hstep.trans bupd_elim
+  have htrue : (True : IProp GF) ⊢ BIBase.later P :=
+    (true_emp (PROP := IProp GF)).1.trans hlate
+  have hP : (True : IProp GF) ⊢ P := UPred.later_soundness htrue
+  exact (true_emp (PROP := IProp GF)).2.trans hP
+
+/-- Step-indexed fancy update soundness (no later credits).
+
+    Coq: `step_fupdN_soundness_no_lc` -/
+theorem step_fupdN_soundness_no_lc
+    (P : IProp GF) [Plain P] (_n : Nat)
+    (h : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢ uPred_fupd (M := M) (F := F) W Iris.Set.univ (fun _ => False) P) :
+    (BIBase.emp : IProp GF) ⊢ P := by
+  -- specialize soundness to `⊤`/`∅` masks
+  exact fupd_soundness_no_lc (E1 := Iris.Set.univ) (E2 := fun _ => False) (P := P) h
+
+end
+
+end
+
+end Iris.BaseLogic
diff --git a/src/Iris/BaseLogic/Lib/Invariants.lean b/src/Iris/BaseLogic/Lib/Invariants.lean
new file mode 100644
index 00000000..1760fbb9
--- /dev/null
+++ b/src/Iris/BaseLogic/Lib/Invariants.lean
@@ -0,0 +1,1866 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.BaseLogic.Lib.FancyUpdates
+import Iris.ProofMode.Tactics
+import Iris.Std.Namespace
+
+/-! # Invariants
+
+Reference: `iris/base_logic/lib/invariants.v`
+
+Invariants are the main user-facing mechanism for shared ownership in Iris.
+An invariant `inv N P` asserts that proposition `P` is maintained as an
+invariant registered under namespace `N`. It is a *derived* definition built
+on top of fancy updates and world satisfaction — not a new primitive.
+
+## Definition
+
+```
+inv N P := □ ∀ E, ⌜↑N ⊆ E⌝ → |={E, E ∖ ↑N}=> ▷ P ∗ (▷ P ={E ∖ ↑N, E}=∗ True)
+```
+
+## Main Results
+
+- `inv_persistent` — `inv N P` is persistent
+- `inv_alloc` — `▷ P ={E}=∗ inv N P`
+- `inv_alloc_open` — allocate and immediately open
+- `inv_acc` — `↑N ⊆ E → inv N P ={E,E∖↑N}=∗ ▷ P ∗ (▷ P ={E∖↑N,E}=∗ True)`
+- `inv_acc_timeless` — strip `▷` when `P` is timeless
+-/
+
+namespace Iris.BaseLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M] variable [FiniteMapLaws Positive M] [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+/-- Mask difference: `E ∖ ↑N` as a set predicate. -/
+private abbrev maskDiff (E : Iris.Set Positive) (N : Namespace) :
+    Iris.Set Positive :=
+  fun x => E x ∧ ¬(nclose N).mem x
+
+-- Keep IProp entailments opaque for proof mode (avoid unfolding to `holds`).
+private structure IPropEntails (P Q : IProp GF) : Prop where
+  toEntails : P ⊢ Q
+
+private def wrapEntails {P Q : IProp GF} (h : P ⊢ Q) :
+    IPropEntails (GF := GF) P Q :=
+  ⟨h⟩
+
+local instance asEmpValid_IPropEntails_inv (d : Iris.ProofMode.AsEmpValid.Direction)
+    (P Q : IProp GF) :
+    Iris.ProofMode.AsEmpValid d (IPropEntails (GF := GF) P Q) iprop(P -∗ Q) := by
+  have hEntails :
+      Iris.ProofMode.AsEmpValid d (P ⊢ Q) iprop(P -∗ Q) := inferInstance
+  refine ⟨?_, ?_⟩
+  · intro hd h
+    exact (hEntails.as_emp_valid.1 hd) h.toEntails
+  · intro hd h
+    exact ⟨(hEntails.as_emp_valid.2 hd) h⟩
+
+-- Make `ownI` persistent for proof mode use.
+instance ownI_persistent_inst {W : WsatGS GF} (i : Positive) (P : IProp GF) :
+    Persistent (ownI (GF := GF) (M := M) (F := F) W i P) :=
+  ⟨ownI_persistent (W := W) (i := i) (P := P)⟩
+
+/-! ## Internal Model -/
+
+/-- Internal invariant ownership: existential over a name in the namespace.
+
+    Coq: `own_inv` -/
+noncomputable def own_inv (_W : WsatGS GF)
+    (N : Namespace) (P : IProp GF) : IProp GF :=
+  BIBase.exists fun i =>
+    BIBase.and (BIBase.pure ((nclose N).mem i))
+      (ownI (GF := GF) (M := M) (F := F) _W i P)
+
+-- `own_inv` is persistent: pure facts plus persistent `ownI`.
+local instance own_inv_persistent_inst {W : WsatGS GF} (N : Namespace) (P : IProp GF) :
+    Persistent (own_inv (GF := GF) (M := M) (F := F) W N P) := by
+  -- unfold and rely on `exists_persistent`/`and_persistent`.
+  unfold own_inv
+  infer_instance
+
+/-- Access an internal invariant: open it to get `▷ P` and a closing view shift.
+
+    Coq: `own_inv_acc` -/
+theorem own_inv_acc {W : WsatGS GF}
+    (N : Namespace) (E : Iris.Set Positive) (P : IProp GF)
+    (h : Subset (nclose N).mem E) :
+    own_inv (GF := GF) (M := M) (F := F) W N P ⊢
+      uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+        (BIBase.sep (BIBase.later P)
+          (BIBase.wand (BIBase.later P)
+            (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+              (BIBase.pure True)))) := by
+  classical
+  unfold uPred_fupd
+  unfold own_inv
+  -- eliminate the existential invariant name
+  refine exists_elim ?_
+  intro i
+  iintro Hinv
+  iintro H
+  icases Hinv with ⟨Hmem, HownI⟩
+  icases Hmem with %Hmem
+  icases HownI with #HownI
+  icases H with ⟨Hwsat, HownE⟩
+  -- split the enabled mask into `↑N` and `E \ ↑N`
+  have hmask : mask E = (nclose N) ∪ mask (maskDiff E N) := by
+    ext x; constructor
+    · intro hx
+      by_cases hxN : (nclose N).mem x
+      · exact Or.inl hxN
+      · exact Or.inr ⟨hx, hxN⟩
+    · intro hx
+      cases hx with
+      | inl hxN => exact h _ hxN
+      | inr hxDiff => exact hxDiff.1
+  have hdisj : CoPset.Disjoint (nclose N) (mask (maskDiff E N)) := by
+    intro x hx
+    exact hx.2.2 hx.1
+  have hsplit :
+      ownE W (mask E) ⊢
+        BIBase.sep (ownE W (nclose N)) (ownE W (mask (maskDiff E N))) := by
+    -- rewrite the mask to the disjoint union and apply `ownE_op`
+    rw [hmask]
+    exact (ownE_op (W := W) (E₁ := nclose N) (E₂ := mask (maskDiff E N)) hdisj).1
+  ihave Hsplit := (wrapEntails (GF := GF) hsplit) $$ HownE
+  icases Hsplit with ⟨HownEN, HownEdiff⟩
+
+  -- split `↑N` into `{i}` and the remainder
+  let rest : CoPset := nclose N \ CoPset.singleton i
+  have hmaskN : (nclose N) = (CoPset.singleton i) ∪ rest := by
+    ext x; constructor
+    · intro hxN
+      by_cases hx : x = i
+      · left; simpa [CoPset.mem_singleton] using hx
+      · right; exact ⟨hxN, by simpa [CoPset.mem_singleton, rest] using hx⟩
+    · intro hx
+      cases hx with
+      | inl hx =>
+          have hx' : x = i := by simpa [CoPset.mem_singleton] using hx
+          subst hx'
+          exact Hmem
+      | inr hx => exact hx.1
+  have hdisjN : CoPset.Disjoint (CoPset.singleton i) rest := by
+    intro x hx
+    exact hx.2.2 hx.1
+  have hsplitN :
+      ownE W (nclose N) ⊢
+        BIBase.sep (ownE W (CoPset.singleton i)) (ownE W rest) := by
+    -- rewrite the namespace to the singleton union and apply `ownE_op`
+    rw [hmaskN]
+    exact (ownE_op (W := W) (E₁ := CoPset.singleton i) (E₂ := rest) hdisjN).1
+  ihave HsplitN := (wrapEntails (GF := GF) hsplitN) $$ HownEN
+  icases HsplitN with ⟨HownEi, HownErest⟩
+
+  -- open the invariant
+  icases (wrapEntails (GF := GF)
+    (ownI_open (W := W) (M := M) (F := F) i P)) $$ [Hwsat, HownI, HownEi]
+    with ⟨Hsep, HownD⟩
+  · -- build the premise `(wsat ∗ ownI) ∗ ownE`
+    isplitl [Hwsat HownI]
+    · isplitl [Hwsat]
+      · iexact Hwsat
+      · iexact HownI
+    · iexact HownEi
+  icases Hsep with ⟨Hwsat', HlaterP⟩
+
+  -- introduce bupd and except0
+  iapply BIUpdate.intro
+  iapply (wrapEntails (GF := GF) (except0_intro (P := _)))
+  -- assemble the postcondition
+  isplitl [Hwsat']
+  · iexact Hwsat'
+  · isplitl [HownEdiff]
+    · iexact HownEdiff
+    · isplitl [HlaterP]
+      · iexact HlaterP
+      · -- closing wand
+        iintro HP
+        iintro Hclose
+        icases Hclose with ⟨Hwsat2, HownEdiff2⟩
+        ihave Hclose' :=
+          (wrapEntails (GF := GF)
+            (ownI_close (W := W) (M := M) (F := F) i P)) $$ [Hwsat2, HownI, HP, HownD]
+        · -- build the premise `((wsat ∗ ownI) ∗ ▷ P) ∗ ownD`
+          isplitl [Hwsat2 HownI HP]
+          · isplitl [Hwsat2 HownI]
+            · isplitl [Hwsat2]
+              · iexact Hwsat2
+              · iexact HownI
+            · iexact HP
+          · iexact HownD
+        icases Hclose' with ⟨Hwsat3, HownEi'⟩
+        have hjoinN :
+            BIBase.sep (ownE W (CoPset.singleton i)) (ownE W rest) ⊢
+            ownE W (nclose N) := by
+          -- rewrite the namespace to the singleton union and apply `ownE_op`
+          rw [hmaskN]
+          exact (ownE_op (W := W) (E₁ := CoPset.singleton i) (E₂ := rest) hdisjN).2
+        ihave HjoinN := (wrapEntails (GF := GF) hjoinN) $$ [HownEi', HownErest]
+        · -- assemble the singleton/rest split
+          isplitl [HownEi']
+          · iexact HownEi'
+          · iexact HownErest
+        have hjoin :
+            BIBase.sep (ownE W (nclose N)) (ownE W (mask (maskDiff E N))) ⊢
+            ownE W (mask E) := by
+          -- rewrite the mask to the disjoint union and apply `ownE_op`
+          rw [hmask]
+          exact (ownE_op (W := W) (E₁ := nclose N)
+            (E₂ := mask (maskDiff E N)) hdisj).2
+        ihave Hjoin := (wrapEntails (GF := GF) hjoin) $$ [HjoinN, HownEdiff2]
+        · -- rejoin `↑N` with the remaining mask
+          isplitl [HjoinN]
+          · iexact HjoinN
+          · iexact HownEdiff2
+        iapply BIUpdate.intro
+        iapply (wrapEntails (GF := GF) (except0_intro (P := _)))
+        isplitl [Hwsat3]
+        · iexact Hwsat3
+        · isplitl [Hjoin]
+          · iexact Hjoin
+          · ipure_intro
+            exact True.intro
+
+/-! ## Definition -/
+
+/-- Semantic invariant: `inv N P` asserts that `P` is maintained as an
+    invariant under namespace `N`. This is persistent — once allocated,
+    the invariant exists forever.
+
+    Coq: `inv_def` -/
+noncomputable def inv (_W : WsatGS GF)
+    (N : Namespace) (P : IProp GF) : IProp GF :=
+  BIBase.persistently <|
+    BIBase.forall fun E : Iris.Set Positive =>
+      BIBase.imp (BIBase.pure (Subset (nclose N).mem E))
+        (uPred_fupd (M := M) (F := F) _W E (maskDiff E N)
+          (BIBase.sep (BIBase.later P)
+            (BIBase.wand (BIBase.later P)
+              (uPred_fupd (M := M) (F := F) _W (maskDiff E N) E
+                (BIBase.pure True)))))
+
+-- `inv` as a non-expansive body over a latered parameter.
+private def invBody (_W : WsatGS GF)
+    (N : Namespace) (X : IProp GF) : IProp GF :=
+  BIBase.persistently <|
+    BIBase.forall fun E : Iris.Set Positive =>
+      BIBase.imp (BIBase.pure (Subset (nclose N).mem E))
+        (uPred_fupd (M := M) (F := F) _W E (maskDiff E N)
+          (BIBase.sep X
+            (BIBase.wand X
+              (uPred_fupd (M := M) (F := F) _W (maskDiff E N) E
+                (BIBase.pure True)))))
+
+/-! ## Notation -/
+
+-- `inv` notation inside `iprop(...)` quotations.
+macro_rules
+  | `(iprop(inv $W $N $P)) =>
+      `(Iris.BaseLogic.inv (W := $W) $N iprop($P))
+
+delab_rule Iris.BaseLogic.inv
+  | `($_ $W $N $P) => do
+      -- display as `inv W N P` inside `iprop(...)`.
+      `(iprop(inv $W $N $(← unpackIprop P)))
+
+private theorem own_inv_to_inv {W : WsatGS GF}
+    (N : Namespace) (P : IProp GF) :
+    own_inv (GF := GF) (M := M) (F := F) W N P ⊢
+      inv (GF := GF) (M := M) (F := F) W N P := by
+  unfold inv
+  refine (persistently_intro''
+    (P := own_inv (GF := GF) (M := M) (F := F) W N P) (Q := _) ?_)
+  -- show the invariant body from internal ownership
+  refine forall_intro ?_
+  intro E
+  refine imp_intro ?_
+  -- pull the pure subset assumption into the context
+  refine pure_elim_r ?_
+  intro hsubset
+  exact (own_inv_acc (W := W) (N := N) (E := E) (P := P) hsubset)
+
+omit [UFraction F] [FiniteMap Positive M]   [FiniteMapLaws Positive M] [HeapFiniteMap Positive M]
+  [ElemG GF (InvF GF M F)] [ElemG GF (COFE.constOF CoPsetDisj)]
+  [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem except0_sep_idemp {P Q R : IProp GF} :
+    BIBase.except0 (BIBase.sep P (BIBase.sep (BIBase.except0 Q) R)) ⊣⊢
+      BIBase.except0 (BIBase.sep P (BIBase.sep Q R)) := by
+  -- distribute except0, eliminate the inner idempotence, then reassemble
+  calc
+    BIBase.except0 (BIBase.sep P (BIBase.sep (BIBase.except0 Q) R))
+        ⊣⊢ BIBase.sep (BIBase.except0 P)
+              (BIBase.except0 (BIBase.sep (BIBase.except0 Q) R)) := by
+          -- push except0 into the outer sep
+          exact (except0_sep (P := P) (Q := BIBase.sep (BIBase.except0 Q) R))
+    _ ⊣⊢ BIBase.sep (BIBase.except0 P)
+            (BIBase.sep (BIBase.except0 (BIBase.except0 Q)) (BIBase.except0 R)) := by
+          -- distribute except0 across the inner sep
+          exact sep_congr_r (except0_sep (P := BIBase.except0 Q) (Q := R))
+    _ ⊣⊢ BIBase.sep (BIBase.except0 P)
+            (BIBase.sep (BIBase.except0 Q) (BIBase.except0 R)) := by
+          -- collapse the redundant except0
+          exact sep_congr_r (sep_congr_l except0_idemp)
+    _ ⊣⊢ BIBase.sep (BIBase.except0 P) (BIBase.except0 (BIBase.sep Q R)) := by
+          -- reassemble the inner except0
+          exact sep_congr_r (except0_sep (P := Q) (Q := R)).symm
+    _ ⊣⊢ BIBase.except0 (BIBase.sep P (BIBase.sep Q R)) := by
+          -- pull except0 back out
+          exact (except0_sep (P := P) (Q := BIBase.sep Q R)).symm
+
+omit [FiniteMapLaws Positive M] in
+private theorem fupd_drop_except0_post {W : WsatGS GF}
+    (E1 E2 : Iris.Set Positive) (P Q : IProp GF) :
+    uPred_fupd (M := M) (F := F) W E1 E2
+        (BIBase.sep (BIBase.except0 P) Q) ⊢
+      uPred_fupd (M := M) (F := F) W E1 E2 (BIBase.sep (PROP := IProp GF) P Q) := by
+  -- drop the redundant except0 under the outer except0 of fupd
+  unfold uPred_fupd
+  refine wand_mono_r ?_
+  refine BIUpdate.mono ?_
+  let A : IProp GF := wsat (GF := GF) (M := M) (F := F) W
+  let B : IProp GF := ownE W (⟨E2⟩ : CoPset)
+  have h :
+      BIBase.except0 (BIBase.sep A (BIBase.sep B (BIBase.sep (BIBase.except0 P) Q))) ⊣⊢
+        BIBase.except0 (BIBase.sep A (BIBase.sep B (BIBase.sep (PROP := IProp GF) P Q))) := by
+    -- reassociate, drop the inner except0, then reassociate back
+    calc
+      BIBase.except0 (BIBase.sep A (BIBase.sep B (BIBase.sep (BIBase.except0 P) Q)))
+          ⊣⊢ BIBase.except0 (BIBase.sep (BIBase.sep A B)
+            (BIBase.sep (BIBase.except0 P) Q)) := by
+            -- expose the left-associated sep
+            exact except0_congr (sep_assoc (P := A) (Q := B)
+              (R := BIBase.sep (BIBase.except0 P) Q)).symm
+      _ ⊣⊢ BIBase.except0 (BIBase.sep (BIBase.sep A B) (BIBase.sep (PROP := IProp GF) P Q)) := by
+            -- remove the redundant except0 on the postcondition
+            exact except0_sep_idemp (P := BIBase.sep A B) (Q := P) (R := Q)
+      _ ⊣⊢ BIBase.except0 (BIBase.sep A (BIBase.sep B (BIBase.sep (PROP := IProp GF) P Q))) := by
+            -- restore right association
+            exact except0_congr (sep_assoc (P := A) (Q := B) (R := BIBase.sep (PROP := IProp GF) P Q))
+  simpa [A, B] using h.1
+
+/-! ## Properties -/
+
+omit [FiniteMapLaws Positive M] in
+/-- `inv N P` is persistent.
+
+    Coq: `inv_persistent` -/
+theorem inv_persistent {W : WsatGS GF}
+    (N : Namespace) (P : IProp GF) :
+    inv (GF := GF) (M := M) (F := F) W N P ⊢
+      BIBase.persistently (inv (GF := GF) (M := M) (F := F) W N P) := by
+  simpa [inv] using
+    (persistently_idem_2 (PROP := IProp GF)
+      (P := BIBase.forall fun E : Iris.Set Positive =>
+        BIBase.imp (BIBase.pure (Subset (nclose N).mem E))
+          (uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+            (BIBase.sep (BIBase.later P)
+              (BIBase.wand (BIBase.later P)
+                (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+                  (BIBase.pure True)))))))
+
+instance inv_persistent_inst {W : WsatGS GF} (N : Namespace) (P : IProp GF) :
+    Persistent (inv (GF := GF) (M := M) (F := F) W N P) :=
+  ⟨inv_persistent (W := W) (N := N) (P := P)⟩
+
+omit [FiniteMapLaws Positive M] in
+/-- Non-expansive core of `inv` over a latered parameter. -/
+private theorem invBody_ne {W : WsatGS GF} (N : Namespace) :
+    OFE.NonExpansive (invBody (GF := GF) (M := M) (F := F) W N) := by
+  -- Push non-expansiveness through persistently, forall, imp, and fupd.
+  refine ⟨?_⟩
+  intro n X Y hXY
+  unfold invBody
+  refine (persistently_ne.ne ?_)
+  refine forall_ne ?_
+  intro E
+  refine (imp_ne.ne .rfl ?_)
+  have hwand :
+      BIBase.wand X (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+        (BIBase.pure True)) ≡{n}≡
+      BIBase.wand Y (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+        (BIBase.pure True)) :=
+    (wand_ne.ne hXY .rfl)
+  have hsep : BIBase.sep X (BIBase.wand X
+      (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+        (BIBase.pure True))) ≡{n}≡
+      BIBase.sep Y (BIBase.wand Y
+        (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+          (BIBase.pure True))) :=
+    (sep_ne.ne hXY hwand)
+  exact (uPred_fupd_ne (W := W) (E1 := E) (E2 := maskDiff E N)).ne hsep
+
+/-- `inv N` is contractive in its body. -/
+instance inv_contractive {W : WsatGS GF} (N : Namespace) :
+    OFE.Contractive (fun P => inv (GF := GF) (M := M) (F := F) W N P) := by
+  -- `inv` is `invBody` applied to the contractive `later`.
+  refine ⟨?_⟩
+  intro n P Q hPQ
+  have hlater :
+      BIBase.later P ≡{n}≡ BIBase.later Q :=
+    (OFE.Contractive.distLater_dist
+      (f := BIBase.later (PROP := IProp GF)) hPQ)
+  simpa [inv, invBody] using
+    (invBody_ne (GF := GF) (M := M) (F := F) (N := N) (W := W)).ne hlater
+
+/-- `inv N` is non-expansive in its body. -/
+instance inv_ne {W : WsatGS GF} (N : Namespace) :
+    OFE.NonExpansive (fun P => inv (GF := GF) (M := M) (F := F) W N P) := by
+  -- contractive functions are non-expansive
+  infer_instance
+
+omit [FiniteMapLaws Positive M] in
+/-- `inv` respects equivalence of its body. -/
+theorem inv_proper {W : WsatGS GF} (N : Namespace) {P Q : IProp GF}
+    (h : P ≡ Q) : inv (GF := GF) (M := M) (F := F) W N P ≡
+      inv (GF := GF) (M := M) (F := F) W N Q := by
+  -- non-expansiveness preserves equivalence
+  exact OFE.NonExpansive.eqv (f := fun P => inv (GF := GF) (M := M) (F := F) W N P) h
+
+/-! ## Allocation -/
+
+/-- Allocate a new invariant from `▷ P`.
+
+    Proof strategy: use `ownI_alloc` from wsat to get a fresh invariant name
+    in `↑N`, then pack behind `□` to form `inv N P`.
+
+    Coq: `inv_alloc` -/
+theorem inv_alloc {W : WsatGS GF}
+    (N : Namespace) (E : Iris.Set Positive) (P : IProp GF)
+    (hfresh : ∀ E : GSet, ∃ i, ¬E.mem i ∧ (nclose N).mem i) :
+    BIBase.later P ⊢
+      uPred_fupd (M := M) (F := F) W E E
+        (inv (GF := GF) (M := M) (F := F) W N P) := by
+  classical
+  unfold uPred_fupd
+  iintro HP
+  iintro H
+  icases H with ⟨Hwsat, HownE⟩
+  -- allocate a fresh invariant name under `↑N`
+  ihave Halloc :=
+    (wrapEntails (GF := GF)
+      (ownI_alloc (GF := GF) (M := M) (F := F) (W := W)
+        (φ := fun i => (nclose N).mem i) (P := P) hfresh)) $$ [Hwsat, HP]
+  · -- build the premise `wsat ∗ ▷ P`
+    isplitl [Hwsat]
+    · iexact Hwsat
+    · iexact HP
+  -- map the update result into the invariant and add except-0
+  have hmono :
+      BIBase.sep (ownE W (mask E)) (BIBase.exists fun i =>
+        BIBase.sep (BIBase.pure ((nclose N).mem i))
+          (BIBase.sep (wsat (GF := GF) (M := M) (F := F) W)
+            (ownI (GF := GF) (M := M) (F := F) W i P))) ⊢
+      BIBase.except0 (BIBase.sep (wsat (GF := GF) (M := M) (F := F) W)
+        (BIBase.sep (ownE W (mask E))
+          (inv (GF := GF) (M := M) (F := F) W N P))) := by
+    -- pull the existential out of the sep, then build the postcondition
+    refine (sep_exists_l (P := ownE W (mask E))
+      (Ψ := fun i =>
+        BIBase.sep (BIBase.pure ((nclose N).mem i))
+          (BIBase.sep (wsat (GF := GF) (M := M) (F := F) W)
+            (ownI (GF := GF) (M := M) (F := F) W i P)))).1.trans ?_
+    refine exists_elim ?_
+    intro i
+    iintro Hres
+    icases Hres with ⟨HownE', Hrest⟩
+    icases Hrest with ⟨Hmem, Hrest⟩
+    icases Hmem with %Hmem
+    icases Hrest with ⟨Hwsat', HownI⟩
+    -- assemble the postcondition, building `inv` from `own_inv`
+    iapply (wrapEntails (GF := GF) (except0_intro (P := _)))
+    isplitl [Hwsat']
+    · iexact Hwsat'
+    · isplitl [HownE']
+      · iexact HownE'
+      · -- derive `inv` from the internal ownership witness
+        iapply (wrapEntails (GF := GF)
+          (own_inv_to_inv (W := W) (N := N) (P := P)))
+        unfold own_inv
+        iexists i
+        isplit
+        · ipure_intro
+          exact Hmem
+        · iexact HownI
+  -- frame `ownE` through the update and apply monotonicity
+  iapply (wrapEntails (GF := GF)
+    (BIUpdate.mono
+      (P := BIBase.sep (ownE W (mask E)) (BIBase.exists fun i =>
+        BIBase.sep (BIBase.pure ((nclose N).mem i))
+          (BIBase.sep (wsat (GF := GF) (M := M) (F := F) W)
+            (ownI (GF := GF) (M := M) (F := F) W i P))))
+      (Q := BIBase.except0 <|
+        BIBase.sep (wsat (GF := GF) (M := M) (F := F) W)
+          (BIBase.sep (ownE W (mask E))
+            (inv (GF := GF) (M := M) (F := F) W N P)))
+      hmono))
+  iapply (wrapEntails (GF := GF)
+    (bupd_frame_l (P := ownE W (mask E))
+      (Q := BIBase.exists fun i =>
+        BIBase.sep (BIBase.pure ((nclose N).mem i))
+          (BIBase.sep (wsat (GF := GF) (M := M) (F := F) W)
+            (ownI (GF := GF) (M := M) (F := F) W i P)))))
+  isplitl [HownE]
+  · iexact HownE
+  · iexact Halloc
+
+/-- Allocate an invariant and immediately open it.
+
+    Coq: `inv_alloc_open` -/
+theorem inv_alloc_open {W : WsatGS GF}
+    (N : Namespace) (E : Iris.Set Positive) (P : IProp GF)
+    (h : Subset (nclose N).mem E)
+    (hfresh : ∀ E : GSet, ∃ i, ¬E.mem i ∧ (nclose N).mem i) :
+    (BIBase.emp : IProp GF) ⊢
+      uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+        (BIBase.sep (inv (GF := GF) (M := M) (F := F) W N P)
+          (BIBase.wand (BIBase.later P)
+            (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+              (BIBase.pure True)))) := by
+  classical
+  unfold uPred_fupd
+  iintro Hemp
+  iintro H
+  icases H with ⟨Hwsat, HownE⟩
+  ihave HwsatB :=
+    (wrapEntails (GF := GF)
+      (BIUpdate.intro (P := wsat (GF := GF) (M := M) (F := F) W))) $$ Hwsat
+  -- allocate and immediately open an invariant in `↑N`
+  ihave Halloc :=
+    (wrapEntails (GF := GF)
+      (ownI_alloc_open (GF := GF) (M := M) (F := F) (W := W)
+        (φ := fun i => (nclose N).mem i) (P := P) hfresh)) $$ HwsatB
+  ihave Halloc' :=
+    (wrapEntails (GF := GF)
+      (bupd_frame_l (P := ownE W (mask E))
+        (Q := BIBase.exists fun i =>
+          BIBase.sep (BIBase.pure ((nclose N).mem i))
+            (BIBase.sep
+              (BIBase.wand (ownE W (CoPset.singleton i))
+                (wsat (GF := GF) (M := M) (F := F) W))
+              (BIBase.sep (ownI (GF := GF) (M := M) (F := F) W i P)
+                (ownD W (GSet.singleton i))))))) $$ [HownE, Halloc]
+  · isplitl [HownE]
+    · iexact HownE
+    · iexact Halloc
+  have hmono_wand :
+      (BIBase.emp : IProp GF) ⊢
+        iprop((ownE W (mask E) ∗
+          BIBase.exists fun i =>
+            BIBase.sep (BIBase.pure ((nclose N).mem i))
+              (BIBase.sep
+                (BIBase.wand (ownE W (CoPset.singleton i))
+                  (wsat (GF := GF) (M := M) (F := F) W))
+                (BIBase.sep (ownI (GF := GF) (M := M) (F := F) W i P)
+                  (ownD W (GSet.singleton i))))) -∗
+          BIBase.except0
+            (BIBase.sep (wsat (GF := GF) (M := M) (F := F) W)
+              (BIBase.sep (ownE W (mask (maskDiff E N)))
+                (BIBase.sep (inv (GF := GF) (M := M) (F := F) W N P)
+                  (BIBase.wand (BIBase.later P)
+                    (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+                      (BIBase.pure True))))))) := by
+    iintro -
+    iintro Hres
+    icases Hres with ⟨HownE, Halloc⟩
+    icases Halloc with ⟨%i, Halloc⟩
+    icases Halloc with ⟨Hmem, Halloc⟩
+    icases Hmem with %Hmem
+    icases Halloc with ⟨HopenW, Halloc⟩
+    icases Halloc with ⟨HownI', HownD⟩
+    icases HownI' with #HownI'
+    -- split `ownE E` into `ownE {i}`, `ownE (↑N \ {i})`, and `ownE (E \ ↑N)`
+    have hmask : mask E = (nclose N) ∪ mask (maskDiff E N) := by
+      ext x; constructor
+      · intro hx
+        by_cases hxN : (nclose N).mem x
+        · exact Or.inl hxN
+        · exact Or.inr ⟨hx, hxN⟩
+      · intro hx
+        cases hx with
+        | inl hxN => exact h _ hxN
+        | inr hxDiff => exact hxDiff.1
+    have hdisj : CoPset.Disjoint (nclose N) (mask (maskDiff E N)) := by
+      intro x hx
+      exact hx.2.2 hx.1
+    let rest : CoPset := nclose N \ CoPset.singleton i
+    have hmaskN : (nclose N) = (CoPset.singleton i) ∪ rest := by
+      ext x; constructor
+      · intro hxN
+        by_cases hx : x = i
+        · left; simpa [CoPset.mem_singleton] using hx
+        · right; exact ⟨hxN, by simpa [CoPset.mem_singleton, rest] using hx⟩
+      · intro hx
+        cases hx with
+        | inl hx =>
+            have hx' : x = i := by simpa [CoPset.mem_singleton] using hx
+            subst hx'
+            exact Hmem
+        | inr hx => exact hx.1
+    have hdisjN : CoPset.Disjoint (CoPset.singleton i) rest := by
+      intro x hx
+      exact hx.2.2 hx.1
+    have hsplit :
+        ownE W (mask E) ⊢
+          BIBase.sep (ownE W (nclose N)) (ownE W (mask (maskDiff E N))) := by
+      -- rewrite the mask to the disjoint union and apply `ownE_op`
+      rw [hmask]
+      exact (ownE_op (W := W) (E₁ := nclose N) (E₂ := mask (maskDiff E N)) hdisj).1
+    ihave Hsplit := (wrapEntails (GF := GF) hsplit) $$ HownE
+    icases Hsplit with ⟨HownEN, HownEdiff⟩
+    have hsplitN :
+        ownE W (nclose N) ⊢
+          BIBase.sep (ownE W (CoPset.singleton i)) (ownE W rest) := by
+      -- rewrite the namespace to the singleton union and apply `ownE_op`
+      rw [hmaskN]
+      exact (ownE_op (W := W) (E₁ := CoPset.singleton i) (E₂ := rest) hdisjN).1
+    ihave HsplitN := (wrapEntails (GF := GF) hsplitN) $$ HownEN
+    icases HsplitN with ⟨HownEi, HownErest⟩
+    -- open the invariant using the allocated opener
+    ihave Hwsat' := HopenW $$ HownEi
+    -- build the result
+    iapply (wrapEntails (GF := GF) (except0_intro (P := _)))
+    isplitl [Hwsat']
+    · iexact Hwsat'
+    · isplitl [HownEdiff]
+      · iexact HownEdiff
+      · -- package `inv` and the closing wand
+        isplitl []
+        · -- `inv` from `own_inv`
+          iapply (wrapEntails (GF := GF) (own_inv_to_inv (W := W) (N := N) (P := P)))
+          unfold own_inv
+          iexists i
+          isplit
+          · ipure_intro
+            exact Hmem
+          · iexact HownI'
+        · iintro HP
+          unfold uPred_fupd
+          iintro Hclose
+          icases Hclose with ⟨Hwsat2, HownEdiff2⟩
+          ihave Hclose' :=
+            (wrapEntails (GF := GF)
+              (ownI_close (W := W) (M := M) (F := F) i P)) $$ [Hwsat2, HownI', HP, HownD]
+          · -- build the premise `((wsat ∗ ownI) ∗ ▷ P) ∗ ownD`
+            isplitl [Hwsat2 HP]
+            · isplitl [Hwsat2]
+              · isplitl [Hwsat2]
+                · iexact Hwsat2
+                · iexact HownI'
+              · iexact HP
+            · iexact HownD
+          icases Hclose' with ⟨Hwsat3, HownEi'⟩
+          have hjoinN :
+              BIBase.sep (ownE W (CoPset.singleton i)) (ownE W rest) ⊢
+              ownE W (nclose N) := by
+            -- rewrite the namespace to the singleton union and apply `ownE_op`
+            rw [hmaskN]
+            exact (ownE_op (W := W) (E₁ := CoPset.singleton i) (E₂ := rest) hdisjN).2
+          ihave HjoinN := (wrapEntails (GF := GF) hjoinN) $$ [HownEi', HownErest]
+          · -- assemble the singleton/rest split
+            isplitl [HownEi']
+            · iexact HownEi'
+            · iexact HownErest
+          have hjoin :
+              BIBase.sep (ownE W (nclose N)) (ownE W (mask (maskDiff E N))) ⊢
+              ownE W (mask E) := by
+            -- rewrite the mask to the disjoint union and apply `ownE_op`
+            rw [hmask]
+            exact (ownE_op (W := W) (E₁ := nclose N)
+              (E₂ := mask (maskDiff E N)) hdisj).2
+          ihave Hjoin := (wrapEntails (GF := GF) hjoin) $$ [HjoinN, HownEdiff2]
+          · -- rejoin `↑N` with the remaining mask
+            isplitl [HjoinN]
+            · iexact HjoinN
+            · iexact HownEdiff2
+          iapply BIUpdate.intro
+          iapply (wrapEntails (GF := GF) (except0_intro (P := _)))
+          isplitl [Hwsat3]
+          · iexact Hwsat3
+          · isplitl [Hjoin]
+            · iexact Hjoin
+            · ipure_intro
+              exact True.intro
+  have hmono :
+      BIBase.sep (ownE W (mask E))
+        (BIBase.exists fun i =>
+          BIBase.sep (BIBase.pure ((nclose N).mem i))
+            (BIBase.sep
+              (BIBase.wand (ownE W (CoPset.singleton i))
+                (wsat (GF := GF) (M := M) (F := F) W))
+              (BIBase.sep (ownI (GF := GF) (M := M) (F := F) W i P)
+                (ownD W (GSet.singleton i))))) ⊢
+      BIBase.except0
+        (BIBase.sep (wsat (GF := GF) (M := M) (F := F) W)
+          (BIBase.sep (ownE W (mask (maskDiff E N)))
+            (BIBase.sep (inv (GF := GF) (M := M) (F := F) W N P)
+              (BIBase.wand (BIBase.later P)
+                (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+                  (BIBase.pure True)))))) := by
+    -- move the wand proof under a sep and eliminate it
+    refine (sep_emp (P := BIBase.sep (ownE W (mask E))
+      (BIBase.exists fun i =>
+        BIBase.sep (BIBase.pure ((nclose N).mem i))
+          (BIBase.sep
+            (BIBase.wand (ownE W (CoPset.singleton i))
+              (wsat (GF := GF) (M := M) (F := F) W))
+            (BIBase.sep (ownI (GF := GF) (M := M) (F := F) W i P)
+              (ownD W (GSet.singleton i))))))).2.trans ?_
+    refine (sep_mono .rfl hmono_wand).trans ?_
+    exact wand_elim_r
+  have hmono' := by
+    -- unfold the nested fupd to match the goal after `unfold uPred_fupd`
+    simpa [uPred_fupd, wsat'] using hmono
+  iapply (wrapEntails (GF := GF) (BIUpdate.mono hmono'))
+  iexact Halloc'
+
+/-! ## Access -/
+
+omit [FiniteMapLaws Positive M] in
+/-- Open an invariant: given `↑N ⊆ E`, access `▷ P` with a closing view shift.
+
+    Proof strategy: unfold `inv` definition, apply the universally quantified
+    body to `E` with the subset proof.
+
+    Coq: `inv_acc` -/
+theorem inv_acc {W : WsatGS GF}
+    (E : Iris.Set Positive) (N : Namespace) (P : IProp GF)
+    (h : Subset (nclose N).mem E) :
+    inv (GF := GF) (M := M) (F := F) W N P ⊢
+      uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+        (BIBase.sep (BIBase.later P)
+          (BIBase.wand (BIBase.later P)
+            (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+              (BIBase.pure True)))) := by
+  have hwand :
+      (BIBase.emp : IProp GF) ⊢
+        iprop((inv (GF := GF) (M := M) (F := F) W N P) -∗
+          (uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+            (BIBase.sep (BIBase.later P)
+              (BIBase.wand (BIBase.later P)
+                (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+                  (BIBase.pure True)))))) := by
+    unfold inv
+    iintro -
+    iintro Hinv
+    iapply Hinv $$ %E
+    ipure_intro
+    exact h
+  -- eliminate the wand using `emp` framing
+  refine (sep_emp (P := inv (GF := GF) (M := M) (F := F) W N P)).2.trans ?_
+  refine (sep_mono .rfl hwand).trans ?_
+  exact wand_elim_r
+
+omit [FiniteMapLaws Positive M] in
+/-- Access a timeless invariant: strip the `▷` when `P` is timeless.
+
+    Coq: `inv_acc_timeless` -/
+theorem inv_acc_timeless {W : WsatGS GF}
+    (E : Iris.Set Positive) (N : Namespace) (P : IProp GF)
+    (h : Subset (nclose N).mem E)
+    (htimeless : (BIBase.later P : IProp GF) ⊢
+      BIBase.or (BIBase.later (BIBase.pure False)) P) :
+    inv (GF := GF) (M := M) (F := F) W N P ⊢
+      uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+        (BIBase.sep P
+          (BIBase.wand P
+            (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+              (BIBase.pure True)))) := by
+  -- first open the invariant, then use timelessness to drop the later
+  have hclose :
+      BIBase.wand (BIBase.later P)
+        (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True)) ⊢
+      BIBase.wand P
+        (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True) : IProp GF) :=
+    wand_mono (later_intro (P := P)) .rfl
+  have hpost :
+      BIBase.sep (BIBase.later P)
+        (BIBase.wand (BIBase.later P)
+          (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True))) ⊢
+      BIBase.sep (BIBase.except0 P)
+        (BIBase.wand P
+          (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True)) : IProp GF) :=
+    sep_mono htimeless hclose
+  refine (inv_acc (W := W) (E := E) (N := N) (P := P) h).trans ?_
+  -- replace `▷ P` by `◇ P` in the postcondition
+  have hmono :=
+    fupd_mono (W := W) (M := M) (F := F) (E1 := E) (E2 := maskDiff E N)
+      (P := _ ) (Q := _ ) hpost
+  -- drop the redundant `◇` under the outer except-0
+  exact hmono.trans (fupd_drop_except0_post (W := W) (M := M) (F := F)
+    (E1 := E) (E2 := maskDiff E N) (P := P)
+    (Q := BIBase.wand P
+      (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True))))
+
+/-! ## Derived Properties -/
+
+omit [FiniteMapLaws Positive M] in
+private theorem maskDiff_self (N : Namespace) :
+    maskDiff (nclose N).mem N = (fun _ => False) := by
+  -- membership is contradictory for the same namespace
+  funext i; simp [maskDiff]
+
+omit [FiniteMapLaws Positive M] in
+private theorem mask_union_diff (N : Namespace) (E : Iris.Set Positive)
+    (h : Subset (nclose N).mem E) :
+    (fun x => (nclose N).mem x ∨ maskDiff E N x) = E := by
+  -- split on whether `x` is in the namespace
+  funext i; apply propext; constructor
+  · intro hx; cases hx with
+    | inl hN => exact h _ hN
+    | inr hdiff => exact hdiff.1
+  · intro hE; by_cases hN : (nclose N).mem i
+    · exact Or.inl hN
+    · exact Or.inr ⟨hE, hN⟩
+
+/-! ### Mask Helpers -/
+
+/- A two-namespace mask difference. -/
+private abbrev maskDiff2 (E : Iris.Set Positive) (N1 N2 : Namespace) :
+    Iris.Set Positive :=
+  -- drop both namespaces from the mask
+  fun x => E x ∧ ¬(nclose N1).mem x ∧ ¬(nclose N2).mem x
+
+omit [FiniteMapLaws Positive M] in
+private theorem maskDiff2_eq (E : Iris.Set Positive) (N1 N2 : Namespace) :
+    maskDiff (maskDiff E N1) N2 = maskDiff2 E N1 N2 := by
+  -- unfold nested differences and reassociate
+  funext i; simp [maskDiff, maskDiff2, and_assoc]
+
+omit [FiniteMapLaws Positive M] in
+private theorem maskDiff2_subset_of_union (E : Iris.Set Positive)
+    (N1 N2 N : Namespace)
+    (hsubset : Subset (fun x => (nclose N1).mem x ∨ (nclose N2).mem x) (nclose N).mem) :
+    Subset (maskDiff E N) (maskDiff2 E N1 N2) := by
+  -- use the union subset to exclude both namespaces
+  intro i hi
+  have hN1 : ¬(nclose N1).mem i := by
+    intro hN1; exact hi.2 (hsubset _ (Or.inl hN1))
+  have hN2 : ¬(nclose N2).mem i := by
+    intro hN2; exact hi.2 (hsubset _ (Or.inr hN2))
+  exact ⟨hi.1, hN1, hN2⟩
+
+omit [FiniteMapLaws Positive M] in
+private theorem nclose_subset_maskDiff (E : Iris.Set Positive)
+    (N1 N2 : Namespace)
+    (hdisj : CoPset.Disjoint (nclose N1) (nclose N2))
+    (hE : Subset (nclose N2).mem E) :
+    Subset (nclose N2).mem (maskDiff E N1) := by
+  -- keep `N2` inside the mask while excluding `N1`
+  intro i hi
+  have hN1 : ¬(nclose N1).mem i := by
+    intro hN1; exact (hdisj i) ⟨hN1, hi⟩
+  exact ⟨hE _ hi, hN1⟩
+
+omit [FiniteMapLaws Positive M] in
+private theorem fupd_from_split' {W : WsatGS GF}
+    (E1 E2 : Iris.Set Positive) (E3 : CoPset)
+    (hE : mask E1 = mask E2 ∪ E3) (hdisj : CoPset.Disjoint (mask E2) E3)
+    (P : IProp GF) :
+    BIBase.sep (ownE W E3) P ⊢ uPred_fupd (M := M) (F := F) W E2 E1 P := by
+  -- reassemble the mask, then wrap with except-0 and bupd
+  unfold uPred_fupd
+  refine wand_intro ?_
+  refine (sep_comm (P := BIBase.sep (ownE W E3) P)
+    (Q := BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E2)))).1.trans ?_
+  refine (sep_assoc (P := wsat' (M := M) (F := F) W) (Q := ownE W (mask E2))
+    (R := BIBase.sep (ownE W E3) P)).1.trans ?_
+  refine (sep_mono .rfl
+    (sep_assoc (P := ownE W (mask E2)) (Q := ownE W E3) (R := P)).2).trans ?_
+  have hown : BIBase.sep (ownE W (mask E2)) (ownE W E3) ⊢ ownE W (mask E1) := by
+    -- collapse the split mask back to `E1`
+    simpa [hE] using (ownE_op (W := W) (E₁ := mask E2) (E₂ := E3) hdisj).2
+  refine (sep_mono .rfl (sep_mono hown .rfl)).trans ?_
+  exact (except0_intro).trans BIUpdate.intro
+
+omit [FiniteMapLaws Positive M] in
+private theorem fupd_mask_intro {W : WsatGS GF}
+    (E1 E2 : Iris.Set Positive) (h : Subset E2 E1) (P : IProp GF) :
+    BIBase.wand (uPred_fupd (M := M) (F := F) W E2 E1 (BIBase.emp : IProp GF)) P ⊢
+      uPred_fupd (M := M) (F := F) W E1 E2 P := by
+  -- split `E1` into `E2` plus the disjoint remainder, then apply the wand
+  rcases CoPset.subseteq_disjoint_union (s₁ := mask E2) (s₂ := mask E1) h with
+    ⟨E3, hE, hdisj⟩
+  let Hwand : IProp GF :=
+    BIBase.wand (uPred_fupd (M := M) (F := F) W E2 E1 (BIBase.emp : IProp GF)) P
+  have hsplit : ownE W (mask E1) ⊢ BIBase.sep (ownE W (mask E2)) (ownE W E3) := by
+    -- expose the split mask via `ownE_op`
+    simpa [hE] using (ownE_op (W := W) (E₁ := mask E2) (E₂ := E3) hdisj).1
+  have hwand :
+      BIBase.sep (ownE W E3) Hwand ⊢ P := by
+    -- build the closing fupd from `ownE E3`, then eliminate the wand
+    have hfupd :
+        BIBase.sep (ownE W E3) (BIBase.emp : IProp GF) ⊢
+          uPred_fupd (M := M) (F := F) W E2 E1 (BIBase.emp : IProp GF) :=
+      fupd_from_split' (W := W) (E1 := E1) (E2 := E2) (E3 := E3) hE hdisj
+        (P := (BIBase.emp : IProp GF))
+    refine (sep_mono (sep_emp (P := ownE W E3)).2 .rfl).trans ?_
+    refine (sep_mono hfupd .rfl).trans ?_
+    exact wand_elim_r
+  unfold uPred_fupd
+  refine wand_intro ?_
+  refine (sep_comm (P := Hwand) (Q := BIBase.sep (wsat' (M := M) (F := F) W)
+    (ownE W (mask E1)))).1.trans ?_
+  refine (sep_assoc (P := wsat' (M := M) (F := F) W) (Q := ownE W (mask E1))
+    (R := Hwand)).1.trans ?_
+  refine (sep_mono .rfl (sep_mono hsplit .rfl)).trans ?_
+  refine (sep_mono .rfl
+    (sep_assoc (P := ownE W (mask E2)) (Q := ownE W E3)
+      (R := Hwand)).1).trans ?_
+  refine (sep_assoc (P := wsat' (M := M) (F := F) W) (Q := ownE W (mask E2))
+    (R := BIBase.sep (ownE W E3) Hwand)).2.trans ?_
+  -- introduce the bupd and the except-0 wrapper
+  have hupd :
+      BIBase.sep (BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E2))) P ⊢
+        BUpd.bupd (BIBase.except0 (BIBase.sep (wsat' (M := M) (F := F) W)
+          (BIBase.sep (ownE W (mask E2)) P))) := by
+    -- reassociate, then use `bupd` intro and monotonicity for `except0`
+    refine (sep_assoc (P := wsat' (M := M) (F := F) W) (Q := ownE W (mask E2)) (R := P)).1.trans ?_
+    exact (BIUpdate.intro (P := BIBase.sep (wsat' (M := M) (F := F) W)
+      (BIBase.sep (ownE W (mask E2)) P))).trans
+        (BIUpdate.mono (PROP := IProp GF)
+          (except0_intro (P := BIBase.sep (wsat' (M := M) (F := F) W)
+            (BIBase.sep (ownE W (mask E2)) P))))
+  exact (sep_mono .rfl hwand).trans hupd
+
+omit [FiniteMapLaws Positive M] in
+private theorem fupd_wand_r {W : WsatGS GF}
+    (E1 E2 : Iris.Set Positive) (P Q : IProp GF) :
+    BIBase.sep (uPred_fupd (M := M) (F := F) W E1 E2 P) (BIBase.wand P Q) ⊢
+      uPred_fupd (M := M) (F := F) W E1 E2 Q := by
+  -- frame the wand through the update, then eliminate it
+  iintro H
+  iapply (wrapEntails (GF := GF)
+    (fupd_mono (W := W) (E1 := E1) (E2 := E2)
+      (P := BIBase.sep P (BIBase.wand P Q)) (Q := Q) (wand_elim_r (P := P) (Q := Q))))
+  iapply (wrapEntails (GF := GF)
+    (fupd_frame_r (W := W) (M := M) (F := F) (E1 := E1) (E2 := E2)
+      (P := P) (Q := BIBase.wand P Q)))
+  iexact H
+
+omit [FiniteMapLaws Positive M] in
+private theorem maskDiff_union_right (E : Iris.Set Positive) (N : Namespace) :
+    (fun x => maskDiff (nclose N).mem N x ∨ maskDiff E N x) = maskDiff E N := by
+  -- the left disjunct is always false
+  funext i; simp [maskDiff]
+
+omit [FiniteMapLaws Positive M] in
+private theorem inv_close_strong {W : WsatGS GF}
+    (N : Namespace) (P : IProp GF) :
+    BIBase.wand (BIBase.later P)
+      (uPred_fupd (M := M) (F := F) W
+        (maskDiff (nclose N).mem N) (nclose N).mem (BIBase.pure True)) ⊢
+      BIBase.forall fun E' : Iris.Set Positive =>
+        BIBase.wand (BIBase.later P)
+          (uPred_fupd (M := M) (F := F) W E'
+            (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True)) := by
+  classical
+  iintro Hclose
+  iintro %E'
+  iintro HP
+  -- apply the original close shift and frame the extra mask
+  have hdisj : CoPset.Disjoint (mask (fun _ => False)) (mask E') := by
+    intro i hi; exact hi.1
+  have hframe :
+      BIBase.wand (BIBase.later P)
+          (uPred_fupd (M := M) (F := F) W (maskDiff (nclose N).mem N)
+            (nclose N).mem (BIBase.pure True)) ⊢
+        BIBase.wand (BIBase.later P)
+          (uPred_fupd (M := M) (F := F) W E'
+            (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True)) := by
+    refine wand_mono_r ?_
+    have hframe' :
+        uPred_fupd (M := M) (F := F) W (fun _ => False) (nclose N).mem (BIBase.pure True) ⊢
+          uPred_fupd (M := M) (F := F) W
+            (fun x => False ∨ E' x) (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True) :=
+      fupd_mask_frame_r (M := M) (F := F) (W := W) (E1 := fun _ => False)
+        (E2 := (nclose N).mem) (Ef := E') (P := BIBase.pure True) hdisj
+    have hfalse : (fun x => False ∨ E' x) = E' := by
+      funext i; simp
+    simpa [maskDiff_self (N := N), hfalse] using hframe'
+  ihave Hclose' := (wrapEntails (GF := GF) hframe) $$ Hclose
+  ispecialize Hclose' $$ HP
+  iexact Hclose'
+
+/-! ### Combination and Splitting -/
+
+omit [FiniteMapLaws Positive M]
+  [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem later_dup (P : IProp GF) :
+    BIBase.persistently (BIBase.wand P (BIBase.sep P P)) ⊢
+      BIBase.wand (BIBase.later P) (BIBase.sep (BIBase.later P) (BIBase.later P)) := by
+  -- duplicate a latered proposition using the persistent duplicator
+  iintro Hdup
+  iintro HP
+  ihave Hdup' :=
+    (wrapEntails (GF := GF)
+      (intuitionistically_elim (P := BIBase.wand P (BIBase.sep P P)))) $$ Hdup
+  ihave Hlater :=
+    (wrapEntails (GF := GF)
+      (later_intro (P := BIBase.wand P (BIBase.sep P P)))) $$ Hdup'
+  ihave Hwand :=
+    (wrapEntails (GF := GF)
+      (later_wand (P := P) (Q := BIBase.sep P P))) $$ Hlater
+  ispecialize Hwand $$ HP
+  ihave Hsplit := (wrapEntails (GF := GF)
+    (later_sep (P := P) (Q := P)).1) $$ Hwand
+  iexact Hsplit
+
+omit [FiniteMapLaws Positive M]
+  [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem inv_split_l_transform (P Q : IProp GF) :
+    (BIBase.emp : IProp GF) ⊢
+      BIBase.later (BIBase.intuitionistically
+        (BIBase.wand (BIBase.sep (PROP := IProp GF) P Q)
+          (BIBase.sep P (BIBase.wand P (BIBase.sep (PROP := IProp GF) P Q))))) := by
+  -- build the latered, persistent split/merge witness
+  have hwand :
+      (BIBase.emp : IProp GF) ⊢
+        BIBase.wand (BIBase.sep (PROP := IProp GF) P Q)
+          (BIBase.sep P (BIBase.wand P (BIBase.sep (PROP := IProp GF) P Q))) := by
+    iintro _
+    iintro HPQ
+    icases HPQ with ⟨HP, HQ⟩
+    isplitl [HP]
+    · iexact HP
+    · iintro HP'
+      isplitl [HP']
+      · iexact HP'
+      · iexact HQ
+  have hbox :
+      BIBase.intuitionistically (BIBase.emp : IProp GF) ⊢
+        BIBase.wand (BIBase.sep (PROP := IProp GF) P Q)
+          (BIBase.sep P (BIBase.wand P (BIBase.sep (PROP := IProp GF) P Q))) :=
+    (intuitionistically_elim (P := (BIBase.emp : IProp GF))).trans hwand
+  have hboxed :
+      BIBase.intuitionistically (BIBase.emp : IProp GF) ⊢
+        BIBase.intuitionistically
+          (BIBase.wand (BIBase.sep (PROP := IProp GF) P Q)
+            (BIBase.sep P (BIBase.wand P (BIBase.sep (PROP := IProp GF) P Q)))) :=
+    intuitionistically_intro' hbox
+  have hemp :
+      (BIBase.emp : IProp GF) ⊢
+        BIBase.intuitionistically (BIBase.emp : IProp GF) :=
+    (intuitionistically_emp (PROP := IProp GF)).2
+  exact (hemp.trans hboxed).trans (later_intro (P := _))
+
+omit [FiniteMapLaws Positive M] in
+private theorem inv_acc_strong_frame {W : WsatGS GF}
+    (E : Iris.Set Positive) (N : Namespace) (P : IProp GF)
+    (h : Subset (nclose N).mem E) :
+    uPred_fupd (M := M) (F := F) W (nclose N).mem
+        (maskDiff (nclose N).mem N)
+        (BIBase.sep (BIBase.later P)
+          (BIBase.wand (BIBase.later P)
+            (uPred_fupd (M := M) (F := F) W (maskDiff (nclose N).mem N)
+              (nclose N).mem (BIBase.pure True)))) ⊢
+      uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+        (BIBase.sep (BIBase.later P)
+          (BIBase.wand (BIBase.later P)
+            (uPred_fupd (M := M) (F := F) W (maskDiff (nclose N).mem N)
+              (nclose N).mem (BIBase.pure True)))) := by
+  -- rewrite mask unions and apply `fupd_mask_frame_r`
+  have hdisj :
+      CoPset.Disjoint (mask (nclose N).mem) (mask (maskDiff E N)) := by
+    intro i hi; exact hi.2.2 hi.1
+  simpa [mask_union_diff (N := N) (E := E) h, maskDiff_union_right (E := E) (N := N),
+    maskDiff_self (N := N)] using
+    (fupd_mask_frame_r (W := W) (E1 := (nclose N).mem)
+      (E2 := maskDiff (nclose N).mem N) (Ef := maskDiff E N)
+      (P := BIBase.sep (BIBase.later P)
+        (BIBase.wand (BIBase.later P)
+          (uPred_fupd (M := M) (F := F) W (maskDiff (nclose N).mem N)
+            (nclose N).mem (BIBase.pure True))))
+      hdisj)
+
+omit [FiniteMapLaws Positive M] in
+private theorem inv_acc_strong_post {W : WsatGS GF}
+    (N : Namespace) (P : IProp GF) :
+    BIBase.sep (BIBase.later P)
+        (BIBase.wand (BIBase.later P)
+          (uPred_fupd (M := M) (F := F) W (maskDiff (nclose N).mem N)
+            (nclose N).mem (BIBase.pure True))) ⊢
+      BIBase.sep (BIBase.later P)
+        (BIBase.forall fun E' : Iris.Set Positive =>
+          BIBase.wand (BIBase.later P)
+            (uPred_fupd (M := M) (F := F) W E'
+              (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True))) := by
+  -- keep the later and strengthen the closing wand
+  exact sep_mono .rfl (inv_close_strong (W := W) (N := N) (P := P))
+
+omit [FiniteMapLaws Positive M] in
+private theorem inv_acc_strong_mono {W : WsatGS GF}
+    (E : Iris.Set Positive) (N : Namespace) (P : IProp GF) :
+    uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+        (BIBase.sep (BIBase.later P)
+          (BIBase.wand (BIBase.later P)
+            (uPred_fupd (M := M) (F := F) W (maskDiff (nclose N).mem N)
+              (nclose N).mem (BIBase.pure True)))) ⊢
+      uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+        (BIBase.sep (BIBase.later P)
+          (BIBase.forall fun E' : Iris.Set Positive =>
+            BIBase.wand (BIBase.later P)
+              (uPred_fupd (M := M) (F := F) W E'
+                (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True)))) := by
+  -- lift the postcondition via `fupd_mono`
+  exact fupd_mono (W := W) (M := M) (F := F) (E1 := E) (E2 := maskDiff E N)
+    (P := BIBase.sep (BIBase.later P)
+      (BIBase.wand (BIBase.later P)
+        (uPred_fupd (M := M) (F := F) W (maskDiff (nclose N).mem N)
+          (nclose N).mem (BIBase.pure True))))
+    (Q := BIBase.sep (BIBase.later P)
+      (BIBase.forall fun E' : Iris.Set Positive =>
+        BIBase.wand (BIBase.later P)
+          (uPred_fupd (M := M) (F := F) W E'
+            (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True))))
+    (inv_acc_strong_post (W := W) (N := N) (P := P))
+
+omit [FiniteMapLaws Positive M] in
+/-- Combine disjoint invariants into a larger namespace.
+
+    Coq: `inv_combine` -/
+theorem inv_combine {W : WsatGS GF}
+    (N1 N2 N : Namespace) (P Q : IProp GF)
+    (hdisj : CoPset.Disjoint (nclose N1) (nclose N2))
+    (hsubset : Subset (fun x => (nclose N1).mem x ∨ (nclose N2).mem x) (nclose N).mem) :
+    inv (GF := GF) (M := M) (F := F) W N1 P ⊢
+      BIBase.wand (inv (GF := GF) (M := M) (F := F) W N2 Q)
+        (inv (GF := GF) (M := M) (F := F) W N (BIBase.sep (PROP := IProp GF) P Q)) := by
+  classical
+  iintro HinvP
+  iintro HinvQ
+  -- unfold the invariant body and build it under a persistent context
+  let body : IProp GF :=
+    BIBase.forall fun E : Iris.Set Positive =>
+      BIBase.imp (BIBase.pure (Subset (nclose N).mem E))
+        (uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+          (BIBase.sep (BIBase.later (BIBase.sep (PROP := IProp GF) P Q))
+            (BIBase.wand (BIBase.later (BIBase.sep (PROP := IProp GF) P Q))
+              (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True)))))
+  have hbody :
+      BIBase.sep (inv (GF := GF) (M := M) (F := F) W N1 P)
+        (inv (GF := GF) (M := M) (F := F) W N2 Q) ⊢
+        body := by
+    -- unpack the invariant context and prove the body
+    iintro Hctx
+    icases Hctx with ⟨HinvP', HinvQ'⟩
+    iintro %E
+    iintro hE
+    icases hE with %hE
+    -- derive namespace inclusions for both invariants
+    have hN1 : Subset (nclose N1).mem E := by
+      intro i hi; exact hE _ (hsubset _ (Or.inl hi))
+    have hN2 : Subset (nclose N2).mem E := by
+      intro i hi; exact hE _ (hsubset _ (Or.inr hi))
+    have hN2' :
+        Subset (nclose N2).mem (maskDiff E N1) :=
+      nclose_subset_maskDiff (E := E) (N1 := N1) (N2 := N2) hdisj hN2
+    -- abbreviations for the staged postconditions
+    let E12 : Iris.Set Positive := maskDiff (maskDiff E N1) N2
+    let postP : IProp GF :=
+      BIBase.sep (BIBase.later P)
+        (BIBase.wand (BIBase.later P)
+          (uPred_fupd (M := M) (F := F) W (maskDiff E N1) E (BIBase.pure True)))
+    let postQ : IProp GF :=
+      BIBase.sep (BIBase.later Q)
+        (BIBase.wand (BIBase.later Q)
+          (uPred_fupd (M := M) (F := F) W E12 (maskDiff E N1) (BIBase.pure True)))
+    let postPQ : IProp GF :=
+      BIBase.sep (BIBase.later (BIBase.sep (PROP := IProp GF) P Q))
+        (BIBase.wand (BIBase.later (BIBase.sep (PROP := IProp GF) P Q))
+          (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True)))
+    -- open the left invariant
+    ihave HaccP :=
+      (wrapEntails (GF := GF)
+        (inv_acc (W := W) (M := M) (F := F) (E := E) (N := N1) (P := P) hN1)) $$ HinvP'
+    -- sequence the two accesses with `fupd_trans`
+    iapply (wrapEntails (GF := GF)
+      (fupd_trans (W := W) (E1 := E) (E2 := maskDiff E N1) (E3 := maskDiff E N)
+        (P := postPQ)))
+    -- strengthen the postcondition after opening `N1`
+    have hpost :
+        BIBase.sep postP (inv (GF := GF) (M := M) (F := F) W N2 Q) ⊢
+          uPred_fupd (M := M) (F := F) W (maskDiff E N1) (maskDiff E N) postPQ := by
+      -- open `N2` under a framed postcondition
+      iintro Hctx'
+      icases Hctx' with ⟨HpostP, HinvQ''⟩
+      iapply (wrapEntails (GF := GF)
+        (fupd_trans (W := W) (E1 := maskDiff E N1) (E2 := E12) (E3 := maskDiff E N)
+          (P := postPQ)))
+      -- open the right invariant inside the postcondition
+      ihave HaccQ :=
+        (wrapEntails (GF := GF)
+          (inv_acc (W := W) (M := M) (F := F) (E := maskDiff E N1) (N := N2) (P := Q) hN2')) $$ HinvQ''
+      have hpostQ :
+          BIBase.sep postQ postP ⊢ uPred_fupd (M := M) (F := F) W E12 (maskDiff E N) postPQ := by
+        -- introduce the smaller mask and assemble the closing wand
+        iintro Hpost
+        icases Hpost with ⟨HpostQ, HpostP⟩
+        icases HpostP with ⟨HP, HcloseP⟩
+        icases HpostQ with ⟨HQ, HcloseQ⟩
+        have hsubset_mask : Subset (maskDiff E N) E12 := by
+          -- rewrite the two-step mask difference
+          simpa [E12, maskDiff2_eq] using
+            (maskDiff2_subset_of_union (E := E) (N1 := N1) (N2 := N2) (N := N) hsubset)
+        iapply (wrapEntails (GF := GF)
+          (fupd_mask_intro (W := W) (E1 := E12) (E2 := maskDiff E N) hsubset_mask postPQ))
+        iintro Hclose
+        have hlater :
+            BIBase.sep (BIBase.later P) (BIBase.later Q) ⊢ BIBase.later (BIBase.sep (PROP := IProp GF) P Q) :=
+          (later_sep (P := P) (Q := Q)).2
+        ihave HPQ := (wrapEntails (GF := GF) hlater) $$ [HP, HQ]
+        -- unfold the target postcondition and split it
+        simp
+        isplitl [HPQ]
+        · iexact HPQ
+        · -- close the smaller mask, then `N2`, then `N1`
+          iintro HPQ'
+          ihave HPQ'' :=
+            (wrapEntails (GF := GF)
+              (later_sep (P := P) (Q := Q)).1) $$ HPQ'
+          icases HPQ'' with ⟨HP', HQ'⟩
+          -- first close `Q`, then re-close the outer mask
+          iapply (wrapEntails (GF := GF)
+            (fupd_trans (W := W) (E1 := maskDiff E N) (E2 := maskDiff E N1) (E3 := E)
+              (P := BIBase.pure True)))
+          iapply (wrapEntails (GF := GF)
+            (fupd_wand_r (W := W) (M := M) (F := F) (E1 := maskDiff E N) (E2 := maskDiff E N1)
+              (P := BIBase.pure True)
+              (Q := uPred_fupd (M := M) (F := F) W (maskDiff E N1) E (BIBase.pure True))))
+          isplitl [Hclose HcloseQ HQ']
+          · -- close `Q` inside the intermediate mask
+            iapply (wrapEntails (GF := GF)
+              (fupd_trans (W := W) (E1 := maskDiff E N) (E2 := E12) (E3 := maskDiff E N1)
+                (P := BIBase.pure True)))
+            iapply (wrapEntails (GF := GF)
+              (fupd_wand_r (W := W) (M := M) (F := F) (E1 := maskDiff E N) (E2 := E12)
+                (P := (BIBase.emp : IProp GF))
+                (Q := uPred_fupd (M := M) (F := F) W E12 (maskDiff E N1) (BIBase.pure True))))
+            isplitl [Hclose]
+            · iexact Hclose
+            · iintro -
+              iapply HcloseQ
+              iexact HQ'
+          · -- ignore `True` and close `P`
+            iintro _
+            iapply HcloseP
+            iexact HP'
+      iapply (wrapEntails (GF := GF)
+        (fupd_mono (W := W) (E1 := maskDiff E N1) (E2 := E12) (P := BIBase.sep postQ postP)
+          (Q := uPred_fupd (M := M) (F := F) W E12 (maskDiff E N) postPQ) hpostQ))
+      iapply (wrapEntails (GF := GF)
+        (fupd_frame_r (W := W) (M := M) (F := F) (E1 := maskDiff E N1) (E2 := E12)
+          (P := postQ) (Q := postP)))
+      isplitl [HaccQ]
+      · iexact HaccQ
+      · iexact HpostP
+    iapply (wrapEntails (GF := GF)
+      (fupd_mono (W := W) (E1 := E) (E2 := maskDiff E N1)
+        (P := BIBase.sep postP (inv (GF := GF) (M := M) (F := F) W N2 Q))
+        (Q := uPred_fupd (M := M) (F := F) W (maskDiff E N1) (maskDiff E N) postPQ) hpost))
+    iapply (wrapEntails (GF := GF)
+      (fupd_frame_r (W := W) (M := M) (F := F) (E1 := E) (E2 := maskDiff E N1)
+        (P := postP)
+        (Q := inv (GF := GF) (M := M) (F := F) W N2 Q)))
+    isplitl [HaccP]
+    · iexact HaccP
+    · iexact HinvQ'
+  have hpers :
+      BIBase.sep (inv (GF := GF) (M := M) (F := F) W N1 P)
+        (inv (GF := GF) (M := M) (F := F) W N2 Q) ⊢
+        BIBase.persistently body :=
+    persistently_intro''
+      (P := BIBase.sep (inv (GF := GF) (M := M) (F := F) W N1 P)
+        (inv (GF := GF) (M := M) (F := F) W N2 Q))
+      (Q := body) hbody
+  iapply (wrapEntails (GF := GF) (by simpa [body] using hpers))
+  isplitl [HinvP]
+  · iexact HinvP
+  · iexact HinvQ
+
+omit [FiniteMapLaws Positive M] in
+/-- Combine invariants using a duplicable left component.
+
+    Coq: `inv_combine_dup_l` -/
+theorem inv_combine_dup_l {W : WsatGS GF}
+    (N : Namespace) (P Q : IProp GF) :
+    BIBase.persistently (BIBase.wand P (BIBase.sep P P)) ⊢
+      BIBase.wand (inv (GF := GF) (M := M) (F := F) W N P)
+        (BIBase.wand (inv (GF := GF) (M := M) (F := F) W N Q)
+          (inv (GF := GF) (M := M) (F := F) W N (BIBase.sep (PROP := IProp GF) P Q))) := by
+  classical
+  iintro Hdup
+  iintro HinvP
+  iintro HinvQ
+  -- unfold the invariant body and build it under a persistent context
+  let body : IProp GF :=
+    BIBase.forall fun E : Iris.Set Positive =>
+      BIBase.imp (BIBase.pure (Subset (nclose N).mem E))
+        (uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+          (BIBase.sep (BIBase.later (BIBase.sep (PROP := IProp GF) P Q))
+            (BIBase.wand (BIBase.later (BIBase.sep (PROP := IProp GF) P Q))
+              (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True)))))
+  have hbody :
+      BIBase.sep (BIBase.persistently (BIBase.wand P (BIBase.sep P P)))
+        (BIBase.sep (inv (GF := GF) (M := M) (F := F) W N P)
+          (inv (GF := GF) (M := M) (F := F) W N Q)) ⊢
+        body := by
+    -- unpack the invariant context and prove the body
+    iintro Hctx
+    icases Hctx with ⟨Hdup', HinvPQ⟩
+    icases HinvPQ with ⟨HinvP', HinvQ'⟩
+    iintro %E
+    iintro hE
+    icases hE with %hE
+    -- abbreviations for postconditions
+    let postP : IProp GF :=
+      BIBase.sep (BIBase.later P)
+        (BIBase.wand (BIBase.later P)
+          (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True)))
+    let postQ : IProp GF :=
+      BIBase.sep (BIBase.later Q)
+        (BIBase.wand (BIBase.later Q)
+          (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True)))
+    let postPQ : IProp GF :=
+      BIBase.sep (BIBase.later (BIBase.sep (PROP := IProp GF) P Q))
+        (BIBase.wand (BIBase.later (BIBase.sep (PROP := IProp GF) P Q))
+          (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True)))
+    -- open the left invariant first
+    ihave HaccP :=
+      (wrapEntails (GF := GF)
+        (inv_acc (W := W) (M := M) (F := F) (E := E) (N := N) (P := P) hE)) $$ HinvP'
+    iapply (wrapEntails (GF := GF)
+      (fupd_trans (W := W) (E1 := E) (E2 := maskDiff E N) (E3 := maskDiff E N) (P := postPQ)))
+    iapply (wrapEntails (GF := GF)
+      (fupd_mono (W := W) (E1 := E) (E2 := maskDiff E N)
+        (P := BIBase.sep postP
+          (BIBase.sep (inv (GF := GF) (M := M) (F := F) W N Q)
+            (BIBase.persistently (BIBase.wand P (BIBase.sep P P)))))
+        (Q := uPred_fupd (M := M) (F := F) W (maskDiff E N) (maskDiff E N) postPQ) ?_))
+    · -- close `P`, open `Q`, then build the combined invariant
+      iintro Hpost
+      icases Hpost with ⟨HpostP, Hrest⟩
+      icases Hrest with ⟨HinvQ'', Hdup''⟩
+      icases HpostP with ⟨HP, HcloseP⟩
+      ihave HPdup :=
+        (wrapEntails (GF := GF) (later_dup (P := P))) $$ Hdup''
+      ispecialize HPdup $$ HP
+      icases HPdup with ⟨HP1, HP2⟩
+      -- close the left invariant to restore the mask
+      ihave Hclosed := HcloseP $$ HP2
+      -- open the right invariant
+      ihave HaccQ :=
+        (wrapEntails (GF := GF)
+          (inv_acc (W := W) (M := M) (F := F) (E := E) (N := N) (P := Q) hE)) $$ HinvQ''
+      -- build the postcondition for the combined invariant
+      have hpostQ : BIBase.sep postQ (BIBase.later P) ⊢ postPQ := by
+        -- use the remaining `▷P` and `▷Q`
+        iintro Hpost
+        icases Hpost with ⟨HpostQ, HP1'⟩
+        icases HpostQ with ⟨HQ, HcloseQ⟩
+        have hlater :
+            BIBase.sep (BIBase.later P) (BIBase.later Q) ⊢ BIBase.later (BIBase.sep (PROP := IProp GF) P Q) :=
+          (later_sep (P := P) (Q := Q)).2
+        ihave HPQ := (wrapEntails (GF := GF) hlater) $$ [HP1', HQ]
+        -- unfold the target postcondition and split it
+        simp
+        isplitl [HPQ]
+        · iexact HPQ
+        · -- close using the right invariant only
+          iintro HPQ'
+          ihave HPQ'' :=
+            (wrapEntails (GF := GF)
+              (later_sep (P := P) (Q := Q)).1) $$ HPQ'
+          icases HPQ'' with ⟨_, HQ'⟩
+          iapply HcloseQ
+          iexact HQ'
+      -- sequence closing `P` with opening `Q`
+      iapply (wrapEntails (GF := GF)
+        (fupd_trans (W := W) (E1 := maskDiff E N) (E2 := E) (E3 := maskDiff E N) (P := postPQ)))
+      iapply (wrapEntails (GF := GF)
+        (fupd_wand_r (W := W) (M := M) (F := F) (E1 := maskDiff E N) (E2 := E)
+          (P := BIBase.pure True)
+          (Q := uPred_fupd (M := M) (F := F) W E (maskDiff E N) postPQ)))
+      isplitl [Hclosed]
+      · iexact Hclosed
+      · -- ignore `True` and use the access to `Q`
+        iintro _
+        iapply (wrapEntails (GF := GF)
+          (fupd_mono (W := W) (M := M) (F := F) (E1 := E) (E2 := maskDiff E N)
+            (P := BIBase.sep postQ (BIBase.later P)) (Q := postPQ) hpostQ))
+        iapply (wrapEntails (GF := GF)
+          (fupd_frame_r (W := W) (M := M) (F := F) (E1 := E) (E2 := maskDiff E N)
+            (P := postQ) (Q := BIBase.later P)))
+        isplitl [HaccQ]
+        · iexact HaccQ
+        · iexact HP1
+    iapply (wrapEntails (GF := GF)
+      (fupd_frame_r (W := W) (M := M) (F := F) (E1 := E) (E2 := maskDiff E N)
+        (P := postP)
+        (Q := BIBase.sep (inv (GF := GF) (M := M) (F := F) W N Q)
+          (BIBase.persistently (BIBase.wand P (BIBase.sep P P))))))
+    isplitl [HaccP]
+    · iexact HaccP
+    · isplitl [HinvQ']
+      · iexact HinvQ'
+      · iexact Hdup'
+  have hpers :
+      BIBase.sep (BIBase.persistently (BIBase.wand P (BIBase.sep P P)))
+        (BIBase.sep (inv (GF := GF) (M := M) (F := F) W N P)
+          (inv (GF := GF) (M := M) (F := F) W N Q)) ⊢
+        BIBase.persistently body :=
+    persistently_intro''
+      (P := BIBase.sep (BIBase.persistently (BIBase.wand P (BIBase.sep P P)))
+        (BIBase.sep (inv (GF := GF) (M := M) (F := F) W N P)
+          (inv (GF := GF) (M := M) (F := F) W N Q)))
+      (Q := body) hbody
+  iapply (wrapEntails (GF := GF) (by simpa [body] using hpers))
+  isplitl [Hdup]
+  · iexact Hdup
+  · isplitl [HinvP]
+    · iexact HinvP
+    · iexact HinvQ
+
+omit [FiniteMapLaws Positive M] in
+/-- Invariants are except-0.
+
+    Coq: `except_0_inv` -/
+theorem except_0_inv {W : WsatGS GF}
+    (N : Namespace) (P : IProp GF) :
+    BIBase.except0 (inv (GF := GF) (M := M) (F := F) W N P) ⊢
+      inv (GF := GF) (M := M) (F := F) W N P := by
+  -- unfold the invariant body and eliminate the outer `◇` by cases
+  unfold inv
+  let body : IProp GF :=
+    BIBase.forall fun E : Iris.Set Positive =>
+      BIBase.imp (BIBase.pure (Subset (nclose N).mem E))
+        (uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+          (BIBase.sep (BIBase.later P)
+            (BIBase.wand (BIBase.later P)
+              (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True)))))
+  have hfalse_body : BIBase.later (BIBase.pure False) ⊢ body := by
+    refine forall_intro ?_
+    intro E
+    refine imp_intro ?_
+    refine pure_elim_r ?_
+    intro _
+    -- `▷ False` proves any fancy update
+    unfold uPred_fupd
+    refine wand_intro ?_
+    refine (sep_elim_l (P := BIBase.later (BIBase.pure False))
+      (Q := BIBase.sep (wsat' (M := M) (F := F) W) (ownE W (mask E)))).trans ?_
+    let post : IProp GF :=
+      BIBase.sep (wsat' (M := M) (F := F) W)
+        (BIBase.sep (ownE W (mask (maskDiff E N)))
+          (BIBase.sep (BIBase.later P)
+            (BIBase.wand (BIBase.later P)
+              (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True)))))
+    have hor : BIBase.later (BIBase.pure False) ⊢ BIBase.except0 post := by
+      -- `◇ post` is `▷ False ∨ post`
+      exact or_intro_l
+    refine (BIUpdate.intro (P := BIBase.later (BIBase.pure False))).trans ?_
+    exact BIUpdate.mono (PROP := IProp GF) hor
+  have hfalse_pers :
+      BIBase.later (BIBase.pure False) ⊢ BIBase.persistently body :=
+    persistently_intro'' (P := BIBase.later (BIBase.pure False)) (Q := body) hfalse_body
+  have hcase :
+      BIBase.or (BIBase.later (BIBase.pure False)) (BIBase.persistently body) ⊢
+        BIBase.persistently body :=
+    or_elim hfalse_pers .rfl
+  simpa [BIBase.except0, body] using hcase
+
+/-! ### Proof Mode Integration -/
+
+omit [FiniteMapLaws Positive M] in
+instance is_except0_inv {W : WsatGS GF} (N : Namespace) (P : IProp GF) :
+    Iris.ProofMode.IsExcept0 (PROP := IProp GF)
+      (inv (GF := GF) (M := M) (F := F) W N P) := by
+  -- reuse the derived lemma
+  exact ⟨except_0_inv (W := W) (N := N) (P := P)⟩
+
+omit [FiniteMapLaws Positive M] in
+instance into_inv_inv {W : WsatGS GF} (N : Namespace) (P : IProp GF) :
+    Iris.ProofMode.IntoInv (PROP := IProp GF)
+      (inv (GF := GF) (M := M) (F := F) W N P) N :=
+  ⟨⟩
+
+omit [FiniteMapLaws Positive M] in
+instance into_acc_inv {W : WsatGS GF}
+    (E : Iris.Set Positive) (N : Namespace) (P : IProp GF) :
+    Iris.ProofMode.IntoAcc (PROP := IProp GF) (X := Unit)
+      (inv (GF := GF) (M := M) (F := F) W N P)
+      (Subset (nclose N).mem E) (BIBase.pure True)
+      (uPred_fupd (M := M) (F := F) W E (maskDiff E N))
+      (uPred_fupd (M := M) (F := F) W (maskDiff E N) E)
+      (fun _ => BIBase.later P) (fun _ => BIBase.later P)
+      (fun _ => some (BIBase.pure True)) := by
+  -- unfold the accessor and use `inv_acc`
+  refine ⟨?_⟩
+  intro hsubset
+  iintro Hinv
+  iintro _
+  let Ψ : Unit → IProp GF := fun _ =>
+    BIBase.sep (BIBase.later P)
+      (BIBase.wand (BIBase.later P)
+        (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True)))
+  -- unfold the accessor to match `inv_acc`
+  simp [Iris.ProofMode.accessor]
+  have hmono :=
+    fupd_mono (W := W) (M := M) (F := F) (E1 := E) (E2 := maskDiff E N)
+      (P := Ψ ()) (Q := BIBase.exists Ψ) (exists_unit (Ψ := Ψ)).2
+  have hacc :=
+    inv_acc (W := W) (M := M) (F := F) (E := E) (N := N) (P := P) hsubset
+  iapply (wrapEntails (GF := GF) (hacc.trans hmono))
+  iexact Hinv
+
+omit [FiniteMapLaws Positive M] in
+/-- Strong invariant accessor: closing under any mask extension.
+
+    Coq: `inv_acc_strong` -/
+theorem inv_acc_strong {W : WsatGS GF}
+    (E : Iris.Set Positive) (N : Namespace) (P : IProp GF)
+    (h : Subset (nclose N).mem E) :
+    inv (GF := GF) (M := M) (F := F) W N P ⊢
+      uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+        (BIBase.sep (BIBase.later P)
+          (BIBase.forall fun E' : Iris.Set Positive =>
+            BIBase.wand (BIBase.later P)
+              (uPred_fupd (M := M) (F := F) W E'
+                (fun x => (nclose N).mem x ∨ E' x) (BIBase.pure True)))) := by
+  classical
+  iintro Hinv
+  -- open at the minimal mask and frame to `E`
+  have hsubset : Subset (nclose N).mem (nclose N).mem := by
+    intro i hi; exact hi
+  ihave Hacc :=
+    (wrapEntails (GF := GF)
+      (inv_acc (W := W) (M := M) (F := F) (E := (nclose N).mem) (N := N) (P := P) hsubset)) $$ Hinv
+  ihave Hacc' :=
+    (wrapEntails (GF := GF)
+      (inv_acc_strong_frame (M := M) (F := F) (W := W) (E := E) (N := N) (P := P) h)) $$ Hacc
+  iapply (wrapEntails (GF := GF)
+    (inv_acc_strong_mono (W := W) (E := E) (N := N) (P := P)))
+  iexact Hacc'
+
+omit [FiniteMapLaws Positive M] in
+/-- Alter the content of an invariant.
+
+    Coq: `inv_alter` -/
+theorem inv_alter {W : WsatGS GF}
+    (N : Namespace) (P Q : IProp GF) :
+    (BIBase.emp : IProp GF) ⊢
+      BIBase.wand (inv (GF := GF) (M := M) (F := F) W N P)
+        (BIBase.wand (BIBase.later (BIBase.intuitionistically
+          (BIBase.wand P (BIBase.sep Q (BIBase.wand Q P)))))
+          (inv (GF := GF) (M := M) (F := F) W N Q)) := by
+  classical
+  iintro Hemp
+  iintro Hinv
+  iintro Hpq
+  -- build the invariant body from a persistent sep context
+  let body : IProp GF :=
+    BIBase.forall fun E : Iris.Set Positive =>
+      BIBase.imp (BIBase.pure (Subset (nclose N).mem E))
+        (uPred_fupd (M := M) (F := F) W E (maskDiff E N)
+          (BIBase.sep (BIBase.later Q)
+            (BIBase.wand (BIBase.later Q)
+              (uPred_fupd (M := M) (F := F) W (maskDiff E N) E
+                (BIBase.pure True)))))
+  have hbody_wand :
+      (BIBase.emp : IProp GF) ⊢
+        iprop((inv (GF := GF) (M := M) (F := F) W N P ∗
+          BIBase.later (BIBase.intuitionistically
+            (BIBase.wand P (BIBase.sep Q (BIBase.wand Q P))))) -∗ body) := by
+    iintro -
+    iintro Hctx
+    icases Hctx with ⟨Hinv', Hpq'⟩
+    iintro %E
+    iintro hsubset
+    icases hsubset with %hsubset
+    -- open the invariant and frame the transformation hypothesis
+    ihave Hacc :=
+      (wrapEntails (GF := GF)
+        (inv_acc (W := W) (M := M) (F := F) (E := E) (N := N) (P := P) hsubset)) $$ Hinv'
+    ihave Hacc' :=
+      (wrapEntails (GF := GF)
+        (fupd_frame_r (W := W) (M := M) (F := F) (E1 := E) (E2 := maskDiff E N)
+          (P := BIBase.sep (BIBase.later P)
+            (BIBase.wand (BIBase.later P)
+              (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True))))
+          (Q := BIBase.later (BIBase.intuitionistically
+            (BIBase.wand P (BIBase.sep Q (BIBase.wand Q P))))))) $$ [Hacc, Hpq']
+    · -- frame the transformation hypothesis across the update
+      isplitl [Hacc]
+      · iexact Hacc
+      · iexact Hpq'
+    -- transform the postcondition
+    have hpost :
+        BIBase.sep
+          (BIBase.sep (BIBase.later P)
+            (BIBase.wand (BIBase.later P)
+              (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True))))
+          (BIBase.later (BIBase.intuitionistically
+            (BIBase.wand P (BIBase.sep Q (BIBase.wand Q P))))) ⊢
+        BIBase.sep (BIBase.later Q)
+          (BIBase.wand (BIBase.later Q)
+            (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True)) : IProp GF) := by
+      iintro Hpost
+      icases Hpost with ⟨HpostP, Hpq''⟩
+      icases HpostP with ⟨HlateP, HcloseP⟩
+      -- derive ▷(P -∗ Q ∗ (Q -∗ P)) from ▷□(...)
+      ihave Hpq''' :=
+        (wrapEntails (GF := GF)
+          (later_mono (P := BIBase.intuitionistically
+            (BIBase.wand P (BIBase.sep Q (BIBase.wand Q P))))
+            (Q := BIBase.wand P (BIBase.sep Q (BIBase.wand Q P)))
+            (intuitionistically_elim (P := BIBase.wand P (BIBase.sep Q (BIBase.wand Q P)))))) $$ Hpq''
+      -- apply later wand to obtain ▷(Q ∗ (Q -∗ P))
+      ihave Hwand :=
+        (wrapEntails (GF := GF)
+          (later_wand (P := P) (Q := BIBase.sep Q (BIBase.wand Q P)))) $$ Hpq'''
+      ispecialize Hwand $$ HlateP
+      -- split the later'd pair
+      ihave Hsplit :=
+        (wrapEntails (GF := GF)
+          (later_sep (P := Q) (Q := BIBase.wand Q P)).1) $$ Hwand
+      icases Hsplit with ⟨HlateQ, HlateQtoP⟩
+      isplitl [HlateQ]
+      · iexact HlateQ
+      · iintro Hq
+        ihave Hqp :=
+          (wrapEntails (GF := GF) (later_wand (P := Q) (Q := P))) $$ HlateQtoP
+        ispecialize Hqp $$ Hq
+        iapply HcloseP
+        iexact Hqp
+    iapply (wrapEntails (GF := GF)
+      (fupd_mono (W := W) (M := M) (F := F) (E1 := E) (E2 := maskDiff E N)
+        (P := BIBase.sep
+          (BIBase.sep (BIBase.later P)
+            (BIBase.wand (BIBase.later P)
+              (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True))))
+          (BIBase.later (BIBase.intuitionistically
+            (BIBase.wand P (BIBase.sep Q (BIBase.wand Q P))))))
+        (Q := BIBase.sep (BIBase.later Q)
+          (BIBase.wand (BIBase.later Q)
+            (uPred_fupd (M := M) (F := F) W (maskDiff E N) E (BIBase.pure True))))
+        hpost))
+    iexact Hacc'
+  have hbody :
+      BIBase.sep (inv (GF := GF) (M := M) (F := F) W N P)
+        (BIBase.later (BIBase.intuitionistically
+          (BIBase.wand P (BIBase.sep Q (BIBase.wand Q P))))) ⊢
+        body := by
+    -- move the wand proof under a sep and eliminate it
+    refine (sep_emp (P := BIBase.sep (inv (GF := GF) (M := M) (F := F) W N P)
+      (BIBase.later (BIBase.intuitionistically
+        (BIBase.wand P (BIBase.sep Q (BIBase.wand Q P))))))).2.trans ?_
+    refine (sep_mono .rfl hbody_wand).trans ?_
+    exact wand_elim_r
+  -- wrap the body in persistently using the persistent context
+  have hpers :
+      BIBase.sep (inv (GF := GF) (M := M) (F := F) W N P)
+        (BIBase.later (BIBase.intuitionistically
+          (BIBase.wand P (BIBase.sep Q (BIBase.wand Q P))))) ⊢
+        BIBase.persistently body :=
+    persistently_intro''
+      (P := BIBase.sep (inv (GF := GF) (M := M) (F := F) W N P)
+        (BIBase.later (BIBase.intuitionistically
+          (BIBase.wand P (BIBase.sep Q (BIBase.wand Q P))))))
+      (Q := body) hbody
+  -- fold the invariant definition on the postcondition
+  have hpers' :
+      BIBase.sep (inv (GF := GF) (M := M) (F := F) W N P)
+        (BIBase.later (BIBase.intuitionistically
+          (BIBase.wand P (BIBase.sep Q (BIBase.wand Q P))))) ⊢
+        inv (GF := GF) (M := M) (F := F) W N Q :=
+    hpers.trans (BIBase.Entails.of_eq (by rfl))
+  iapply (wrapEntails (GF := GF) hpers')
+  -- supply the persistent context
+  isplitl [Hinv]
+  · iexact Hinv
+  · iexact Hpq
+
+-- Abbreviation for the wand-based `P ↔ Q`.
+private abbrev iffWand (P Q : IProp GF) : IProp GF :=
+  BIBase.and (BIBase.wand P Q) (BIBase.wand Q P)
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)]
+  [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem iff_wand_left (P Q : IProp GF) :
+    BIBase.intuitionistically (iffWand P Q) ⊢ BIBase.wand P Q := by
+  -- Pull the left implication out of the persistent conjunction.
+  exact (intuitionistically_elim (P := iffWand P Q)).trans
+    (and_elim_l (P := BIBase.wand P Q) (Q := BIBase.wand Q P))
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)]
+  [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem iff_wand_right (P Q : IProp GF) :
+    BIBase.intuitionistically (iffWand P Q) ⊢ BIBase.wand Q P := by
+  -- Pull the right implication out of the persistent conjunction.
+  exact (intuitionistically_elim (P := iffWand P Q)).trans
+    (and_elim_r (P := BIBase.wand P Q) (Q := BIBase.wand Q P))
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)]
+  [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem iff_to_sep_wand (P Q : IProp GF) :
+    BIBase.intuitionistically (iffWand P Q) ⊢
+      BIBase.wand P (BIBase.sep Q (BIBase.wand Q P)) := by
+  -- Duplicate the iff and use each direction once.
+  refine wand_intro ?_
+  have hdup :
+      BIBase.intuitionistically (iffWand P Q) ⊢
+        BIBase.sep (BIBase.intuitionistically (iffWand P Q))
+          (BIBase.intuitionistically (iffWand P Q)) :=
+    (intuitionistically_sep_idem (P := iffWand P Q)).2
+  refine (sep_mono_l hdup).trans ?_
+  refine sep_assoc_l.trans ?_
+  have hQ :
+      BIBase.sep (BIBase.intuitionistically (iffWand P Q)) P ⊢ Q :=
+    (sep_mono_l (iff_wand_left (P := P) (Q := Q))).trans wand_elim_l
+  refine (sep_mono (iff_wand_right (P := P) (Q := Q)) hQ).trans ?_
+  exact sep_comm.1
+
+omit [FiniteMapLaws Positive M] in
+/-- Invariant content equivalence.
+
+    Coq: `inv_iff` -/
+theorem inv_iff {W : WsatGS GF}
+    (N : Namespace) (P Q : IProp GF) :
+    (BIBase.emp : IProp GF) ⊢
+      BIBase.wand (inv (GF := GF) (M := M) (F := F) W N P)
+        (BIBase.wand (BIBase.later (BIBase.intuitionistically
+          (BIBase.and (BIBase.wand P Q) (BIBase.wand Q P))))
+          (inv (GF := GF) (M := M) (F := F) W N Q)) := by
+  classical
+  iintro Hemp
+  iintro Hinv
+  iintro Hpq
+  -- Lift the iff into the wand form expected by `inv_alter`.
+  have hbox :
+      BIBase.intuitionistically (iffWand P Q) ⊢
+      BIBase.intuitionistically
+        (BIBase.wand P (BIBase.sep Q (BIBase.wand Q P))) :=
+    intuitionistically_intro' (iff_to_sep_wand (P := P) (Q := Q))
+  ihave Hpq' :=
+    (wrapEntails (GF := GF)
+      (later_mono
+        (P := BIBase.intuitionistically (iffWand P Q))
+        (Q := BIBase.intuitionistically
+          (BIBase.wand P (BIBase.sep Q (BIBase.wand Q P))))
+        hbox)) $$ Hpq
+  -- Apply `inv_alter` with the converted hypothesis.
+  ihave Hinv' :=
+    (wrapEntails (GF := GF)
+      (inv_alter (W := W) (M := M) (F := F) (N := N) (P := P) (Q := Q))) $$ Hemp
+  ispecialize Hinv' $$ Hinv
+  ispecialize Hinv' $$ Hpq'
+  iexact Hinv'
+
+omit [FiniteMapLaws Positive M] in
+/-- Split an invariant on the left component.
+
+    Coq: `inv_split_l` -/
+theorem inv_split_l {W : WsatGS GF}
+    (N : Namespace) (P Q : IProp GF) :
+    inv (GF := GF) (M := M) (F := F) W N (BIBase.sep (PROP := IProp GF) P Q) ⊢
+      inv (GF := GF) (M := M) (F := F) W N P := by
+  -- build the wand via `inv_alter`, then eliminate it with `emp`
+  have hwand :
+      (BIBase.emp : IProp GF) ⊢
+        BIBase.wand
+          (inv (GF := GF) (M := M) (F := F) W N (BIBase.sep (PROP := IProp GF) P Q))
+          (inv (GF := GF) (M := M) (F := F) W N P) := by
+    let Einv : IProp GF :=
+      inv (GF := GF) (M := M) (F := F) W N (BIBase.sep (PROP := IProp GF) P Q)
+    let Hstep : IProp GF :=
+      BIBase.later (BIBase.intuitionistically
+        (BIBase.wand (BIBase.sep (PROP := IProp GF) P Q)
+          (BIBase.sep P (BIBase.wand P (BIBase.sep (PROP := IProp GF) P Q)))))
+    have Halter :
+        (BIBase.emp : IProp GF) ⊢
+          BIBase.wand Einv
+            (BIBase.wand Hstep (inv (GF := GF) (M := M) (F := F) W N P)) :=
+      inv_alter (W := W) (M := M) (F := F) (N := N)
+        (P := BIBase.sep (PROP := IProp GF) P Q) (Q := P)
+    have Htrans : (BIBase.emp : IProp GF) ⊢ Hstep :=
+      inv_split_l_transform (P := P) (Q := Q)
+    refine wand_intro ?_
+    -- duplicate `emp` so we can build the close shift and the mask introduction
+    have hemp_dup :
+        (BIBase.emp : IProp GF) ⊢
+          BIBase.sep (BIBase.emp : IProp GF) (BIBase.emp : IProp GF) :=
+      (sep_emp (P := (BIBase.emp : IProp GF))).2
+    refine (sep_mono hemp_dup .rfl).trans ?_
+    refine (sep_right_comm (P := (BIBase.emp : IProp GF))
+      (Q := (BIBase.emp : IProp GF)) (R := Einv)).1.trans ?_
+    have hleft :
+        BIBase.sep (BIBase.emp : IProp GF) Einv ⊢
+          BIBase.wand Hstep (inv (GF := GF) (M := M) (F := F) W N P) := by
+      refine (sep_mono Halter .rfl).trans ?_
+      exact wand_elim_l
+    refine (sep_mono hleft .rfl).trans ?_
+    refine (sep_mono .rfl Htrans).trans ?_
+    exact wand_elim_l
+  refine (sep_emp (P := inv (GF := GF) (M := M) (F := F) W N (BIBase.sep (PROP := IProp GF) P Q))).2.trans ?_
+  refine (sep_mono .rfl hwand).trans ?_
+  exact wand_elim_r
+
+omit [FiniteMapLaws Positive M] in
+/-- Split an invariant on the right component.
+
+    Coq: `inv_split_r` -/
+theorem inv_split_r {W : WsatGS GF}
+    (N : Namespace) (P Q : IProp GF) :
+    inv (GF := GF) (M := M) (F := F) W N (BIBase.sep (PROP := IProp GF) P Q) ⊢
+      inv (GF := GF) (M := M) (F := F) W N Q := by
+  -- commute the sep and reuse the left split lemma
+  have hcomm :
+      inv (GF := GF) (M := M) (F := F) W N (BIBase.sep (PROP := IProp GF) P Q) ⊢
+        inv (GF := GF) (M := M) (F := F) W N (BIBase.sep Q P) := by
+    have hsep : BIBase.sep (PROP := IProp GF) P Q ≡ BIBase.sep Q P := by
+      have hsep' : BIBase.sep (PROP := IProp GF) P Q ⊣⊢ BIBase.sep Q P :=
+        sep_comm (P := P) (Q := Q)
+      exact (BI.equiv_iff (P := BIBase.sep (PROP := IProp GF) P Q) (Q := BIBase.sep Q P)).2 hsep'
+    have hEquiv :
+        inv (GF := GF) (M := M) (F := F) W N (BIBase.sep (PROP := IProp GF) P Q) ≡
+          inv (GF := GF) (M := M) (F := F) W N (BIBase.sep Q P) :=
+      inv_proper (W := W) (N := N) (P := BIBase.sep (PROP := IProp GF) P Q) (Q := BIBase.sep Q P) hsep
+    have hBi :
+        inv (GF := GF) (M := M) (F := F) W N (BIBase.sep (PROP := IProp GF) P Q) ⊣⊢
+          inv (GF := GF) (M := M) (F := F) W N (BIBase.sep Q P) :=
+      (BI.equiv_iff (P := inv (GF := GF) (M := M) (F := F) W N (BIBase.sep (PROP := IProp GF) P Q))
+        (Q := inv (GF := GF) (M := M) (F := F) W N (BIBase.sep Q P))).1 hEquiv
+    exact hBi.1
+  exact hcomm.trans (inv_split_l (W := W) (M := M) (F := F) (N := N) (P := Q) (Q := P))
+
+omit [FiniteMapLaws Positive M] in
+/-- Split an invariant into two components.
+
+    Coq: `inv_split` -/
+theorem inv_split {W : WsatGS GF}
+    (N : Namespace) (P Q : IProp GF) :
+    inv (GF := GF) (M := M) (F := F) W N (BIBase.sep (PROP := IProp GF) P Q) ⊢
+      BIBase.sep (inv (GF := GF) (M := M) (F := F) W N P)
+        (inv (GF := GF) (M := M) (F := F) W N Q) := by
+  -- apply both split lemmas under a separating conjunction
+  iintro Hinv
+  isplit
+  · iapply (wrapEntails (GF := GF)
+      (inv_split_l (W := W) (M := M) (F := F) (N := N) (P := P) (Q := Q)))
+    iexact Hinv
+  · iapply (wrapEntails (GF := GF)
+      (inv_split_r (W := W) (M := M) (F := F) (N := N) (P := P) (Q := Q)))
+    iexact Hinv
+
+end Iris.BaseLogic
diff --git a/src/Iris/BaseLogic/Lib/Wsat.lean b/src/Iris/BaseLogic/Lib/Wsat.lean
new file mode 100644
index 00000000..12537f47
--- /dev/null
+++ b/src/Iris/BaseLogic/Lib/Wsat.lean
@@ -0,0 +1,1104 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.Instances.IProp.Instance
+import Iris.Algebra.CoPset
+import Iris.BI.BigOp
+import Iris.ProofMode.Tactics
+
+/-! # World Satisfaction
+
+Reference: `iris/base_logic/lib/wsat.v`
+
+World satisfaction (`wsat`) is the central invariant of the Iris base logic.
+It asserts ownership of a map from invariant names to propositions, together
+with the bookkeeping that each invariant is either *open* (its content has
+been taken out, tracked by a disabled token `ownD`) or *closed* (the content
+is still inside, tracked by an enabled token `ownE`).
+
+The three ownership connectives are:
+- `ownI i P` — invariant `i` is registered with content `P` (persistent)
+- `ownE E` — the caller holds the enabled mask `E` (a set of invariant names)
+- `ownD E` — the caller holds the disabled tokens `E`
+
+The open/close lemmas (`ownI_open`, `ownI_close`) allow temporarily
+extracting `▷ P` from a closed invariant and putting it back, exchanging
+enabled and disabled tokens in the process. This is the engine behind fancy
+updates and the `iInv` tactic.
+
+## Main Definitions
+
+- `WsatGS` — ghost state names for the three ghost cells
+- `ownI`, `ownE`, `ownD` — ownership connectives
+- `wsat` — world satisfaction assertion
+
+## Main Results
+
+- `ownE_op`, `ownD_op` — disjoint union splits
+- `ownE_singleton_twice`, `ownD_singleton_twice` — no duplication
+- `ownI_open` — open an invariant: extract `▷ P`, get disabled token
+- `ownI_close` — close an invariant: return `▷ P`, get enabled token back
+- `ownI_alloc` — allocate a fresh invariant name
+- `wsat_alloc` — allocate the initial world satisfaction
+-/
+
+namespace Iris.BaseLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI Iris.ProofMode COFE CMRA One
+
+/-! ## Finite Map + Heap Compatibility -/
+
+/-- Compatibility between `FiniteMap.get?` and `Store.get` for heaps. -/
+class HeapFiniteMap (K : Type _) (M : Type _ → Type _)
+    [FiniteMap K M] : Type _ where
+  /-- Heap structure for all value types. -/
+  heap : ∀ V, Heap (M V) K V
+  /-- Compatibility between `FiniteMap.get?` and `Store.get`. -/
+  get?_eq_get : ∀ {V} (m : M V) (k : K), (FiniteMap.get? m k) = Store.get m k
+
+instance (K : Type _) (M : Type _ → Type _) [FiniteMap K M] [h : HeapFiniteMap K M] (V) :
+    Heap (M V) K V :=
+  h.heap V
+
+instance (K : Type _) (M : Type _ → Type _) [FiniteMap K M] [h : HeapFiniteMap K M] :
+    (∀ V, Heap (M V) K V) := by
+  intro V
+  exact h.heap V
+
+/-! ## Ghost State Configuration -/
+
+/-- Ghost state names for world satisfaction.
+    Tracks the three ghost cells: invariant map, enabled mask, disabled tokens. -/
+structure WsatGS (GF : BundledGFunctors) where
+  /-- Ghost name for the invariant map (HeapView auth over agree ∘ later ∘ iProp) -/
+  invariant_name : GName
+  /-- Ghost name for the enabled mask (CoPsetDisj) -/
+  enabled_name : GName
+  /-- Ghost name for the disabled tokens (GSetDisj) -/
+  disabled_name : GName
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M] variable [FiniteMapLaws Positive M]
+variable [HeapFiniteMap Positive M]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+/-- Invariant bodies (no universe lift now that the registry is `IProp`-valued). -/
+abbrev IPropU (GF : BundledGFunctors) : Type _ := IProp GF
+
+/-- Equality on `IProp` as a `UPred` (fixes the underlying resource type). -/
+abbrev IPropEq (GF : BundledGFunctors) (P Q : IProp GF) : IProp GF :=
+  UPred.eq (M := IResUR GF) P Q
+
+/-- Heap instance for the invariant map values. -/
+private def heapM : ∀ V, Heap (M V) Positive V := fun V =>
+  (HeapFiniteMap.heap (K := Positive) (M := M) V)
+
+/-- Invariant registry view (gmap_view) specialized to `HeapView`. -/
+abbrev InvView (GF : BundledGFunctors) (M : Type _ → Type _) (F : Type _)
+    [UFraction F] [FiniteMap Positive M] [HeapFiniteMap Positive M] :=
+  @HeapView F Positive (Agree (IPropU GF)) M _ heapM _
+
+/-- Functor for the invariant registry ghost state. -/
+abbrev InvF (GF : BundledGFunctors) (M : Type _ → Type _) (F : Type _)
+    [UFraction F] [FiniteMap Positive M] [HeapFiniteMap Positive M] : OFunctorPre :=
+  COFE.constOF (InvView (GF := GF) (M := M) (F := F))
+
+variable [ElemG GF (InvF GF M F)]
+
+variable (W : WsatGS GF)
+
+-- Keep IProp entailments opaque for proof mode (avoid unfolding to `holds`).
+private structure IPropEntails (P Q : IProp GF) : Prop where
+  toEntails : P ⊢ Q
+
+private def wrapEntails {P Q : IProp GF} (h : P ⊢ Q) :
+    IPropEntails (GF := GF) P Q :=
+  ⟨h⟩
+
+local instance asEmpValid_IPropEntails (d : Iris.ProofMode.AsEmpValid.Direction)
+    (P Q : IProp GF) :
+    Iris.ProofMode.AsEmpValid d (IPropEntails (GF := GF) P Q) iprop(P -∗ Q) := by
+  have hEntails :
+      Iris.ProofMode.AsEmpValid d (P ⊢ Q) iprop(P -∗ Q) := inferInstance
+  refine ⟨?_, ?_⟩
+  · intro hd h
+    exact (hEntails.as_emp_valid.1 hd) h.toEntails
+  · intro hd h
+    exact ⟨(hEntails.as_emp_valid.2 hd) h⟩
+
+/-! ## Ownership Connectives -/
+
+/-- Unfold an invariant body (no OFE-level `Later` at the moment). -/
+noncomputable def invariant_unfold (P : IProp GF) : IProp GF :=
+  -- TODO: switch to OFE `Later` once universe-polymorphic constOF is in place
+  P
+
+/-- Map invariant bodies into the agreement CMRA. -/
+noncomputable def inv_map (I : M (IPropU GF)) : M (Agree (IPropU GF)) :=
+  -- pointwise map: P ↦ toAgree P
+  FiniteMap.map (fun P => toAgree P) I
+
+/-- Authoritative element for the invariant registry. -/
+abbrev gmap_view_auth (dq : DFrac F) (m : M (Agree (IPropU GF))) : InvView GF M F :=
+  @HeapView.Auth F Positive (Agree (IPropU GF)) M _ heapM _ dq m
+
+/-- Fragment element for a single invariant name. -/
+abbrev gmap_view_frag (i : Positive) (dq : DFrac F) (v : Agree (IPropU GF)) :
+    InvView GF M F :=
+  @HeapView.Frag F Positive (Agree (IPropU GF)) M _ heapM _ i dq v
+
+/-- Invariant ownership: `ownI i P` asserts that invariant `i` is registered
+    with content `P`. This is persistent — once registered, an invariant
+    exists forever. -/
+noncomputable def ownI (_W : WsatGS GF) (i : Positive) (P : IProp GF) : IProp GF :=
+  -- store the invariant body under key `i` as a discarded fragment
+  iOwn (GF := GF) (F := InvF GF M F) _W.invariant_name <|
+    gmap_view_frag (GF := GF) (M := M) (F := F) i .discard (toAgree (invariant_unfold (GF := GF) P))
+
+/-- Enabled mask ownership: `ownE E` asserts the caller holds the right to
+    open invariants in the set `E`. Implemented via the `CoPsetDisj` CMRA. -/
+noncomputable def ownE (_W : WsatGS GF) (E : CoPset) : IProp GF :=
+  -- use a constant ghost functor over `CoPsetDisj`
+  iOwn (GF := GF) (F := COFE.constOF CoPsetDisj) _W.enabled_name <| CoPsetDisj.coPset E
+
+/-- Disabled token ownership: `ownD E` asserts the caller holds disabled
+    tokens for invariants in `E`. Implemented via the `GSetDisj` CMRA. -/
+noncomputable def ownD (_W : WsatGS GF) (E : GSet) : IProp GF :=
+  -- use a constant ghost functor over `GSetDisj`
+  iOwn (GF := GF) (F := COFE.constOF GSetDisj) _W.disabled_name <| GSetDisj.gset E
+
+/-! ## World Satisfaction -/
+
+/-- World satisfaction: asserts existence of an invariant map `I` such that
+    the caller owns the authoritative view of `I`, and for each invariant
+    `i ↦ Q` in `I`, either `Q` is closed (content `▷ Q` present with a
+    disabled token) or open (an enabled token is present).
+
+    ```
+    wsat := ∃ I : gmap positive (iProp Σ),
+      own γ_inv (gmap_view_auth 1 I) ∗
+      [∗ map] i ↦ Q ∈ I, (▷ Q ∗ ownD {[i]}) ∨ ownE {[i]}
+    ``` -/
+noncomputable def wsat (_W : WsatGS GF) : IProp GF :=
+  -- registry + big sep over all invariants
+  BIBase.exists fun I : M (IPropU GF) =>
+    BIBase.sep
+      (iOwn (GF := GF) (F := InvF GF M F) _W.invariant_name <|
+        gmap_view_auth (GF := GF) (M := M) (F := F) (.own one) (inv_map (GF := GF) I))
+      (big_sepM (PROP := IProp GF)
+        (fun i Q =>
+          BIBase.or
+            (BIBase.sep (BIBase.later Q) (ownD _W (GSet.singleton i)))
+            (ownE _W (CoPset.singleton i))) I)
+
+instance intoExists_wsat (W : WsatGS GF) :
+    IntoExists (PROP := IProp GF)
+      (wsat (GF := GF) (M := M) (F := F) W)
+      (fun I : M (IPropU GF) =>
+        BIBase.sep
+          (iOwn (GF := GF) (F := InvF GF M F) W.invariant_name <|
+            gmap_view_auth (GF := GF) (M := M) (F := F) (.own one) (inv_map (GF := GF) I))
+          (big_sepM (PROP := IProp GF)
+            (fun i Q =>
+              BIBase.or
+                (BIBase.sep (BIBase.later Q) (ownD W (GSet.singleton i)))
+                (ownE W (CoPset.singleton i)))
+            I)) := by
+  refine ⟨by simp [wsat]⟩
+
+instance fromExists_wsat (W : WsatGS GF) :
+    FromExists (PROP := IProp GF)
+      (wsat (GF := GF) (M := M) (F := F) W)
+      (fun I : M (IPropU GF) =>
+        BIBase.sep
+          (iOwn (GF := GF) (F := InvF GF M F) W.invariant_name <|
+            gmap_view_auth (GF := GF) (M := M) (F := F) (.own one) (inv_map (GF := GF) I))
+          (big_sepM (PROP := IProp GF)
+            (fun i Q =>
+              BIBase.or
+                (BIBase.sep (BIBase.later Q) (ownD W (GSet.singleton i)))
+                (ownE W (CoPset.singleton i)))
+            I)) := by
+  refine ⟨by simp [wsat]⟩
+
+/-! ## Enabled Mask Properties -/
+
+omit [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Allocate an empty enabled mask. -/
+theorem ownE_empty : (BIBase.emp : IProp GF) ⊢ BUpd.bupd (ownE W ∅) := by
+  -- `CoPsetDisj.coPset ∅` is definitionally the unit
+  haveI : IsUnit (CoPsetDisj.coPset (∅ : CoPset)) := by
+    simpa using (inferInstance : IsUnit (UCMRA.unit : CoPsetDisj))
+  simpa [ownE] using
+    (iOwn_unit (GF := GF) (F := COFE.constOF CoPsetDisj) (γ := W.enabled_name))
+
+omit [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Disjoint union of enabled masks splits into separating conjunction. -/
+theorem ownE_op (E₁ E₂ : CoPset) (h : E₁.Disjoint E₂) :
+    ownE W (E₁.union E₂) ⊣⊢ BIBase.sep (ownE W E₁) (ownE W E₂) := by
+  have h' :
+      CoPsetDisj.coPset (E₁.union E₂) =
+        (CoPsetDisj.coPset E₁ : CoPsetDisj) • CoPsetDisj.coPset E₂ :=
+    (coPset_disj_union h).symm
+  simpa [ownE, h'] using
+    (iOwn_op (GF := GF) (F := COFE.constOF CoPsetDisj) (γ := W.enabled_name)
+      (a1 := CoPsetDisj.coPset E₁) (a2 := CoPsetDisj.coPset E₂))
+
+omit [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Enabled masks in separating conjunction must be disjoint. -/
+theorem ownE_disjoint (E₁ E₂ : CoPset) :
+    BIBase.sep (ownE W E₁) (ownE W E₂) ⊢
+      BIBase.pure (E₁.Disjoint E₂) := by
+  refine (iOwn_cmraValid_op (GF := GF) (F := COFE.constOF CoPsetDisj)
+      (γ := W.enabled_name) (a1 := CoPsetDisj.coPset E₁)
+      (a2 := CoPsetDisj.coPset E₂)).trans ?_
+  refine (UPred.cmraValid_elim
+      (a := (CoPsetDisj.coPset E₁ : CoPsetDisj) • CoPsetDisj.coPset E₂)).trans ?_
+  refine BI.pure_mono ?_
+  intro hvalid0
+  have hvalid :
+      ✓ ((CoPsetDisj.coPset E₁ : CoPsetDisj) • CoPsetDisj.coPset E₂) :=
+    CMRA.discrete_valid hvalid0
+  exact (coPset_disj_valid_op).1 hvalid
+
+omit [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Cannot own the same singleton enabled token twice. -/
+theorem ownE_singleton_twice (i : Positive) :
+    BIBase.sep (ownE W (CoPset.singleton i)) (ownE W (CoPset.singleton i)) ⊢
+      (BIBase.pure False : IProp GF) := by
+  refine (ownE_disjoint (W := W)
+      (E₁ := CoPset.singleton i) (E₂ := CoPset.singleton i)).trans ?_
+  refine BI.pure_mono ?_
+  intro hdisj
+  have hmem : (CoPset.singleton i).mem i := by
+    rfl
+  exact (hdisj i) ⟨hmem, hmem⟩
+
+/-! ## Disabled Token Properties -/
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] in
+/-- Allocate empty disabled tokens. -/
+theorem ownD_empty : (BIBase.emp : IProp GF) ⊢ BUpd.bupd (ownD W ∅) := by
+  -- allocate the unit for the `GSetDisj` ghost cell
+  haveI : IsUnit (GSetDisj.gset (∅ : GSet)) := by
+    simpa using (inferInstance : IsUnit (UCMRA.unit : GSetDisj))
+  simpa [ownD] using
+    (iOwn_unit (GF := GF) (F := COFE.constOF GSetDisj) (γ := W.disabled_name))
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] in
+private theorem ownD_emptyE :
+    IPropEntails (GF := GF) (BIBase.emp : IProp GF) (BUpd.bupd (ownD W ∅)) := by
+  exact ⟨ownD_empty (W := W)⟩
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] in
+/-- Disjoint union of disabled tokens splits into separating conjunction. -/
+theorem ownD_op (E₁ E₂ : GSet) (h : E₁.Disjoint E₂) :
+    ownD W (E₁.union E₂) ⊣⊢ BIBase.sep (ownD W E₁) (ownD W E₂) := by
+  have h' :
+      GSetDisj.gset (E₁.union E₂) =
+        (GSetDisj.gset E₁ : GSetDisj) • GSetDisj.gset E₂ :=
+    (gset_disj_union h).symm
+  simpa [ownD, h'] using
+    (iOwn_op (GF := GF) (F := COFE.constOF GSetDisj) (γ := W.disabled_name)
+      (a1 := GSetDisj.gset E₁) (a2 := GSetDisj.gset E₂))
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] in
+/-- Disabled tokens in separating conjunction must be disjoint. -/
+theorem ownD_disjoint (E₁ E₂ : GSet) :
+    BIBase.sep (ownD W E₁) (ownD W E₂) ⊢
+      BIBase.pure (E₁.Disjoint E₂) := by
+  refine (iOwn_cmraValid_op (GF := GF) (F := COFE.constOF GSetDisj)
+      (γ := W.disabled_name) (a1 := GSetDisj.gset E₁)
+      (a2 := GSetDisj.gset E₂)).trans ?_
+  refine (UPred.cmraValid_elim
+      (a := (GSetDisj.gset E₁ : GSetDisj) • GSetDisj.gset E₂)).trans ?_
+  refine BI.pure_mono ?_
+  intro hvalid0
+  have hvalid :
+      ✓ ((GSetDisj.gset E₁ : GSetDisj) • GSetDisj.gset E₂) :=
+    CMRA.discrete_valid hvalid0
+  exact (gset_disj_valid_op).1 hvalid
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] in
+/-- Cannot own the same singleton disabled token twice. -/
+theorem ownD_singleton_twice (i : Positive) :
+    BIBase.sep (ownD W (GSet.singleton i)) (ownD W (GSet.singleton i)) ⊢
+      (BIBase.pure False : IProp GF) := by
+  refine (ownD_disjoint (W := W)
+      (E₁ := GSet.singleton i) (E₂ := GSet.singleton i)).trans ?_
+  refine BI.pure_mono ?_
+  intro hdisj
+  have hmem : (GSet.singleton i).mem i := by
+    rfl
+  exact (hdisj i) ⟨hmem, hmem⟩
+
+/-! ## Invariant Properties -/
+
+omit [FiniteMapLaws Positive M]
+    [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+/-- `ownI` is persistent. -/
+theorem ownI_persistent (i : Positive) (P : IProp GF) :
+    ownI (GF := GF) (M := M) (F := F) W i P ⊢
+      BIBase.persistently (ownI (GF := GF) (M := M) (F := F) W i P) := by
+  classical
+  -- `discard` and `toAgree` have trivial cores, so the fragment is core-id
+  haveI : CMRA.CoreId (DFrac.discard (F := F)) := by
+    refine CMRA.CoreId.of_pcore_eq_some (x := DFrac.discard (F := F)) ?_
+    simp [CMRA.pcore, DFrac.pcore]
+  haveI : CMRA.CoreId (toAgree (invariant_unfold (GF := GF) P)) := by
+    refine CMRA.CoreId.of_pcore_eq_some (x := toAgree (invariant_unfold (GF := GF) P)) ?_
+    simp [CMRA.pcore]
+  simpa [ownI] using
+    (persistently_intro (P := iOwn (GF := GF) (F := InvF GF M F) W.invariant_name <|
+      gmap_view_frag (GF := GF) (M := M) (F := F) i .discard
+        (toAgree (invariant_unfold (GF := GF) P))))
+
+
+/-! ## Invariant Lookup Helper -/
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem inv_map_lookup {I : M (IPropU GF)} {i : Positive} {v : Agree (IPropU GF)}
+    (hget : Store.get (inv_map (GF := GF) I) i = some v) :
+    ∃ Q, FiniteMap.get? I i = some Q ∧
+      v = toAgree Q := by
+  classical
+  have hget' : FiniteMap.get? (inv_map (GF := GF) I) i = some v := by
+    simpa [HeapFiniteMap.get?_eq_get] using hget
+  have hget'' : (FiniteMap.get? I i).map (fun P => toAgree P) = some v := by
+    simpa [inv_map, FiniteMapLaws.get?_map] using hget'
+  cases hI : FiniteMap.get? I i with
+  | none =>
+      simp [hI] at hget''
+  | some Q =>
+      refine ⟨Q, rfl, ?_⟩
+      have hv : some (toAgree Q) = some v := by
+        simpa [hI] using hget''
+      exact (Option.some.inj hv).symm
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem invariant_lookup (I : M (IPropU GF)) (i : Positive) (P : IProp GF) :
+    BIBase.sep
+      (iOwn (GF := GF) (F := InvF GF M F) W.invariant_name
+        (gmap_view_auth (GF := GF) (M := M) (F := F) (.own one) (inv_map (GF := GF) I)))
+      (ownI (GF := GF) (M := M) (F := F) W i P) ⊢
+      BIBase.sep
+        (BIBase.exists (fun Q =>
+          BIBase.sep (BIBase.pure (FiniteMap.get? I i = some Q))
+            (BIBase.later (IPropEq (GF := GF) Q P))))
+        (iOwn (GF := GF) (F := InvF GF M F) W.invariant_name
+          (gmap_view_auth (GF := GF) (M := M) (F := F) (.own one) (inv_map (GF := GF) I))) := by
+  intro n x hvalid hsep
+  -- get validity of auth • frag from ownership
+  have hvalid :
+      ✓{n} (gmap_view_auth (GF := GF) (M := M) (F := F) (.own one)
+              (inv_map (GF := GF) I) •
+            gmap_view_frag (GF := GF) (M := M) (F := F) i .discard
+              (toAgree (invariant_unfold (GF := GF) P))) :=
+    by
+      have hvalid' :
+          (UPred.cmraValid
+              (gmap_view_auth (GF := GF) (M := M) (F := F) (.own one)
+                (inv_map (GF := GF) I) •
+              gmap_view_frag (GF := GF) (M := M) (F := F) i .discard
+                (toAgree (invariant_unfold (GF := GF) P))) : IProp GF).holds n x := by
+        have hsep' :
+            (BIBase.sep
+                (iOwn (GF := GF) (F := InvF GF M F) W.invariant_name
+                  (gmap_view_auth (GF := GF) (M := M) (F := F) (.own one)
+                    (inv_map (GF := GF) I)))
+                (iOwn (GF := GF) (F := InvF GF M F) W.invariant_name
+                  (gmap_view_frag (GF := GF) (M := M) (F := F) i .discard
+                    (toAgree (invariant_unfold (GF := GF) P))))) n x := by
+          simpa [ownI] using hsep
+        exact (iOwn_cmraValid_op (GF := GF) (F := InvF GF M F)
+          (γ := W.invariant_name)
+          (a1 := gmap_view_auth (GF := GF) (M := M) (F := F) (.own one)
+            (inv_map (GF := GF) I))
+          (a2 := gmap_view_frag (GF := GF) (M := M) (F := F) i .discard
+            (toAgree (invariant_unfold (GF := GF) P)))) n x hvalid hsep'
+      simpa [UPred.cmraValid] using hvalid'
+  -- decode validity via HeapView
+  obtain ⟨v', dq', _Hdp, hlookup, hval, hinc⟩ :=
+    (HeapView.auth_op_frag_validN_iff (F := F) (K := Positive)
+        (V := Agree (IPropU GF)) (H := M)).1 hvalid
+  obtain ⟨Q, hI, hv'⟩ := inv_map_lookup (I := I) (i := i) (v := v') hlookup
+  -- normalize the inclusion/validity facts with the discovered entry
+  have hinc' :
+      some (DFrac.discard, toAgree (invariant_unfold (GF := GF) P)) ≼{n}
+        some (dq', toAgree Q) := by
+    simpa [hv'] using hinc
+  have hval' : ✓{n} (dq', toAgree Q) := by
+    simpa [hv'] using hval
+  -- derive agreement of invariant bodies
+  have hvdist :
+        toAgree (invariant_unfold (GF := GF) P) ≡{n}≡
+          toAgree Q := by
+    have hinc'' := (Option.some_incN_some_iff).1 hinc'
+    cases hinc'' with
+    | inl hEq =>
+        exact OFE.dist_snd hEq
+    | inr hInc =>
+        obtain ⟨c, hc⟩ := hInc
+        have hvinc :
+            toAgree (invariant_unfold (GF := GF) P) ≼{n}
+              toAgree Q := by
+          exact ⟨c.snd, OFE.dist_snd hc⟩
+        have hvvalid : ✓{n} (toAgree Q) :=
+          hval'.2
+        exact (Agree.valid_includedN (x := toAgree (invariant_unfold (GF := GF) P))
+          (y := toAgree Q) hvvalid hvinc)
+  have hdist : invariant_unfold (GF := GF) P ≡{n}≡ Q :=
+    Agree.toAgree_injN hvdist
+  -- build the later equality proof (resource-independent)
+  have hLaterEq : ∀ x, BIBase.later (IPropEq (GF := GF) Q P) n x := by
+    intro x
+    cases n with
+    | zero =>
+        simp [BIBase.later, UPred.later]
+    | succ n' =>
+        have hPQ : P ≡{n'}≡ Q := by
+          exact OFE.Dist.lt hdist (Nat.lt_succ_self _)
+        -- UPred.eq Q P at step n' is Q ≡{n'}≡ P
+        simpa [BIBase.later, UPred.later, IPropEq, UPred.eq] using hPQ.symm
+  -- split the resources to keep the auth part
+  rcases hsep with ⟨x1, x2, hx, hAuth, _hFrag⟩
+  -- show the existential holds on the fragment side
+  have hExists :
+      (BIBase.exists (fun Q =>
+        BIBase.sep (BIBase.pure (FiniteMap.get? I i = some Q))
+          (BIBase.later (IPropEq (GF := GF) Q P)))) n x2 := by
+    refine ⟨
+        BIBase.sep (BIBase.pure (FiniteMap.get? I i = some Q))
+          (BIBase.later (IPropEq (GF := GF) Q P)), ?_, ?_⟩
+    · exact ⟨Q, rfl⟩
+    · refine ⟨x2, (UCMRA.unit : IResUR GF),
+        (CMRA.unit_right_id_dist (α := IResUR GF) x2).symm, ?_, ?_⟩
+      · exact hI
+      · simpa using hLaterEq x2
+  -- assemble the separating conjunction with the auth ownership
+  refine ⟨x2, x1, ?_, hExists, hAuth⟩
+  exact hx.trans (CMRA.op_commN (x := x1) (y := x2))
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem invariant_lookupE (I : M (IPropU GF)) (i : Positive) (P : IProp GF) :
+    IPropEntails (GF := GF)
+      (BIBase.sep
+        (iOwn (GF := GF) (F := InvF GF M F) W.invariant_name
+          (gmap_view_auth (GF := GF) (M := M) (F := F) (.own one) (inv_map (GF := GF) I)))
+        (ownI (GF := GF) (M := M) (F := F) W i P))
+      (BIBase.sep
+        (BIBase.exists (fun Q =>
+          BIBase.sep (BIBase.pure (FiniteMap.get? I i = some Q))
+            (BIBase.later (IPropEq (GF := GF) Q P))))
+        (iOwn (GF := GF) (F := InvF GF M F) W.invariant_name
+          (gmap_view_auth (GF := GF) (M := M) (F := F) (.own one) (inv_map (GF := GF) I)))) := by
+  exact ⟨invariant_lookup (W := W) (I := I) (i := i) (P := P)⟩
+
+/-! ## Later Equality Helpers -/
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)]
+    [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem later_eq_symm (P Q : IProp GF) :
+    BIBase.later (IPropEq (GF := GF) Q P) ⊢ BIBase.later (IPropEq (GF := GF) P Q) := by
+  -- `UPred.eq` is symmetric at each step index
+  intro n x _ hEq
+  cases n with
+  | zero =>
+      simp [BIBase.later, UPred.later]
+  | succ n' =>
+      simpa [BIBase.later, UPred.later, IPropEq, UPred.eq] using hEq.symm
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)]
+    [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem later_eq_elim (P Q : IProp GF) :
+    BIBase.sep (BIBase.later P) (BIBase.later (IPropEq (GF := GF) P Q)) ⊢ BIBase.later Q := by
+  -- use the internal equality to rewrite the later'd proposition
+  intro n x Hv hsep
+  rcases hsep with ⟨x1, x2, hx, hP, hEq⟩
+  cases n with
+  | zero =>
+      simp [BIBase.later, UPred.later]
+  | succ n' =>
+      -- lift `P` to the full resource and rewrite along equality
+      have hx' : x1 ≼{n'} x := by
+        -- extend by the right frame then transport along the split equality
+        have hinc : x1 • x2 ≼{n'} x := by
+          exact CMRA.incN_of_incN_succ (OFE.Dist.to_incN hx.symm)
+        exact CMRA.incN_trans (CMRA.incN_op_left n' x1 x2) hinc
+      have hP' : P n' x := P.mono hP hx' (Nat.le_refl _)
+      have hPQ : P ≡{n'}≡ Q := by
+        simpa [BIBase.later, UPred.later, IPropEq, UPred.eq] using hEq
+      have hQ : Q n' x :=
+        uPred_holds_ne (P := Q) (Q := P) hPQ.symm (Nat.le_refl _)
+          (CMRA.validN_of_le (Nat.le_succ _) Hv) hP'
+      simpa [BIBase.later, UPred.later] using hQ
+
+/-! ## GSet Disjoint Allocation Helper -/
+
+private theorem gset_disj_alloc_empty_updateP_strong' (P : Positive → Prop)
+    (Hfresh : ∀ E : GSet, ∃ i, ¬E.mem i ∧ P i) :
+    (GSetDisj.gset (∅ : GSet) : GSetDisj) ~~>:
+      fun Y => ∃ i, Y = GSetDisj.gset (GSet.singleton i) ∧ P i := by
+  -- reduce to discrete updateP and pick a fresh singleton
+  refine (UpdateP.discrete (x := (GSetDisj.gset (∅ : GSet) : GSetDisj))
+    (P := fun Y => ∃ i, Y = GSetDisj.gset (GSet.singleton i) ∧ P i)).mpr ?_
+  intro mz hvalid
+  cases mz with
+  | none =>
+      -- empty frame: any fresh singleton is valid
+      obtain ⟨i, _, hiP⟩ := Hfresh ∅
+      refine ⟨GSetDisj.gset (GSet.singleton i), ⟨i, rfl, hiP⟩, ?_⟩
+      simp [CMRA.op?, CMRA.Valid]
+  | some z =>
+      cases z with
+      | invalid =>
+          -- invalid frame contradicts validity
+          cases hvalid
+      | gset X =>
+          -- choose a singleton disjoint from the frame
+          obtain ⟨i, hiX, hiP⟩ := Hfresh X
+          refine ⟨GSetDisj.gset (GSet.singleton i), ⟨i, rfl, hiP⟩, ?_⟩
+          have hdisj : GSet.Disjoint (GSet.singleton i) X := by
+            intro n hn
+            have hn' : n = i := by simpa using hn.1
+            subst hn'
+            exact hiX hn.2
+          simp [CMRA.op?, gset_disj_valid_op, hdisj]
+
+/-! ## Map/Heap Helpers -/
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem inv_map_get_none {I : M (IPropU GF)} {i : Positive}
+    (hI : FiniteMap.get? I i = none) :
+    Store.get (inv_map (GF := GF) I) i = none := by
+  -- translate `get?` through `inv_map` and the heap lookup
+  classical
+  have h' : FiniteMap.get? (inv_map (GF := GF) I) i = none := by
+    simp [inv_map, FiniteMapLaws.get?_map, hI]
+  simpa [HeapFiniteMap.get?_eq_get] using h'
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem inv_map_insert (I : M (IPropU GF)) (i : Positive) (P : IProp GF) :
+    inv_map (GF := GF) (FiniteMap.insert I i P) =
+      Store.set (inv_map (GF := GF) I) i
+        (some (toAgree (invariant_unfold (GF := GF) P))) := by
+  -- extensionality by `get?`, computed via map and heap lookup
+  classical
+  apply FiniteMapLaws.ext
+  intro k
+  by_cases hki : k = i
+  · subst k
+    have hL :
+        FiniteMap.get? (inv_map (GF := GF) (FiniteMap.insert I i P)) i =
+          some (toAgree (invariant_unfold (GF := GF) P)) := by
+      simp [inv_map, FiniteMapLaws.get?_map, FiniteMapLaws.get?_insert_same, invariant_unfold]
+    have hR :
+        FiniteMap.get? (Store.set (inv_map (GF := GF) I) i
+          (some (toAgree (invariant_unfold (GF := GF) P)))) i =
+          some (toAgree (invariant_unfold (GF := GF) P)) := by
+      simp [HeapFiniteMap.get?_eq_get, Store.get_set_eq, invariant_unfold]
+    exact hL.trans hR.symm
+  · have hne : i ≠ k := Ne.symm hki
+    have hL :
+        FiniteMap.get? (inv_map (GF := GF) (FiniteMap.insert I i P)) k =
+          FiniteMap.get? (inv_map (GF := GF) I) k := by
+      simp [inv_map, FiniteMapLaws.get?_map, FiniteMapLaws.get?_insert_ne _ _ _ _ hne]
+    have hR :
+        FiniteMap.get? (Store.set (inv_map (GF := GF) I) i
+          (some (toAgree (invariant_unfold (GF := GF) P)))) k =
+          FiniteMap.get? (inv_map (GF := GF) I) k := by
+      simp [HeapFiniteMap.get?_eq_get, Store.get_set_ne hne]
+    exact hL.trans hR.symm
+
+omit [ElemG GF (InvF GF M F)] [ElemG GF (COFE.constOF CoPsetDisj)]
+    [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem inv_auth_alloc (I : M (IPropU GF)) (i : Positive) (P : IProp GF)
+    (hI : FiniteMap.get? I i = none) :
+    gmap_view_auth (GF := GF) (M := M) (F := F) (.own one) (inv_map (GF := GF) I) ~~>
+      gmap_view_auth (GF := GF) (M := M) (F := F) (.own one)
+        (inv_map (GF := GF) (FiniteMap.insert I i P)) •
+      gmap_view_frag (GF := GF) (M := M) (F := F) i .discard
+        (toAgree (invariant_unfold (GF := GF) P)) := by
+  have hget : Store.get (inv_map (GF := GF) I) i = none :=
+    inv_map_get_none (I := I) (i := i) hI
+  have hdq : ✓ (DFrac.discard (F := F)) := by
+    simpa using (DFrac.valid_discard (F := F))
+  have hval : ✓ (toAgree (invariant_unfold (GF := GF) P)) := by
+    simp [Agree.valid_def, Agree.valid, Agree.validN_iff, toAgree, invariant_unfold]
+  simpa [inv_map_insert] using
+    (HeapView.update_one_alloc (H := M) (k := i)
+      (m1 := inv_map (GF := GF) I)
+      (dq := DFrac.discard) (v1 := toAgree (invariant_unfold (GF := GF) P))
+      hget hdq hval)
+
+/-! ## Open and Close -/
+
+/-- Open an invariant: given world satisfaction, invariant ownership, and
+    the enabled token for `i`, extract the later'd content and a disabled
+    token.
+
+    Proof strategy (from Coq `wsat.v`):
+    1. Unfold `wsat` to get the invariant map `I` and auth fragment
+    2. Use `invariant_lookup` to find `Q` with `I !! i = Some Q` and `▷(Q ≡ P)`
+    3. Use `big_sepM_delete` to extract the entry for `i`
+    4. The entry is `(▷ Q ∗ ownD {[i]}) ∨ ownE {[i]}` — eliminate the disjunction
+    5. In the `ownE` case, derive contradiction from `ownE_singleton_twice`
+    6. In the `▷ Q ∗ ownD` case, rewrite `Q` to `P` and reassemble `wsat` -/
+theorem ownI_open (i : Positive) (P : IProp GF) :
+    BIBase.sep
+      (BIBase.sep (wsat (GF := GF) (M := M) (F := F) W)
+        (ownI (GF := GF) (M := M) (F := F) W i P))
+      (ownE W (CoPset.singleton i)) ⊢
+      BIBase.sep
+        (BIBase.sep (wsat (GF := GF) (M := M) (F := F) W) (BIBase.later P))
+        (ownD W (GSet.singleton i)) := by
+  classical
+  iintro H
+  icases H with ⟨Hsep, HownE⟩
+  icases Hsep with ⟨Hwsat, HownI⟩
+  icases Hwsat with ⟨%I, Hwsat⟩
+  icases Hwsat with ⟨Hauth, Hbig⟩
+  -- lookup the invariant body
+  ihave Hlookup := (invariant_lookupE (GF := GF) (M := M) (F := F) (W := W)
+      (I := I) (i := i) (P := P))
+  ispecialize Hlookup $$ [Hauth, HownI]
+  · isplitl [Hauth]
+    · iexact Hauth
+    · iexact HownI
+  icases Hlookup with ⟨Hlookup, Hauth⟩
+  icases Hlookup with ⟨%Q, %hI, HlaterEq⟩
+  -- peel off the map entry for `i`
+  ihave Hbig' := (wrapEntails (GF := GF) (big_sepM_delete
+      (Φ := fun i Q =>
+        BIBase.or
+          (BIBase.sep (BIBase.later Q) (ownD W (GSet.singleton i)))
+          (ownE W (CoPset.singleton i)))
+      (m := I) (i := i) (x := Q) hI).mp) $$ Hbig
+  icases Hbig' with ⟨Hentry, Hrest⟩
+  icases Hentry with (Hclosed | Hopen)
+  · -- closed case: swap tokens, extract ▷P
+    icases Hclosed with ⟨HlaterQ, HownD⟩
+    ihave HlaterP := (wrapEntails (GF := GF) (later_eq_elim (P := Q) (Q := P))) $$ [HlaterQ, HlaterEq]
+    · isplitl [HlaterQ]
+      · iexact HlaterQ
+      · iexact HlaterEq
+    -- build wsat with the entry opened via `ownE`
+    isplitr [HownD]
+    · isplitr [HlaterP]
+      · iexists I
+        isplitl [Hauth]
+        · iexact Hauth
+        · iapply (wrapEntails (GF := GF) (big_sepM_delete
+            (Φ := fun i Q =>
+              BIBase.or
+                (BIBase.sep (BIBase.later Q) (ownD W (GSet.singleton i)))
+                (ownE W (CoPset.singleton i)))
+            (m := I) (i := i) (x := Q) hI).mpr)
+          isplitl [HownE]
+          · iright; iexact HownE
+          · iexact Hrest
+      · iexact HlaterP
+    · iexact HownD
+  · -- open case: duplicate enabled token is impossible
+    iexfalso
+    iapply (wrapEntails (GF := GF) (ownE_singleton_twice (W := W) i))
+    isplitl [HownE]
+    · iexact HownE
+    · iexact Hopen
+
+/-- Close an invariant: given world satisfaction, invariant ownership,
+    the later'd content, and the disabled token, return the enabled token.
+
+    Proof strategy: dual of `ownI_open` — put the content back into the big sep,
+    swap disabled for enabled. -/
+theorem ownI_close (i : Positive) (P : IProp GF) :
+    BIBase.sep
+      (BIBase.sep
+        (BIBase.sep (wsat (GF := GF) (M := M) (F := F) W)
+          (ownI (GF := GF) (M := M) (F := F) W i P))
+        (BIBase.later P))
+      (ownD W (GSet.singleton i)) ⊢
+      BIBase.sep (wsat (GF := GF) (M := M) (F := F) W) (ownE W (CoPset.singleton i)) := by
+  classical
+  iintro H
+  icases H with ⟨Hsep, HownD⟩
+  icases Hsep with ⟨Hsep, HlaterP⟩
+  icases Hsep with ⟨Hwsat, HownI⟩
+  icases Hwsat with ⟨%I, Hwsat⟩
+  icases Hwsat with ⟨Hauth, Hbig⟩
+  -- lookup the invariant body
+  ihave Hlookup := (invariant_lookupE (GF := GF) (M := M) (F := F) (W := W)
+      (I := I) (i := i) (P := P))
+  ispecialize Hlookup $$ [Hauth, HownI]
+  · isplitl [Hauth]
+    · iexact Hauth
+    · iexact HownI
+  icases Hlookup with ⟨Hlookup, Hauth⟩
+  icases Hlookup with ⟨%Q, %hI, HlaterEq⟩
+  -- peel off the map entry for `i`
+  ihave Hbig' := (wrapEntails (GF := GF) (big_sepM_delete
+      (Φ := fun i Q =>
+        BIBase.or
+          (BIBase.sep (BIBase.later Q) (ownD W (GSet.singleton i)))
+          (ownE W (CoPset.singleton i)))
+      (m := I) (i := i) (x := Q) hI).mp) $$ Hbig
+  icases Hbig' with ⟨Hentry, Hrest⟩
+  icases Hentry with (Hclosed | Hopen)
+  · -- closed case: duplicate disabled token
+    iexfalso
+    iapply (wrapEntails (GF := GF) (ownD_singleton_twice (W := W) i))
+    isplitl [HownD]
+    · iexact HownD
+    · icases Hclosed with ⟨_, HownD'⟩
+      iexact HownD'
+  · -- open case: close with ▷P and ownD, return ownE
+    -- rewrite ▷P to ▷Q using the later equality
+    ihave HlaterEq' := (wrapEntails (GF := GF) (later_eq_symm (P := P) (Q := Q))) $$ HlaterEq
+    ihave HlaterQ := (wrapEntails (GF := GF) (later_eq_elim (P := P) (Q := Q))) $$ [HlaterP, HlaterEq']
+    · isplitl [HlaterP]
+      · iexact HlaterP
+      · iexact HlaterEq'
+    -- build wsat with the entry closed
+    isplitr [Hopen]
+    · iexists I
+      isplitl [Hauth]
+      · iexact Hauth
+      · iapply (wrapEntails (GF := GF) (big_sepM_delete
+          (Φ := fun i Q =>
+            BIBase.or
+              (BIBase.sep (BIBase.later Q) (ownD W (GSet.singleton i)))
+              (ownE W (CoPset.singleton i)))
+          (m := I) (i := i) (x := Q) hI).mpr)
+        isplitl [HlaterQ HownD]
+        · ileft
+          isplitl [HlaterQ]
+          · iexact HlaterQ
+          · iexact HownD
+        · iexact Hrest
+    · iexact Hopen
+
+/-! ## Allocation -/
+
+set_option linter.unnecessarySimpa false in
+/-- Allocate a fresh invariant name satisfying predicate `φ`.
+    Given world satisfaction and `▷ P`, produces a fresh name `i` with
+    `φ i`, updated world satisfaction, and `ownI i P`. -/
+theorem ownI_alloc (φ : Positive → Prop) (P : IProp GF)
+    (hfresh : ∀ E : GSet, ∃ i, ¬E.mem i ∧ φ i) :
+    BIBase.sep (wsat (GF := GF) (M := M) (F := F) W) (BIBase.later P) ⊢
+      BUpd.bupd (BIBase.exists fun i =>
+        BIBase.sep (BIBase.pure (φ i))
+          (BIBase.sep (wsat (GF := GF) (M := M) (F := F) W)
+            (ownI (GF := GF) (M := M) (F := F) W i P))) := by
+  classical
+  iintro H
+  icases H with ⟨Hwsat, HlaterP⟩
+  -- unwrap `wsat` as an existential via `IntoExists`
+  ihave Hwsat' := (wrapEntails (GF := GF)
+      (into_exists (PROP := IProp GF)
+        (P := wsat (GF := GF) (M := M) (F := F) W)
+        (Φ := fun I : M (IPropU GF) =>
+          BIBase.sep
+            (iOwn (GF := GF) (F := InvF GF M F) W.invariant_name <|
+              gmap_view_auth (GF := GF) (M := M) (F := F) (.own one) (inv_map (GF := GF) I))
+            (big_sepM (PROP := IProp GF)
+              (fun i Q =>
+                BIBase.or
+                  (BIBase.sep (BIBase.later Q) (ownD W (GSet.singleton i)))
+                  (ownE W (CoPset.singleton i)))
+              I)))) $$ Hwsat
+  icases Hwsat' with ⟨%I, Hwsat⟩
+  icases Hwsat with ⟨Hauth, Hbig⟩
+
+  -- prepare the fresh allocation predicate
+  have Hfresh' : ∀ E : GSet, ∃ i, ¬E.mem i ∧ (FiniteMap.get? I i = none ∧ φ i) := by
+    intro E
+    let domI : GSet := ⟨fun k => (FiniteMap.get? I k).isSome⟩
+    obtain ⟨i, hi, hiφ⟩ := hfresh (E ∪ domI)
+    refine ⟨i, ?_, ?_⟩
+    · intro hmem
+      exact hi (Or.inl hmem)
+    · have hnotDom : ¬ domI.mem i := by
+        intro hmem
+        exact hi (Or.inr hmem)
+      have hnone : FiniteMap.get? I i = none := by
+        cases hget : FiniteMap.get? I i with
+        | none => rfl
+        | some v =>
+            have : domI.mem i := by simp [domI, hget]
+            exact (hnotDom this).elim
+      exact ⟨hnone, hiφ⟩
+
+  -- allow two extra nested bupds (for updateP and auth update)
+  iapply BIUpdate.trans
+  iapply BIUpdate.trans
+
+  -- first bupd: allocate the disabled token cell
+  iapply (wrapEntails (GF := GF) (bupd_wand_l (P := ownD W (∅ : GSet))))
+  isplitr []
+  · iintro HownD0
+    -- second bupd: update empty disabled tokens to a fresh singleton
+    let updP : IProp GF :=
+      BIBase.exists fun Y : GSetDisj =>
+        BIBase.sep
+          (BIBase.pure (∃ i, Y = GSetDisj.gset (GSet.singleton i) ∧
+            (FiniteMap.get? I i = none ∧ φ i)))
+          (iOwn (GF := GF) (F := COFE.constOF GSetDisj) (γ := W.disabled_name) Y)
+    iapply (wrapEntails (GF := GF) (bupd_wand_l (P := updP)))
+    isplitr [HownD0]
+    · iintro HupdRes
+      icases HupdRes with ⟨%Y, HupdRes⟩
+      icases HupdRes with ⟨%hY, HownDY⟩
+      rcases hY with ⟨i, hYeq, hIφ⟩
+      subst hYeq
+      have hnone : FiniteMap.get? I i = none := hIφ.1
+      have hφ : φ i := hIφ.2
+      -- third bupd: update the invariant registry auth to insert the new entry
+      iapply bupd_wand_l
+      isplitr [Hauth]
+      · iintro Hauth'
+        -- split auth and fragment
+        icases (wrapEntails (GF := GF) (iOwn_op (GF := GF) (F := InvF GF M F) (γ := W.invariant_name)
+            (a1 := gmap_view_auth (GF := GF) (M := M) (F := F) (.own one)
+              (inv_map (GF := GF) (FiniteMap.insert I i P)))
+            (a2 := gmap_view_frag (GF := GF) (M := M) (F := F) i .discard
+              (toAgree (invariant_unfold (GF := GF) P)))).mp) $$ Hauth' with ⟨Hauth1, Hfrag⟩
+        -- assemble the result
+        iexists i
+        isplit
+        · ipure_intro; exact hφ
+        · -- wsat ∗ ownI
+          isplitl [Hauth1 Hbig HownDY HlaterP]
+          · -- wsat
+            iexists (FiniteMap.insert I i P)
+            isplitl [Hauth1]
+            · iexact Hauth1
+            · iapply (wrapEntails (GF := GF) (big_sepM_insert
+                (Φ := fun i Q =>
+                  BIBase.or
+                    (BIBase.sep (BIBase.later Q) (ownD W (GSet.singleton i)))
+                    (ownE W (CoPset.singleton i)))
+                (m := I) (i := i) (x := P) hnone).mpr)
+              isplitl [HlaterP HownDY]
+              · ileft
+                isplitl [HlaterP]
+                · iexact HlaterP
+                · simpa [ownD] using HownDY
+              · iexact Hbig
+          · -- ownI
+            simpa [ownI] using Hfrag
+      · -- build the update on the auth map
+        iapply (wrapEntails (GF := GF) (iOwn_update (GF := GF) (F := InvF GF M F) (γ := W.invariant_name)
+          (a := gmap_view_auth (GF := GF) (M := M) (F := F) (.own one)
+            (inv_map (GF := GF) I))
+          (a' := gmap_view_auth (GF := GF) (M := M) (F := F) (.own one)
+              (inv_map (GF := GF) (FiniteMap.insert I i P)) •
+            gmap_view_frag (GF := GF) (M := M) (F := F) i .discard
+              (toAgree (invariant_unfold (GF := GF) P)))
+          (inv_auth_alloc (I := I) (i := i) (P := P) hnone)))
+        iexact Hauth
+    · -- update the disabled tokens
+      iapply (wrapEntails (GF := GF) (iOwn_updateP (GF := GF) (F := COFE.constOF GSetDisj) (γ := W.disabled_name)
+        (a := GSetDisj.gset (∅ : GSet))
+        (P := fun Y => ∃ i, Y = GSetDisj.gset (GSet.singleton i) ∧
+          (FiniteMap.get? I i = none ∧ φ i))
+        (gset_disj_alloc_empty_updateP_strong'
+          (P := fun i => FiniteMap.get? I i = none ∧ φ i) Hfresh')))
+      simpa [ownD] using HownD0
+  · iapply (ownD_emptyE (W := W))
+    iemp_intro
+
+set_option linter.unnecessarySimpa false in
+/-- Allocate a fresh invariant and immediately open it.
+    Returns the fresh name, a closing wand, `ownI`, and `ownD`. -/
+theorem ownI_alloc_open (φ : Positive → Prop) (P : IProp GF)
+    (hfresh : ∀ E : GSet, ∃ i, ¬E.mem i ∧ φ i) :
+    BUpd.bupd (wsat (GF := GF) (M := M) (F := F) W) ⊢
+      BUpd.bupd (BIBase.exists fun i =>
+        BIBase.sep (BIBase.pure (φ i))
+          (BIBase.sep
+            (BIBase.wand (ownE W (CoPset.singleton i))
+              (wsat (GF := GF) (M := M) (F := F) W))
+            (BIBase.sep
+              (ownI (GF := GF) (M := M) (F := F) W i P)
+              (ownD W (GSet.singleton i))))) := by
+  classical
+  -- reduce to a single bupd on the inside
+  refine (BIUpdate.mono ?_).trans BIUpdate.trans
+  iintro Hwsat
+  ihave Hwsat' := (wrapEntails (GF := GF)
+      (into_exists (PROP := IProp GF)
+        (P := wsat (GF := GF) (M := M) (F := F) W)
+        (Φ := fun I : M (IPropU GF) =>
+          BIBase.sep
+            (iOwn (GF := GF) (F := InvF GF M F) W.invariant_name <|
+              gmap_view_auth (GF := GF) (M := M) (F := F) (.own one) (inv_map (GF := GF) I))
+            (big_sepM (PROP := IProp GF)
+              (fun i Q =>
+                BIBase.or
+                  (BIBase.sep (BIBase.later Q) (ownD W (GSet.singleton i)))
+                  (ownE W (CoPset.singleton i)))
+              I)))) $$ Hwsat
+  icases Hwsat' with ⟨%I, Hwsat⟩
+  icases Hwsat with ⟨Hauth, Hbig⟩
+
+  have Hfresh' : ∀ E : GSet, ∃ i, ¬E.mem i ∧ (FiniteMap.get? I i = none ∧ φ i) := by
+    intro E
+    let domI : GSet := ⟨fun k => (FiniteMap.get? I k).isSome⟩
+    obtain ⟨i, hi, hiφ⟩ := hfresh (E ∪ domI)
+    refine ⟨i, ?_, ?_⟩
+    · intro hmem
+      exact hi (Or.inl hmem)
+    · have hnotDom : ¬ domI.mem i := by
+        intro hmem
+        exact hi (Or.inr hmem)
+      have hnone : FiniteMap.get? I i = none := by
+        cases hget : FiniteMap.get? I i with
+        | none => rfl
+        | some v =>
+            have : domI.mem i := by simp [domI, hget]
+            exact (hnotDom this).elim
+      exact ⟨hnone, hiφ⟩
+
+  -- allow two extra nested bupds (for updateP and auth update)
+  iapply BIUpdate.trans
+  iapply BIUpdate.trans
+
+  -- first bupd: allocate the disabled token cell
+  iapply (wrapEntails (GF := GF) (bupd_wand_l (P := ownD W (∅ : GSet))))
+  isplitr []
+  · iintro HownD0
+    -- second bupd: update empty disabled tokens to a fresh singleton
+    let updP : IProp GF :=
+      BIBase.exists fun Y : GSetDisj =>
+        BIBase.sep
+          (BIBase.pure (∃ i, Y = GSetDisj.gset (GSet.singleton i) ∧
+            (FiniteMap.get? I i = none ∧ φ i)))
+          (iOwn (GF := GF) (F := COFE.constOF GSetDisj) (γ := W.disabled_name) Y)
+    iapply (wrapEntails (GF := GF) (bupd_wand_l (P := updP)))
+    isplitr [HownD0]
+    · iintro HupdRes
+      icases HupdRes with ⟨%Y, HupdRes⟩
+      icases HupdRes with ⟨%hY, HownDY⟩
+      rcases hY with ⟨i, hYeq, hIφ⟩
+      subst hYeq
+      have hnone : FiniteMap.get? I i = none := hIφ.1
+      have hφ : φ i := hIφ.2
+      -- third bupd: update the invariant registry auth to insert the new entry
+      iapply bupd_wand_l
+      isplitr [Hauth]
+      · iintro Hauth'
+        icases (wrapEntails (GF := GF) (iOwn_op (GF := GF) (F := InvF GF M F) (γ := W.invariant_name)
+            (a1 := gmap_view_auth (GF := GF) (M := M) (F := F) (.own one)
+              (inv_map (GF := GF) (FiniteMap.insert I i P)))
+            (a2 := gmap_view_frag (GF := GF) (M := M) (F := F) i .discard
+              (toAgree (invariant_unfold (GF := GF) P)))).mp) $$ Hauth' with ⟨Hauth1, Hfrag⟩
+        iexists i
+        isplit
+        · ipure_intro; exact hφ
+        · isplitr [Hfrag HownDY]
+          · -- wand for closing
+            iintro HownE
+            iexists (FiniteMap.insert I i P)
+            isplitl [Hauth1]
+            · iexact Hauth1
+            · iapply (wrapEntails (GF := GF) (big_sepM_insert
+                (Φ := fun i Q =>
+                  BIBase.or
+                    (BIBase.sep (BIBase.later Q) (ownD W (GSet.singleton i)))
+                    (ownE W (CoPset.singleton i)))
+                (m := I) (i := i) (x := P) hnone).mpr)
+              isplitl [HownE]
+              · iright; iexact HownE
+              · iexact Hbig
+          · -- ownI ∗ ownD
+            isplitl [Hfrag]
+            · simpa [ownI] using Hfrag
+            · simpa [ownD] using HownDY
+      · -- build the update on the auth map
+        iapply (wrapEntails (GF := GF) (iOwn_update (GF := GF) (F := InvF GF M F) (γ := W.invariant_name)
+          (a := gmap_view_auth (GF := GF) (M := M) (F := F) (.own one)
+            (inv_map (GF := GF) I))
+          (a' := gmap_view_auth (GF := GF) (M := M) (F := F) (.own one)
+              (inv_map (GF := GF) (FiniteMap.insert I i P)) •
+            gmap_view_frag (GF := GF) (M := M) (F := F) i .discard
+              (toAgree (invariant_unfold (GF := GF) P)))
+          (inv_auth_alloc (I := I) (i := i) (P := P) hnone)))
+        iexact Hauth
+    · -- update the disabled tokens
+      iapply (wrapEntails (GF := GF) (iOwn_updateP (GF := GF) (F := COFE.constOF GSetDisj) (γ := W.disabled_name)
+        (a := GSetDisj.gset (∅ : GSet))
+        (P := fun Y => ∃ i, Y = GSetDisj.gset (GSet.singleton i) ∧
+          (FiniteMap.get? I i = none ∧ φ i))
+        (gset_disj_alloc_empty_updateP_strong'
+          (P := fun i => FiniteMap.get? I i = none ∧ φ i) Hfresh')))
+      simpa [ownD] using HownD0
+  · iapply (ownD_emptyE (W := W))
+    iemp_intro
+
+/-! ## Initial World -/
+
+/-- Allocate the initial world satisfaction and top-level enabled mask.
+    This is the entry point: from nothing, produce `wsat ∗ ownE ⊤`. -/
+theorem wsat_alloc :
+    (BIBase.emp : IProp GF) ⊢
+      BUpd.bupd (BIBase.exists fun W' : WsatGS GF =>
+        BIBase.sep (wsat (GF := GF) (M := M) (F := F) W') (ownE W' CoPset.top)) := by
+  classical
+  -- allocate the three ghost cells
+  let aI :=
+    gmap_view_auth (GF := GF) (M := M) (F := F) (.own one)
+      (inv_map (GF := GF) (∅ : M (IPropU GF)))
+  let aE : CoPsetDisj := CoPsetDisj.coPset CoPset.top
+  let aD : GSetDisj := GSetDisj.gset (∅ : GSet)
+  have hI : ✓ aI := by
+    simpa [aI, gmap_view_auth] using
+      (HeapView.auth_one_valid (F := F) (H := M)
+        (m1 := inv_map (GF := GF) (∅ : M (IPropU GF))))
+  have hE : ✓ aE := by
+    simp [aE, CMRA.Valid]
+  have hD : ✓ aD := by
+    simp [aD, CMRA.Valid]
+
+  refine emp_sep.mpr.trans <|
+    (sep_mono (iOwn_alloc (GF := GF) (F := COFE.constOF GSetDisj) aD hD) .rfl).trans ?_
+  refine emp_sep.mpr.trans <|
+    (sep_mono (iOwn_alloc (GF := GF) (F := COFE.constOF CoPsetDisj) aE hE) .rfl).trans ?_
+  refine emp_sep.mpr.trans <|
+    (sep_mono (iOwn_alloc (GF := GF) (F := InvF GF M F) aI hI) .rfl).trans ?_
+
+  -- combine the bupds
+  refine ((@sep_mono (PROP := IProp GF)) .rfl (sep_assoc (PROP := IProp GF)).2).trans ?_
+  refine ((@sep_mono (PROP := IProp GF)) .rfl sep_emp.mp).trans ?_
+  refine ((@sep_mono (PROP := IProp GF)) .rfl bupd_sep).trans ?_
+  refine (bupd_sep (PROP := IProp GF)).trans ?_
+
+  refine (BIUpdate.mono (PROP := IProp GF) ?_)
+  istart
+  iintro Halloc
+  icases Halloc with ⟨HγI, Hrest⟩
+  icases HγI with ⟨%γI, HγI⟩
+  icases Hrest with ⟨HγE, HγD⟩
+  icases HγE with ⟨%γE, HγE⟩
+  icases HγD with ⟨%γD, HγD⟩
+  haveI : CMRA.CoreId aD := by
+    refine ⟨by rfl⟩
+  icases HγD with #HγD
+  let W' : WsatGS GF := { invariant_name := γI, enabled_name := γE, disabled_name := γD }
+  iexists W'
+  isplitr [HγE]
+  · -- wsat for the empty map
+    iexists (∅ : M (IPropU GF))
+    isplitl [HγI]
+    · iexact HγI
+    · simp [big_sepM_empty]
+      iemp_intro
+  · -- enabled mask at top
+    simp [ownE]
+    iexact HγE
+
+end Iris.BaseLogic
diff --git a/src/Iris/ProgramLogic/Adequacy.lean b/src/Iris/ProgramLogic/Adequacy.lean
new file mode 100644
index 00000000..c2a4b595
--- /dev/null
+++ b/src/Iris/ProgramLogic/Adequacy.lean
@@ -0,0 +1,25 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.ProgramLogic.Adequacy.ThreadPool
+import Iris.ProgramLogic.Adequacy.WptpHelpersA
+import Iris.ProgramLogic.Adequacy.WptpHelpersB
+import Iris.ProgramLogic.Adequacy.WptpHelpersC
+import Iris.ProgramLogic.Adequacy.FUpd
+import Iris.ProgramLogic.Adequacy.WpStep
+import Iris.ProgramLogic.Adequacy.WptpStep
+import Iris.ProgramLogic.Adequacy.Preservation
+import Iris.ProgramLogic.Adequacy.Adequate
+import Iris.ProgramLogic.Adequacy.StrongAdequacy
+import Iris.ProgramLogic.Adequacy.SimplifiedAdequacy
+import Iris.ProgramLogic.Adequacy.Invariance
+
+/-! # Adequacy
+
+Reference: `iris/program_logic/adequacy.v`
+
+This file re-exports the adequacy development, which is split across
+smaller submodules to keep each file within the project size limits.
+-/
diff --git a/src/Iris/ProgramLogic/Adequacy/Adequate.lean b/src/Iris/ProgramLogic/Adequacy/Adequate.lean
new file mode 100644
index 00000000..f627cf02
--- /dev/null
+++ b/src/Iris/ProgramLogic/Adequacy/Adequate.lean
@@ -0,0 +1,105 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.ProgramLogic.Adequacy.Preservation
+
+/-! # Adequacy: Adequate Records
+
+Reference: `iris/program_logic/adequacy.v`
+
+This file defines the adequacy record and its basic characterizations.
+-/
+
+namespace Iris.ProgramLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI Iris.BaseLogic
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M]
+variable [FiniteMapLaws Positive M] [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+variable {Λ : Language}
+variable [inst : IrisGS Λ GF]
+variable {W : WsatGS GF}
+/-! ## Adequate -/
+
+/-- The adequacy record: a program `e1` starting in state `σ1` is adequate
+if (1) whenever it reduces to a value, the postcondition holds, and
+(2) it is never stuck (when `s = NotStuck`).
+Coq: `adequate` record in `adequacy.v`. -/
+structure Adequate (s : Stuckness) (e1 : Λ.expr) (σ1 : Λ.state)
+    (φ : Λ.val → Λ.state → Prop) : Prop where
+  /-- If the main thread terminates with value `v2` in state `σ2`, then `φ v2 σ2`. -/
+  adequate_result : ∀ t2 σ2 v2,
+    rtc (erased_step (Λ := Λ)) ([e1], σ1) (Λ.of_val v2 :: t2, σ2) →
+    φ v2 σ2
+  /-- If `s = NotStuck`, every reachable expression is not stuck. -/
+  adequate_not_stuck : ∀ t2 σ2 e2,
+    s = .notStuck →
+    rtc (erased_step (Λ := Λ)) ([e1], σ1) (t2, σ2) →
+    e2 ∈ t2 → not_stuck e2 σ2
+
+/-- Alternative characterization of adequacy.
+Coq: `adequate_alt` in `adequacy.v`. -/
+theorem adequate_alt (s : Stuckness) (e1 : Λ.expr) (σ1 : Λ.state)
+    (φ : Λ.val → Λ.state → Prop) :
+    Adequate s e1 σ1 φ ↔
+    ∀ t2 σ2,
+      rtc (erased_step (Λ := Λ)) ([e1], σ1) (t2, σ2) →
+        (∀ v2 t2', t2 = Λ.of_val v2 :: t2' → φ v2 σ2) ∧
+        (∀ e2, s = .notStuck → e2 ∈ t2 → not_stuck e2 σ2) :=
+  by
+    -- unfold the record and rearrange the quantifiers
+    constructor
+    · intro had t2 σ2 hrtc
+      refine ⟨?_, ?_⟩
+      · intro v2 t2' ht2
+        exact had.adequate_result t2' σ2 v2 (by simpa [ht2] using hrtc)
+      · intro e2 hs hemem
+        exact had.adequate_not_stuck t2 σ2 e2 hs hrtc hemem
+    · intro h
+      refine ⟨?_, ?_⟩
+      · intro t2 σ2 v2 hrtc
+        have h' := h (Λ.of_val v2 :: t2) σ2 hrtc
+        exact (h'.1 v2 t2 rfl)
+      · intro t2 σ2 e2 hs hrtc hemem
+        exact (h t2 σ2 hrtc).2 e2 hs hemem
+
+/-- Thread pool type safety: an adequate program either all threads
+have terminated or the pool can take another step.
+Coq: `adequate_tp_safe` in `adequacy.v`. -/
+theorem adequate_tp_safe (e1 : Λ.expr) (t2 : List Λ.expr) (σ1 σ2 : Λ.state)
+    (φ : Λ.val → Λ.state → Prop)
+    (had : Adequate (Λ := Λ) .notStuck e1 σ1 φ)
+    (hsteps : rtc (erased_step (Λ := Λ)) ([e1], σ1) (t2, σ2)) :
+    (∀ e, e ∈ t2 → ∃ v, Λ.to_val e = some v) ∨
+    ∃ t3 σ3, erased_step (Λ := Λ) (t2, σ2) (t3, σ3) :=
+  by
+    -- either all threads are values, or pick a non-value and step it
+    classical
+    by_cases hval : ∀ e, e ∈ t2 → ∃ v, Λ.to_val e = some v
+    · exact Or.inl hval
+    · have hnot : ∃ e, e ∈ t2 ∧ ∀ v, Λ.to_val e ≠ some v := by
+        -- extract a counterexample to the value predicate
+        simpa [Classical.not_forall, not_exists, Decidable.not_imp_iff_and_not] using hval
+      rcases hnot with ⟨e2, hemem, hnv⟩
+      have hns := had.adequate_not_stuck t2 σ2 e2 rfl hsteps hemem
+      rcases hns with ⟨v, hv⟩ | hred
+      · exact False.elim (hnv v hv)
+      · rcases hred with ⟨κ, e3, σ3, efs, hprim⟩
+        rcases mem_split hemem with ⟨t1, t2', ht2⟩
+        refine Or.inr ⟨t1 ++ e3 :: t2' ++ efs, σ3, ?_⟩
+        refine ⟨κ, ?_⟩
+        simpa [ht2, List.append_assoc] using
+          (step.step_atomic (Λ := Λ) (e1 := e2) (σ1 := σ2)
+            (e2 := e3) (σ2 := σ3) (efs := efs) (t1 := t1) (t2 := t2')
+            (κ := κ) hprim)
+
+
+end Iris.ProgramLogic
diff --git a/src/Iris/ProgramLogic/Adequacy/FUpd.lean b/src/Iris/ProgramLogic/Adequacy/FUpd.lean
new file mode 100644
index 00000000..f53f2b4c
--- /dev/null
+++ b/src/Iris/ProgramLogic/Adequacy/FUpd.lean
@@ -0,0 +1,468 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.ProgramLogic.Adequacy.ThreadPool
+
+/-! # Adequacy: Fancy-Update Helpers
+
+Reference: `iris/program_logic/adequacy.v`
+
+This file defines the local fancy-update helpers and the step-indexed
+`step_fupdN` modality used in adequacy.
+-/
+
+namespace Iris.ProgramLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI Iris.BaseLogic
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M]
+variable [FiniteMapLaws Positive M] [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+variable {Λ : Language}
+variable [inst : IrisGS Λ GF]
+variable {W : WsatGS GF}
+
+/-- Alias exposing `W` for local `BIFUpdate` instances. -/
+abbrev IPropWsatW (_W : WsatGS GF) : Type _ := IPropWsat GF M F
+
+noncomputable instance instBIFUpdateIPropW (W : WsatGS GF) :
+    BIFUpdate (IPropWsatW (GF := GF) (M := M) (F := F) W) Positive :=
+  Iris.BaseLogic.instBIFUpdateIProp (GF := GF) (M := M) (F := F) (W := W)
+
+noncomputable instance instBIFUpdatePlainlyIPropW (W : WsatGS GF) :
+    @BIFUpdatePlainly (IPropWsatW (GF := GF) (M := M) (F := F) W) Positive _
+      (instBIFUpdateIPropW (GF := GF) (M := M) (F := F) (W := W)) _ := by
+  simpa [IPropWsatW] using
+    (Iris.BaseLogic.instBIFUpdatePlainlyIProp (GF := GF) (M := M) (F := F) (W := W))
+/-! ## FUpd Helpers -/
+
+omit [FiniteMapLaws Positive M] in
+theorem fupd_intro (E : Iris.Set Positive) (P : IProp GF) :
+    P ⊢ fupd' (W := W) (M := M) (F := F) E E P := by
+  -- introduce a nested update and then collapse it
+  have hsubset : Subset E E := by
+    intro _ h; exact h
+  have hintro :=
+    Iris.BaseLogic.fupd_intro_mask (W := W)
+      (M := M) (F := F) (E1 := E) (E2 := E) hsubset (P := P)
+  exact hintro.trans <|
+    Iris.BaseLogic.fupd_trans (W := W)
+      (M := M) (F := F) (E1 := E) (E2 := E) (E3 := E) (P := P)
+
+omit [FiniteMapLaws Positive M] in
+theorem fupd_intro_univ_empty (P : IProp GF) :
+    P ⊢ fupd' (W := W) (M := M) (F := F) Iris.Set.univ maskEmpty P := by
+  -- open to the empty mask, shrink, then compose
+  have hsubset : Subset maskEmpty Iris.Set.univ := by
+    intro _ h; exact False.elim h
+  have hopen :=
+    Iris.BaseLogic.fupd_intro_mask (W := W)
+      (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := maskEmpty) hsubset (P := P)
+  have hshrink :
+      fupd' (W := W) (M := M) (F := F) maskEmpty Iris.Set.univ P ⊢
+        fupd' (W := W) (M := M) (F := F) maskEmpty maskEmpty P :=
+    Iris.BaseLogic.fupd_plain_mask (W := W)
+      (M := M) (F := F) (E1 := maskEmpty) (E2 := Iris.Set.univ) hsubset (P := P)
+  have hmono :
+      fupd' (W := W) (M := M) (F := F) Iris.Set.univ maskEmpty
+          (fupd' (W := W) (M := M) (F := F) maskEmpty Iris.Set.univ P) ⊢
+        fupd' (W := W) (M := M) (F := F) Iris.Set.univ maskEmpty
+          (fupd' (W := W) (M := M) (F := F) maskEmpty maskEmpty P) :=
+    Iris.BaseLogic.fupd_mono (W := W)
+      (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := maskEmpty)
+      (P := fupd' (W := W) (M := M) (F := F) maskEmpty Iris.Set.univ P)
+      (Q := fupd' (W := W) (M := M) (F := F) maskEmpty maskEmpty P) hshrink
+  exact hopen.trans (hmono.trans <|
+    Iris.BaseLogic.fupd_trans (W := W)
+      (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := maskEmpty)
+      (E3 := maskEmpty) (P := P))
+
+set_option linter.unusedVariables false in
+noncomputable def step_fupdN {Λ : Language} {W : WsatGS GF} (n : Nat) (P : IProp GF) :
+    IProp GF :=
+  -- iterate the Coq-style step-fupd: `|={E}=> ▷ |={E}=>` `n` times
+  Nat.rec P
+    (fun _ Q =>
+      fupd' (W := W) (M := M) (F := F) Iris.Set.univ Iris.Set.univ <|
+        BIBase.later
+          (fupd' (W := W) (M := M) (F := F) Iris.Set.univ Iris.Set.univ Q))
+    n
+
+omit [FiniteMapLaws Positive M] inst in
+/-- Adequacy-local `step_fupdN_plain` specialized to the top mask.
+
+    Coq: `step_fupdN_plain` in `updates.v`. -/
+theorem step_fupdN_plain {W : WsatGS GF} (n : Nat) (P : IProp GF) [Plain P] :
+    step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P ⊢
+      fupd' (W := W) (M := M) (F := F) Iris.Set.univ Iris.Set.univ
+        (BIBase.laterN (PROP := IProp GF) n (BIBase.except0 (PROP := IProp GF) P)) := by
+  -- unfold to the BI step-fupd chain and apply the generic lemma
+  simpa [IPropWsatW, Iris.BaseLogic.IPropWsat, step_fupdN, Iris.step_fupdN, fupd'] using
+    (Iris.step_fupdN_plain (PROP := IPropWsatW (GF := GF) (M := M) (F := F) W)
+      (MASK := Positive)
+      (Eo := Iris.Set.univ) (Ei := Iris.Set.univ) (n := n) (P := P))
+
+omit [FiniteMapLaws Positive M] inst in
+/-- Helper: lift `step_fupdN_plain` through an outer `fupd`. -/
+theorem step_fupdN_plain_fupd {W : WsatGS GF} (n : Nat) (P : IProp GF) [Plain P] :
+    uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+        (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P) ⊢
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+        (BIBase.laterN (PROP := IProp GF) n (BIBase.except0 (PROP := IProp GF) P)) := by
+  -- push the plain step-fupd under the outer update
+  have hmono :=
+    Iris.BaseLogic.fupd_mono (W := W)
+      (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+      (P := step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P)
+      (Q := uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+        (BIBase.laterN (PROP := IProp GF) n (BIBase.except0 (PROP := IProp GF) P)))
+      (step_fupdN_plain (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (n := n) (P := P))
+  have htrans :=
+    Iris.BaseLogic.fupd_trans (W := W)
+      (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+      (E3 := Iris.Set.univ)
+      (P := BIBase.laterN (PROP := IProp GF) n (BIBase.except0 (PROP := IProp GF) P))
+  exact hmono.trans htrans
+
+omit [FiniteMapLaws Positive M] inst in
+/-- Introduce the `step_fupdN` chain from a plain goal. -/
+theorem step_fupdN_intro {W : WsatGS GF} (n : Nat) (P : IProp GF) :
+    P ⊢ step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P := by
+  -- iterate fupd/later introductions along the recursion
+  induction n with
+  | zero =>
+      dsimp [step_fupdN]
+      exact BIBase.Entails.rfl
+  | succ n ih =>
+      have hinner :
+          P ⊢ uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+            (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P) :=
+        ih.trans (fupd_intro (W := W) (M := M) (F := F)
+          (E := Iris.Set.univ)
+          (P := step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P))
+      have hlater :
+          P ⊢ BIBase.later
+            (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+              (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P)) :=
+        hinner.trans (later_intro (PROP := IProp GF))
+      have houter :
+          P ⊢ uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+            (BIBase.later
+              (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+                (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P))) :=
+        hlater.trans (fupd_intro (W := W) (M := M) (F := F)
+          (E := Iris.Set.univ)
+          (P := BIBase.later
+            (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+              (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P))))
+      simpa [step_fupdN] using houter
+
+omit [FiniteMapLaws Positive M] inst in
+theorem step_fupdN_mono {W : WsatGS GF} (n : Nat) {P Q : IProp GF} (h : P ⊢ Q) :
+    step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P ⊢
+      step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n Q := by
+  -- recurse on `n`, pushing entailment through the step-fupd chain
+  induction n with
+  | zero =>
+      simpa [step_fupdN] using h
+  | succ n ih =>
+      -- push the entailment through the inner and outer fupd layers
+      have hinner :
+          uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+              (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P) ⊢
+            uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+              (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n Q) :=
+        Iris.BaseLogic.fupd_mono (W := W)
+          (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+          (P := step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P)
+          (Q := step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n Q) ih
+      have hlater :
+          BIBase.later
+              (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+                (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P)) ⊢
+            BIBase.later
+              (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+                (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n Q)) :=
+        later_mono (PROP := IProp GF) hinner
+      have houter :=
+        Iris.BaseLogic.fupd_mono (W := W)
+          (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+          (P := BIBase.later
+            (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+              (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P)))
+          (Q := BIBase.later
+            (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+              (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n Q))) hlater
+      simpa [step_fupdN] using houter
+
+omit [FiniteMapLaws Positive M] inst in
+theorem step_fupdN_frame_r_later {W : WsatGS GF} (n : Nat) (P Q : IProp GF)
+    (ih :
+      BIBase.sep (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P) Q ⊢
+        step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n (BIBase.sep P Q)) :
+    BIBase.sep
+        (BIBase.later
+          (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+            (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P))) Q ⊢
+      BIBase.later
+        (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n
+            (BIBase.sep P Q))) := by
+  -- move `later` across `sep`, then frame under the inner fupd
+  have hsep :
+      BIBase.sep
+          (BIBase.later
+            (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+              (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P))) Q ⊢
+        BIBase.later
+          (BIBase.sep
+            (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+              (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P)) Q) :=
+    (sep_mono (PROP := IProp GF) .rfl later_intro).trans
+      (later_sep (PROP := IProp GF)).2
+  have hframe :
+      BIBase.sep
+          (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+            (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P)) Q ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n
+            (BIBase.sep P Q)) := by
+    -- frame the inner fupd and apply the induction hypothesis
+    refine (Iris.BaseLogic.fupd_frame_r (W := W)
+      (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+      (P := step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P)
+      (Q := Q)).trans ?_
+    exact Iris.BaseLogic.fupd_mono (W := W)
+      (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+      (P := BIBase.sep
+        (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P) Q)
+      (Q := step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n
+        (BIBase.sep P Q)) ih
+  exact hsep.trans (later_mono (PROP := IProp GF) hframe)
+
+omit [FiniteMapLaws Positive M] inst in
+theorem step_fupdN_frame_r {W : WsatGS GF} (n : Nat) (P Q : IProp GF) :
+    BIBase.sep (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P) Q ⊢
+      step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n (BIBase.sep P Q) := by
+  induction n with -- push framing under each `step_fupdN` layer
+  | zero =>
+      -- base: `step_fupdN 0` is identity
+      dsimp [step_fupdN]
+      exact BIBase.Entails.rfl
+  | succ n ih =>
+      have hinside :=
+        step_fupdN_frame_r_later (GF := GF) (M := M) (F := F) (W := W)
+          (n := n) (P := P) (Q := Q) ih
+      have hframe :=
+        Iris.BaseLogic.fupd_frame_r (W := W)
+          (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+          (P := BIBase.later
+            (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+              (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P)))
+          (Q := Q)
+      have hmono :=
+        Iris.BaseLogic.fupd_mono (W := W)
+          (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+          (P := BIBase.sep
+            (BIBase.later
+              (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+                (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P))) Q)
+          (Q := BIBase.later
+            (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+              (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n
+                (BIBase.sep P Q))))
+          hinside
+      simpa [step_fupdN] using hframe.trans hmono
+
+/-! ## Plain Step-FUpd Rewrites -/
+
+omit [FiniteMapLaws Positive M] inst in
+/-- `step_fupdN` commutes with a final `fupd` once a step is taken.
+
+    Coq: `step_fupdN_S_fupd` in `updates.v`. -/
+theorem step_fupdN_succ_fupd {W : WsatGS GF} (n : Nat) (P : IProp GF) :
+    step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) (n + 1) P ⊣⊢
+      step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) (n + 1)
+        (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ P) := by
+  -- lift `step_fupd_fupd` through the iterated step-fupd chain
+  induction n with
+  | zero =>
+      simpa [IPropWsatW, Iris.BaseLogic.IPropWsat, step_fupdN, Iris.step_fupdN, fupd'] using
+        (Iris.step_fupd_fupd (PROP := IPropWsatW (GF := GF) (M := M) (F := F) W)
+          (MASK := Positive)
+          (Eo := Iris.Set.univ) (Ei := Iris.Set.univ) (P := P))
+  | succ n ih =>
+      constructor
+      · -- forward direction: apply monotonicity under one outer step
+        have hmono :=
+          Iris.step_fupd_mono (PROP := IPropWsatW (GF := GF) (M := M) (F := F) W)
+            (MASK := Positive)
+            (Eo := Iris.Set.univ) (Ei := Iris.Set.univ)
+            (P := step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+              (n + 1) P)
+            (Q := step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+              (n + 1)
+              (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ P)) ih.1
+        simpa [IPropWsatW, Iris.BaseLogic.IPropWsat, step_fupdN, Iris.step_fupdN, fupd'] using hmono
+      · -- backward direction: apply monotonicity under one outer step
+        have hmono :=
+          Iris.step_fupd_mono (PROP := IPropWsatW (GF := GF) (M := M) (F := F) W)
+            (MASK := Positive)
+            (Eo := Iris.Set.univ) (Ei := Iris.Set.univ)
+            (P := step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+              (n + 1)
+              (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ P))
+            (Q := step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+              (n + 1) P) ih.2
+        simpa [IPropWsatW, Iris.BaseLogic.IPropWsat, step_fupdN, Iris.step_fupdN, fupd'] using hmono
+
+omit [FiniteMapLaws Positive M] inst in
+/-- Strip a final `fupd` inside a non-zero `step_fupdN` chain for plain goals. -/
+theorem step_fupdN_strip_fupd {W : WsatGS GF} (n : Nat) (P : IProp GF) [Plain P] :
+    step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) (n + 1)
+        (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty P) ⊢
+      step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) (n + 1) P := by
+  -- eliminate the final `fupd` using plainness
+  have hmask :
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty P ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ P :=
+    Iris.fupd_plain_mask (PROP := IPropWsatW (GF := GF) (M := M) (F := F) W)
+      (MASK := Positive)
+      (E := Iris.Set.univ) (E' := maskEmpty) (P := P)
+  have hmono :=
+    step_fupdN_mono (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (n := n + 1) hmask
+  exact hmono.trans
+    (step_fupdN_succ_fupd (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (W := W) (n := n) (P := P)).2
+
+omit [FiniteMapLaws Positive M] inst in
+/-- Lift `step_fupdN_strip_fupd` through an outer `fupd`. -/
+theorem fupd_step_fupdN_strip_fupd {W : WsatGS GF} (n : Nat) (P : IProp GF) [Plain P] :
+    uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+        (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) (n + 1)
+          (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty P)) ⊢
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+        (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) (n + 1) P) := by
+  -- apply `fupd_mono` to the stripped chain
+  exact Iris.BaseLogic.fupd_mono (W := W)
+    (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+    (P := step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) (n + 1)
+      (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty P))
+    (Q := step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) (n + 1) P)
+    (step_fupdN_strip_fupd (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (W := W) (n := n) (P := P))
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Helper: strip `▷^[n]` from `True` using `later_soundness`. -/
+theorem laterN_soundness (n : Nat) (P : IProp GF)
+    (h : (True : IProp GF) ⊢ BIBase.laterN (PROP := IProp GF) n P) :
+    (True : IProp GF) ⊢ P := by
+  -- iterate the single-step `later_soundness`
+  induction n with
+  | zero =>
+      simpa [BIBase.laterN] using h
+  | succ n ih =>
+      have hstep :
+          (True : IProp GF) ⊢
+            BIBase.later (BIBase.laterN (PROP := IProp GF) n P) := by
+        simpa [BIBase.laterN] using h
+      have hnext :
+          (True : IProp GF) ⊢ BIBase.laterN (PROP := IProp GF) n P :=
+        UPred.later_soundness hstep
+      exact ih hnext
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+/-- Helper: turn `▷^[n] ◇ P` into `▷^[n+1] P`. -/
+theorem laterN_except0_to_later (n : Nat) (P : IProp GF) :
+    BIBase.laterN (PROP := IProp GF) n (BIBase.except0 (PROP := IProp GF) P) ⊢
+      BIBase.laterN (PROP := IProp GF) (n + 1) P := by
+  -- push `◇` through `laterN`, then re-associate one extra `▷`
+  have hmono :
+      BIBase.laterN (PROP := IProp GF) n (BIBase.except0 (PROP := IProp GF) P) ⊢
+        BIBase.laterN (PROP := IProp GF) n (BIBase.later (PROP := IProp GF) P) :=
+    laterN_mono (PROP := IProp GF) n (except0_into_later (PROP := IProp GF))
+  exact hmono.trans
+    (laterN_later (PROP := IProp GF) (n := n) (P := P)).2
+
+omit [FiniteMapLaws Positive M] inst in
+/-- Strip a `step_fupdN` chain to obtain `▷^[n] ◇ P`. -/
+theorem step_fupdN_soundness_later (P : IProp GF) [Plain P] (n : Nat)
+    [FiniteMapLaws Positive M]
+    (h : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P)) :
+    (BIBase.emp : IProp GF) ⊢
+      BIBase.laterN (PROP := IProp GF) n (BIBase.except0 (PROP := IProp GF) P) := by
+  -- lift the plain step-fupd under `fupd`, then apply soundness
+  haveI : Plain (BIBase.except0 (PROP := IProp GF) P) := ⟨plain_except0 (P := P)⟩
+  haveI :
+      Plain (BIBase.laterN (PROP := IProp GF) n (BIBase.except0 (PROP := IProp GF) P)) :=
+    ⟨plain_laterN (P := BIBase.except0 (PROP := IProp GF) P) n⟩
+  have hstep :
+      ∀ W : WsatGS GF,
+        (BIBase.emp : IProp GF) ⊢
+          uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+            (BIBase.laterN (PROP := IProp GF) n (BIBase.except0 (PROP := IProp GF) P)) := by
+    intro W
+    exact (h W).trans (step_fupdN_plain_fupd (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (W := W) (n := n) (P := P))
+  have instFML : FiniteMapLaws Positive M := inferInstance
+  exact fupd_soundness_no_lc (M := M) (F := F) (GF := GF)
+    (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+    (P := BIBase.laterN (PROP := IProp GF) n (BIBase.except0 (PROP := IProp GF) P))
+    (h := hstep)
+
+omit inst in
+/-- Soundness: extract a plain proposition from the step-fupd chain. -/
+theorem step_fupdN_soundness (P : IProp GF) [Plain P] (n : Nat)
+    (h : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n P)) :
+    (BIBase.emp : IProp GF) ⊢ P := by
+  -- use plain step-fupd soundness, then strip the remaining laters
+  have hlate :
+      (BIBase.emp : IProp GF) ⊢
+        BIBase.laterN (PROP := IProp GF) n (BIBase.except0 (PROP := IProp GF) P) :=
+    step_fupdN_soundness_later (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (P := P) (n := n) (h := h)
+  have hnext :
+      (BIBase.emp : IProp GF) ⊢
+        BIBase.laterN (PROP := IProp GF) (n + 1) P :=
+    hlate.trans (laterN_except0_to_later (n := n) (P := P))
+  have htrue :
+      (True : IProp GF) ⊢ BIBase.laterN (PROP := IProp GF) (n + 1) P :=
+    (true_emp (PROP := IProp GF)).1.trans hnext
+  have hP : (True : IProp GF) ⊢ P :=
+    laterN_soundness (n := n + 1) (P := P) htrue
+  exact (true_emp (PROP := IProp GF)).2.trans hP
+
+omit inst in
+/-- Soundness step: peel one `step_fupdN` layer and rebuild the chain. -/
+theorem step_fupdN_soundness_step (P : IProp GF) [Plain P] (n : Nat)
+    (h : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) (n + 1) P)) :
+    (BIBase.emp : IProp GF) ⊢ step_fupdN (Λ := Λ) (GF := GF) (M := M)
+      (F := F) (W := W) n P := by
+  -- strip to `P` and re-introduce the chain
+  have hP :
+      (BIBase.emp : IProp GF) ⊢ P :=
+    step_fupdN_soundness (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (P := P) (n := n + 1) (h := h)
+  exact hP.trans (step_fupdN_intro (Λ := Λ) (GF := GF) (M := M) (F := F)
+    (W := W) (n := n) (P := P))
+
+
+end Iris.ProgramLogic
diff --git a/src/Iris/ProgramLogic/Adequacy/Invariance.lean b/src/Iris/ProgramLogic/Adequacy/Invariance.lean
new file mode 100644
index 00000000..4a0084a8
--- /dev/null
+++ b/src/Iris/ProgramLogic/Adequacy/Invariance.lean
@@ -0,0 +1,62 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.ProgramLogic.Adequacy.SimplifiedAdequacy
+
+/-! # Adequacy: Invariance
+
+Reference: `iris/program_logic/adequacy.v`
+
+This file provides the state invariance corollary of adequacy.
+-/
+
+namespace Iris.ProgramLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI Iris.BaseLogic
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M]
+variable [FiniteMapLaws Positive M] [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+variable {Λ : Language}
+variable [inst : IrisGS Λ GF]
+variable {W : WsatGS GF}
+/-! ## Invariance -/
+
+/-- State invariance: if we can prove a WP and extract a property `φ`
+from the final state interpretation, then `φ` holds at the meta-level.
+Coq: `wp_invariance` in `adequacy.v`. -/
+theorem wp_invariance (s : Stuckness) (e1 : Λ.expr) (σ1 : Λ.state)
+    (t2 : List Λ.expr) (σ2 : Λ.state) (φ : Prop)
+    (Hwp : ∀ W : WsatGS GF, ∀ κs : List Λ.observation, ∀ ns : Nat,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ1 0 κs 0)
+            (BIBase.sep
+              (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e1
+                (fun _ => BIBase.pure True))
+              (BIBase.wand
+                (state_interp (Λ := Λ) (GF := GF) σ2 ns [] (t2.length - 1))
+                (BIBase.«exists» fun (_ : Iris.Set Positive) =>
+                  uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty
+                    (BIBase.pure φ))))))
+    (hsteps : rtc (erased_step (Λ := Λ)) ([e1], σ1) (t2, σ2)) :
+    φ :=
+  by
+    -- reduce to `nsteps` and apply strong adequacy with invariance continuation
+    rcases (erased_steps_nsteps (Λ := Λ) ([e1], σ1) (t2, σ2)).1 hsteps
+      with ⟨n, κs, hsteps⟩
+    have Hinv := wp_invariance_inv (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (s := s) (e1 := e1) (σ1 := σ1) (κs := κs)
+      (t2 := t2) (σ2 := σ2) (n := n) (φ := φ) (Hwp := fun W => Hwp W κs n)
+    exact wp_strong_adequacy (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (s := s) (es := [e1]) (σ1 := σ1) (n := n) (κs := κs)
+      (t2 := t2) (σ2 := σ2) (φ := φ) Hinv hsteps
+
+end Iris.ProgramLogic
diff --git a/src/Iris/ProgramLogic/Adequacy/Preservation.lean b/src/Iris/ProgramLogic/Adequacy/Preservation.lean
new file mode 100644
index 00000000..7becc3e1
--- /dev/null
+++ b/src/Iris/ProgramLogic/Adequacy/Preservation.lean
@@ -0,0 +1,665 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.ProgramLogic.Adequacy.WptpStep
+
+/-! # Adequacy: Preservation and Progress
+
+Reference: `iris/program_logic/adequacy.v`
+
+This file proves multi-step preservation, thread-pool progress, and the
+not-stuck consequences for WP.
+-/
+
+namespace Iris.ProgramLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI Iris.BaseLogic
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M]
+variable [FiniteMapLaws Positive M] [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+variable {Λ : Language}
+variable [inst : IrisGS Λ GF]
+variable {W : WsatGS GF}
+/-! ## Multi-Step Preservation -/
+
+/-- Induction hypothesis shape for `wptp_preservation`. -/
+abbrev WptpPreservationIH (s : Stuckness) (n : Nat) (κs' : List Λ.observation) : Prop :=
+  ∀ {es1 es2 : List Λ.expr} {κs : List Λ.observation}
+      {σ1 σ2 : Λ.state} {ns nt : Nat} {Φs : List (Λ.val → IProp GF)},
+    nsteps (Λ := Λ) n (es1, σ1) κs (es2, σ2) →
+      BIBase.sep
+        (IrisGS.state_interp (Λ := Λ) (GF := GF) σ1 ns (κs ++ κs') nt)
+        (wptp (W := W) (M := M) (F := F) (Λ := Λ) s es1 Φs) ⊢
+      step_fupdN (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) n
+        (wptp_post (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+          s es2 Φs σ2 (n + ns) κs' nt)
+
+omit [FiniteMapLaws Positive M] in
+/-- Helper: lift the induction hypothesis under `▷` and merge forked posts. -/
+theorem wptp_preservation_later
+    (s : Stuckness) (n : Nat) (κs_tail κs' : List Λ.observation)
+    (es_mid es2 : List Λ.expr) (σ_mid σ2 : Λ.state)
+    (ns nt : Nat) (Φs : List (Λ.val → IProp GF))
+    (ih : WptpPreservationIH (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s n κs')
+    (hrest : nsteps (Λ := Λ) n (es_mid, σ_mid) κs_tail (es2, σ2)) :
+    BIBase.later
+        (wptp_post (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+          s es_mid Φs σ_mid (ns + 1) (κs_tail ++ κs') nt) ⊢
+      BIBase.later
+        (step_fupdN (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) n
+          (wptp_post (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+            s es2 Φs σ2 (n + (ns + 1)) κs' nt)) := by
+  -- open the existential, apply the IH, then merge forked suffixes
+  refine later_mono ?_
+  refine exists_elim ?_
+  intro nt'
+  have ih' :=
+    ih (es1 := es_mid) (es2 := es2) (κs := κs_tail)
+      (σ1 := σ_mid) (σ2 := σ2)
+      (Φs := Φs ++ List.replicate nt' fork_post)
+      (ns := ns + 1) (nt := nt + nt') hrest
+  have hmerge :=
+    wptp_post_merge (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (es := es2) (Φs := Φs) (σ := σ2)
+      (ns := n + (ns + 1)) (κs := κs') (nt := nt) (nt' := nt')
+  exact (by
+    simpa [List.append_assoc, Nat.add_assoc] using
+      ih'.trans (step_fupdN_mono (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) n hmerge))
+
+omit [FiniteMapLaws Positive M] inst in
+/-- Helper: finish the successor step of `step_fupdN`. -/
+theorem step_fupdN_succ_finish (P mid X : IProp GF) (n : Nat)
+    (hstep' :
+      P ⊢ fupd' (W := W) (M := M) (F := F) Iris.Set.univ Iris.Set.univ
+        (BIBase.later mid))
+    (hmono :
+      BIBase.later mid ⊢
+        BIBase.later
+          (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+            (step_fupdN (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) n X))) :
+    P ⊢ step_fupdN (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) (n + 1) X := by
+  -- push the refinement under the outer `fupd`
+  have hmono' :=
+    Iris.BaseLogic.fupd_mono (W := W)
+      (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+      (P := BIBase.later mid)
+      (Q := BIBase.later
+        (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (step_fupdN (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) n X))) hmono
+  simpa [step_fupdN, Iris.step_fupdN, fupd'] using hstep'.trans hmono'
+
+/-- Helper: precondition for preservation statements. -/
+noncomputable abbrev wptp_preservation_pre
+    (s : Stuckness) (es : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ : Λ.state) (ns : Nat) (κs κs' : List Λ.observation) (nt : Nat) : IProp GF :=
+  -- state interpretation with the pool WP
+  BIBase.sep
+    (IrisGS.state_interp (Λ := Λ) (GF := GF) σ ns (κs ++ κs') nt)
+    (wptp (W := W) (M := M) (F := F) (Λ := Λ) s es Φs)
+
+/-- Helper: postcondition for preservation statements. -/
+noncomputable abbrev wptp_preservation_post
+    (s : Stuckness) (n : Nat) (es : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ : Λ.state) (ns : Nat) (κs' : List Λ.observation) (nt : Nat) : IProp GF :=
+  -- `step_fupdN` wrapped `wptp_post`
+  step_fupdN (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) n
+    (wptp_post (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+      s es Φs σ (n + ns) κs' nt)
+
+omit [FiniteMapLaws Positive M] in
+/-- Helper: single-step `fupd` for the successor case. -/
+theorem wptp_preservation_succ_step
+    (s : Stuckness) (κ κs_tail κs' : List Λ.observation)
+    (es1 es_mid : List Λ.expr) (σ1 σ_mid : Λ.state)
+    (ns nt : Nat) (Φs : List (Λ.val → IProp GF))
+    (hstep : step (Λ := Λ) (es1, σ1) κ (es_mid, σ_mid)) :
+    wptp_preservation_pre (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (s := s) (es := es1) (Φs := Φs) (σ := σ1) (ns := ns)
+        (κs := κ ++ κs_tail) (κs' := κs') (nt := nt) ⊢
+      fupd' (W := W) (M := M) (F := F) Iris.Set.univ Iris.Set.univ
+        (BIBase.later
+          (wptp_post (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+            s es_mid Φs σ_mid (ns + 1) (κs_tail ++ κs') nt)) := by
+  -- specialize `wptp_step'` and rewrite the trace shape
+  simpa [wptp_preservation_pre, List.append_assoc] using
+    wptp_step' (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (es1 := es1) (es2 := es_mid) (κ := κ)
+      (κs := κs_tail ++ κs') (σ1 := σ1) (ns := ns)
+      (σ2 := σ_mid) (nt := nt) (Φs := Φs) hstep
+
+omit [FiniteMapLaws Positive M] in
+/-- Helper: successor step of `wptp_preservation`. -/
+theorem wptp_preservation_succ
+    (s : Stuckness) (n : Nat) (κ κs_tail κs' : List Λ.observation)
+    (es1 es_mid es2 : List Λ.expr) (σ1 σ_mid σ2 : Λ.state)
+    (ns nt : Nat) (Φs : List (Λ.val → IProp GF))
+    (ih : WptpPreservationIH (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s n κs')
+    (hstep : step (Λ := Λ) (es1, σ1) κ (es_mid, σ_mid))
+    (hrest : nsteps (Λ := Λ) n (es_mid, σ_mid) κs_tail (es2, σ2)) :
+    wptp_preservation_pre (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (s := s) (es := es1) (Φs := Φs) (σ := σ1) (ns := ns)
+        (κs := κ ++ κs_tail) (κs' := κs') (nt := nt) ⊢
+      wptp_preservation_post (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (s := s) (n := n + 1) (es := es2) (Φs := Φs) (σ := σ2)
+        (ns := ns) (κs' := κs') (nt := nt) := by
+  -- step once, then lift the induction hypothesis under `▷`
+  have hstep' := wptp_preservation_succ_step (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (κ := κ) (κs_tail := κs_tail) (κs' := κs')
+    (es1 := es1) (es_mid := es_mid) (σ1 := σ1) (σ_mid := σ_mid)
+    (ns := ns) (nt := nt) (Φs := Φs) hstep
+  have hlater :=
+    wptp_preservation_later (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (s := s) (n := n) (κs_tail := κs_tail) (κs' := κs')
+      (es_mid := es_mid) (es2 := es2) (σ_mid := σ_mid) (σ2 := σ2)
+      (ns := ns) (nt := nt) (Φs := Φs) (ih := ih) hrest
+  have hintro :=
+    fupd_intro (W := W) (GF := GF) (M := M) (F := F)
+      (E := Iris.Set.univ)
+      (P := step_fupdN (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) n
+        (wptp_post (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+          s es2 Φs σ2 (n + (ns + 1)) κs' nt))
+  have hmono :=
+    hlater.trans (later_mono (PROP := IProp GF) hintro)
+  simpa [wptp_preservation_post, List.append_assoc, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using
+    (step_fupdN_succ_finish (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (P := _) (mid := _) (X := _) (n := n) hstep' hmono)
+
+omit [FiniteMapLaws Positive M] in
+/-- Multi-step preservation: after `n` steps, the thread pool WP
+and state interpretation are preserved (modulo fupd and later).
+Coq: `wptp_preservation` in `adequacy.v`. -/
+theorem wptp_preservation (s : Stuckness) (n : Nat)
+    (es1 es2 : List Λ.expr) (κs κs' : List Λ.observation)
+    (σ1 : Λ.state) (ns : Nat) (σ2 : Λ.state) (nt : Nat)
+    (Φs : List (Λ.val → IProp GF))
+    (hsteps : nsteps (Λ := Λ) n (es1, σ1) κs (es2, σ2)) :
+    wptp_preservation_pre (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (s := s) (es := es1) (Φs := Φs) (σ := σ1) (ns := ns)
+        (κs := κs) (κs' := κs') (nt := nt) ⊢
+      wptp_preservation_post (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (s := s) (n := n) (es := es2) (Φs := Φs) (σ := σ2)
+        (ns := ns) (κs' := κs') (nt := nt) := by
+  -- induct on the execution trace, generalizing `ns`/`nt`/`Φs`
+  induction n generalizing es1 es2 κs σ1 σ2 Φs ns nt with
+  | zero =>
+      cases hsteps with
+      | nsteps_refl ρ =>
+          refine exists_intro' (a := 0) ?_
+          simp [wptp_preservation_pre,
+            List.append_nil, Nat.add_comm]
+  | succ n ih =>
+      cases hsteps with
+      | nsteps_l n' ρ1 ρ2 ρ3 κ κs_tail hstep hrest =>
+          rcases ρ2 with ⟨es_mid, σ_mid⟩
+          have ih' : WptpPreservationIH (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+              s n κs' := by
+            -- unfold the pre/post abbreviations to match the IH shape
+            intro es1 es2 κs σ1 σ2 ns nt Φs hsteps
+            simpa [wptp_preservation_pre, wptp_preservation_post] using
+              ih (es1 := es1) (es2 := es2) (κs := κs) (σ1 := σ1) (σ2 := σ2)
+                (ns := ns) (nt := nt) (Φs := Φs) hsteps
+          exact wptp_preservation_succ (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+            (s := s) (n := n) (κ := κ) (κs_tail := κs_tail) (κs' := κs')
+            (es1 := es1) (es_mid := es_mid) (es2 := es2)
+            (σ1 := σ1) (σ_mid := σ_mid) (σ2 := σ2)
+            (ns := ns) (nt := nt) (Φs := Φs) (ih := ih') hstep hrest
+
+/-! ## Wptp Progress -/
+
+omit [FiniteMapLaws Positive M] in
+/-- Helper: extract a single-thread WP from a thread pool. -/
+theorem wptp_post_not_stuck_wp_of_get
+    (t1 t2 : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF) (nt' : Nat)
+    (hget : (Φs ++ List.replicate nt' fork_post)[t1.length]? = some Φ) :
+    wptp (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) .notStuck
+        (t1 ++ e2 :: t2) (Φs ++ List.replicate nt' fork_post) ⊢
+      wp (W := W) (M := M) (F := F) (Λ := Λ) .notStuck Iris.Set.univ e2 Φ := by
+  -- peel `wptp` to the middle component and project the WP
+  have hbody := wptp_body_of_wptp (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+    (s := .notStuck) (es := t1 ++ e2 :: t2) (Φs := Φs ++ List.replicate nt' fork_post)
+  have hmid :=
+    (wptp_body_at_middle (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (s := .notStuck) (t1 := t1) (t2 := t2) (e := e2)
+      (Φs := Φs ++ List.replicate nt' fork_post) (k := 0) (Φ := Φ)
+      (by simpa [Nat.zero_add] using hget)).1
+  have hsep := hbody.trans (by simpa using hmid)
+  let A :=
+    big_sepL (PROP := IProp GF)
+      (wptp_body_at_fn (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        .notStuck (Φs ++ List.replicate nt' fork_post) 0) t1
+  let C :=
+    big_sepL (PROP := IProp GF)
+      (wptp_body_at_fn (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        .notStuck (Φs ++ List.replicate nt' fork_post) (t1.length + 1)) t2
+  have hsep' :
+      wptp (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) .notStuck
+          (t1 ++ e2 :: t2) (Φs ++ List.replicate nt' fork_post) ⊢
+        BIBase.sep A
+          (BIBase.sep
+            (wp (W := W) (M := M) (F := F) (Λ := Λ) .notStuck Iris.Set.univ e2 Φ) C) := by
+    -- unfold `wptp_body_at` to align with `sep_elim`
+    simpa [A, C, wptp_body_at_unfold] using hsep
+  exact (hsep'.trans <|
+    sep_elim_r (PROP := IProp GF) (P := A) (Q := BIBase.sep
+      (wp (W := W) (M := M) (F := F) (Λ := Λ) .notStuck Iris.Set.univ e2 Φ) C)).trans
+    (sep_elim_l (PROP := IProp GF)
+      (P := wp (W := W) (M := M) (F := F) (Λ := Λ) .notStuck Iris.Set.univ e2 Φ)
+      (Q := C))
+
+/-! ## Not Stuck -/
+
+omit [FiniteMapLaws Positive M] in
+/-- Helper: map reducibility to `not_stuck` in the step case. -/
+theorem wp_not_stuck_step_mono (e : Λ.expr) (σ : Λ.state) (ns : Nat)
+    (κs : List Λ.observation) (nt : Nat) (Φ : Λ.val → IProp GF) :
+    BIBase.sep (BIBase.pure (reducible e σ))
+        (wp_step_cont (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+          (s := .notStuck) (e1 := e) (σ1 := σ) (κ := [])
+          (Φ := Φ) (ns := ns) (κs := κs) (nt := nt)) ⊢
+      BIBase.pure (not_stuck e σ) := by
+  -- drop the continuation and lift reducibility into `not_stuck`
+  exact (sep_elim_l (P := BIBase.pure (reducible e σ))
+    (Q := wp_step_cont (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (s := .notStuck) (e1 := e) (σ1 := σ) (κ := [])
+      (Φ := Φ) (ns := ns) (κs := κs) (nt := nt))).trans
+    (pure_mono fun h => Or.inr h)
+
+omit [FiniteMapLaws Positive M] in
+/-- Helper: WP not-stuck in the value case. -/
+theorem wp_not_stuck_value (e : Λ.expr) (σ : Λ.state) (ns : Nat)
+    (κs : List Λ.observation) (nt : Nat) (Φ : Λ.val → IProp GF)
+    (v : Λ.val) (hto : Λ.to_val e = some v) :
+    BIBase.sep
+        (IrisGS.state_interp (Λ := Λ) (GF := GF) σ ns κs nt)
+        (wp (W := W) (M := M) (F := F) (Λ := Λ) .notStuck Iris.Set.univ e Φ)
+      ⊢ uPred_fupd (M := M) (F := F) W
+          Iris.Set.univ (fun _ => False) (BIBase.pure (not_stuck e σ)) := by
+  -- discharge using pure introduction and `fupd` intro
+  have hns : not_stuck e σ := Or.inl ⟨v, hto⟩
+  have hpure :
+      wp (W := W) (M := M) (F := F) (Λ := Λ) .notStuck Iris.Set.univ e Φ ⊢
+        BIBase.pure (not_stuck e σ) := pure_intro hns
+  exact (sep_elim_r
+    (P := IrisGS.state_interp (Λ := Λ) (GF := GF) σ ns κs nt)
+    (Q := wp (W := W) (M := M) (F := F) (Λ := Λ) .notStuck Iris.Set.univ e Φ)).trans <|
+    hpure.trans (fupd_intro_univ_empty (W := W) (GF := GF) (M := M) (F := F)
+      (P := BIBase.pure (not_stuck e σ)))
+
+omit [FiniteMapLaws Positive M] in
+/-- Helper: WP not-stuck in the non-value case. -/
+theorem wp_not_stuck_step (e : Λ.expr) (σ : Λ.state) (ns : Nat)
+    (κs : List Λ.observation) (nt : Nat) (Φ : Λ.val → IProp GF)
+    (hto : Λ.to_val e = none) :
+    BIBase.sep
+        (IrisGS.state_interp (Λ := Λ) (GF := GF) σ ns κs nt)
+        (wp (W := W) (M := M) (F := F) (Λ := Λ) .notStuck Iris.Set.univ e Φ)
+      ⊢ uPred_fupd (M := M) (F := F) W
+          Iris.Set.univ (fun _ => False) (BIBase.pure (not_stuck e σ)) := by
+  -- use the step case of the WP and map reducibility to not-stuck
+  have hpre := adq_wp_step_pre (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+    (s := .notStuck) (e1 := e) (σ1 := σ) (ns := ns)
+    (κ := []) (κs := κs) (nt := nt) (Φ := Φ) hto
+  have hmono := wp_not_stuck_step_mono (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (e := e) (σ := σ) (ns := ns) (κs := κs) (nt := nt) (Φ := Φ)
+  exact hpre.trans <|
+    Iris.BaseLogic.fupd_mono (W := W)
+      (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := maskEmpty)
+      (P := BIBase.sep (BIBase.pure (reducible e σ))
+        (wp_step_cont (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+          (s := .notStuck) (e1 := e) (σ1 := σ) (κ := [])
+          (Φ := Φ) (ns := ns) (κs := κs) (nt := nt)))
+      (Q := BIBase.pure (not_stuck e σ)) hmono
+
+omit [FiniteMapLaws Positive M] in
+/-- WP at `NotStuck` stuckness implies the expression is not stuck.
+Coq: `wp_not_stuck` in `adequacy.v`. -/
+theorem wp_not_stuck' (e : Λ.expr) (σ : Λ.state) (ns : Nat)
+    (κs : List Λ.observation) (nt : Nat)
+    (Φ : Λ.val → IProp GF) :
+    BIBase.sep
+      (IrisGS.state_interp (Λ := Λ) (GF := GF) σ ns κs nt)
+      (wp (W := W) (M := M) (F := F) (Λ := Λ) .notStuck Iris.Set.univ e Φ)
+    ⊢ uPred_fupd (M := M) (F := F) W
+        Iris.Set.univ (fun _ => False) (BIBase.pure (not_stuck e σ)) :=
+  by
+    -- split on the value case and use `adq_wp_step_pre` otherwise
+    classical
+    cases hto : Λ.to_val e with
+    | some v =>
+        exact wp_not_stuck_value (Λ := Λ) (GF := GF) (M := M) (F := F)
+          (e := e) (σ := σ) (ns := ns) (κs := κs) (nt := nt)
+          (Φ := Φ) (v := v) hto
+    | none =>
+        exact wp_not_stuck_step (Λ := Λ) (GF := GF) (M := M) (F := F)
+          (e := e) (σ := σ) (ns := ns) (κs := κs) (nt := nt)
+          (Φ := Φ) hto
+/-- Helper: precondition for not-stuck extraction from `wptp`. -/
+noncomputable abbrev wptp_post_not_stuck_pre
+    (es2 : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ2 : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt nt' : Nat) : IProp GF :=
+  -- state interpretation paired with the extended thread pool
+  BIBase.sep
+    (state_interp (Λ := Λ) (GF := GF) σ2 ns κs (nt + nt'))
+    (wptp (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) .notStuck es2
+      (Φs ++ List.replicate nt' fork_post))
+
+omit [FiniteMapLaws Positive M] in
+/-- Helper: frame a WP with the state interpretation to derive not-stuck. -/
+theorem wptp_post_not_stuck_frame
+    (es2 : List Λ.expr) (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ2 : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt nt' : Nat)
+    (e2 : Λ.expr)
+    (hwp :
+      wptp (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) .notStuck es2
+          (Φs ++ List.replicate nt' fork_post) ⊢
+        wp (W := W) (M := M) (F := F) (Λ := Λ) .notStuck Iris.Set.univ e2 Φ) :
+    BIBase.sep
+        (state_interp (Λ := Λ) (GF := GF) σ2 ns κs (nt + nt'))
+        (wptp (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) .notStuck es2
+          (Φs ++ List.replicate nt' fork_post)) ⊢
+      uPred_fupd (M := M) (F := F) W
+        Iris.Set.univ maskEmpty (BIBase.pure (not_stuck e2 σ2)) := by
+  -- frame the WP and apply `wp_not_stuck'`
+  have hframe :
+      BIBase.sep
+          (state_interp (Λ := Λ) (GF := GF) σ2 ns κs (nt + nt'))
+          (wptp (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) .notStuck es2
+            (Φs ++ List.replicate nt' fork_post)) ⊢
+        BIBase.sep
+          (state_interp (Λ := Λ) (GF := GF) σ2 ns κs (nt + nt'))
+          (wp (W := W) (M := M) (F := F) (Λ := Λ) .notStuck Iris.Set.univ e2 Φ) :=
+    sep_mono (PROP := IProp GF) .rfl hwp
+  exact hframe.trans
+    (wp_not_stuck' (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (e := e2) (σ := σ2) (ns := ns) (κs := κs) (nt := nt + nt') (Φ := Φ))
+
+omit [FiniteMapLaws Positive M] in
+/-- Helper: the length-known branch of `wptp_post_not_stuck_aux`. -/
+theorem wptp_post_not_stuck_aux_core
+    (es2 : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ2 : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt nt' : Nat)
+    (e2 : Λ.expr) (hemem : e2 ∈ es2)
+    (hlen' : es2.length = (Φs ++ List.replicate nt' fork_post).length) :
+    wptp_post_not_stuck_pre (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (es2 := es2) (Φs := Φs) (σ2 := σ2) (ns := ns) (κs := κs)
+        (nt := nt) (nt' := nt') ⊢
+      uPred_fupd (M := M) (F := F) W
+        Iris.Set.univ maskEmpty (BIBase.pure (not_stuck e2 σ2)) := by
+  -- split the list, locate the focused thread, then apply `wp_not_stuck'`
+  rcases mem_split hemem with ⟨t1, t2, ht⟩
+  have hlen_es : es2.length = t1.length + t2.length + 1 := by
+    simp [ht, List.length_append, List.length_cons, Nat.add_assoc]
+  have hlen'' : (Φs ++ List.replicate nt' fork_post).length = t1.length + t2.length + 1 :=
+    hlen'.symm.trans hlen_es
+  rcases wptp_lookup_middle (Λ := Λ) (GF := GF)
+      (t1 := t1) (t2 := t2) (Φs := Φs ++ List.replicate nt' fork_post) hlen'' with ⟨Φ, hget⟩
+  have hwp :
+      wptp (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) .notStuck es2
+          (Φs ++ List.replicate nt' fork_post) ⊢
+        wp (W := W) (M := M) (F := F) (Λ := Λ) .notStuck Iris.Set.univ e2 Φ := by
+    simpa [ht] using
+      (wptp_post_not_stuck_wp_of_get (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (t1 := t1) (t2 := t2) (e2 := e2) (Φs := Φs) (Φ := Φ)
+        (nt' := nt') hget)
+  exact wptp_post_not_stuck_frame (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+    (es2 := es2) (Φs := Φs) (Φ := Φ) (σ2 := σ2) (ns := ns) (κs := κs)
+    (nt := nt) (nt' := nt') (e2 := e2) hwp
+
+omit [FiniteMapLaws Positive M] in
+/-- Helper: extract not-stuck from a concrete `wptp` instance. -/
+theorem wptp_post_not_stuck_aux
+    (es2 : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ2 : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt nt' : Nat)
+    (e2 : Λ.expr) (hemem : e2 ∈ es2) :
+    wptp_post_not_stuck_pre (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (es2 := es2) (Φs := Φs) (σ2 := σ2) (ns := ns) (κs := κs)
+        (nt := nt) (nt' := nt') ⊢
+      uPred_fupd (M := M) (F := F) W
+        Iris.Set.univ maskEmpty (BIBase.pure (not_stuck e2 σ2)) := by
+  -- derive the relevant WP and apply `wp_not_stuck'`
+  have hlen :
+      wptp (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) .notStuck es2
+          (Φs ++ List.replicate nt' fork_post) ⊢
+        BIBase.pure (es2.length = (Φs ++ List.replicate nt' fork_post).length) :=
+    wptp_length (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (s := .notStuck) (es := es2) (Φs := Φs ++ List.replicate nt' fork_post)
+  refine (pure_elim (PROP := IProp GF)
+    (φ := es2.length = (Φs ++ List.replicate nt' fork_post).length) ?_ ?_)
+  · exact (sep_elim_r (P := state_interp (Λ := Λ) (GF := GF) σ2 ns κs (nt + nt'))
+      (Q := wptp (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) .notStuck es2
+        (Φs ++ List.replicate nt' fork_post))).trans hlen
+  · intro hlen'
+    exact wptp_post_not_stuck_aux_core (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (es2 := es2) (Φs := Φs) (σ2 := σ2) (ns := ns) (κs := κs)
+      (nt := nt) (nt' := nt') (e2 := e2) hemem hlen'
+
+omit [FiniteMapLaws Positive M] in
+theorem wptp_post_not_stuck
+    (es2 : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ2 : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt : Nat)
+    (e2 : Λ.expr) (hemem : e2 ∈ es2) :
+    wptp_post (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+        .notStuck es2 Φs σ2 ns κs nt ⊢
+      uPred_fupd (M := M) (F := F) W
+        Iris.Set.univ maskEmpty (BIBase.pure (not_stuck e2 σ2)) := by
+  -- open the existential and extract the WP for `e2`
+  classical
+  refine exists_elim ?_
+  intro nt'
+  exact wptp_post_not_stuck_aux (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+    (es2 := es2) (Φs := Φs) (σ2 := σ2) (ns := ns) (κs := κs)
+    (nt := nt) (nt' := nt') (e2 := e2) hemem
+
+omit [FiniteMapLaws Positive M] in
+theorem wptp_progress (n : Nat)
+    (es1 es2 : List Λ.expr) (κs κs' : List Λ.observation)
+    (σ1 : Λ.state) (ns : Nat) (σ2 : Λ.state) (nt : Nat)
+    (Φs : List (Λ.val → IProp GF)) (e2 : Λ.expr)
+    (hsteps : nsteps (Λ := Λ) n (es1, σ1) κs (es2, σ2)) (hemem : e2 ∈ es2) :
+    BIBase.sep
+      (state_interp (Λ := Λ) (GF := GF) σ1 ns (κs ++ κs') nt)
+      (wptp (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) .notStuck es1 Φs) ⊢
+    step_fupdN (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) n
+      (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty
+        (BIBase.pure (not_stuck e2 σ2))) := by
+  -- preserve the thread pool, then extract not-stuck for the chosen thread
+  have hpres :=
+    wptp_preservation (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := .notStuck) (n := n) (es1 := es1) (es2 := es2)
+      (κs := κs) (κs' := κs') (σ1 := σ1) (ns := ns)
+      (σ2 := σ2) (nt := nt) (Φs := Φs) hsteps
+  have hmono :
+      wptp_post (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+          .notStuck es2 Φs σ2 (n + ns) κs' nt ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty
+          (BIBase.pure (not_stuck e2 σ2)) :=
+    wptp_post_not_stuck (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (es2 := es2) (Φs := Φs) (σ2 := σ2) (ns := n + ns)
+      (κs := κs') (nt := nt) (e2 := e2) hemem
+  exact hpres.trans (step_fupdN_mono (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) n hmono)
+
+omit [FiniteMapLaws Positive M] in
+/-- Helper: build the `step_fupdN` chain for `wp_progress`. -/
+theorem wp_progress_fupd_elim (n : Nat)
+    (es : List Λ.expr) (σ1 : Λ.state) (κs : List Λ.observation)
+    (t2 : List Λ.expr) (σ2 : Λ.state) (e2 : Λ.expr)
+    (hsteps : nsteps (Λ := Λ) n (es, σ1) κs (t2, σ2)) (hemem : e2 ∈ t2) :
+    (BIBase.«exists» (PROP := IProp GF) fun (Φs : List (Λ.val → IProp GF)) =>
+        BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ1 0 κs 0)
+          (wptp (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) .notStuck es Φs)) ⊢
+      step_fupdN (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) n
+        (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty
+          (BIBase.pure (not_stuck e2 σ2))) := by
+  -- pick the existential witness and apply `wptp_progress`
+  refine exists_elim ?_
+  intro Φs
+  have hprogress :=
+    wptp_progress (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (n := n) (es1 := es) (es2 := t2) (κs := κs) (κs' := [])
+      (σ1 := σ1) (ns := 0) (σ2 := σ2) (nt := 0)
+      (Φs := Φs) (e2 := e2) hsteps hemem
+  -- normalize the empty trace suffix
+  simpa [List.append_nil] using hprogress
+
+omit [FiniteMapLaws Positive M] in
+/-- Helper: build the `step_fupdN` chain for `wp_progress`. -/
+theorem wp_progress_fupd (n : Nat)
+    (es : List Λ.expr) (σ1 : Λ.state) (κs : List Λ.observation)
+    (t2 : List Λ.expr) (σ2 : Λ.state) (e2 : Λ.expr)
+    (Hwp : ∀ W : WsatGS GF, (BIBase.emp : IProp GF) ⊢
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+        (BIBase.«exists» fun (Φs : List (Λ.val → IProp GF)) =>
+          BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ1 0 κs 0)
+            (wptp (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) .notStuck es Φs)))
+    (hsteps : nsteps (Λ := Λ) n (es, σ1) κs (t2, σ2))
+    (hemem : e2 ∈ t2) :
+    ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (step_fupdN (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) n
+            (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty
+            (BIBase.pure (not_stuck e2 σ2)))) := by
+  -- specialize the existential and apply `wptp_progress`
+  intro W
+  refine (Hwp W).trans ?_
+  refine Iris.BaseLogic.fupd_mono (W := W)
+    (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+    (P := BIBase.«exists» fun (Φs : List (Λ.val → IProp GF)) =>
+      BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ1 0 κs 0)
+        (wptp (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) .notStuck es Φs))
+    (Q := step_fupdN (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) n
+      (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty
+        (BIBase.pure (not_stuck e2 σ2)))) ?_
+  exact wp_progress_fupd_elim
+    (n := n) (es := es) (σ1 := σ1) (κs := κs)
+    (t2 := t2) (σ2 := σ2) (e2 := e2) hsteps hemem
+
+omit inst in
+/-- Helper: `n = 0` case for `wp_progress_soundness_pure`. -/
+theorem wp_progress_soundness_pure_zero (σ2 : Λ.state) (e2 : Λ.expr)
+    (hmono : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (step_fupdN (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) 0
+            (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty
+              (BIBase.pure (not_stuck e2 σ2))))) :
+    (True : IProp GF) ⊢ BIBase.pure (not_stuck e2 σ2) := by
+  -- collapse the nested update, then apply soundness
+  haveI : Plain (BIBase.pure (not_stuck e2 σ2)) :=
+    -- pure propositions are plain via `■ ⌜φ⌝ ⊣⊢ ⌜φ⌝`
+    ⟨(Iris.BI.plainly_pure (PROP := IProp GF) (φ := not_stuck e2 σ2)).mpr⟩
+  have hplain :
+      (BIBase.emp : IProp GF) ⊢ BIBase.pure (not_stuck e2 σ2) :=
+    fupd_soundness_no_lc (M := M) (F := F) (GF := GF)
+      (E1 := Iris.Set.univ) (E2 := maskEmpty)
+      (P := BIBase.pure (not_stuck e2 σ2)) (h := fun W => by
+        have hmono0 :
+            (BIBase.emp : IProp GF) ⊢
+              uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+                (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty
+                  (BIBase.pure (not_stuck e2 σ2))) := by
+          simpa [step_fupdN] using (hmono W)
+        have htrans :=
+          Iris.BaseLogic.fupd_trans (W := W)
+            (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+            (E3 := maskEmpty) (P := BIBase.pure (not_stuck e2 σ2))
+        exact hmono0.trans htrans)
+  exact (true_emp (PROP := IProp GF)).1.trans hplain
+
+omit inst in
+/-- Helper: `n = n+1` case for `wp_progress_soundness_pure`. -/
+theorem wp_progress_soundness_pure_succ (n : Nat) (σ2 : Λ.state) (e2 : Λ.expr)
+    (hmono : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (step_fupdN (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) (n + 1)
+            (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty
+              (BIBase.pure (not_stuck e2 σ2))))) :
+    (True : IProp GF) ⊢ BIBase.pure (not_stuck e2 σ2) := by
+  -- strip the final fupd and apply step-fupd soundness
+  haveI : Plain (BIBase.pure (not_stuck e2 σ2)) :=
+    -- reuse the plainness of pure propositions
+    ⟨(Iris.BI.plainly_pure (PROP := IProp GF) (φ := not_stuck e2 σ2)).mpr⟩
+  have hstep :
+      ∀ W : WsatGS GF,
+        (BIBase.emp : IProp GF) ⊢
+          uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+            (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) (n + 1)
+              (BIBase.pure (not_stuck e2 σ2))) := by
+    intro W
+    exact (hmono W).trans
+      (fupd_step_fupdN_strip_fupd (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (W := W) (n := n) (P := BIBase.pure (not_stuck e2 σ2)))
+  have hplain :
+      (BIBase.emp : IProp GF) ⊢ BIBase.pure (not_stuck e2 σ2) :=
+    step_fupdN_soundness (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (P := BIBase.pure (not_stuck e2 σ2)) (n := n + 1) (h := hstep)
+  exact (true_emp (PROP := IProp GF)).1.trans hplain
+
+omit inst in
+/-- Helper: extract `not_stuck` from the `step_fupdN` chain. -/
+theorem wp_progress_soundness_pure (n : Nat) (σ2 : Λ.state) (e2 : Λ.expr)
+    (hmono : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (step_fupdN (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) n
+            (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty
+              (BIBase.pure (not_stuck e2 σ2))))) :
+    (True : IProp GF) ⊢ BIBase.pure (not_stuck e2 σ2) := by
+  -- split on `n` and delegate to the specialized helpers
+  cases n with
+  | zero =>
+      exact wp_progress_soundness_pure_zero (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (σ2 := σ2) (e2 := e2) hmono
+  | succ n =>
+      exact wp_progress_soundness_pure_succ (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (n := n) (σ2 := σ2) (e2 := e2) hmono
+
+omit inst in
+/-- Helper: extract `not_stuck` from the `step_fupdN` chain. -/
+theorem wp_progress_soundness (n : Nat) (σ2 : Λ.state) (e2 : Λ.expr)
+    (hmono : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (step_fupdN (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) n
+            (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty
+              (BIBase.pure (not_stuck e2 σ2))))) :
+    not_stuck e2 σ2 := by
+  -- peel updates and apply pure soundness
+  have htrue :=
+    wp_progress_soundness_pure (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (n := n) (σ2 := σ2) (e2 := e2) hmono
+  exact UPred.pure_soundness (P := not_stuck e2 σ2) htrue
+
+theorem wp_progress (n : Nat)
+    (es : List Λ.expr) (σ1 : Λ.state) (κs : List Λ.observation)
+    (t2 : List Λ.expr) (σ2 : Λ.state) (e2 : Λ.expr)
+    (Hwp : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (BIBase.«exists» (PROP := IProp GF) fun (Φs : List (Λ.val → IProp GF)) =>
+            BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ1 0 κs 0)
+              (wptp (W := W) (Λ := Λ) (GF := GF) (M := M) (F := F) .notStuck es Φs)))
+    (hsteps : nsteps (Λ := Λ) n (es, σ1) κs (t2, σ2))
+    (hemem : e2 ∈ t2) :
+    not_stuck e2 σ2 := by
+  -- run preservation and soundness to extract not-stuck at the meta-level
+  have hmono :=
+    wp_progress_fupd (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (n := n) (es := es) (σ1 := σ1) (κs := κs)
+      (t2 := t2) (σ2 := σ2) (e2 := e2) Hwp hsteps hemem
+  exact wp_progress_soundness (Λ := Λ) (GF := GF) (M := M) (F := F)
+    (n := n) (σ2 := σ2) (e2 := e2) hmono
+
+
+
+end Iris.ProgramLogic
diff --git a/src/Iris/ProgramLogic/Adequacy/SimplifiedAdequacy.lean b/src/Iris/ProgramLogic/Adequacy/SimplifiedAdequacy.lean
new file mode 100644
index 00000000..4116b3d5
--- /dev/null
+++ b/src/Iris/ProgramLogic/Adequacy/SimplifiedAdequacy.lean
@@ -0,0 +1,455 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.ProgramLogic.Adequacy.StrongAdequacy
+
+/-! # Adequacy: Simplified Adequacy
+
+Reference: `iris/program_logic/adequacy.v`
+
+This file derives simplified adequacy for single expressions and the
+auxiliary adequacy invariants used in the proof.
+-/
+
+namespace Iris.ProgramLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI Iris.BaseLogic
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M]
+variable [FiniteMapLaws Positive M] [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+variable {Λ : Language}
+variable [inst : IrisGS Λ GF]
+variable {W : WsatGS GF}
+/-! ## Simplified Adequacy -/
+
+theorem head_eq_of_splits (e2 : Λ.expr) (t2 t2' t2'' : List Λ.expr) (v2 : Λ.val)
+    (hsplit' : t2 = e2 :: t2'') (ht2 : t2 = Λ.of_val v2 :: t2') :
+    e2 = Λ.of_val v2 := by
+  -- compare heads of the two decompositions of `t2`
+  have hcons : e2 :: t2'' = Λ.of_val v2 :: t2' := by
+    calc
+      e2 :: t2'' = t2 := by simp [hsplit']
+      _ = Λ.of_val v2 :: t2' := by simp [ht2]
+  cases hcons
+  rfl
+
+omit [FiniteMapLaws Positive M] in
+theorem wp_value_fupd_mask (s : Stuckness) (v2 : Λ.val) (φ : Λ.val → Prop) :
+    wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ (Λ.of_val v2)
+        (fun v => BIBase.pure (φ v)) ⊢
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure (φ v2)) := by
+  -- use the value case and then shrink the mask
+  have hval :
+      wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ (Λ.of_val v2)
+          (fun v => BIBase.pure (φ v)) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (BIBase.pure (φ v2)) := by
+    simpa using
+      (wp_value_fupd (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (E := Iris.Set.univ) (Φ := fun v => BIBase.pure (φ v)) (v := v2)).1
+  have hmask :
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ (BIBase.pure (φ v2)) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure (φ v2)) :=
+    (Iris.BaseLogic.fupd_mono (W := W) (M := M) (F := F)
+      Iris.Set.univ Iris.Set.univ
+      (fupd_intro_univ_empty (GF := GF) (M := M) (F := F) (W := W)
+        (P := BIBase.pure (φ v2)))).trans
+    (Iris.BaseLogic.fupd_trans (W := W) (M := M) (F := F)
+      Iris.Set.univ Iris.Set.univ maskEmpty (BIBase.pure (φ v2)))
+  exact hval.trans hmask
+
+omit [FiniteMapLaws Positive M] in
+theorem wptp_singleton_fupd
+    (s : Stuckness) (e2 : Λ.expr) (v2 : Λ.val) (φ : Λ.val → Prop)
+    (hhead : e2 = Λ.of_val v2) :
+    wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s [e2]
+        [fun v => BIBase.pure (φ v)] ⊢
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure (φ v2)) := by
+  -- reduce to the singleton WP and use the value case
+  have hwp :=
+    wptp_singleton_elim (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (e := e2) (Φ := fun v => BIBase.pure (φ v))
+  have hval :=
+    wp_value_fupd_mask (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (v2 := v2) (φ := φ)
+  exact hwp.trans (by simpa [hhead] using hval)
+
+omit [FiniteMapLaws Positive M] in
+theorem adequacy_cont_value
+    (s : Stuckness) (e : Λ.expr) (t2 : List Λ.expr) (σ2 : Λ.state) (n : Nat)
+    (v2 : Λ.val) (t2' : List Λ.expr) (φ : Λ.val → Prop)
+    (ht2 : t2 = Λ.of_val v2 :: t2') :
+    (BIBase.emp : IProp GF) ⊢
+      adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := [e]) (t2 := t2) (σ2 := σ2) (n := n)
+        (Φs := [fun v => BIBase.pure (φ v)]) (φ := φ v2) := by
+  -- discharge the continuation using the head value
+  iintro _ %es' %t2'' ⌜hsplit⌝ ⌜hlen⌝ _ _ Hwp _
+  rcases list_length_eq_one (l := es') (by simpa using hlen) with ⟨e2, hes⟩
+  subst hes
+  have hsplit' : t2 = e2 :: t2'' := by simpa using hsplit
+  have hhead := head_eq_of_splits (Λ := Λ) (e2 := e2) (t2 := t2)
+    (t2' := t2') (t2'' := t2'') (v2 := v2) hsplit' ht2
+  iapply (wptp_singleton_fupd (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (e2 := e2) (v2 := v2) (φ := φ) hhead)
+  iexact Hwp
+
+omit [FiniteMapLaws Positive M] in
+theorem adequacy_cont_true
+    (s : Stuckness) (es t2 : List Λ.expr) (σ2 : Λ.state) (n : Nat)
+    (Φs : List (Λ.val → IProp GF)) :
+    (BIBase.emp : IProp GF) ⊢
+      adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := es) (t2 := t2) (σ2 := σ2) (n := n)
+        (Φs := Φs) (φ := True) := by
+  -- ignore the resources and return `True` under a fancy update
+  iintro _ %es' %t2' _ _ _ _ _ _
+  exact (pure_intro True.intro).trans <|
+    fupd_intro_univ_empty (GF := GF) (M := M) (F := F) (W := W)
+      (P := BIBase.pure True)
+
+omit [FiniteMapLaws Positive M] in
+theorem adequacy_cont_invariance
+    (s : Stuckness) (e : Λ.expr) (t2 : List Λ.expr) (σ2 : Λ.state) (n : Nat)
+    (φ : Prop) :
+    BIBase.wand
+        (state_interp (Λ := Λ) (GF := GF) σ2 n [] (t2.length - 1))
+        (BIBase.«exists» fun (_ : Iris.Set Positive) =>
+          uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure φ)) ⊢
+      adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := [e]) (t2 := t2) (σ2 := σ2) (n := n)
+        (Φs := [fun _ => BIBase.pure True]) (φ := φ) := by
+  -- use the provided wand to discharge the final state interpretation
+  iintro Hφ
+  iintro %es' %t2' ⌜hsplit⌝ ⌜hlen⌝ _ Hσ _ _
+  rcases list_length_eq_one (l := es') (by simpa using hlen) with ⟨e2, hes⟩
+  subst hes
+  have hsplit' : t2 = e2 :: t2' := by simpa using hsplit
+  have hlen' : t2.length - 1 = t2'.length := by
+    simp [hsplit']
+  simp only [hlen']
+  ispecialize Hφ $$ Hσ
+  iapply (exists_elim
+    (Φ := fun (_ : Iris.Set Positive) =>
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure φ))
+    (Q := uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure φ)) ?_)
+  · intro _; exact .rfl
+  · iexact Hφ
+
+omit [FiniteMapLaws Positive M] in
+theorem wptp_frame_cont
+    (s : Stuckness) (e : Λ.expr) (t2 : List Λ.expr) (σ2 : Λ.state) (n : Nat)
+    (Φ : Λ.val → IProp GF) (φ : Prop)
+    (hcont : (BIBase.emp : IProp GF) ⊢
+      adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := [e]) (t2 := t2) (σ2 := σ2) (n := n)
+        (Φs := [Φ]) (φ := φ)) :
+    wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s [e] [Φ] ⊢
+      BIBase.sep
+        (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s [e] [Φ])
+        (adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (es := [e]) (t2 := t2) (σ2 := σ2) (n := n)
+          (Φs := [Φ]) (φ := φ)) := by
+  -- append the continuation using `emp` framing
+  exact (sep_emp (P := wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s [e] [Φ])).2.trans
+    (sep_mono (PROP := IProp GF) .rfl hcont)
+
+omit [FiniteMapLaws Positive M] in
+theorem wp_to_wptp_cont_frame
+    (s : Stuckness) (e : Λ.expr) (t2 : List Λ.expr) (σ2 : Λ.state) (n : Nat)
+    (Φ : Λ.val → IProp GF) (φ : Prop) (R : IProp GF)
+    (hcont : R ⊢
+      adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := [e]) (t2 := t2) (σ2 := σ2) (n := n)
+        (Φs := [Φ]) (φ := φ)) :
+    BIBase.sep (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ) R ⊢
+      BIBase.sep
+        (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s [e] [Φ])
+        (adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (es := [e]) (t2 := t2) (σ2 := σ2) (n := n)
+          (Φs := [Φ]) (φ := φ)) := by
+  -- lift the singleton WP and swap in the continuation resource
+  have hwp :=
+    wptp_singleton_intro (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (e := e) (Φ := Φ)
+  have hframe :
+      BIBase.sep (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ) R ⊢
+        BIBase.sep (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s [e] [Φ]) R :=
+    sep_mono (PROP := IProp GF) hwp .rfl
+  exact hframe.trans (sep_mono (PROP := IProp GF) .rfl hcont)
+
+omit [FiniteMapLaws Positive M] in
+theorem wp_to_wptp_cont
+    (s : Stuckness) (e : Λ.expr) (t2 : List Λ.expr) (σ2 : Λ.state) (n : Nat)
+    (Φ : Λ.val → IProp GF) (φ : Prop)
+    (hcont : (BIBase.emp : IProp GF) ⊢
+      adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := [e]) (t2 := t2) (σ2 := σ2) (n := n)
+        (Φs := [Φ]) (φ := φ)) :
+    wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ ⊢
+      BIBase.sep
+        (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s [e] [Φ])
+        (adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (es := [e]) (t2 := t2) (σ2 := σ2) (n := n)
+          (Φs := [Φ]) (φ := φ)) := by
+  -- add `emp` and use the framed continuation lemma
+  have hframe :=
+    wp_to_wptp_cont_frame (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (e := e) (t2 := t2) (σ2 := σ2) (n := n)
+      (Φ := Φ) (φ := φ) (R := (BIBase.emp : IProp GF)) hcont
+  exact (sep_emp (P := wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ)).2.trans hframe
+
+section AdequacyInv
+
+variable (s : Stuckness) (e : Λ.expr) (σ : Λ.state)
+variable (κs : List Λ.observation) (t2 : List Λ.expr) (σ2 : Λ.state) (n : Nat)
+variable (Φ : Λ.val → IProp GF) (φ : Prop)
+
+omit [FiniteMapLaws Positive M] in
+theorem wp_adequacy_inv_core
+    (hcont : (BIBase.emp : IProp GF) ⊢
+      adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := [e]) (t2 := t2) (σ2 := σ2) (n := n)
+        (Φs := [Φ]) (φ := φ)) :
+    BIBase.sep
+        (state_interp (Λ := Λ) (GF := GF) σ 0 κs 0)
+        (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ) ⊢
+      adequacy_inv (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := [e]) (σ1 := σ) (κs := κs)
+        (t2 := t2) (σ2 := σ2) (n := n) (φ := φ) := by
+  -- package the singleton continuation into the adequacy invariant
+  have hwp_cont :=
+    wp_to_wptp_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (e := e) (t2 := t2) (σ2 := σ2) (n := n) (Φ := Φ) (φ := φ) hcont
+  exact (exists_intro' (Ψ := fun Φs =>
+    adequacy_pre (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (es := [e]) (σ1 := σ) (κs := κs)
+      (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ))
+    [Φ] (sep_mono (PROP := IProp GF) .rfl hwp_cont))
+
+omit [FiniteMapLaws Positive M] in
+theorem wp_adequacy_inv_frame_core
+    (R : IProp GF)
+    (hcont : R ⊢
+      adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := [e]) (t2 := t2) (σ2 := σ2) (n := n)
+        (Φs := [Φ]) (φ := φ)) :
+    BIBase.sep
+        (state_interp (Λ := Λ) (GF := GF) σ 0 κs 0)
+        (BIBase.sep (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ) R) ⊢
+      adequacy_inv (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := [e]) (σ1 := σ) (κs := κs)
+        (t2 := t2) (σ2 := σ2) (n := n) (φ := φ) := by
+  -- package the framed continuation into the adequacy invariant
+  have hwp_cont :=
+    wp_to_wptp_cont_frame (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (e := e) (t2 := t2) (σ2 := σ2) (n := n)
+      (Φ := Φ) (φ := φ) (R := R) hcont
+  exact (exists_intro' (Ψ := fun Φs =>
+    adequacy_pre (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (es := [e]) (σ1 := σ) (κs := κs)
+      (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ))
+    [Φ] (sep_mono (PROP := IProp GF) .rfl hwp_cont))
+
+omit [FiniteMapLaws Positive M] in
+theorem wp_adequacy_inv
+    (Hwp : ∀ W : WsatGS GF, ∀ κs : List Λ.observation,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (BIBase.sep
+            (state_interp (Λ := Λ) (GF := GF) σ 0 κs 0)
+            (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ)))
+    (hcont : ∀ W : WsatGS GF, (BIBase.emp : IProp GF) ⊢
+      adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := [e]) (t2 := t2) (σ2 := σ2) (n := n)
+        (Φs := [Φ]) (φ := φ)) :
+    ∀ W : WsatGS GF, (BIBase.emp : IProp GF) ⊢
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+        (adequacy_inv (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (es := [e]) (σ1 := σ) (κs := κs)
+          (t2 := t2) (σ2 := σ2) (n := n) (φ := φ)) := by
+  -- repackage the single-thread WP into the adequacy invariant
+  intro W
+  have hcore := wp_adequacy_inv_core (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (e := e) (σ := σ) (κs := κs)
+    (t2 := t2) (σ2 := σ2) (n := n) (Φ := Φ) (φ := φ) (hcont W)
+  exact (Hwp W κs).trans <|
+    Iris.BaseLogic.fupd_mono (W := W)
+      (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+      (P := BIBase.sep
+        (state_interp (Λ := Λ) (GF := GF) σ 0 κs 0)
+        (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ))
+      (Q := adequacy_inv (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := [e]) (σ1 := σ) (κs := κs)
+        (t2 := t2) (σ2 := σ2) (n := n) (φ := φ)) hcore
+
+omit [FiniteMapLaws Positive M] in
+theorem wp_adequacy_inv_frame
+    (W : WsatGS GF) (R : IProp GF)
+    (Hwp : (BIBase.emp : IProp GF) ⊢
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+        (BIBase.sep
+          (state_interp (Λ := Λ) (GF := GF) σ 0 κs 0)
+          (BIBase.sep (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ) R)))
+    (hcont : R ⊢
+      adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := [e]) (t2 := t2) (σ2 := σ2) (n := n)
+        (Φs := [Φ]) (φ := φ)) :
+    (BIBase.emp : IProp GF) ⊢
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+        (adequacy_inv (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (es := [e]) (σ1 := σ) (κs := κs)
+          (t2 := t2) (σ2 := σ2) (n := n) (φ := φ)) := by
+  -- frame the extra resource into the continuation
+  have hcore := wp_adequacy_inv_frame_core (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (e := e) (σ := σ) (κs := κs)
+    (t2 := t2) (σ2 := σ2) (n := n) (Φ := Φ) (φ := φ) (R := R) hcont
+  exact Hwp.trans <|
+    Iris.BaseLogic.fupd_mono (W := W)
+      (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+      (P := BIBase.sep
+        (state_interp (Λ := Λ) (GF := GF) σ 0 κs 0)
+        (BIBase.sep (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ) R))
+      (Q := adequacy_inv (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := [e]) (σ1 := σ) (κs := κs)
+        (t2 := t2) (σ2 := σ2) (n := n) (φ := φ)) hcore
+
+end AdequacyInv
+
+theorem wp_adequacy_value
+    (s : Stuckness) (e : Λ.expr) (σ : Λ.state) (κs : List Λ.observation)
+    (t2 : List Λ.expr) (σ2 : Λ.state) (n : Nat) (φ : Λ.val → Prop)
+    (Hwp : ∀ W : WsatGS GF,
+      ∀ κs : List Λ.observation,
+        (BIBase.emp : IProp GF) ⊢
+          uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+            (BIBase.sep
+              (state_interp (Λ := Λ) (GF := GF) σ 0 κs 0)
+              (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e
+                (fun v => BIBase.pure (φ v)))))
+    (hsteps : nsteps (Λ := Λ) n ([e], σ) κs (t2, σ2))
+    (v2 : Λ.val) (t2' : List Λ.expr) (ht2 : t2 = Λ.of_val v2 :: t2') :
+    φ v2 := by
+  -- apply strong adequacy with the value continuation
+  have Hinv :=
+    wp_adequacy_inv (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (s := s) (e := e) (σ := σ) (κs := κs)
+      (t2 := t2) (σ2 := σ2) (n := n) (Φ := fun v => BIBase.pure (φ v))
+      (φ := φ v2) Hwp (fun W =>
+        adequacy_cont_value (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (e := e) (t2 := t2) (σ2 := σ2) (n := n)
+          (v2 := v2) (t2' := t2') (φ := φ) ht2)
+  exact wp_strong_adequacy (Λ := Λ) (GF := GF) (M := M) (F := F)
+    (s := s) (es := [e]) (σ1 := σ) (n := n) (κs := κs)
+    (t2 := t2) (σ2 := σ2) (φ := φ v2) Hinv hsteps
+
+theorem wp_adequacy_not_stuck
+    (s : Stuckness) (e : Λ.expr) (σ : Λ.state) (κs : List Λ.observation)
+    (t2 : List Λ.expr) (σ2 : Λ.state) (n : Nat) (φ : Λ.val → Prop)
+    (Hwp : ∀ W : WsatGS GF,
+      ∀ κs : List Λ.observation,
+        (BIBase.emp : IProp GF) ⊢
+          uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+            (BIBase.sep
+              (state_interp (Λ := Λ) (GF := GF) σ 0 κs 0)
+              (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e
+                (fun v => BIBase.pure (φ v)))))
+    (hsteps : nsteps (Λ := Λ) n ([e], σ) κs (t2, σ2))
+    (e2 : Λ.expr) (hs : s = .notStuck) (hemem : e2 ∈ t2) :
+    not_stuck (Λ := Λ) e2 σ2 := by
+  -- reuse strong adequacy to extract the progress property
+  have Hinv :=
+    wp_adequacy_inv (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (s := s) (e := e) (σ := σ) (κs := κs)
+      (t2 := t2) (σ2 := σ2) (n := n) (Φ := fun v => BIBase.pure (φ v))
+      (φ := True) Hwp (fun W =>
+        adequacy_cont_true (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (es := [e]) (t2 := t2) (σ2 := σ2) (n := n)
+          (Φs := [fun v => BIBase.pure (φ v)]))
+  exact wp_progress_from_strong (Λ := Λ) (GF := GF) (M := M) (F := F)
+    (s := s) (es := [e]) (σ1 := σ) (κs := κs)
+    (t2 := t2) (σ2 := σ2) (n := n) (φ := True) Hinv hsteps e2 hs hemem
+
+section InvarianceInv
+
+variable (s : Stuckness) (e1 : Λ.expr) (σ1 : Λ.state)
+variable (κs : List Λ.observation) (t2 : List Λ.expr) (σ2 : Λ.state) (n : Nat)
+variable (φ : Prop)
+
+omit [FiniteMapLaws Positive M] in
+theorem wp_invariance_inv
+    (Hwp : ∀ W : WsatGS GF, (BIBase.emp : IProp GF) ⊢
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+        (BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ1 0 κs 0)
+          (BIBase.sep
+            (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e1
+              (fun _ => BIBase.pure True))
+            (BIBase.wand
+              (state_interp (Λ := Λ) (GF := GF) σ2 n [] (t2.length - 1))
+              (BIBase.«exists» fun (_ : Iris.Set Positive) =>
+                uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty
+                  (BIBase.pure φ)))))) :
+    ∀ W : WsatGS GF, (BIBase.emp : IProp GF) ⊢
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+        (adequacy_inv (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (es := [e1]) (σ1 := σ1) (κs := κs) (t2 := t2)
+          (σ2 := σ2) (n := n) (φ := φ)) := by
+  -- wrap the invariance wand into the adequacy invariant
+  intro W
+  let R : IProp GF :=
+    BIBase.wand (state_interp (Λ := Λ) (GF := GF) σ2 n [] (t2.length - 1))
+      (BIBase.«exists» fun (_ : Iris.Set Positive) =>
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure φ))
+  exact wp_adequacy_inv_frame (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (e := e1) (σ := σ1) (κs := κs)
+    (t2 := t2) (σ2 := σ2) (n := n) (Φ := fun _ => BIBase.pure True)
+    (φ := φ) (R := R) (by simpa [R] using (Hwp W)) (by
+      simpa [R] using
+        (adequacy_cont_invariance (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (e := e1) (t2 := t2) (σ2 := σ2) (n := n) (φ := φ)))
+
+end InvarianceInv
+
+
+/-- Simplified adequacy for a single expression. This requires the
+`IrisGS` instance to use `num_laters_per_step = 0` and a simple
+state interpretation that ignores step count and fork count.
+Coq: `wp_adequacy` in `adequacy.v`. -/
+theorem wp_adequacy (s : Stuckness) (e : Λ.expr) (σ : Λ.state)
+    (φ : Λ.val → Prop)
+    (Hwp : ∀ W : WsatGS GF,
+      ∀ κs : List Λ.observation,
+        (BIBase.emp : IProp GF) ⊢
+          uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+            (BIBase.sep
+              (state_interp (Λ := Λ) (GF := GF) σ 0 κs 0)
+              (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e
+                (fun v => BIBase.pure (φ v))))) :
+    Adequate (Λ := Λ) s e σ (fun v _ => φ v) :=
+  by
+    -- unpack `rtc` into `nsteps` and use strong adequacy for value/progress
+    refine (adequate_alt (Λ := Λ) (s := s) (e1 := e) (σ1 := σ)
+      (φ := fun v _ => φ v)).2 ?_
+    intro t2 σ2 hrtc
+    rcases (erased_steps_nsteps (Λ := Λ) ([e], σ) (t2, σ2)).1 hrtc with
+      ⟨n, κs, hsteps⟩
+    refine ⟨?_, ?_⟩
+    · intro v2 t2' ht2
+      exact wp_adequacy_value (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (s := s) (e := e) (σ := σ) (κs := κs)
+        (t2 := t2) (σ2 := σ2) (n := n) (φ := φ) Hwp hsteps v2 t2' ht2
+    · intro e2 hs hemem
+      exact wp_adequacy_not_stuck (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (s := s) (e := e) (σ := σ) (κs := κs)
+        (t2 := t2) (σ2 := σ2) (n := n) (φ := φ) Hwp hsteps e2 hs hemem
+
+
+end Iris.ProgramLogic
diff --git a/src/Iris/ProgramLogic/Adequacy/StrongAdequacy.lean b/src/Iris/ProgramLogic/Adequacy/StrongAdequacy.lean
new file mode 100644
index 00000000..facd8779
--- /dev/null
+++ b/src/Iris/ProgramLogic/Adequacy/StrongAdequacy.lean
@@ -0,0 +1,272 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.ProgramLogic.Adequacy.Adequate
+import Iris.ProgramLogic.Adequacy.WptpHelpersC
+
+/-! # Adequacy: Strong Adequacy
+
+Reference: `iris/program_logic/adequacy.v`
+
+This file contains the main strong adequacy theorem.
+-/
+
+namespace Iris.ProgramLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI Iris.BaseLogic
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M]
+variable [FiniteMapLaws Positive M] [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+variable {Λ : Language}
+variable [inst : IrisGS Λ GF]
+
+/-! ## Helper: Strip outer fupd from step_fupdN -/
+
+omit [FiniteMapLaws Positive M] inst in
+/-- Strip an outer `fupd` from a `step_fupdN` chain whose payload
+is already a `fupd`. Uses `fupd_trans` in both the zero and successor cases. -/
+theorem fupd_step_fupdN_fupd {W : WsatGS GF} (n : Nat) (P : IProp GF) :
+    uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+      (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n
+        (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty P)) ⊢
+    step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n
+      (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty P) := by
+  cases n with
+  | zero =>
+      -- step_fupdN 0 Q = Q, so fupd univ univ (fupd univ empty P) ⊢ fupd univ empty P
+      exact Iris.BaseLogic.fupd_trans (W := W) (M := M) (F := F)
+        (E1 := Iris.Set.univ) (E2 := Iris.Set.univ) (E3 := maskEmpty) (P := P)
+  | succ n =>
+      -- step_fupdN (n+1) Q = fupd(later(fupd(step_fupdN n Q))), so
+      -- fupd(fupd(later(...))) ⊢ fupd(later(...)) by fupd_trans
+      exact Iris.BaseLogic.fupd_trans (W := W) (M := M) (F := F)
+        (E1 := Iris.Set.univ) (E2 := Iris.Set.univ) (E3 := Iris.Set.univ)
+        (P := BIBase.later
+          (uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+            (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n
+              (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty P))))
+
+/-! ## Strong Adequacy -/
+
+section StrongAdequacy
+
+variable (s : Stuckness) (es : List Λ.expr) (σ1 : Λ.state) (n : Nat)
+variable (κs : List Λ.observation) (t2 : List Λ.expr) (σ2 : Λ.state) (φ : Prop)
+
+/-- Apply the adequacy post-condition to produce a fancy update to `φ`.
+Coq: part of `wp_strong_adequacy` in `adequacy.v`. -/
+theorem adequacy_post_apply {W : WsatGS GF}
+    (Φs : List (Λ.val → IProp GF))
+    (Hwp : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (adequacy_inv (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+            (s := s) (es := es) (σ1 := σ1) (κs := κs)
+            (t2 := t2) (σ2 := σ2) (n := n) (φ := φ)))
+    (hsteps : nsteps (Λ := Λ) n (es, σ1) κs (t2, σ2))
+    (hlen_init : es.length = Φs.length) :
+    adequacy_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := es) (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ) ⊢
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure φ) := by
+  -- discharge the continuation using the progress lemma
+  let cont := adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (es := es) (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ)
+  let post := wptp_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    s t2 Φs σ2 n [] 0
+  have hns :=
+    wp_progress_from_strong (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (s := s) (es := es) (σ1 := σ1) (κs := κs)
+      (t2 := t2) (σ2 := σ2) (n := n) (φ := φ) Hwp hsteps
+  have happly :=
+    wptp_post_apply (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (es := es) (t2 := t2) (Φs := Φs)
+      (σ2 := σ2) (n := n) (φ := φ) hlen_init hns
+  exact (sep_comm (PROP := IProp GF) (P := post) (Q := cont)).1.trans happly
+
+/-- Lift the adequacy pre-condition to a `step_fupdN` chain.
+Coq: part of `wp_strong_adequacy` in `adequacy.v`. -/
+theorem adequacy_pre_to_step_fupd {W : WsatGS GF}
+    (Φs : List (Λ.val → IProp GF))
+    (Hwp : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (adequacy_inv (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+            (s := s) (es := es) (σ1 := σ1) (κs := κs)
+            (t2 := t2) (σ2 := σ2) (n := n) (φ := φ)))
+    (hsteps : nsteps (Λ := Λ) n (es, σ1) κs (t2, σ2))
+    (hlen_init : es.length = Φs.length) :
+    adequacy_pre (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := es) (σ1 := σ1) (κs := κs)
+        (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ) ⊢
+      step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n
+        (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure φ)) := by
+  -- preserve the pool and apply the continuation under `step_fupdN`
+  have happly :=
+    adequacy_post_apply (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (es := es) (σ1 := σ1) (n := n) (κs := κs)
+      (t2 := t2) (σ2 := σ2) (φ := φ) (Φs := Φs) Hwp hsteps hlen_init
+  have hmono := step_fupdN_mono (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n happly
+  exact (wptp_preservation_frame (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (es := es) (σ1 := σ1) (κs := κs)
+    (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ) hsteps).trans hmono
+
+/-- Push the adequacy invariant through preservation to obtain
+a `step_fupdN` chain for every world.
+Coq: part of `wp_strong_adequacy` in `adequacy.v`. -/
+theorem wp_strong_adequacy_step
+    (Hwp : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (adequacy_inv (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+            (s := s) (es := es) (σ1 := σ1) (κs := κs)
+            (t2 := t2) (σ2 := σ2) (n := n) (φ := φ)))
+    (hsteps : nsteps (Λ := Λ) n (es, σ1) κs (t2, σ2)) :
+    ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n
+          (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure φ)) := by
+  intro W -- push the adequacy invariant through preservation
+  -- Step 1: show adequacy_inv ⊢ step_fupdN n (fupd (pure φ))
+  have h_inv :
+      adequacy_inv (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := es) (σ1 := σ1) (κs := κs)
+        (t2 := t2) (σ2 := σ2) (n := n) (φ := φ) ⊢
+      step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n
+        (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure φ)) := by
+    refine exists_elim ?_; intro Φs
+    have hlen :=
+      wptp_len_from_pre (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := es) (Φs := Φs) (σ1 := σ1) (κs := κs)
+        (t2 := t2) (σ2 := σ2) (n := n) (φ := φ)
+    refine pure_elim (PROP := IProp GF)
+      (φ := es.length = Φs.length) hlen ?_
+    intro hlen_init
+    exact adequacy_pre_to_step_fupd (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (s := s) (es := es) (σ1 := σ1) (κs := κs)
+      (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs)
+      (φ := φ) Hwp hsteps hlen_init
+  -- Step 2: lift through fupd_mono and strip via fupd_trans
+  have h_fupd :=
+    Iris.BaseLogic.fupd_mono (W := W) (M := M) (F := F)
+      (E1 := Iris.Set.univ) (E2 := Iris.Set.univ) h_inv
+  have h_strip :=
+    fupd_step_fupdN_fupd (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (n := n) (P := BIBase.pure φ)
+  exact (Hwp W).trans (h_fupd.trans h_strip)
+
+end StrongAdequacy
+
+omit inst in
+/-- Helper: `n = 0` case for `wp_strong_adequacy_finish`. -/
+theorem wp_strong_adequacy_finish_zero (φ : Prop)
+    (hstep : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) 0
+          (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure φ))) :
+    φ := by
+  -- discharge the single fupd and apply pure soundness
+  haveI : Plain (BIBase.pure (PROP := IProp GF) φ) :=
+    ⟨(Iris.BI.plainly_pure (PROP := IProp GF) (φ := φ)).mpr⟩
+  have hplain :
+      ∀ W : WsatGS GF,
+        (BIBase.emp : IProp GF) ⊢
+          uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure φ) := by
+    intro W
+    simpa [step_fupdN] using (hstep W)
+  have htrue :
+      (True : IProp GF) ⊢ (BIBase.pure φ) :=
+    (true_emp (PROP := IProp GF)).1.trans <|
+      fupd_soundness_no_lc (M := M) (F := F) (GF := GF)
+        (E1 := Iris.Set.univ) (E2 := maskEmpty) (P := BIBase.pure φ)
+        (h := hplain)
+  exact UPred.pure_soundness (P := φ) htrue
+
+omit inst in
+/-- Helper: `n = n+1` case for `wp_strong_adequacy_finish`. -/
+theorem wp_strong_adequacy_finish_succ (n : Nat) (φ : Prop)
+    (hstep : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) (n + 1)
+          (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure φ))) :
+    φ := by
+  -- strip the trailing fupd and apply step-fupd soundness
+  haveI : Plain (BIBase.pure (PROP := IProp GF) φ) :=
+    ⟨(Iris.BI.plainly_pure (PROP := IProp GF) (φ := φ)).mpr⟩
+  have houter :
+      ∀ W : WsatGS GF,
+        (BIBase.emp : IProp GF) ⊢
+          uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+            (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) (n + 1)
+              (BIBase.pure φ)) := by
+    intro W
+    have hplainW :
+        (BIBase.emp : IProp GF) ⊢
+          step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) (n + 1)
+            (BIBase.pure φ) :=
+      (hstep W).trans (step_fupdN_strip_fupd (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (W := W) (n := n) (P := BIBase.pure φ))
+    exact hplainW.trans (fupd_intro (W := W) (M := M) (F := F)
+      (E := Iris.Set.univ)
+      (P := step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (W := W) (n + 1) (BIBase.pure φ)))
+  have hplain :
+      (BIBase.emp : IProp GF) ⊢ BIBase.pure φ :=
+    step_fupdN_soundness (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (P := BIBase.pure φ) (n := n + 1) (h := houter)
+  have htrue :
+      (True : IProp GF) ⊢ (BIBase.pure φ) :=
+    (true_emp (PROP := IProp GF)).1.trans hplain
+  exact UPred.pure_soundness (P := φ) htrue
+
+omit inst in
+/-- Helper: conclude strong adequacy from the step-indexed soundness chain. -/
+theorem wp_strong_adequacy_finish (n : Nat) (φ : Prop)
+    (hstep : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n
+          (uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure φ))) :
+    φ := by
+  -- split on `n` and dispatch to the specialized helpers
+  cases n with
+  | zero =>
+      exact wp_strong_adequacy_finish_zero (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (φ := φ) hstep
+  | succ n =>
+      exact wp_strong_adequacy_finish_succ (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (n := n) (φ := φ) hstep
+
+/-- The main strong adequacy theorem of Iris.
+Given an Iris proof of the weakest precondition for a thread pool,
+any property `φ` that follows from the postconditions holds at the
+meta-level after `n` steps of execution.
+Coq: `wp_strong_adequacy` in `adequacy.v`. -/
+theorem wp_strong_adequacy (s : Stuckness)
+    (es : List Λ.expr) (σ1 : Λ.state) (n : Nat)
+    (κs : List Λ.observation) (t2 : List Λ.expr) (σ2 : Λ.state) (φ : Prop)
+    (Hwp : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (adequacy_inv (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+            (s := s) (es := es) (σ1 := σ1) (κs := κs)
+            (t2 := t2) (σ2 := σ2) (n := n) (φ := φ)))
+    (hsteps : nsteps (Λ := Λ) n (es, σ1) κs (t2, σ2)) :
+    φ :=
+  by
+    -- strip the step-indexed update and conclude
+    have hstep :=
+      wp_strong_adequacy_step (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (s := s) (es := es) (σ1 := σ1) (n := n) (κs := κs)
+        (t2 := t2) (σ2 := σ2) (φ := φ) Hwp hsteps
+    exact wp_strong_adequacy_finish (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (n := n) (φ := φ) hstep
+
+
+end Iris.ProgramLogic
diff --git a/src/Iris/ProgramLogic/Adequacy/ThreadPool.lean b/src/Iris/ProgramLogic/Adequacy/ThreadPool.lean
new file mode 100644
index 00000000..90a2a538
--- /dev/null
+++ b/src/Iris/ProgramLogic/Adequacy/ThreadPool.lean
@@ -0,0 +1,292 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.ProgramLogic.Lifting
+import Iris.Instances.UPred.Instance
+
+/-! # Adequacy: Thread Pool Definitions
+
+Reference: `iris/program_logic/adequacy.v`
+
+This file sets up the thread-pool weakest precondition, the core list
+helpers, and the local abbreviations shared by the adequacy proof.
+-/
+
+namespace Iris.ProgramLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI Iris.BaseLogic
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M] [DecidableEq Positive]
+variable [FiniteMapLaws Positive M] [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+variable {Λ : Language}
+variable [inst : IrisGS Λ GF]
+variable {W : WsatGS GF}
+/-! ## Local Abbreviations -/
+
+noncomputable abbrev fupd' {W : WsatGS GF}
+    (E1 E2 : Iris.Set Positive) (P : IProp GF) : IProp GF :=
+  -- specialize the fancy update to the Iris world satisfaction
+  uPred_fupd (M := M) (F := F) W E1 E2 P
+
+abbrev maskEmpty : Iris.Set Positive := fun _ => False
+  -- the empty mask is the constantly-false predicate
+
+abbrev state_interp (σ : Λ.state) (ns : Nat)
+    (κs : List Λ.observation) (nt : Nat) : IProp GF :=
+  -- state interpretation from the IrisGS instance
+  IrisGS.state_interp (Λ := Λ) (GF := GF) σ ns κs nt
+
+abbrev fork_post : Λ.val → IProp GF :=
+  -- fork postcondition from the IrisGS instance
+  IrisGS.fork_post (Λ := Λ) (GF := GF)
+
+abbrev stuckness_pred (s : Stuckness) (e : Λ.expr) (σ : Λ.state) : Prop :=
+  -- matches the predicate used in `wp_pre`
+  match s with
+  | .notStuck => reducible e σ
+  | .maybeStuck => True
+
+noncomputable abbrev wp_univ {W : WsatGS GF} (s : Stuckness) (e : Λ.expr)
+    (Φ : Λ.val → IProp GF) : IProp GF :=
+  -- shorthand for `WP` with the full mask
+  wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ
+
+noncomputable abbrev wptp_fork {W : WsatGS GF} (s : Stuckness)
+    (efs : List Λ.expr) : IProp GF :=
+  -- shorthand for forked-thread WPs
+  big_sepL (fun _ ef =>
+    wp_univ (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s ef fork_post) efs
+
+/-! ## Thread Pool WP
+
+A thread pool weakest precondition `wptp s es Φs` asserts that
+each thread `es[i]` satisfies `WP es[i] @ s; ⊤ {{ Φs[i] }}`.
+We define it as the big separating conjunction over paired lists. -/
+
+/-- Body of the thread pool WP with an index offset.
+Coq: `big_sepL` list indexing in `adequacy.v`. -/
+noncomputable def wptp_body_at_fn {W : WsatGS GF} (s : Stuckness)
+    (Φs : List (Λ.val → IProp GF)) (k : Nat) : Nat → Λ.expr → IProp GF :=
+  -- index into `Φs` with the given offset
+  fun i e =>
+    match Φs[i + k]? with
+    | some Φ => wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ
+    | none => BIBase.emp
+
+/-- Body of the thread pool WP with an index offset.
+Coq: `big_sepL` list indexing in `adequacy.v`. -/
+noncomputable def wptp_body_at {W : WsatGS GF}
+    (s : Stuckness) (es : List Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (k : Nat) : IProp GF :=
+  -- index into `Φs` with the given offset
+  big_sepL (PROP := IProp GF) (wptp_body_at_fn (Λ := Λ) (GF := GF)
+    (M := M) (F := F) (W := W) s Φs k) es
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Unfold `wptp_body_at` to the underlying big_sepL. -/
+@[simp] theorem wptp_body_at_unfold {W : WsatGS GF}
+    (s : Stuckness) (es : List Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (k : Nat) :
+    wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs k =
+      big_sepL (PROP := IProp GF)
+        (wptp_body_at_fn (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s Φs k) es := by
+  -- unfold the definition
+  rfl
+
+/-- Thread pool weakest precondition: the big separating conjunction of
+per-thread WPs over the thread pool.
+Coq: `wptp` notation in `adequacy.v`. -/
+noncomputable def wptp {W : WsatGS GF}
+    (s : Stuckness) (es : List Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) : IProp GF :=
+  -- track list-length equality explicitly (as in `big_sepL2`)
+  BIBase.sep (BIBase.pure (es.length = Φs.length))
+    (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs 0)
+
+noncomputable abbrev wptp_post {W : WsatGS GF}
+    (s : Stuckness) (es : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt : Nat) : IProp GF :=
+  -- package the post-state interpretation with a fork-extended `wptp`
+  BIBase.«exists» fun nt' =>
+    BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ ns κs (nt + nt'))
+      (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es
+        (Φs ++ List.replicate nt' fork_post))
+
+/-! ## List Helpers -/
+
+omit [DecidableEq Positive] in
+theorem get?_append_left {α : Type _} (l₁ l₂ : List α) (i : Nat)
+    (h : i < l₁.length) :
+    (l₁ ++ l₂)[i]? = l₁[i]? := by
+  -- reduce by list recursion and index cases
+  induction l₁ generalizing i with
+  | nil =>
+      cases h
+  | cons x xs ih =>
+      cases i with
+      | zero =>
+          simp
+      | succ i =>
+          have h' : i < xs.length := by
+            simpa [List.length] using Nat.lt_of_succ_lt_succ h
+          simpa using ih (i := i) h'
+
+omit [DecidableEq Positive] in
+theorem get?_append_right {α : Type _} (l₁ l₂ : List α) (i : Nat)
+    (h : l₁.length ≤ i) :
+    (l₁ ++ l₂)[i]? = l₂[i - l₁.length]? := by
+  -- reduce by list recursion and index arithmetic
+  induction l₁ generalizing i with
+  | nil =>
+      simp
+  | cons x xs ih =>
+      cases i with
+      | zero =>
+          cases h
+      | succ i =>
+          have h' : xs.length ≤ i := by
+            simpa [List.length] using Nat.le_of_succ_le_succ h
+          simpa [List.length, Nat.succ_sub_succ] using ih (i := i) h'
+
+omit [DecidableEq Positive] in
+theorem get?_replicate {α : Type _} (n : Nat) (a : α) (i : Nat)
+    (h : i < n) :
+    (List.replicate n a)[i]? = some a := by
+  -- unfold `replicate` along the index
+  induction n generalizing i with
+  | zero =>
+      cases h
+  | succ n ih =>
+      cases i with
+      | zero =>
+          simp
+      | succ i =>
+          have h' : i < n := by
+            simpa using Nat.lt_of_succ_lt_succ h
+          simpa using ih (i := i) h'
+
+omit [DecidableEq Positive] in
+theorem get?_lt_of_eq_some {α : Type _} {l : List α} {i : Nat} {a : α}
+    (h : l[i]? = some a) : i < l.length := by
+  -- show any successful lookup is in range
+  induction l generalizing i with
+  | nil =>
+      cases i <;> simp at h
+  | cons x xs ih =>
+      cases i with
+      | zero =>
+          simp at h
+          subst h
+          simp
+      | succ i =>
+          have h' : xs[i]? = some a := by
+            simpa using h
+          have hi := ih (i := i) h'
+          simpa [List.length] using Nat.succ_lt_succ hi
+
+omit [DecidableEq Positive] in
+theorem get?_eq_some_of_lt {α : Type _} (l : List α) {i : Nat}
+    (h : i < l.length) :
+    l[i]? = some (l.get ⟨i, h⟩) := by
+  -- compute the lookup by recursion on the list
+  induction l generalizing i with
+  | nil =>
+      cases h
+  | cons x xs ih =>
+      cases i with
+      | zero =>
+          simp
+      | succ i =>
+          have hi : i < xs.length := by
+            simpa [List.length] using Nat.lt_of_succ_lt_succ h
+          simp
+
+omit [DecidableEq Positive] in
+theorem append_replicate {α : Type _} (Φs : List α) (n m : Nat) (a : α) :
+    Φs ++ List.replicate n a ++ List.replicate m a =
+      Φs ++ List.replicate (n + m) a := by
+  -- fold the two replicate blocks into one
+  calc
+    Φs ++ List.replicate n a ++ List.replicate m a =
+        Φs ++ (List.replicate n a ++ List.replicate m a) := by
+          simp [List.append_assoc]
+    _ = Φs ++ List.replicate (n + m) a := by
+          simp
+
+omit [DecidableEq Positive] in
+theorem length_take_eq {α : Type _} (es t2 : List α) (n : Nat)
+    (hlen : t2.length = es.length + n) :
+    (t2.take es.length).length = es.length := by
+  -- bound the take length by the given equation
+  have hle : es.length ≤ t2.length := by
+    simp [hlen]
+  simpa using (List.length_take_of_le (l := t2) (i := es.length) hle)
+
+omit [DecidableEq Positive] in
+theorem length_drop_eq {α : Type _} (es t2 : List α) (n : Nat)
+    (hlen : t2.length = es.length + n) :
+    (t2.drop es.length).length = n := by
+  -- turn the drop length into subtraction
+  calc
+    (t2.drop es.length).length = t2.length - es.length := by simp
+    _ = (es.length + n) - es.length := by simp [hlen]
+    _ = n := by simp
+
+omit [DecidableEq Positive] in
+theorem list_length_eq_one {α : Type _} (l : List α) (h : l.length = 1) :
+    ∃ a, l = [a] := by
+  -- split on the shape of the list
+  cases l with
+  | nil =>
+      cases h
+  | cons a l =>
+      cases l with
+      | nil =>
+          exact ⟨a, rfl⟩
+      | cons b l =>
+          cases h
+
+omit [DecidableEq Positive] in
+theorem get?_append_replicate {α : Type _} (Φs : List α) (n : Nat) (a : α)
+    (i k : Nat) (hlen : Φs.length = k) (hi : i < n) :
+    (Φs ++ List.replicate n a)[i + k]? = some a := by
+  -- reduce to the replicate suffix and apply `get?_replicate`
+  have hle : Φs.length ≤ i + k := by
+    simp [hlen]
+  have hget := get?_append_right (l₁ := Φs) (l₂ := List.replicate n a) (i := i + k) hle
+  have hsub : i + k - Φs.length = i := by
+    simp [hlen]
+  have hget' :
+      (Φs ++ List.replicate n a)[i + k]? = (List.replicate n a)[i]? := by
+    -- rewrite the shifted index into the replicate suffix
+    simpa [hsub] using hget
+  exact hget'.trans (get?_replicate (n := n) (a := a) (i := i) hi)
+
+omit [DecidableEq Positive] in
+theorem mem_split {α : Type _} {a : α} {l : List α} (h : a ∈ l) :
+    ∃ t1 t2, l = t1 ++ a :: t2 := by
+  -- split the list at the first occurrence of `a`
+  induction l with
+  | nil =>
+      cases h
+  | cons x xs ih =>
+      -- split membership into head/tail cases
+      simp [List.mem_cons] at h
+      cases h with
+      | inl hx =>
+          subst hx
+          exact ⟨[], xs, by simp⟩
+      | inr hmem =>
+          rcases ih hmem with ⟨t1, t2, ht⟩
+          exact ⟨x :: t1, t2, by simp [ht]⟩
+
+
+end Iris.ProgramLogic
diff --git a/src/Iris/ProgramLogic/Adequacy/WpStep.lean b/src/Iris/ProgramLogic/Adequacy/WpStep.lean
new file mode 100644
index 00000000..b7abb37c
--- /dev/null
+++ b/src/Iris/ProgramLogic/Adequacy/WpStep.lean
@@ -0,0 +1,223 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.ProgramLogic.Adequacy.FUpd
+
+/-! # Adequacy: WP Step Helpers
+
+Reference: `iris/program_logic/adequacy.v`
+
+This file proves the single-step preservation lemma for WP and the
+auxiliary step continuations used in the thread-pool proof.
+-/
+
+namespace Iris.ProgramLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI Iris.BaseLogic
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M] [DecidableEq Positive]
+variable [FiniteMapLaws Positive M] [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+variable {Λ : Language}
+variable [inst : IrisGS Λ GF]
+variable {W : WsatGS GF}
+/-! ## WP Step Helpers -/
+
+noncomputable abbrev wp_step_cont (s : Stuckness) (e1 : Λ.expr) (σ1 : Λ.state)
+    (κ : List Λ.observation) (Φ : Λ.val → IProp GF)
+    (ns : Nat) (κs : List Λ.observation) (nt : Nat) : IProp GF :=
+  -- the recursive continuation of the step case in `wp_pre`
+  BIBase.forall fun e2 : Λ.expr =>
+    BIBase.forall fun σ2 : Λ.state =>
+      BIBase.forall fun efs : List Λ.expr =>
+        BIBase.wand (BIBase.pure (Λ.prim_step e1 σ1 κ e2 σ2 efs)) <|
+          fupd' (W := W) (M := M) (F := F) maskEmpty Iris.Set.univ <|
+            BIBase.later <|
+              BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ2 (ns + 1) κs (efs.length + nt))
+                (BIBase.sep
+                  (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e2 Φ)
+                (big_sepL (fun _ ef =>
+                    wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs))
+
+noncomputable abbrev adq_wp_step_post
+    (s : Stuckness) (e2 : Λ.expr) (σ2 : Λ.state) (efs : List Λ.expr)
+    (ns : Nat) (κs : List Λ.observation) (nt : Nat) (Φ : Λ.val → IProp GF) : IProp GF :=
+  -- post-state bundle after the primitive step
+  BIBase.later <|
+    BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ2 (ns + 1) κs (efs.length + nt))
+      (BIBase.sep
+        (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e2 Φ)
+        (big_sepL (fun _ ef =>
+          wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs))
+
+noncomputable abbrev adq_wp_step_pre_prop
+    (s : Stuckness) (e1 : Λ.expr) (σ1 : Λ.state) (ns : Nat)
+    (κ : List Λ.observation) (κs : List Λ.observation) (nt : Nat)
+    (Φ : Λ.val → IProp GF) : IProp GF :=
+  -- precondition: state interpretation and focused WP
+  BIBase.sep
+    (IrisGS.state_interp (Λ := Λ) (GF := GF) σ1 ns (κ ++ κs) nt)
+    (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e1 Φ)
+
+noncomputable abbrev adq_wp_step_cont_prop
+    (s : Stuckness) (e1 : Λ.expr) (σ1 : Λ.state) (ns : Nat)
+    (κ : List Λ.observation) (κs : List Λ.observation) (nt : Nat)
+    (Φ : Λ.val → IProp GF) : IProp GF :=
+  -- precondition for the step continuation
+  BIBase.sep (BIBase.pure (stuckness_pred s e1 σ1))
+    (wp_step_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (e1 := e1) (σ1 := σ1) (κ := κ) (Φ := Φ)
+      (ns := ns) (κs := κs) (nt := nt))
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem adq_wp_step_pre (s : Stuckness) (e1 : Λ.expr) (σ1 : Λ.state) (ns : Nat)
+    (κ : List Λ.observation) (κs : List Λ.observation) (nt : Nat)
+    (Φ : Λ.val → IProp GF) (hv : Λ.to_val e1 = none) :
+    BIBase.sep
+      (state_interp (Λ := Λ) (GF := GF) σ1 ns (κ ++ κs) nt)
+      (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e1 Φ)
+    ⊢ fupd' (W := W) (M := M) (F := F) Iris.Set.univ maskEmpty
+        (BIBase.sep (BIBase.pure (stuckness_pred s e1 σ1))
+          (wp_step_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+            (s := s) (e1 := e1) (σ1 := σ1) (κ := κ) (Φ := Φ)
+            (ns := ns) (κs := κs) (nt := nt))) := by
+  -- unfold the WP and specialize the step case
+  have hwp :
+      wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e1 Φ ⊢
+        wp_pre (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s
+          (wp (W := W) (M := M) (F := F) (Λ := Λ) s) Iris.Set.univ e1 Φ :=
+    (wp_unfold (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (E := Iris.Set.univ) (e := e1) (Φ := Φ)).1
+  refine (sep_mono_r hwp).trans ?_
+  -- specialize the quantified state parameters, then apply the wand
+  simp [wp_pre, hv, wp_pre_step, wp_step_cont]
+  refine (sep_mono_r ?_).trans (wand_elim_r (PROP := IProp GF))
+  refine (forall_elim (PROP := IProp GF) (Ψ := fun σ => _) σ1).trans ?_
+  refine (forall_elim (PROP := IProp GF) (Ψ := fun ns => _) ns).trans ?_
+  refine (forall_elim (PROP := IProp GF) (Ψ := fun κ => _) κ).trans ?_
+  refine (forall_elim (PROP := IProp GF) (Ψ := fun κs => _) κs).trans ?_
+  exact (forall_elim (PROP := IProp GF) (Ψ := fun nt => _) nt)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wp_step_cont_wand (s : Stuckness) (e1 : Λ.expr) (σ1 : Λ.state) (ns : Nat)
+    (κ : List Λ.observation) (κs : List Λ.observation)
+    (e2 : Λ.expr) (σ2 : Λ.state) (efs : List Λ.expr) (nt : Nat)
+    (Φ : Λ.val → IProp GF) :
+    wp_step_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (e1 := e1) (σ1 := σ1) (κ := κ) (Φ := Φ)
+        (ns := ns) (κs := κs) (nt := nt) ⊢
+      BIBase.wand (BIBase.pure (Λ.prim_step e1 σ1 κ e2 σ2 efs))
+        (fupd' (W := W) (M := M) (F := F) maskEmpty Iris.Set.univ
+          (BIBase.later
+            (BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ2 (ns + 1) κs (efs.length + nt))
+              (BIBase.sep
+                (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e2 Φ)
+                (big_sepL (fun _ ef =>
+                  wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs))))) := by
+  -- specialize the nested `∀` binders
+  refine (forall_elim (PROP := IProp GF) (Ψ := fun e2 => _) e2).trans ?_
+  refine (forall_elim (PROP := IProp GF) (Ψ := fun σ2 => _) σ2).trans ?_
+  exact (forall_elim (PROP := IProp GF) (Ψ := fun efs => _) efs)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wp_step_cont_pure (s : Stuckness) (e1 : Λ.expr) (σ1 : Λ.state) (ns : Nat)
+    (κ : List Λ.observation) (κs : List Λ.observation)
+    (e2 : Λ.expr) (σ2 : Λ.state) (efs : List Λ.expr) (nt : Nat)
+    (Φ : Λ.val → IProp GF)
+    (hstep : Λ.prim_step e1 σ1 κ e2 σ2 efs) :
+    wp_step_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (e1 := e1) (σ1 := σ1) (κ := κ) (Φ := Φ)
+        (ns := ns) (κs := κs) (nt := nt) ⊢
+      BIBase.sep (BIBase.pure (Λ.prim_step e1 σ1 κ e2 σ2 efs))
+        (wp_step_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (e1 := e1) (σ1 := σ1) (κ := κ) (Φ := Φ)
+          (ns := ns) (κs := κs) (nt := nt)) := by
+  -- insert the pure step using `True ∗ P`
+  exact (true_sep_2 (PROP := IProp GF)
+    (P := wp_step_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (e1 := e1) (σ1 := σ1) (κ := κ) (Φ := Φ)
+      (ns := ns) (κs := κs) (nt := nt))).trans
+    (sep_mono (pure_intro hstep) .rfl)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem adq_wp_step_cont (s : Stuckness) (e1 : Λ.expr) (σ1 : Λ.state) (ns : Nat)
+    (κ : List Λ.observation) (κs : List Λ.observation)
+    (e2 : Λ.expr) (σ2 : Λ.state) (efs : List Λ.expr) (nt : Nat)
+    (Φ : Λ.val → IProp GF)
+    (hstep : Λ.prim_step e1 σ1 κ e2 σ2 efs) :
+    BIBase.sep (BIBase.pure (stuckness_pred s e1 σ1))
+      (wp_step_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (e1 := e1) (σ1 := σ1) (κ := κ) (Φ := Φ)
+        (ns := ns) (κs := κs) (nt := nt))
+    ⊢ fupd' (W := W) (M := M) (F := F) maskEmpty Iris.Set.univ
+        (adq_wp_step_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (e2 := e2) (σ2 := σ2) (efs := efs)
+          (ns := ns) (κs := κs) (nt := nt) (Φ := Φ)) := by
+  -- drop the stuckness predicate and apply the step continuation
+  refine (sep_elim_r (P := BIBase.pure _) (Q := wp_step_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (e1 := e1) (σ1 := σ1) (κ := κ) (Φ := Φ)
+    (ns := ns) (κs := κs) (nt := nt))).trans ?_
+  have hwand := wp_step_cont_wand (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (e1 := e1) (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs)
+    (e2 := e2) (σ2 := σ2) (efs := efs) (nt := nt) (Φ := Φ)
+  have hpure := wp_step_cont_pure (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (e1 := e1) (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs)
+    (e2 := e2) (σ2 := σ2) (efs := efs) (nt := nt) (Φ := Φ) hstep
+  exact hpure.trans (sep_mono .rfl hwand) |>.trans (wand_elim_r (PROP := IProp GF))
+
+/-! ## Single Step -/
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Helper: lift the step continuation through the outer `fupd`. -/
+theorem adq_wp_step_finish (P Q : IProp GF)
+    (hcont : P ⊢ fupd' (W := W) (M := M) (F := F) maskEmpty Iris.Set.univ Q) :
+    fupd' (W := W) (M := M) (F := F) Iris.Set.univ maskEmpty P ⊢
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ Q := by
+  -- lift under `fupd` and compose the update masks
+  exact (Iris.BaseLogic.fupd_mono (W := W)
+    (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := maskEmpty)
+    (P := P) (Q := fupd' (W := W) (M := M) (F := F) maskEmpty Iris.Set.univ Q) hcont).trans
+    (Iris.BaseLogic.fupd_trans (W := W)
+      (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := maskEmpty)
+      (E3 := Iris.Set.univ) (P := Q))
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- A single primitive step preserves the weakest precondition.
+Given a step `e1 → e2` producing new threads `efs`, the state
+interpretation and WP transfer to the post-state.
+Coq: `wp_step` in `adequacy.v`. -/
+theorem adq_wp_step (s : Stuckness) (e1 : Λ.expr) (σ1 : Λ.state) (ns : Nat)
+    (κ : List Λ.observation) (κs : List Λ.observation) (e2 : Λ.expr) (σ2 : Λ.state)
+    (efs : List Λ.expr) (nt : Nat) (Φ : Λ.val → IProp GF)
+    (hstep : Λ.prim_step e1 σ1 κ e2 σ2 efs) :
+    adq_wp_step_pre_prop (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (e1 := e1) (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs)
+        (nt := nt) (Φ := Φ) ⊢
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+        (adq_wp_step_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (e2 := e2) (σ2 := σ2) (efs := efs)
+          (ns := ns) (κs := κs) (nt := nt) (Φ := Φ)) :=
+  by
+    -- unfold the WP step case and apply the concrete primitive step
+    have hv : Λ.to_val e1 = none := val_stuck (Λ := Λ) (e := e1) (σ := σ1) (κ := κ) (e' := e2) (σ' := σ2) (efs := efs) hstep
+    have hpre := adq_wp_step_pre (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (e1 := e1) (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs) (nt := nt) (Φ := Φ) hv
+    have hcont := adq_wp_step_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (e1 := e1) (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs)
+      (e2 := e2) (σ2 := σ2) (efs := efs) (nt := nt) (Φ := Φ) hstep
+    -- lift the continuation through the outer update and compose
+    let P := adq_wp_step_cont_prop (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (e1 := e1) (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs) (nt := nt) (Φ := Φ)
+    let Q := adq_wp_step_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (e2 := e2) (σ2 := σ2) (efs := efs) (ns := ns) (κs := κs) (nt := nt) (Φ := Φ)
+    exact hpre.trans (adq_wp_step_finish (P := P) (Q := Q) hcont)
+
+
+end Iris.ProgramLogic
diff --git a/src/Iris/ProgramLogic/Adequacy/WptpHelpersA.lean b/src/Iris/ProgramLogic/Adequacy/WptpHelpersA.lean
new file mode 100644
index 00000000..45269227
--- /dev/null
+++ b/src/Iris/ProgramLogic/Adequacy/WptpHelpersA.lean
@@ -0,0 +1,581 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.ProgramLogic.Adequacy.ThreadPool
+
+/-! # Adequacy: Thread Pool Helpers (A)
+
+Reference: `iris/program_logic/adequacy.v`
+
+This file collects the first chunk of helper lemmas about the thread-pool
+weakest precondition (`wptp`) and its list indexing structure.
+-/
+
+namespace Iris.ProgramLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI Iris.BaseLogic
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M] [DecidableEq Positive]
+variable [FiniteMapLaws Positive M] [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+variable {Λ : Language}
+variable [inst : IrisGS Λ GF]
+variable {W : WsatGS GF}
+/-! ## Wptp Helpers -/
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_length (s : Stuckness) (es : List Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) :
+    wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs ⊢
+      BIBase.pure (es.length = Φs.length) := by
+  -- drop the body of the conjunction
+  exact sep_elim_l (P := BIBase.pure (es.length = Φs.length))
+    (Q := wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs 0)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_body_of_wptp (s : Stuckness) (es : List Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) :
+    wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs ⊢
+      wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs 0 := by
+  -- drop the pure length equality
+  exact sep_elim_r (P := BIBase.pure (es.length = Φs.length))
+    (Q := wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs 0)
+
+omit [DecidableEq Positive] [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+theorem sep_pure_intro {φ : Prop} (P : IProp GF) (h : φ) :
+    P ⊢ BIBase.sep (BIBase.pure φ) P := by
+  -- insert `True` then replace it with the desired pure fact
+  exact (true_sep_2 (PROP := IProp GF) (P := P)).trans
+    (sep_mono (pure_intro h) .rfl)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_of_body (s : Stuckness) (es : List Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (hlen : es.length = Φs.length) :
+    wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs 0 ⊢
+      wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs := by
+  -- reinsert the pure length equality to form `wptp`
+  simpa [wptp] using (sep_pure_intro (P := wptp_body_at (Λ := Λ) (GF := GF)
+    (M := M) (F := F) s es Φs 0) hlen)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_singleton_intro (s : Stuckness) (e : Λ.expr)
+    (Φ : Λ.val → IProp GF) :
+    wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ ⊢
+      wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s [e] [Φ] := by
+  -- build the singleton pool WP from its body
+  have hbody :
+      wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ ⊢
+        wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s [e] [Φ] 0 := by
+    simpa [wptp_body_at_unfold, wptp_body_at_fn, big_sepL_cons] using
+      (sep_emp (PROP := IProp GF)
+        (P := wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ)).2
+  have hlen : ([e] : List Λ.expr).length = ([Φ] : List (Λ.val → IProp GF)).length := by
+    simp
+  exact hbody.trans <|
+    wptp_of_body (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (es := [e]) (Φs := [Φ]) hlen
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_singleton_elim (s : Stuckness) (e : Λ.expr)
+    (Φ : Λ.val → IProp GF) :
+    wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s [e] [Φ] ⊢
+      wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ := by
+  -- strip the singleton body and simplify
+  have hbody :=
+    wptp_body_of_wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (es := [e]) (Φs := [Φ])
+  have hemp :
+      wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s [e] [Φ] 0 ⊢
+        wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ := by
+    simpa [wptp_body_at_unfold, wptp_body_at_fn, big_sepL_cons] using
+      (sep_emp (PROP := IProp GF)
+        (P := wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ)).1
+  exact hbody.trans hemp
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Helper: shift the index argument of `wptp_body_at_fn`. -/
+private theorem wptp_body_at_fn_shift
+    (s : Stuckness) (Φs : List (Λ.val → IProp GF)) (k n : Nat) :
+    (fun i e =>
+      wptp_body_at_fn (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s Φs k (i + n) e) =
+      wptp_body_at_fn (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s Φs (n + k) := by
+  -- re-associate the list index offset
+  funext i e
+  simp [wptp_body_at_fn, Nat.add_left_comm, Nat.add_comm]
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_body_at_split_middle
+    (s : Stuckness) (t1 t2 : List Λ.expr) (e1 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (k : Nat) :
+    wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s (t1 ++ e1 :: t2) Φs k ⊣⊢
+      BIBase.sep
+        (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t1 Φs k)
+        (BIBase.sep
+          (match Φs[k + t1.length]? with
+          | some Φ => wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e1 Φ
+          | none => BIBase.emp)
+          (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2 Φs (k + t1.length + 1))) := by
+  -- split the big separating conjunction over `t1` and `e1 :: t2`
+  have happ :=
+    big_sepL_app (PROP := IProp GF)
+      (Φ := wptp_body_at_fn (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s Φs k)
+      t1 (e1 :: t2)
+  -- simplify the tail using the cons rule
+  simpa [wptp_body_at_unfold, wptp_body_at_fn, wptp_body_at_fn_shift, big_sepL_cons,
+    Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using happ
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_body_at_middle
+    (s : Stuckness) (t1 t2 : List Λ.expr) (e : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (k : Nat) (Φ : Λ.val → IProp GF)
+    (hget : Φs[k + t1.length]? = some Φ) :
+    wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s (t1 ++ e :: t2) Φs k ⊣⊢
+      BIBase.sep
+        (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t1 Φs k)
+        (BIBase.sep
+          (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e Φ)
+          (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+            s t2 Φs (k + t1.length + 1))) := by
+  -- specialize the split lemma and rewrite the middle lookup
+  simpa [hget] using (wptp_body_at_split_middle (Λ := Λ) (GF := GF)
+    (M := M) (F := F) (W := W) (s := s) (t1 := t1) (t2 := t2) (e1 := e)
+    (Φs := Φs) (k := k))
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_body_at_append_left
+    (s : Stuckness) (es : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (k n : Nat) (hle : k + es.length ≤ Φs.length) :
+    wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es (Φs ++ List.replicate n fork_post) k ⊣⊢
+      wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs k := by
+  -- the append does not affect indices below `Φs.length`
+  refine ⟨?_, ?_⟩
+  · refine big_sepL_mono ?_
+    intro i e hget
+    have hi := get?_lt_of_eq_some hget
+    have hlt : i + k < Φs.length := by
+      have hlt' : i + k < es.length + k := Nat.add_lt_add_right hi k
+      have hlt'' : i + k < k + es.length := by
+        simpa [Nat.add_comm] using hlt'
+      exact Nat.lt_of_lt_of_le hlt'' (by simpa [Nat.add_comm] using hle)
+    have hget' := get?_append_left (l₁ := Φs) (l₂ := List.replicate n fork_post)
+      (i := i + k) hlt
+    simp [wptp_body_at_fn, hget']
+  · refine big_sepL_mono ?_
+    intro i e hget
+    have hi := get?_lt_of_eq_some hget
+    have hlt : i + k < Φs.length := by
+      have hlt' : i + k < es.length + k := Nat.add_lt_add_right hi k
+      have hlt'' : i + k < k + es.length := by
+        simpa [Nat.add_comm] using hlt'
+      exact Nat.lt_of_lt_of_le hlt'' (by simpa [Nat.add_comm] using hle)
+    have hget' := get?_append_left (l₁ := Φs) (l₂ := List.replicate n fork_post)
+      (i := i + k) hlt
+    simp [wptp_body_at_fn, hget']
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_body_at_replicate
+    (s : Stuckness) (es : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (k : Nat) (hlen : Φs.length = k) :
+    wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es
+        (Φs ++ List.replicate es.length fork_post) k ⊣⊢
+      big_sepL (fun _ ef =>
+        wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) es := by
+  -- the entire tail list comes from the replicate suffix
+  refine ⟨?_, ?_⟩
+  · refine big_sepL_mono ?_
+    intro i ef hget
+    have hi := get?_lt_of_eq_some hget
+    have hsome := get?_append_replicate (Φs := Φs) (n := es.length) (a := fork_post)
+      (i := i) (k := k) (hlen := hlen) hi
+    simp [wptp_body_at_fn, hsome]
+  · refine big_sepL_mono ?_
+    intro i ef hget
+    have hi := get?_lt_of_eq_some hget
+    have hsome := get?_append_replicate (Φs := Φs) (n := es.length) (a := fork_post)
+      (i := i) (k := k) (hlen := hlen) hi
+    simp [wptp_body_at_fn, hsome]
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Helper: split the explicit big-sep over an append. -/
+private theorem wptp_body_at_append_split_big_sep
+    (s : Stuckness) (t2 efs : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (k : Nat) :
+    big_sepL (PROP := IProp GF)
+        (wptp_body_at_fn (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s
+          (Φs ++ List.replicate efs.length fork_post) k)
+        (t2 ++ efs) ⊣⊢
+      BIBase.sep (PROP := IProp GF)
+        (big_sepL (PROP := IProp GF)
+          (wptp_body_at_fn (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s
+            (Φs ++ List.replicate efs.length fork_post) k) t2)
+        (big_sepL (PROP := IProp GF)
+          (wptp_body_at_fn (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s
+            (Φs ++ List.replicate efs.length fork_post) (t2.length + k)) efs) := by
+  -- direct instance of `big_sepL_app`
+  have hshift :
+      (fun i => wptp_body_at_fn (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s
+        (Φs ++ List.replicate efs.length fork_post) k (i + t2.length)) =
+        wptp_body_at_fn (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s
+          (Φs ++ List.replicate efs.length fork_post) (t2.length + k) := by
+    -- rewrite the shifted index into the offset parameter
+    funext i e
+    simp [wptp_body_at_fn, Nat.add_assoc]
+  simpa [← hshift] using
+    (big_sepL_app (PROP := IProp GF)
+      (Φ := wptp_body_at_fn (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s
+        (Φs ++ List.replicate efs.length fork_post) k) t2 efs)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_body_at_append_split
+    (s : Stuckness) (t2 efs : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (k : Nat) :
+    wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s (t2 ++ efs)
+        (Φs ++ List.replicate efs.length fork_post) k ⊣⊢
+      BIBase.sep
+        (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          s t2 (Φs ++ List.replicate efs.length fork_post) k)
+        (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          s efs (Φs ++ List.replicate efs.length fork_post) (t2.length + k)) := by
+  -- unfold `wptp_body_at` and re-associate the tail offset
+  simpa [wptp_body_at_unfold] using
+    (wptp_body_at_append_split_big_sep (Λ := Λ) (GF := GF)
+      (M := M) (F := F) (W := W) (s := s) (t2 := t2) (efs := efs) (Φs := Φs) (k := k))
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_body_at_append_fork_left
+    (s : Stuckness) (t2 efs : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (k : Nat) (hlen : Φs.length = k + t2.length) :
+    BIBase.sep
+        (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2 Φs k)
+        (big_sepL (fun _ ef =>
+          wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs) ⊢
+      wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s (t2 ++ efs)
+        (Φs ++ List.replicate efs.length fork_post) k := by
+  -- rewrite the left and right components, then rejoin the split
+  have hle : k + t2.length ≤ Φs.length := by
+    simp [hlen]
+  have hleft := wptp_body_at_append_left (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (es := t2) (Φs := Φs) (k := k) (n := efs.length) hle
+  have hright := wptp_body_at_replicate (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (es := efs) (Φs := Φs) (k := k + t2.length) (hlen := hlen)
+  have hsep :=
+    sep_mono (PROP := IProp GF)
+      (P := wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2 Φs k)
+      (P' := big_sepL (fun _ ef =>
+        wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs)
+      (Q := wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        s t2 (Φs ++ List.replicate efs.length fork_post) k)
+      (Q' := wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        s efs (Φs ++ List.replicate efs.length fork_post) (k + t2.length))
+      hleft.2 hright.2
+  exact hsep.trans <| by
+    simpa [Nat.add_comm] using
+      (wptp_body_at_append_split (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t2 := t2) (efs := efs) (Φs := Φs) (k := k)).symm.1
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_body_at_append_fork_right
+    (s : Stuckness) (t2 efs : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (k : Nat) (hlen : Φs.length = k + t2.length) :
+    wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s (t2 ++ efs)
+        (Φs ++ List.replicate efs.length fork_post) k ⊢
+      BIBase.sep
+        (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2 Φs k)
+        (big_sepL (fun _ ef =>
+          wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs) := by
+  -- split, then rewrite the two sides back to the original shape
+  have hle : k + t2.length ≤ Φs.length := by
+    simp [hlen]
+  have hleft := wptp_body_at_append_left (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (es := t2) (Φs := Φs) (k := k) (n := efs.length) hle
+  have hright := wptp_body_at_replicate (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (es := efs) (Φs := Φs) (k := k + t2.length) (hlen := hlen)
+  have hsep :=
+    sep_mono (PROP := IProp GF)
+      (P := wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        s t2 (Φs ++ List.replicate efs.length fork_post) k)
+      (P' := wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        s efs (Φs ++ List.replicate efs.length fork_post) (k + t2.length))
+      (Q := wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2 Φs k)
+      (Q' := big_sepL (fun _ ef =>
+        wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs)
+      hleft.1 hright.1
+  have hsplit :
+      wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s (t2 ++ efs)
+          (Φs ++ List.replicate efs.length fork_post) k ⊢
+        BIBase.sep
+          (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+            s t2 (Φs ++ List.replicate efs.length fork_post) k)
+          (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+            s efs (Φs ++ List.replicate efs.length fork_post) (k + t2.length)) := by
+    simpa [Nat.add_comm] using
+      (wptp_body_at_append_split (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t2 := t2) (efs := efs) (Φs := Φs) (k := k)).1
+  exact hsplit.trans hsep
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_body_at_append_fork
+    (s : Stuckness) (t2 efs : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (k : Nat) (hlen : Φs.length = k + t2.length) :
+    BIBase.sep
+      (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2 Φs k)
+      (big_sepL (fun _ ef =>
+        wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs) ⊣⊢
+      wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s (t2 ++ efs)
+        (Φs ++ List.replicate efs.length fork_post) k := by
+  -- package the two directional entailments
+  exact ⟨
+    wptp_body_at_append_fork_left (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (t2 := t2) (efs := efs) (Φs := Φs) (k := k) hlen,
+    wptp_body_at_append_fork_right (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (t2 := t2) (efs := efs) (Φs := Φs) (k := k) hlen⟩
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_tail_fork
+    (s : Stuckness) (t1 t2 efs : List Λ.expr)
+    (Φs : List (Λ.val → IProp GF))
+    (hlen : Φs.length = t1.length + t2.length + 1) :
+    BIBase.sep
+      (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        s t2 Φs (t1.length + 1))
+      (big_sepL (fun _ ef =>
+        wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs) ⊢
+      wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s
+        (t2 ++ efs) (Φs ++ List.replicate efs.length fork_post) (t1.length + 1) := by
+  -- specialize the append-fork lemma with the computed offset
+  have hlen' : Φs.length = (t1.length + 1) + t2.length := by
+    simpa [Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using hlen
+  exact (wptp_body_at_append_fork (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (t2 := t2) (efs := efs) (Φs := Φs)
+    (k := t1.length + 1) (hlen := hlen')).1
+
+omit [DecidableEq Positive] [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+theorem wptp_append_lookup
+    (t1 t2 efs : List Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (hlen : Φs.length = t1.length + t2.length + 1)
+    (hget : Φs[t1.length]? = some Φ) :
+    (Φs ++ List.replicate efs.length fork_post)[t1.length]? = some Φ := by
+  -- show the lookup stays in the left prefix
+  have hlt : t1.length < Φs.length := by
+    have hlt' : t1.length < t1.length + 1 + t2.length := by
+      exact Nat.lt_of_lt_of_le (Nat.lt_succ_self _) (Nat.le_add_right _ _)
+    simp [hlen, Nat.add_assoc]
+  simpa [hget] using
+    (get?_append_left (l₁ := Φs) (l₂ := List.replicate efs.length fork_post)
+      (i := t1.length) hlt)
+
+omit [DecidableEq Positive] [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] inst in
+theorem wptp_lookup_middle
+    (t1 t2 : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (hlen : Φs.length = t1.length + t2.length + 1) :
+    ∃ Φ, Φs[t1.length]? = some Φ := by
+  -- use the list length equality to show the middle index is in range
+  have hlt : t1.length < Φs.length := by
+    have hlt' : t1.length < t1.length + 1 + t2.length := by
+      exact Nat.lt_of_lt_of_le (Nat.lt_succ_self _) (Nat.le_add_right _ _)
+    simp [hlen, Nat.add_assoc]
+  refine ⟨Φs.get ⟨t1.length, hlt⟩, ?_⟩
+  exact get?_eq_some_of_lt (l := Φs) hlt
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_middle_append
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (hlen : Φs.length = t1.length + t2.length + 1)
+    (hget : Φs[t1.length]? = some Φ) :
+    BIBase.sep
+      (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        s t1 (Φs ++ List.replicate efs.length fork_post) 0)
+      (BIBase.sep
+        (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e2 Φ)
+        (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s
+          (t2 ++ efs) (Φs ++ List.replicate efs.length fork_post)
+          (t1.length + 1))) ⊢
+      wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s
+        (t1 ++ e2 :: t2 ++ efs) (Φs ++ List.replicate efs.length fork_post) 0 := by
+  -- rebuild the middle using the updated lookup
+  have hget' := wptp_append_lookup (t1 := t1) (t2 := t2) (efs := efs)
+    (Φs := Φs) (Φ := Φ) hlen hget
+  have hget0 :
+      (Φs ++ List.replicate efs.length fork_post)[0 + t1.length]? = some Φ := by
+    -- align the index with the expected `0 + t1.length`
+    simpa [Nat.zero_add] using hget'
+  have hmid :=
+    (wptp_body_at_middle (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (t1 := t1) (t2 := t2 ++ efs) (e := e2)
+      (Φs := Φs ++ List.replicate efs.length fork_post) (k := 0) (Φ := Φ) hget0).2
+  simpa [Nat.zero_add, Nat.add_assoc, List.append_assoc] using hmid
+
+omit [DecidableEq Positive] [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+theorem wptp_rebuild_len
+    (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF))
+    (hlen : Φs.length = t1.length + t2.length + 1) :
+    (t1 ++ e2 :: t2 ++ efs).length =
+      (Φs ++ List.replicate efs.length fork_post).length := by
+  -- compute the list lengths explicitly
+  simp [List.length_append, List.length_cons, List.length_replicate, hlen,
+    Nat.add_assoc, Nat.add_left_comm, Nat.add_comm]
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_rebuild_tail
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (hlen : Φs.length = t1.length + t2.length + 1) :
+    BIBase.sep
+        (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e2 Φ)
+        (BIBase.sep
+          (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+            s t2 Φs (t1.length + 1))
+          (big_sepL (fun _ ef =>
+            wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs)) ⊢
+      BIBase.sep
+        (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e2 Φ)
+        (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          s (t2 ++ efs) (Φs ++ List.replicate efs.length fork_post) (t1.length + 1)) := by
+  -- replace the tail segment using `wptp_tail_fork`
+  have htail := wptp_tail_fork (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (t1 := t1) (t2 := t2) (efs := efs) (Φs := Φs) hlen
+  exact sep_mono (PROP := IProp GF)
+    (P := wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e2 Φ)
+    (P' := BIBase.sep
+      (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        s t2 Φs (t1.length + 1))
+      (big_sepL (fun _ ef =>
+        wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs))
+    (Q := wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e2 Φ)
+    (Q' := wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      s (t2 ++ efs) (Φs ++ List.replicate efs.length fork_post) (t1.length + 1))
+    BIBase.Entails.rfl htail
+
+noncomputable abbrev wptp_rebuild_left
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF) : IProp GF :=
+  -- full `wptp` body before rebuilding the middle
+  BIBase.sep
+    (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t1 Φs 0)
+    (BIBase.sep
+      (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e2 Φ)
+      (BIBase.sep
+        (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          s t2 Φs (t1.length + 1))
+        (big_sepL (fun _ ef =>
+          wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs)))
+
+noncomputable abbrev wptp_rebuild_right
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF) : IProp GF :=
+  -- `wptp` body after replacing the forked tail
+  BIBase.sep
+    (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      s t1 (Φs ++ List.replicate efs.length fork_post) 0)
+    (BIBase.sep
+      (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e2 Φ)
+      (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        s (t2 ++ efs) (Φs ++ List.replicate efs.length fork_post)
+        (t1.length + 1)))
+
+noncomputable abbrev wptp_rebuild_head
+    (s : Stuckness) (t1 : List Λ.expr) (Φs : List (Λ.val → IProp GF)) : IProp GF :=
+  -- shared head of the `wptp` body
+  wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t1 Φs 0
+
+noncomputable abbrev wptp_rebuild_head_ext
+    (s : Stuckness) (t1 : List Λ.expr) (efs : List Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) : IProp GF :=
+  -- head after adding the forked suffix to `Φs`
+  wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    s t1 (Φs ++ List.replicate efs.length fork_post) 0
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_rebuild_prep
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (hlen : Φs.length = t1.length + t2.length + 1)
+    (hleft :
+      wptp_rebuild_head (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (t1 := t1) (Φs := Φs) ⊢
+        wptp_rebuild_head_ext (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (t1 := t1) (efs := efs) (Φs := Φs)) :
+    wptp_rebuild_left (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+          (Φs := Φs) (Φ := Φ) ⊢
+      wptp_rebuild_right (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+        (Φs := Φs) (Φ := Φ) := by
+  -- rewrite the head with `hleft` and the tail with `wptp_rebuild_tail`
+  have htail := wptp_rebuild_tail (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+    (Φs := Φs) (Φ := Φ) hlen
+  have hsep := sep_mono (PROP := IProp GF) hleft htail
+  simpa [wptp_rebuild_left, wptp_rebuild_right] using hsep
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_rebuild
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (hlen : Φs.length = t1.length + t2.length + 1)
+    (hget : Φs[t1.length]? = some Φ) :
+    wptp_rebuild_left (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+        (Φs := Φs) (Φ := Φ) ⊢ wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          s (t1 ++ e2 :: t2 ++ efs) (Φs ++ List.replicate efs.length fork_post) := by
+  -- replace the tail, rebuild the middle, then add the length proof
+  have hle : t1.length ≤ Φs.length := by
+    -- `t1.length` is within the left prefix of `Φs`
+    have hle' : t1.length ≤ t1.length + t2.length + 1 :=
+      Nat.le_trans (Nat.le_add_right _ _) (Nat.le_add_right _ _)
+    simp [hlen, Nat.add_assoc]
+  have hleft := wptp_body_at_append_left (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (es := t1) (Φs := Φs) (k := 0) (n := efs.length) (by simpa using hle)
+  have hprep := wptp_rebuild_prep (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+    (Φs := Φs) (Φ := Φ) hlen hleft.2
+  have hmid := wptp_middle_append (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+    (Φs := Φs) (Φ := Φ) hlen hget
+  have hlen2 := wptp_rebuild_len (Λ := Λ) (GF := GF)
+    (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2) (Φs := Φs) hlen
+  exact hprep.trans (hmid.trans <|
+    wptp_of_body (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (es := t1 ++ e2 :: t2 ++ efs)
+      (Φs := Φs ++ List.replicate efs.length fork_post) hlen2)
+
+omit [DecidableEq Positive] [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+theorem sep_reorder_for_rebuild
+    (P A B C D : IProp GF) :
+    BIBase.sep (BIBase.sep P (BIBase.sep B D)) (BIBase.sep A C) ⊣⊢
+      BIBase.sep P (BIBase.sep A (BIBase.sep B (BIBase.sep C D))) := by
+  -- swap the middle components and reassociate the tail
+  have hswap :
+      BIBase.sep (BIBase.sep P (BIBase.sep B D)) (BIBase.sep A C) ⊣⊢
+        BIBase.sep (BIBase.sep P A) (BIBase.sep (BIBase.sep B D) C) :=
+    sep_sep_sep_comm (P := P) (Q := BIBase.sep B D) (R := A) (S := C)
+  have htail :
+      BIBase.sep (BIBase.sep B D) C ⊣⊢ BIBase.sep B (BIBase.sep C D) := by
+    exact (sep_right_comm (P := B) (Q := D) (R := C)).trans
+      (sep_assoc (P := B) (Q := C) (R := D))
+  have hmid :
+      BIBase.sep (BIBase.sep P A) (BIBase.sep (BIBase.sep B D) C) ⊣⊢
+        BIBase.sep (BIBase.sep P A) (BIBase.sep B (BIBase.sep C D)) := by
+    refine ⟨?_, ?_⟩
+    · exact sep_mono (PROP := IProp GF)
+        (P := BIBase.sep P A) (P' := BIBase.sep (BIBase.sep B D) C)
+        (Q := BIBase.sep P A) (Q' := BIBase.sep B (BIBase.sep C D))
+        BIBase.Entails.rfl htail.1
+    · exact sep_mono (PROP := IProp GF)
+        (P := BIBase.sep P A) (P' := BIBase.sep B (BIBase.sep C D))
+        (Q := BIBase.sep P A) (Q' := BIBase.sep (BIBase.sep B D) C)
+        BIBase.Entails.rfl htail.2
+  exact hswap.trans (hmid.trans (sep_assoc (P := P) (Q := A) (R := BIBase.sep B (BIBase.sep C D))))
+
+
+end Iris.ProgramLogic
diff --git a/src/Iris/ProgramLogic/Adequacy/WptpHelpersB.lean b/src/Iris/ProgramLogic/Adequacy/WptpHelpersB.lean
new file mode 100644
index 00000000..b35195e8
--- /dev/null
+++ b/src/Iris/ProgramLogic/Adequacy/WptpHelpersB.lean
@@ -0,0 +1,332 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.ProgramLogic.Adequacy.WptpHelpersA
+
+/-! # Adequacy: Thread Pool Helpers (B)
+
+Reference: `iris/program_logic/adequacy.v`
+
+This file continues the thread-pool helper lemmas, focusing on rebuilding
+`wptp` after a step and merging forked resources.
+-/
+
+namespace Iris.ProgramLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI Iris.BaseLogic
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M] [DecidableEq Positive]
+variable [FiniteMapLaws Positive M] [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+variable {Λ : Language}
+variable [inst : IrisGS Λ GF]
+variable {W : WsatGS GF}
+
+noncomputable abbrev wptp_step_post_inner_src
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ2 : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt : Nat) : IProp GF :=
+  -- inner state and body layout before rebuilding `wptp`
+  BIBase.sep
+    (BIBase.sep
+      (state_interp (Λ := Λ) (GF := GF) σ2 (ns + 1) κs (efs.length + nt))
+      (BIBase.sep (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e2 Φ)
+        (big_sepL (fun _ ef =>
+          wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs)))
+    (BIBase.sep
+      (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t1 Φs 0)
+      (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2 Φs (t1.length + 1)))
+
+set_option linter.unusedVariables false in
+noncomputable abbrev wptp_step_post_inner_tgt
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ2 : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt : Nat) : IProp GF :=
+  -- rebuilt `wptp` in the post-state
+  BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ2 (ns + 1) κs (efs.length + nt))
+    (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s
+      (t1 ++ e2 :: t2 ++ efs)
+      (Φs ++ List.replicate efs.length fork_post))
+
+noncomputable abbrev wptp_step_post_src
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ2 : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt : Nat) : IProp GF :=
+  -- `later`-wrapped variant of `wptp_step_post_inner_src`
+  BIBase.sep
+    (BIBase.later
+      (BIBase.sep
+        (state_interp (Λ := Λ) (GF := GF) σ2 (ns + 1) κs (efs.length + nt))
+        (BIBase.sep (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e2 Φ)
+          (big_sepL (fun _ ef =>
+            wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs))))
+    (BIBase.sep
+      (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t1 Φs 0)
+      (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2 Φs (t1.length + 1)))
+
+set_option linter.unusedVariables false in
+noncomputable abbrev wptp_step_post_tgt
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ2 : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt : Nat) : IProp GF :=
+  -- `later`-wrapped variant of `wptp_step_post_inner_tgt`
+  BIBase.later
+    (BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ2 (ns + 1) κs (efs.length + nt))
+      (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s
+        (t1 ++ e2 :: t2 ++ efs)
+        (Φs ++ List.replicate efs.length fork_post)))
+
+noncomputable abbrev wptp_split_fork_pre
+    (s : Stuckness) (es t2 : List Λ.expr) (Φs : List (Λ.val → IProp GF)) : IProp GF :=
+  -- precondition for rebuilding a forked pool
+  BIBase.sep
+      (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs)
+      (big_sepL (fun _ ef =>
+        wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) t2)
+
+noncomputable abbrev wptp_split_fork_post
+    (s : Stuckness) (es t2 : List Λ.expr) (Φs : List (Λ.val → IProp GF)) : IProp GF :=
+  -- combined `wptp` after reattaching forked threads
+  wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s (es ++ t2)
+    (Φs ++ List.replicate t2.length fork_post)
+omit [DecidableEq Positive] [ElemG GF (COFE.constOF CoPsetDisj)]
+    [ElemG GF (COFE.constOF GSetDisj)] in
+theorem wptp_step_post_push (X A C : IProp GF) :
+    BIBase.sep (BIBase.later X) (BIBase.sep A C) ⊢
+      BIBase.later (BIBase.sep X (BIBase.sep A C)) := by
+  -- add the `later` frame to the right and combine with `later_sep`
+  have hlat : BIBase.sep A C ⊢ BIBase.later (BIBase.sep A C) := later_intro
+  exact (sep_mono (PROP := IProp GF) .rfl hlat).trans
+    (later_sep (P := X) (Q := BIBase.sep A C)).2
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_step_post_inner
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ2 : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt : Nat)
+    (hlen : Φs.length = t1.length + t2.length + 1)
+    (hget : Φs[t1.length]? = some Φ) :
+    wptp_step_post_inner_src (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+        (Φs := Φs) (Φ := Φ) (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt) ⊢
+      wptp_step_post_inner_tgt (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+        (Φs := Φs) (Φ := Φ) (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt) := by
+  -- reorder the pieces and rebuild the thread pool
+  have hreorder := (sep_reorder_for_rebuild
+    (P := state_interp (Λ := Λ) (GF := GF) σ2 (ns + 1) κs (efs.length + nt))
+    (A := wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t1 Φs 0)
+    (B := wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e2 Φ)
+    (C := wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2 Φs (t1.length + 1))
+    (D := big_sepL (fun _ ef =>
+      wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs)).1
+  exact hreorder.trans <|
+    sep_mono (PROP := IProp GF) .rfl
+      (wptp_rebuild (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+        (Φs := Φs) (Φ := Φ) hlen hget)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_step_post
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ2 : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt : Nat)
+    (hlen : Φs.length = t1.length + t2.length + 1)
+    (hget : Φs[t1.length]? = some Φ) :
+    wptp_step_post_src (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+        (Φs := Φs) (Φ := Φ) (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt) ⊢
+      wptp_step_post_tgt (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+        (Φs := Φs) (Φ := Φ) (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt) := by
+  -- push under `▷` then apply the rebuild lemma inside
+  let X :=
+    BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ2 (ns + 1) κs (efs.length + nt))
+      (BIBase.sep
+        (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e2 Φ)
+        (big_sepL (fun _ ef =>
+          wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs))
+  let A := wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t1 Φs 0
+  let C := wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2 Φs (t1.length + 1)
+  have hpush := wptp_step_post_push (X := X) (A := A) (C := C)
+  have hinner := wptp_step_post_inner (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+    (Φs := Φs) (Φ := Φ) (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt)
+    hlen hget
+  exact hpush.trans (later_mono (PROP := IProp GF) hinner)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_post_merge
+    (s : Stuckness) (es : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt nt' : Nat) :
+    wptp_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        s es (Φs ++ List.replicate nt' fork_post) σ ns κs (nt + nt')
+      ⊢ wptp_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        s es Φs σ ns κs nt := by
+  -- repackage the existential by merging the replicate suffixes
+  refine exists_elim ?_
+  intro nt''
+  refine exists_intro' (a := nt' + nt'') ?_
+  simp [Nat.add_left_comm, Nat.add_comm]
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_split_fork_left
+    (s : Stuckness) (es t2 : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (hlen : es.length = Φs.length) :
+    wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s (es ++ t2)
+        (Φs ++ List.replicate t2.length fork_post) ⊢
+      BIBase.sep
+        (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs)
+        (big_sepL (fun _ ef =>
+          wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) t2) := by
+  -- peel the body and apply the append-fork split
+  have hbody := wptp_body_of_wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (es := es ++ t2) (Φs := Φs ++ List.replicate t2.length fork_post)
+  have hsplit := (wptp_body_at_append_fork (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (t2 := es) (efs := t2) (Φs := Φs) (k := 0)
+    (hlen := by simp [Nat.zero_add, hlen])).2
+  have hleft :
+      wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs 0 ⊢
+        wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs :=
+    wptp_of_body (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (es := es) (Φs := Φs) hlen
+  exact (hbody.trans hsplit).trans (sep_mono (PROP := IProp GF) hleft .rfl)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_split_fork_right
+    (s : Stuckness) (es t2 : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (hlen : es.length = Φs.length) :
+    wptp_split_fork_pre (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := es) (t2 := t2) (Φs := Φs) ⊢
+      wptp_split_fork_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := es) (t2 := t2) (Φs := Φs) := by
+  -- rebuild the combined `wptp` from the body and length equality
+  have hbody' := wptp_body_of_wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (es := es) (Φs := Φs)
+  have hcomb :=
+    (wptp_body_at_append_fork (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (t2 := es) (efs := t2) (Φs := Φs) (k := 0)
+      (hlen := by simp [Nat.zero_add, hlen])).1
+  have hlen' :
+      (es ++ t2).length =
+        (Φs ++ List.replicate t2.length fork_post).length := by
+    simp [hlen, List.length_append, List.length_replicate]
+  have hwrap := wptp_of_body (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (es := es ++ t2) (Φs := Φs ++ List.replicate t2.length fork_post) hlen'
+  exact (sep_mono (PROP := IProp GF) hbody' .rfl).trans (hcomb.trans hwrap)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_split_fork
+    (s : Stuckness) (es t2 : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (hlen : es.length = Φs.length) :
+    wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s (es ++ t2)
+        (Φs ++ List.replicate t2.length fork_post) ⊣⊢
+      BIBase.sep
+        (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs)
+        (big_sepL (fun _ ef =>
+          wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) t2) := by
+  -- package the two directions using the helper lemmas
+  exact ⟨
+    wptp_split_fork_left (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (s := s) (es := es) (t2 := t2) (Φs := Φs) hlen,
+    wptp_split_fork_right (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (s := s) (es := es) (t2 := t2) (Φs := Φs) hlen⟩
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_split_take_drop
+    (s : Stuckness) (es t2 : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (nt' : Nat) (hlen_init : es.length = Φs.length)
+    (hlen_t2 : t2.length = Φs.length + nt') :
+    wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2
+        (Φs ++ List.replicate nt' fork_post) ⊣⊢
+      BIBase.sep
+        (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s (t2.take es.length) Φs)
+        (big_sepL (fun _ ef =>
+          wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post)
+          (t2.drop es.length)) := by
+  let es' := t2.take es.length -- split the pool at the original length
+  let t2' := t2.drop es.length
+  have ht2 : t2.length = es.length + nt' := by -- normalize the length equation
+    simp [hlen_init, hlen_t2]
+  have hsplit : t2 = es' ++ t2' := by
+    simp [es', t2']
+  have hlen_es : es'.length = es.length := by
+    simpa [es'] using length_take_eq (es := es) (t2 := t2) (n := nt') ht2
+  have hlen_esΦ : es'.length = Φs.length := by
+    simp [hlen_es, hlen_init]
+  have hlen_drop : t2'.length = nt' := by
+    simpa [t2'] using length_drop_eq (es := es) (t2 := t2) (n := nt') ht2
+  have hsplit_wptp :=
+    wptp_split_fork (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (es := es') (t2 := t2') (Φs := Φs) hlen_esΦ
+  have hsplit_wptp' :
+      wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2
+          (Φs ++ List.replicate nt' fork_post) ⊣⊢
+        BIBase.sep
+          (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es' Φs)
+          (big_sepL (fun _ ef =>
+            wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) t2') := by
+    -- normalize the split to use `t2` and `nt'`
+    simpa [hsplit, hlen_drop] using hsplit_wptp
+  simpa [es', t2'] using hsplit_wptp'
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_post_split_resources
+    (s : Stuckness) (es t2 : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ2 : Λ.state) (n nt' : Nat)
+    (hlen_init : es.length = Φs.length)
+    (hlen_t2 : t2.length = Φs.length + nt') :
+    BIBase.sep
+        (state_interp (Λ := Λ) (GF := GF) σ2 n [] nt')
+        (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2
+          (Φs ++ List.replicate nt' fork_post)) ⊢
+      BIBase.sep
+        (state_interp (Λ := Λ) (GF := GF) σ2 n [] (t2.drop es.length).length)
+        (BIBase.sep
+          (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s (t2.take es.length) Φs)
+          (big_sepL (fun _ ef =>
+            wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post)
+            (t2.drop es.length))) := by
+  have ht2 : t2.length = es.length + nt' := by
+    simpa [hlen_init] using hlen_t2
+  have hlen_drop : (t2.drop es.length).length = nt' := by
+    simpa using length_drop_eq (es := es) (t2 := t2) (n := nt') ht2
+  have hstate :
+      state_interp (Λ := Λ) (GF := GF) σ2 n [] nt' ⊢
+        state_interp (Λ := Λ) (GF := GF) σ2 n [] (t2.drop es.length).length := by
+    simp [hlen_drop]
+  have hsplit :=
+    wptp_split_take_drop (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (es := es) (t2 := t2) (Φs := Φs) (nt' := nt') hlen_init hlen_t2
+  exact sep_mono (PROP := IProp GF) hstate hsplit.1
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_post_len
+    (s : Stuckness) (t2 : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ2 : Λ.state) (n nt' : Nat) :
+    BIBase.sep
+        (state_interp (Λ := Λ) (GF := GF) σ2 n [] nt')
+        (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2
+          (Φs ++ List.replicate nt' fork_post)) ⊢
+      BIBase.pure (t2.length = Φs.length + nt') := by
+  have hlen := -- extract the length equality from `wptp`
+    (sep_elim_r
+      (P := state_interp (Λ := Λ) (GF := GF) σ2 n [] nt')
+      (Q := wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2
+        (Φs ++ List.replicate nt' fork_post))).trans
+      (wptp_length (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := t2) (Φs := Φs ++ List.replicate nt' fork_post))
+  refine hlen.trans ?_
+  refine pure_mono ?_
+  intro h
+  simpa [List.length_append, List.length_replicate, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using h
+
+
+end Iris.ProgramLogic
diff --git a/src/Iris/ProgramLogic/Adequacy/WptpHelpersC.lean b/src/Iris/ProgramLogic/Adequacy/WptpHelpersC.lean
new file mode 100644
index 00000000..73d8a4af
--- /dev/null
+++ b/src/Iris/ProgramLogic/Adequacy/WptpHelpersC.lean
@@ -0,0 +1,339 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.ProgramLogic.Adequacy.FUpd
+import Iris.ProgramLogic.Adequacy.WptpHelpersB
+import Iris.ProgramLogic.Adequacy.Preservation
+
+/-! # Adequacy: Thread Pool Helpers (C)
+
+Reference: `iris/program_logic/adequacy.v`
+
+This file defines the adequacy continuation/invariant packaging and the
+remaining `wptp` preservation helpers used by strong adequacy.
+-/
+
+namespace Iris.ProgramLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI Iris.BaseLogic
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M]
+variable [FiniteMapLaws Positive M] [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+variable {Λ : Language}
+variable [inst : IrisGS Λ GF]
+variable {W : WsatGS GF}
+noncomputable abbrev adequacy_cont
+    (s : Stuckness) (es t2 : List Λ.expr) (σ2 : Λ.state)
+    (n : Nat) (Φs : List (Λ.val → IProp GF)) (φ : Prop) : IProp GF :=
+  -- continuation that consumes the final resources to establish `φ`
+  BIBase.forall fun es' =>
+    BIBase.forall fun t2' =>
+      BIBase.wand (BIBase.pure (t2 = es' ++ t2')) <|
+      BIBase.wand (BIBase.pure (es'.length = es.length)) <|
+      BIBase.wand
+        (BIBase.pure (∀ e2, s = .notStuck → e2 ∈ t2 → not_stuck e2 σ2)) <|
+      BIBase.wand (state_interp (Λ := Λ) (GF := GF) σ2 n [] t2'.length) <|
+      BIBase.wand
+        (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es' Φs) <|
+      BIBase.wand
+        (big_sepL (fun _ ef =>
+          wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) t2') <|
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure φ)
+
+noncomputable abbrev adequacy_pre
+    (s : Stuckness) (es : List Λ.expr) (σ1 : Λ.state) (κs : List Λ.observation)
+    (t2 : List Λ.expr) (σ2 : Λ.state) (n : Nat)
+    (Φs : List (Λ.val → IProp GF)) (φ : Prop) : IProp GF :=
+  -- precondition: initial state interpretation, pool WP, and continuation
+  BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ1 0 κs 0)
+    (BIBase.sep
+      (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs)
+      (adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := es) (t2 := t2) (σ2 := σ2)
+        (n := n) (Φs := Φs) (φ := φ)))
+
+noncomputable abbrev adequacy_inv
+    (s : Stuckness) (es : List Λ.expr) (σ1 : Λ.state) (κs : List Λ.observation)
+    (t2 : List Λ.expr) (σ2 : Λ.state) (n : Nat) (φ : Prop) : IProp GF :=
+  -- existentially package the postconditions for the thread pool
+  BIBase.«exists» fun (Φs : List (Λ.val → IProp GF)) =>
+    adequacy_pre (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (es := es) (σ1 := σ1) (κs := κs)
+      (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ)
+
+noncomputable abbrev adequacy_post
+    (s : Stuckness) (es t2 : List Λ.expr) (σ2 : Λ.state) (n : Nat)
+    (Φs : List (Λ.val → IProp GF)) (φ : Prop) : IProp GF :=
+  -- postcondition: final state interpretation, post WPs, and continuation
+  BIBase.sep
+    (wptp_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      s t2 Φs σ2 n [] 0)
+    (adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (es := es) (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ))
+
+omit [FiniteMapLaws Positive M] in
+theorem adequacy_cont_drop
+    (s : Stuckness) (es : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ1 : Λ.state) (κs : List Λ.observation) (t2 : List Λ.expr) (σ2 : Λ.state)
+    (n : Nat) (φ : Prop) :
+    BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ1 0 κs 0)
+        (BIBase.sep
+          (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs)
+          (adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+            (s := s) (es := es) (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ))) ⊢
+      BIBase.sep
+        (state_interp (Λ := Λ) (GF := GF) σ1 0 κs 0)
+        (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs) := by
+  -- discard the continuation from the precondition
+  exact sep_mono (PROP := IProp GF) .rfl
+    (sep_elim_l
+      (P := wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs)
+      (Q := adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := es) (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ)))
+
+omit [FiniteMapLaws Positive M] in
+theorem wptp_len_from_pre
+    (s : Stuckness) (es : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ1 : Λ.state) (κs : List Λ.observation) (t2 : List Λ.expr) (σ2 : Λ.state)
+    (n : Nat) (φ : Prop) :
+    BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ1 0 κs 0)
+        (BIBase.sep
+          (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs)
+          (adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+            (s := s) (es := es) (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ))) ⊢
+      BIBase.pure (es.length = Φs.length) := by
+  -- extract the length equality hidden in `wptp`
+  exact (sep_elim_r (P := state_interp (Λ := Λ) (GF := GF) σ1 0 κs 0)
+    (Q := BIBase.sep
+      (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs)
+      (adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := es) (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ)))).trans
+    ((sep_elim_l (P := wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs)
+      (Q := adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := es) (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ))).trans
+      (wptp_length (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := es) (Φs := Φs)))
+
+omit [FiniteMapLaws Positive M] in
+theorem wptp_preservation_core
+    (s : Stuckness) (es : List Λ.expr) (σ1 : Λ.state) (κs : List Λ.observation)
+    (t2 : List Λ.expr) (σ2 : Λ.state) (n : Nat) (Φs : List (Λ.val → IProp GF))
+    (hsteps : nsteps (Λ := Λ) n (es, σ1) κs (t2, σ2)) :
+    BIBase.sep
+        (state_interp (Λ := Λ) (GF := GF) σ1 0 κs 0)
+        (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs) ⊢
+      step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n
+        (wptp_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          s t2 Φs σ2 n [] 0) := by
+  -- specialize preservation to an empty fork suffix
+  have hpres :=
+    wptp_preservation (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (n := n) (es1 := es) (es2 := t2) (κs := κs) (κs' := [])
+      (σ1 := σ1) (ns := 0) (σ2 := σ2) (nt := 0) (Φs := Φs) hsteps
+  simpa [wptp_preservation_pre, wptp_preservation_post, List.append_nil, Nat.add_zero] using hpres
+
+omit [FiniteMapLaws Positive M] in
+theorem wptp_preservation_frame
+    (s : Stuckness) (es : List Λ.expr) (σ1 : Λ.state) (κs : List Λ.observation)
+    (t2 : List Λ.expr) (σ2 : Λ.state) (n : Nat)
+    (Φs : List (Λ.val → IProp GF)) (φ : Prop)
+  (hsteps : nsteps (Λ := Λ) n (es, σ1) κs (t2, σ2)) :
+    adequacy_pre (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es := es) (σ1 := σ1) (κs := κs)
+        (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ) ⊢
+      step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n
+        (adequacy_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (es := es) (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ)) := by
+  let cont := adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) -- frame continuation
+    (s := s) (es := es) (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ)
+  let post := wptp_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2 Φs σ2 n [] 0
+  have hmono :
+      BIBase.sep
+          (BIBase.sep
+            (state_interp (Λ := Λ) (GF := GF) σ1 0 κs 0)
+            (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs)) cont ⊢
+        BIBase.sep
+          (step_fupdN (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) n post) cont :=
+    sep_mono (PROP := IProp GF)
+      (wptp_preservation_core (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (s := s) (es := es) (σ1 := σ1) (κs := κs) (t2 := t2) (σ2 := σ2)
+        (n := n) (Φs := Φs) hsteps) .rfl
+  exact (sep_assoc (P := state_interp (Λ := Λ) (GF := GF) σ1 0 κs 0)
+    (Q := wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es Φs) (R := cont)).2.trans
+    (hmono.trans
+      (step_fupdN_frame_r (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) (n := n)
+        (P := post) (Q := cont)))
+
+omit [FiniteMapLaws Positive M] in
+theorem apply_cont
+    (s : Stuckness) (es t2 es' t2' : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ2 : Λ.state) (n : Nat) (φ : Prop)
+    (hsplit : t2 = es' ++ t2')
+    (hlen_es : es'.length = es.length)
+    (hns : ∀ e2, s = .notStuck → e2 ∈ t2 → not_stuck e2 σ2) :
+  BIBase.sep
+        (adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (es := es) (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ))
+        (BIBase.sep
+          (state_interp (Λ := Λ) (GF := GF) σ2 n [] t2'.length)
+          (BIBase.sep
+            (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es' Φs)
+            (big_sepL (fun _ ef =>
+              wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) t2')))
+      ⊢ uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure φ) := by
+  iintro ⟨Hcont, Hσ, Hwp, Hfork⟩ -- apply the stored continuation
+  ispecialize Hcont $$ %es'
+  ispecialize Hcont $$ %t2'
+  ispecialize Hcont $$ %hsplit
+  ispecialize Hcont $$ %hlen_es
+  ispecialize Hcont $$ %hns
+  ispecialize Hcont $$ Hσ
+  ispecialize Hcont $$ Hwp
+  ispecialize Hcont $$ Hfork
+  iexact Hcont
+
+omit [FiniteMapLaws Positive M] in
+theorem wptp_post_apply_core
+    (s : Stuckness) (es t2 : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ2 : Λ.state) (n nt' : Nat) (φ : Prop)
+    (hlen_init : es.length = Φs.length)
+    (hns : ∀ e2, s = .notStuck → e2 ∈ t2 → not_stuck e2 σ2)
+    (hlen_t2 : t2.length = Φs.length + nt') :
+  BIBase.sep
+        (adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (es := es) (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ))
+        (BIBase.sep
+          (state_interp (Λ := Λ) (GF := GF) σ2 n [] nt')
+          (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2
+            (Φs ++ List.replicate nt' fork_post))) ⊢
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure φ) := by
+  let es' := t2.take es.length -- isolate the original threads
+  let t2' := t2.drop es.length
+  have hsplit : t2 = es' ++ t2' := by
+    simp [es', t2']
+  have hlen_es : es'.length = es.length := by
+    have ht2 : t2.length = es.length + nt' := by simpa [hlen_init] using hlen_t2
+    simpa [es'] using length_take_eq (es := es) (t2 := t2) (n := nt') ht2
+  have hres :=
+    wptp_post_split_resources (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (es := es) (t2 := t2) (Φs := Φs)
+      (σ2 := σ2) (n := n) (nt' := nt') hlen_init hlen_t2
+  have happly :=
+    apply_cont (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (s := s) (es := es) (t2 := t2) (es' := es') (t2' := t2') (Φs := Φs) (W := W)
+      (σ2 := σ2) (n := n) (φ := φ) hsplit hlen_es hns
+  exact (sep_mono (PROP := IProp GF) .rfl hres).trans happly
+
+omit [FiniteMapLaws Positive M] in
+theorem wptp_post_apply
+    (s : Stuckness) (es t2 : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ2 : Λ.state) (n : Nat) (φ : Prop)
+    (hlen_init : es.length = Φs.length)
+    (hns : ∀ e2, s = .notStuck → e2 ∈ t2 → not_stuck e2 σ2) :
+    BIBase.sep
+        (adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (es := es) (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ))
+        (wptp_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          s t2 Φs σ2 n [] 0) ⊢
+      uPred_fupd (M := M) (F := F) W Iris.Set.univ maskEmpty (BIBase.pure φ) := by
+  let cont :=
+    adequacy_cont (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (es := es) (t2 := t2) (σ2 := σ2) (n := n) (Φs := Φs) (φ := φ)
+  refine (sep_exists_l (P := cont) (Ψ := fun nt' => -- open the post-state existential
+    BIBase.sep
+      (state_interp (Λ := Λ) (GF := GF) σ2 n [] (0 + nt'))
+      (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2
+        (Φs ++ List.replicate nt' fork_post)))).1.trans ?_
+  refine exists_elim ?_
+  intro nt'
+  simp only [Nat.zero_add]
+  have hlenP :=
+    wptp_post_len (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (t2 := t2) (Φs := Φs) (σ2 := σ2) (n := n) (nt' := nt')
+  have hlenP' :
+      BIBase.sep cont
+          (BIBase.sep
+            (state_interp (Λ := Λ) (GF := GF) σ2 n [] nt')
+            (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2
+              (Φs ++ List.replicate nt' fork_post))) ⊢
+        BIBase.pure (t2.length = Φs.length + nt') :=
+    (sep_elim_r
+      (P := cont)
+      (Q := BIBase.sep
+        (state_interp (Λ := Λ) (GF := GF) σ2 n [] nt')
+        (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t2
+          (Φs ++ List.replicate nt' fork_post)))).trans hlenP
+  refine pure_elim (PROP := IProp GF)
+    (φ := t2.length = Φs.length + nt') hlenP' ?_
+  intro hlen_t2
+  exact wptp_post_apply_core (Λ := Λ) (GF := GF) (M := M) (F := F)
+    (s := s) (es := es) (t2 := t2) (Φs := Φs)
+    (σ2 := σ2) (n := n) (nt' := nt') (φ := φ) hlen_init hns hlen_t2
+
+omit [FiniteMapLaws Positive M] in
+theorem wp_progress_drop_cont
+    (es : List Λ.expr) (σ1 : Λ.state) (κs : List Λ.observation)
+    (t2 : List Λ.expr) (σ2 : Λ.state) (n : Nat) (φ : Prop)
+    (Hwp : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (adequacy_inv (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+            (s := .notStuck) (es := es) (σ1 := σ1) (κs := κs)
+            (t2 := t2) (σ2 := σ2) (n := n) (φ := φ))) :
+    ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (BIBase.«exists» fun (Φs : List (Λ.val → IProp GF)) =>
+            BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ1 0 κs 0)
+              (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) .notStuck es Φs)) := by
+  intro W -- drop the continuation to obtain the plain pool WP
+  refine (Hwp W).trans ?_
+  refine Iris.BaseLogic.fupd_mono (W := W)
+    (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+    (P := adequacy_inv (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := .notStuck) (es := es) (σ1 := σ1) (κs := κs)
+      (t2 := t2) (σ2 := σ2) (n := n) (φ := φ))
+    (Q := BIBase.«exists» fun (Φs : List (Λ.val → IProp GF)) =>
+      BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ1 0 κs 0)
+        (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) .notStuck es Φs)) ?_
+  refine exists_elim ?_; intro Φs
+  refine exists_intro' (a := Φs) ?_
+  -- peel the continuation and rebuild the existential witness
+  simpa [adequacy_pre] using
+    (adequacy_cont_drop (Λ := Λ) (GF := GF) (M := M) (F := F)
+      (s := .notStuck) (es := es) (Φs := Φs) (σ1 := σ1) (κs := κs)
+      (t2 := t2) (σ2 := σ2) (n := n) (φ := φ))
+
+theorem wp_progress_from_strong
+    (s : Stuckness) (es : List Λ.expr) (σ1 : Λ.state) (κs : List Λ.observation)
+    (t2 : List Λ.expr) (σ2 : Λ.state) (n : Nat) (φ : Prop)
+    (Hwp : ∀ W : WsatGS GF,
+      (BIBase.emp : IProp GF) ⊢
+        uPred_fupd (M := M) (F := F) W Iris.Set.univ Iris.Set.univ
+          (adequacy_inv (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+            (s := s) (es := es) (σ1 := σ1) (κs := κs)
+            (t2 := t2) (σ2 := σ2) (n := n) (φ := φ)))
+    (hsteps : nsteps (Λ := Λ) n (es, σ1) κs (t2, σ2)) :
+    ∀ e2, s = .notStuck → e2 ∈ t2 → not_stuck e2 σ2 := by
+  intro e2 hs hemem -- reduce to the non-stuck case and reuse `wp_progress`
+  cases s with
+  | notStuck =>
+      have hwp' :=
+        wp_progress_drop_cont (Λ := Λ) (GF := GF) (M := M) (F := F)
+          (es := es) (σ1 := σ1) (κs := κs) (t2 := t2) (σ2 := σ2) (n := n) (φ := φ) Hwp
+      exact wp_progress (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (n := n) (es := es) (σ1 := σ1) (κs := κs)
+        (t2 := t2) (σ2 := σ2) (e2 := e2) hwp' hsteps hemem
+  | maybeStuck =>
+      cases hs
+
+
+end Iris.ProgramLogic
diff --git a/src/Iris/ProgramLogic/Adequacy/WptpStep.lean b/src/Iris/ProgramLogic/Adequacy/WptpStep.lean
new file mode 100644
index 00000000..b13d1c4d
--- /dev/null
+++ b/src/Iris/ProgramLogic/Adequacy/WptpStep.lean
@@ -0,0 +1,517 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.ProgramLogic.Adequacy.WpStep
+import Iris.ProgramLogic.Adequacy.WptpHelpersA
+import Iris.ProgramLogic.Adequacy.WptpHelpersB
+
+/-! # Adequacy: Thread Pool Step
+
+Reference: `iris/program_logic/adequacy.v`
+
+This file packages the step-preservation lemmas for thread pools.
+-/
+
+namespace Iris.ProgramLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI Iris.BaseLogic
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M] [DecidableEq Positive]
+variable [FiniteMapLaws Positive M] [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+variable {Λ : Language}
+variable [inst : IrisGS Λ GF]
+variable {W : WsatGS GF}
+
+/-! ## Wptp Step Helpers -/
+
+noncomputable abbrev wptp_step_post_body
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ2 : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt : Nat) : IProp GF :=
+  -- post-step body before rebuilding `wptp`
+  BIBase.sep
+    (BIBase.later
+      (BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ2 (ns + 1) κs (efs.length + nt))
+        (BIBase.sep
+          (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e2 Φ)
+          (big_sepL (fun _ ef =>
+            wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs))))
+    (BIBase.sep
+      (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t1 Φs 0)
+      (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        s t2 Φs (t1.length + 1)))
+
+set_option linter.unusedVariables false in
+noncomputable abbrev wptp_step_post_target
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ2 : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt : Nat) : IProp GF :=
+  -- rebuilt `wptp` after the step
+  BIBase.later
+    (BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ2 (ns + 1) κs (efs.length + nt))
+      (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s
+        (t1 ++ e2 :: t2 ++ efs)
+        (Φs ++ List.replicate efs.length fork_post)))
+
+set_option linter.unusedVariables false in
+noncomputable abbrev wptp_step_split_src
+    (s : Stuckness) (t1 t2 : List Λ.expr) (e1 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ1 : Λ.state) (ns : Nat) (κ : List Λ.observation) (κs : List Λ.observation) (nt : Nat) :
+    IProp GF :=
+  -- pool state paired with the full `wptp` body
+  BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ1 ns (κ ++ κs) nt)
+    (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      s (t1 ++ e1 :: t2) Φs 0)
+
+noncomputable abbrev wptp_step_split_mid
+    (s : Stuckness) (t1 t2 : List Λ.expr) (e1 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ1 : Λ.state) (ns : Nat) (κ : List Λ.observation) (κs : List Λ.observation) (nt : Nat) :
+    IProp GF :=
+  -- `wptp` body with the focused thread separated
+  BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ1 ns (κ ++ κs) nt)
+    (BIBase.sep
+      (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t1 Φs 0)
+      (BIBase.sep
+        (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e1 Φ)
+        (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          s t2 Φs (t1.length + 1))))
+
+noncomputable abbrev wptp_step_split_tgt
+    (s : Stuckness) (t1 t2 : List Λ.expr) (e1 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ1 : Λ.state) (ns : Nat) (κ : List Λ.observation) (κs : List Λ.observation) (nt : Nat) :
+    IProp GF :=
+  -- `wptp` body reordered with the focused WP next to the state
+  BIBase.sep
+    (BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ1 ns (κ ++ κs) nt)
+      (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e1 Φ))
+    (BIBase.sep
+      (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t1 Φs 0)
+      (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        s t2 Φs (t1.length + 1)))
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_step_split_body
+    (s : Stuckness) (t1 t2 : List Λ.expr) (e1 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ1 : Λ.state) (ns : Nat) (κ : List Λ.observation) (κs : List Λ.observation) (nt : Nat)
+    (hget : Φs[t1.length]? = some Φ) :
+    wptp_step_split_src (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (e1 := e1) (Φs := Φs) (Φ := Φ)
+        (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs) (nt := nt) ⊢
+      wptp_step_split_mid (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (e1 := e1) (Φs := Φs) (Φ := Φ)
+        (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs) (nt := nt) := by
+  -- split the middle element inside the `big_sepL`
+  have hsplit :=
+    (wptp_body_at_middle (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (t1 := t1) (t2 := t2) (e := e1) (Φs := Φs) (k := 0)
+      (Φ := Φ) (by simpa [Nat.zero_add] using hget)).1
+  have hsplit' :
+      wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          s (t1 ++ e1 :: t2) Φs 0 ⊢
+        BIBase.sep
+          (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t1 Φs 0)
+          (BIBase.sep
+            (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e1 Φ)
+            (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+              s t2 Φs (t1.length + 1))) := by
+    -- normalize the tail offset in the split lemma
+    simpa [Nat.zero_add] using hsplit
+  let P :=
+    wptp_step_split_src (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (t1 := t1) (t2 := t2) (e1 := e1) (Φs := Φs) (Φ := Φ)
+      (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs) (nt := nt)
+  let Q :=
+    wptp_step_split_mid (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (t1 := t1) (t2 := t2) (e1 := e1) (Φs := Φs) (Φ := Φ)
+      (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs) (nt := nt)
+  have hbody : P ⊢ Q :=
+    sep_mono (PROP := IProp GF) .rfl hsplit'
+  simpa [P, Q] using hbody
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_step_split_reorder
+    (s : Stuckness) (t1 t2 : List Λ.expr) (e1 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ1 : Λ.state) (ns : Nat) (κ : List Λ.observation) (κs : List Λ.observation) (nt : Nat) :
+    wptp_step_split_mid (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (e1 := e1) (Φs := Φs) (Φ := Φ)
+        (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs) (nt := nt) ⊢
+      wptp_step_split_tgt (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (e1 := e1) (Φs := Φs) (Φ := Φ)
+        (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs) (nt := nt) := by
+  -- reassociate and swap the middle elements
+  have hassoc := (sep_assoc
+    (P := state_interp (Λ := Λ) (GF := GF) σ1 ns (κ ++ κs) nt)
+    (Q := wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t1 Φs 0)
+    (R := BIBase.sep (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e1 Φ)
+      (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        s t2 Φs (t1.length + 1)))).2
+  have hswap := (sep_sep_sep_comm
+    (P := state_interp (Λ := Λ) (GF := GF) σ1 ns (κ ++ κs) nt)
+    (Q := wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t1 Φs 0)
+    (R := wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e1 Φ)
+    (S := wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      s t2 Φs (t1.length + 1))).1
+  exact hassoc.trans hswap
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_step_split
+    (s : Stuckness) (t1 t2 : List Λ.expr) (e1 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ1 : Λ.state) (ns : Nat) (κ : List Λ.observation) (κs : List Λ.observation) (nt : Nat)
+    (hget : Φs[t1.length]? = some Φ) :
+    wptp_step_split_src (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (e1 := e1) (Φs := Φs) (Φ := Φ)
+        (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs) (nt := nt) ⊢
+      wptp_step_split_tgt (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (e1 := e1) (Φs := Φs) (Φ := Φ)
+        (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs) (nt := nt) := by
+  -- split the middle element, then reorder the `sep` chain
+  have hbody := wptp_step_split_body (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (t1 := t1) (t2 := t2) (e1 := e1)
+    (Φs := Φs) (Φ := Φ) (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs) (nt := nt) hget
+  have hreorder := wptp_step_split_reorder (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (t1 := t1) (t2 := t2) (e1 := e1)
+    (Φs := Φs) (Φ := Φ) (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs) (nt := nt)
+  exact hbody.trans hreorder
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_step_apply
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e1 e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ1 σ2 : Λ.state) (ns : Nat) (κ : List Λ.observation) (κs : List Λ.observation)
+    (nt : Nat) (hstep : Λ.prim_step e1 σ1 κ e2 σ2 efs) :
+    wptp_step_split_tgt (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (e1 := e1) (Φs := Φs) (Φ := Φ)
+        (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs) (nt := nt) ⊢
+      fupd' (W := W) (M := M) (F := F) Iris.Set.univ Iris.Set.univ
+        (wptp_step_post_body (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+          (Φs := Φs) (Φ := Φ) (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt)) := by
+  -- step the focused thread and frame the remaining pool
+  let X :=
+    BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ2 (ns + 1) κs (efs.length + nt))
+      (BIBase.sep
+        (wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ e2 Φ)
+        (big_sepL (fun _ ef =>
+          wp (W := W) (M := M) (F := F) (Λ := Λ) s Iris.Set.univ ef fork_post) efs))
+  have hwp := adq_wp_step (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (e1 := e1) (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs)
+    (e2 := e2) (σ2 := σ2) (efs := efs) (nt := nt) (Φ := Φ) hstep
+  exact (sep_mono (PROP := IProp GF) hwp .rfl).trans
+    (Iris.BaseLogic.fupd_frame_r (W := W)
+      (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+      (P := BIBase.later X)
+      (Q := BIBase.sep
+        (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s t1 Φs 0)
+        (wptp_body_at (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          s t2 Φs (t1.length + 1))))
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Helper: combine split and apply for `wptp_step_frame`. -/
+theorem wptp_step_frame_apply
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e1 e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ1 σ2 : Λ.state) (ns : Nat) (κ : List Λ.observation) (κs : List Λ.observation)
+    (nt : Nat) (hstep : Λ.prim_step e1 σ1 κ e2 σ2 efs)
+    (hget : Φs[t1.length]? = some Φ) :
+    wptp_step_split_src (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (e1 := e1) (Φs := Φs) (Φ := Φ)
+        (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs) (nt := nt) ⊢
+      fupd' (W := W) (M := M) (F := F) Iris.Set.univ Iris.Set.univ
+        (wptp_step_post_body (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+          (Φs := Φs) (Φ := Φ) (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt)) := by
+  -- split the middle thread, then apply the step rule
+  have hsplit := wptp_step_split (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (t1 := t1) (t2 := t2) (e1 := e1) (Φs := Φs) (Φ := Φ)
+    (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs) (nt := nt) hget
+  have happly := wptp_step_apply (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e1 := e1) (e2 := e2)
+    (Φs := Φs) (Φ := Φ) (σ1 := σ1) (σ2 := σ2) (ns := ns)
+    (κ := κ) (κs := κs) (nt := nt) hstep
+  exact hsplit.trans happly
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Helper: lift the rebuild lemma under `fupd`. -/
+theorem wptp_step_frame_post
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ2 : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt : Nat)
+    (hlen : Φs.length = t1.length + t2.length + 1)
+    (hget : Φs[t1.length]? = some Φ) :
+    fupd' (W := W) (M := M) (F := F) Iris.Set.univ Iris.Set.univ
+        (wptp_step_post_body (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+          (Φs := Φs) (Φ := Φ) (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt)) ⊢
+      fupd' (W := W) (M := M) (F := F) Iris.Set.univ Iris.Set.univ
+        (wptp_step_post_target (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+          (Φs := Φs) (Φ := Φ) (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt)) := by
+  -- lift `wptp_step_post` under the outer `fupd`
+  exact Iris.BaseLogic.fupd_mono (W := W)
+    (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+    (P := wptp_step_post_body (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+      (Φs := Φs) (Φ := Φ) (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt))
+    (Q := wptp_step_post_target (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+      (Φs := Φs) (Φ := Φ) (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt))
+    (wptp_step_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+      (Φs := Φs) (Φ := Φ) (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt) hlen hget)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_step_frame
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e1 e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ1 σ2 : Λ.state) (ns : Nat) (κ : List Λ.observation) (κs : List Λ.observation)
+    (nt : Nat) (hstep : Λ.prim_step e1 σ1 κ e2 σ2 efs)
+    (hlen : Φs.length = t1.length + t2.length + 1)
+    (hget : Φs[t1.length]? = some Φ) :
+    wptp_step_split_src (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (e1 := e1) (Φs := Φs) (Φ := Φ)
+        (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs) (nt := nt) ⊢
+      fupd' (W := W) (M := M) (F := F) Iris.Set.univ Iris.Set.univ
+        (wptp_step_post_target (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+          (Φs := Φs) (Φ := Φ) (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt)) := by
+  -- split the middle thread, step it, then rebuild the pool
+  have happly := wptp_step_frame_apply (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e1 := e1) (e2 := e2)
+    (Φs := Φs) (Φ := Φ) (σ1 := σ1) (σ2 := σ2) (ns := ns)
+    (κ := κ) (κs := κs) (nt := nt) hstep hget
+  have hpost := wptp_step_frame_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+    (Φs := Φs) (Φ := Φ) (σ2 := σ2) (ns := ns) (κs := κs)
+    (nt := nt) hlen hget
+  exact happly.trans hpost
+
+/-! ## Thread Pool Step -/
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- A step of the thread pool preserves the thread pool WP.
+Coq: `wptp_step` in `adequacy.v`. -/
+theorem wptp_step_len_false (s : Stuckness) (es1 es2 : List Λ.expr)
+    (κ : List Λ.observation) (κs : List Λ.observation)
+    (σ1 : Λ.state) (ns : Nat) (σ2 : Λ.state) (nt : Nat)
+    (Φs : List (Λ.val → IProp GF))
+    (hlen : es1.length ≠ Φs.length) :
+    BIBase.sep
+      (state_interp (Λ := Λ) (GF := GF) σ1 ns (κ ++ κs) nt)
+      (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es1 Φs) ⊢
+      fupd' (W := W) (M := M) (F := F) Iris.Set.univ Iris.Set.univ
+        (BIBase.later
+          (wptp_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+            s es2 Φs σ2 (ns + 1) κs nt)) := by
+  -- discharge the inconsistent-length case via pure elimination
+  let Q :=
+    BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ1 ns (κ ++ κs) nt)
+      (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es1 Φs)
+  have hlenP : Q ⊢ BIBase.pure (es1.length = Φs.length) :=
+    (sep_elim_r (P := state_interp (Λ := Λ) (GF := GF) σ1 ns (κ ++ κs) nt)
+      (Q := wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es1 Φs)).trans
+      (wptp_length (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) (s := s) (es := es1)
+        (Φs := Φs))
+  have hkill : es1.length = Φs.length → Q ⊢
+      fupd' (W := W) (M := M) (F := F) Iris.Set.univ Iris.Set.univ
+        (BIBase.later (wptp_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          s es2 Φs σ2 (ns + 1) κs nt)) := by
+    intro h; exact (False.elim (hlen h))
+  exact pure_elim (φ := es1.length = Φs.length) hlenP hkill
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Helper: step a focused thread starting from a full `wptp`. -/
+theorem wptp_step_len_true_frame
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e1 e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (Φ : Λ.val → IProp GF)
+    (σ1 σ2 : Λ.state) (ns : Nat) (κ : List Λ.observation) (κs : List Λ.observation)
+    (nt : Nat) (hstep : Λ.prim_step e1 σ1 κ e2 σ2 efs)
+    (hlen : Φs.length = t1.length + t2.length + 1)
+    (hget : Φs[t1.length]? = some Φ) :
+    BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ1 ns (κ ++ κs) nt)
+        (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s
+          (t1 ++ [e1] ++ t2) Φs) ⊢
+      fupd' (W := W) (M := M) (F := F) Iris.Set.univ Iris.Set.univ
+        (BIBase.later
+          (BIBase.sep
+            (state_interp (Λ := Λ) (GF := GF) σ2 (ns + 1) κs (efs.length + nt))
+            (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s
+              (t1 ++ [e2] ++ t2 ++ efs)
+              (Φs ++ List.replicate efs.length fork_post)))) := by
+  -- open `wptp`, apply the frame rule, then rewrite list structure
+  have hbody := wptp_body_of_wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (es := t1 ++ e1 :: t2) (Φs := Φs)
+  have hframe := wptp_step_frame (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e1 := e1) (e2 := e2)
+    (Φs := Φs) (Φ := Φ) (σ1 := σ1) (σ2 := σ2) (ns := ns)
+    (κ := κ) (κs := κs) (nt := nt) hstep hlen hget
+  have hmain := (sep_mono (PROP := IProp GF) .rfl hbody).trans hframe
+  simpa [wptp_step_post_target, List.singleton_append, List.append_assoc] using hmain
+
+/-- Helper: precondition for `wptp_step_len_true`. -/
+noncomputable abbrev wptp_step_len_pre
+    (s : Stuckness) (es1 : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ1 : Λ.state) (ns : Nat) (κ : List Λ.observation) (κs : List Λ.observation) (nt : Nat) :
+    IProp GF :=
+  -- state interpretation paired with the pool WP
+  BIBase.sep
+    (state_interp (Λ := Λ) (GF := GF) σ1 ns (κ ++ κs) nt)
+    (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es1 Φs)
+
+/-- Helper: post-step body for `wptp_step_len_true`. -/
+noncomputable abbrev wptp_step_len_body
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (σ2 : Λ.state) (ns : Nat)
+    (κs : List Λ.observation) (nt : Nat) : IProp GF :=
+  -- later-guarded state interpretation and rebuilt pool
+  BIBase.later
+    (BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ2 (ns + 1) κs (efs.length + nt))
+      (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s
+        (t1 ++ [e2] ++ t2 ++ efs)
+        (Φs ++ List.replicate efs.length fork_post)))
+
+/-- Helper: `wptp_post` target for `wptp_step_len_true`. -/
+noncomputable abbrev wptp_step_len_post
+    (s : Stuckness) (es2 : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ2 : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt : Nat) : IProp GF :=
+  -- later-guarded thread-pool postcondition
+  BIBase.later
+    (wptp_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+      s es2 Φs σ2 (ns + 1) κs nt)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Helper: package a `wptp_post` existential under `▷`. -/
+theorem wptp_post_later_intro
+    (s : Stuckness) (es : List Λ.expr) (Φs : List (Λ.val → IProp GF))
+    (σ : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt nt' : Nat) :
+    BIBase.later
+        (BIBase.sep (state_interp (Λ := Λ) (GF := GF) σ ns κs (nt' + nt))
+          (wptp (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W) s es
+            (Φs ++ List.replicate nt' fork_post))) ⊢
+      BIBase.later
+        (wptp_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          s es Φs σ ns κs nt) := by
+  -- introduce the existential fork count under the `later`
+  refine later_mono ?_
+  refine exists_intro' (a := nt') ?_
+  simp [Nat.add_comm]
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Helper: lift the post body to `wptp_post` in the atomic case. -/
+theorem wptp_step_len_true_atomic_post
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF)) (σ2 : Λ.state) (ns : Nat)
+    (κs : List Λ.observation) (nt : Nat) :
+    wptp_step_len_body (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+        (Φs := Φs) (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt) ⊢
+      wptp_step_len_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es2 := t1 ++ [e2] ++ t2 ++ efs) (Φs := Φs)
+        (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt) := by
+  -- package the `wptp_post` existential under `▷`
+  exact wptp_post_later_intro (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (es := t1 ++ [e2] ++ t2 ++ efs) (Φs := Φs)
+    (σ := σ2) (ns := ns + 1) (κs := κs) (nt := nt) (nt' := efs.length)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Helper: atomic step case for `wptp_step_len_true`. -/
+theorem wptp_step_len_true_atomic
+    (s : Stuckness) (t1 t2 efs : List Λ.expr) (e1 e2 : Λ.expr)
+    (Φs : List (Λ.val → IProp GF))
+    (σ1 σ2 : Λ.state) (ns : Nat) (κ : List Λ.observation) (κs : List Λ.observation)
+    (nt : Nat) (hprim : Λ.prim_step e1 σ1 κ e2 σ2 efs)
+    (hlen : (t1 ++ [e1] ++ t2).length = Φs.length) :
+    wptp_step_len_pre (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es1 := t1 ++ [e1] ++ t2) (Φs := Φs)
+        (σ1 := σ1) (ns := ns) (κ := κ) (κs := κs) (nt := nt) ⊢
+      fupd' (W := W) (M := M) (F := F) Iris.Set.univ Iris.Set.univ
+        (wptp_step_len_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (es2 := t1 ++ [e2] ++ t2 ++ efs) (Φs := Φs)
+          (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt)) := by
+  -- rebuild the pool and package the `wptp_post`
+  have hlen' : Φs.length = t1.length + t2.length + 1 := by
+    simpa [List.length_append, List.length_cons, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using hlen.symm
+  rcases wptp_lookup_middle (t1 := t1) (t2 := t2) (Φs := Φs) hlen' with ⟨Φ, hget⟩
+  have hmain := wptp_step_len_true_frame (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e1 := e1) (e2 := e2)
+    (Φs := Φs) (Φ := Φ) (σ1 := σ1) (σ2 := σ2) (ns := ns) (κ := κ) (κs := κs)
+    (nt := nt) hprim hlen' hget
+  have hpost := wptp_step_len_true_atomic_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+    (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+    (Φs := Φs) (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt)
+  exact hmain.trans <|
+    Iris.BaseLogic.fupd_mono (W := W)
+      (M := M) (F := F) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+      (P := wptp_step_len_body (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e2 := e2)
+        (Φs := Φs) (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt))
+      (Q := wptp_step_len_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es2 := t1 ++ [e2] ++ t2 ++ efs) (Φs := Φs)
+        (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt)) hpost
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_step_len_true (s : Stuckness) (es1 es2 : List Λ.expr)
+    (κ : List Λ.observation) (κs : List Λ.observation)
+    (σ1 : Λ.state) (ns : Nat) (σ2 : Λ.state) (nt : Nat)
+    (Φs : List (Λ.val → IProp GF))
+    (hstep : step (Λ := Λ) (es1, σ1) κ (es2, σ2))
+    (hlen : es1.length = Φs.length) :
+    wptp_step_len_pre (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es1 := es1) (Φs := Φs) (σ1 := σ1) (ns := ns)
+        (κ := κ) (κs := κs) (nt := nt) ⊢
+      fupd' (W := W) (M := M) (F := F) Iris.Set.univ Iris.Set.univ
+        (wptp_step_len_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+          (s := s) (es2 := es2) (Φs := Φs) (σ2 := σ2) (ns := ns)
+          (κs := κs) (nt := nt)) := by
+  -- focus the stepping thread, then rebuild the pool and add the existential
+  classical
+  cases hstep with
+  | step_atomic e1 σ1' e2 σ2' efs t1 t2 _ hprim =>
+      exact wptp_step_len_true_atomic (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (t1 := t1) (t2 := t2) (efs := efs) (e1 := e1) (e2 := e2)
+        (Φs := Φs) (σ1 := σ1) (σ2 := σ2) (ns := ns) (κ := κ) (κs := κs)
+        (nt := nt) hprim (by simpa using hlen)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+theorem wptp_step' (s : Stuckness) (es1 es2 : List Λ.expr)
+    (κ : List Λ.observation) (κs : List Λ.observation)
+    (σ1 : Λ.state) (ns : Nat) (σ2 : Λ.state) (nt : Nat)
+    (Φs : List (Λ.val → IProp GF))
+    (hstep : step (es1, σ1) κ (es2, σ2)) :
+    BIBase.sep
+      (IrisGS.state_interp (Λ := Λ) (GF := GF) σ1 ns (κ ++ κs) nt)
+      (wptp (M := M) (F := F) (Λ := Λ) (W := W) s es1 Φs)
+    ⊢ uPred_fupd (M := M) (F := F) W
+        Iris.Set.univ Iris.Set.univ
+        (BIBase.later
+          (wptp_post (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+            s es2 Φs σ2 (ns + 1) κs nt)) := by
+  -- split on length consistency, then dispatch to the appropriate lemma
+  classical
+  by_cases hlen : es1.length = Φs.length
+  · simpa [state_interp] using
+      wptp_step_len_true (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es1 := es1) (es2 := es2) (κ := κ) (κs := κs)
+        (σ1 := σ1) (ns := ns) (σ2 := σ2) (nt := nt)
+        (Φs := Φs) hstep hlen
+  · simpa [state_interp] using
+      wptp_step_len_false (Λ := Λ) (GF := GF) (M := M) (F := F) (W := W)
+        (s := s) (es1 := es1) (es2 := es2) (κ := κ) (κs := κs)
+        (σ1 := σ1) (ns := ns) (σ2 := σ2) (nt := nt)
+        (Φs := Φs) hlen
+
+
+end Iris.ProgramLogic
diff --git a/src/Iris/ProgramLogic/EctxLanguage.lean b/src/Iris/ProgramLogic/EctxLanguage.lean
new file mode 100644
index 00000000..50dedb51
--- /dev/null
+++ b/src/Iris/ProgramLogic/EctxLanguage.lean
@@ -0,0 +1,625 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.ProgramLogic.Language
+
+/-! # Evaluation Context Language
+
+Reference: `iris/program_logic/ectx_language.v`
+
+An axiomatization of evaluation-context based languages, including a proof
+that this gives rise to a `Language` in the Iris sense. An `EctxLanguage`
+factors the step relation through a decomposition into evaluation contexts
+and base redexes, which simplifies reasoning about contextual stepping.
+
+## Main Definitions
+
+- `EctxLanguageMixin` — axioms for ectx-based languages
+- `EctxLanguage` — structure bundling expr, val, ectx, state, observation,
+  and the mixin axioms
+- `ectx_lang` — construct a `Language` from an `EctxLanguage`
+- `base_reducible`, `base_irreducible`, `base_stuck` — base-level stepping predicates
+- `sub_redexes_are_values` — all sub-redexes are values
+- `pure_base_step` — pure step at the base level
+
+## Key Results
+
+- `fill_not_val` — filling a non-value gives a non-value
+- `base_redex_unique` — decomposition into base redex is unique
+- `ectx_lang_ctx` — every evaluation context is a `LanguageCtx`
+- `ectx_language_atomic` — base-atomic + sub-redexes-are-values implies `Atomic`
+- `base_reducible_prim_step` — base-reducible implies base step
+- `pure_base_step_pure_step` — base pure step implies language pure step
+-/
+
+namespace Iris.ProgramLogic
+
+/-! ## Ectx Language Mixin -/
+
+/-- Axioms for an evaluation-context based language.
+Coq: `EctxLanguageMixin` in `ectx_language.v`. -/
+structure EctxLanguageMixin (expr val ectx : Type) (state : Type) (observation : Type)
+    (of_val : val → expr) (to_val : expr → Option val)
+    (empty_ectx : ectx) (comp_ectx : ectx → ectx → ectx)
+    (fill : ectx → expr → expr) (base_step : expr → state → List observation → expr → state → List expr → Prop) where
+  -- axioms governing evaluation contexts and base steps
+  /-- `to_val (of_val v) = some v` -/ to_of_val : ∀ v, to_val (of_val v) = some v
+  /-- `to_val e = some v → of_val v = e` -/ of_to_val : ∀ e v, to_val e = some v → of_val v = e
+  /-- Base values do not step. -/ val_base_stuck :
+    ∀ e1 σ1 κ e2 σ2 efs, base_step e1 σ1 κ e2 σ2 efs → to_val e1 = none
+  /-- Filling with the empty context is the identity. -/ fill_empty :
+    ∀ e, fill empty_ectx e = e
+  /-- Filling distributes over context composition. -/ fill_comp :
+    ∀ K1 K2 e, fill K1 (fill K2 e) = fill (comp_ectx K1 K2) e
+  /-- Filling is injective. -/ fill_inj : ∀ K, Function.Injective (fill K)
+  /-- Filling preserves value-ness. -/ fill_val :
+    ∀ K e, (∃ v, to_val (fill K e) = some v) → ∃ v, to_val e = some v
+  /-- Step-by-value: decompositions agree up to context extension. -/ step_by_val :
+    ∀ K' K_redex e1' e1_redex σ1 κ e2 σ2 efs,
+      fill K' e1' = fill K_redex e1_redex →
+      to_val e1' = none →
+      base_step e1_redex σ1 κ e2 σ2 efs →
+      ∃ K'', K_redex = comp_ectx K' K''
+  /-- Base steps only happen at the root or on values. -/ base_ctx_step_val :
+    ∀ K e σ1 κ e2 σ2 efs,
+      base_step (fill K e) σ1 κ e2 σ2 efs → (∃ v, to_val e = some v) ∨ K = empty_ectx
+
+/-! ## Ectx Language Structure -/
+
+/-- An evaluation-context based language.
+Coq: `ectxLanguage` in `ectx_language.v`. -/
+structure EctxLanguage where
+  -- bundle types, operations, and axioms for ectx languages
+  /-- Expression type -/ expr : Type
+  /-- Value type -/ val : Type
+  /-- Evaluation context type -/ ectx : Type
+  /-- State type -/ state : Type
+  /-- Observation type -/ observation : Type
+  /-- Inject a value into an expression -/ of_val : val → expr
+  /-- Extract a value from an expression -/ to_val : expr → Option val
+  /-- Empty evaluation context -/ empty_ectx : ectx
+  /-- Compose evaluation contexts -/ comp_ectx : ectx → ectx → ectx
+  /-- Fill an evaluation context with an expression -/ fill : ectx → expr → expr
+  /-- Base step relation -/ base_step :
+    expr → state → List observation → expr → state → List expr → Prop
+  /-- The mixin axioms hold -/ mixin :
+    EctxLanguageMixin expr val ectx state observation of_val to_val
+      empty_ectx comp_ectx fill base_step
+
+variable {Λ : EctxLanguage}
+
+/-! ## Mixin Projections -/
+
+/-- Coq: `val_base_stuck` in `ectx_language.v`. -/
+theorem val_base_stuck' (e1 : Λ.expr) (σ1 : Λ.state) (κ : List Λ.observation)
+    (e2 : Λ.expr) (σ2 : Λ.state) (efs : List Λ.expr) :
+    Λ.base_step e1 σ1 κ e2 σ2 efs → Λ.to_val e1 = none :=
+  Λ.mixin.val_base_stuck e1 σ1 κ e2 σ2 efs
+
+/-- Coq: `fill_empty` in `ectx_language.v`. -/
+theorem fill_empty (e : Λ.expr) : Λ.fill Λ.empty_ectx e = e :=
+  Λ.mixin.fill_empty e
+
+/-- Coq: `fill_comp` in `ectx_language.v`. -/
+theorem fill_comp (K1 K2 : Λ.ectx) (e : Λ.expr) :
+    Λ.fill K1 (Λ.fill K2 e) = Λ.fill (Λ.comp_ectx K1 K2) e :=
+  Λ.mixin.fill_comp K1 K2 e
+
+/-- Coq: `fill_inj` in `ectx_language.v`. -/
+theorem fill_inj (K : Λ.ectx) : Function.Injective (Λ.fill K) :=
+  Λ.mixin.fill_inj K
+
+/-- Coq: `fill_val` in `ectx_language.v`. -/
+theorem fill_val (K : Λ.ectx) (e : Λ.expr) :
+    (∃ v, Λ.to_val (Λ.fill K e) = some v) → ∃ v, Λ.to_val e = some v :=
+  Λ.mixin.fill_val K e
+
+/-- Coq: `step_by_val` in `ectx_language.v`. -/
+theorem step_by_val (K' K_redex : Λ.ectx) (e1' e1_redex : Λ.expr)
+    (σ1 : Λ.state) (κ : List Λ.observation) (e2 : Λ.expr) (σ2 : Λ.state)
+    (efs : List Λ.expr) :
+    Λ.fill K' e1' = Λ.fill K_redex e1_redex →
+    Λ.to_val e1' = none →
+    Λ.base_step e1_redex σ1 κ e2 σ2 efs →
+    ∃ K'', K_redex = Λ.comp_ectx K' K'' :=
+  Λ.mixin.step_by_val K' K_redex e1' e1_redex σ1 κ e2 σ2 efs
+
+/-- Coq: `base_ctx_step_val` in `ectx_language.v`. -/
+theorem base_ctx_step_val (K : Λ.ectx) (e : Λ.expr)
+    (σ1 : Λ.state) (κ : List Λ.observation) (e2 : Λ.expr) (σ2 : Λ.state)
+    (efs : List Λ.expr) :
+    Λ.base_step (Λ.fill K e) σ1 κ e2 σ2 efs →
+    (∃ v, Λ.to_val e = some v) ∨ K = Λ.empty_ectx :=
+  Λ.mixin.base_ctx_step_val K e σ1 κ e2 σ2 efs
+
+/-! ## Base Stepping Predicates -/
+
+/-- An expression is base-reducible if it can take a base step.
+Coq: `base_reducible` in `ectx_language.v`. -/
+def base_reducible (e : Λ.expr) (σ : Λ.state) : Prop :=
+  ∃ κ e' σ' efs, Λ.base_step e σ κ e' σ' efs
+
+/-- An expression is base-reducible with no observations.
+Coq: `base_reducible_no_obs` in `ectx_language.v`. -/
+def base_reducible_no_obs (e : Λ.expr) (σ : Λ.state) : Prop :=
+  ∃ e' σ' efs, Λ.base_step e σ [] e' σ' efs
+
+/-- An expression is base-irreducible if it cannot take any base step.
+Coq: `base_irreducible` in `ectx_language.v`. -/
+def base_irreducible (e : Λ.expr) (σ : Λ.state) : Prop :=
+  ∀ κ e' σ' efs, ¬Λ.base_step e σ κ e' σ' efs
+
+/-- An expression is base-stuck if it is not a value and is base-irreducible.
+Coq: `base_stuck` in `ectx_language.v`. -/
+def base_stuck (e : Λ.expr) (σ : Λ.state) : Prop :=
+  Λ.to_val e = none ∧ base_irreducible e σ
+
+/-- All sub-redexes are values: if `e = fill K e'` and `e'` is not a value,
+then `K` is the empty context.
+Coq: `sub_redexes_are_values` in `ectx_language.v`. -/
+def sub_redexes_are_values (e : Λ.expr) : Prop :=
+  ∀ K e', e = Λ.fill K e' → Λ.to_val e' = none → K = Λ.empty_ectx
+
+/-! ## Prim Step from Base Step -/
+
+/-- Primitive step for an ectx language: decompose into context and base redex.
+Coq: `prim_step` (inductive) in `ectx_language.v`. -/
+inductive ectx_prim_step (Λ : EctxLanguage) :
+    Λ.expr → Λ.state → List Λ.observation → Λ.expr → Λ.state → List Λ.expr → Prop where
+  | ectx_step (K : Λ.ectx) (e1' e2' : Λ.expr) (σ1 : Λ.state) (κ : List Λ.observation)
+      (σ2 : Λ.state) (efs : List Λ.expr) (e1 e2 : Λ.expr) :
+    e1 = Λ.fill K e1' →
+    e2 = Λ.fill K e2' →
+    Λ.base_step e1' σ1 κ e2' σ2 efs →
+    ectx_prim_step Λ e1 σ1 κ e2 σ2 efs
+
+/-! ## Prim Step Helpers -/
+
+/-- Helper: invert an ectx primitive step into its context and redex. -/
+private theorem ectx_prim_step_inv (e1 : Λ.expr) (σ1 : Λ.state) (κ : List Λ.observation)
+    (e2 : Λ.expr) (σ2 : Λ.state) (efs : List Λ.expr) :
+    ectx_prim_step Λ e1 σ1 κ e2 σ2 efs →
+    ∃ K e1' e2', e1 = Λ.fill K e1' ∧ e2 = Λ.fill K e2' ∧ Λ.base_step e1' σ1 κ e2' σ2 efs :=
+  by
+    -- unpack the constructor and expose the equalities
+    intro hstep
+    cases hstep with
+    | ectx_step K e1' e2' σ1 κ σ2 efs e1 e2 hEq1 hEq2 hbase =>
+        exact ⟨K, e1', e2', hEq1, hEq2, hbase⟩
+
+/-- Helper: solve the hole equation produced by `step_by_val`. -/
+private theorem fill_eq_of_step_by_val (K K' K'' : Λ.ectx) (e1 e1' : Λ.expr)
+    (hEq : Λ.fill K e1 = Λ.fill K' e1') (hK' : K' = Λ.comp_ectx K K'') :
+    e1 = Λ.fill K'' e1' := by
+  -- rewrite by context composition and apply injectivity
+  have hfill : Λ.fill K e1 = Λ.fill K (Λ.fill K'' e1') := by
+    simpa [hK', fill_comp] using hEq
+  exact (fill_inj (Λ := Λ) K) hfill
+
+/-- Helper: values do not take primitive steps in the ectx language. -/
+private theorem ectx_lang_val_stuck (e : Λ.expr) (σ : Λ.state) (κ : List Λ.observation)
+    (e' : Λ.expr) (σ' : Λ.state) (efs : List Λ.expr) :
+    ectx_prim_step Λ e σ κ e' σ' efs → Λ.to_val e = none :=
+  by
+    -- reduce to the base step and use `fill_val` to rule out values
+    intro hstep
+    cases hstep with
+    | ectx_step K e1' e2' σ1 κ σ2 efs e1 e2 hEq1 _ hbase =>
+        have hnone : Λ.to_val e1' = none :=
+          val_base_stuck' (Λ := Λ) e1' _ _ _ _ _ hbase
+        have hfill : Λ.to_val (Λ.fill K e1') = none := by
+          -- split on value-ness of the filled expression
+          cases hto : Λ.to_val (Λ.fill K e1') with
+          | none => rfl
+          | some v =>
+              have hval : ∃ v, Λ.to_val (Λ.fill K e1') = some v := ⟨v, hto⟩
+              rcases fill_val (Λ := Λ) K e1' hval with ⟨v', hv'⟩
+              have : False := by
+                -- contradict non-value by discriminating `none = some`
+                cases hnone.symm.trans hv'
+              exact (False.elim this)
+        simpa [hEq1] using hfill
+
+/-- Construct a `Language` from an `EctxLanguage`.
+Coq: `ectx_lang` / `LanguageOfEctx` in `ectx_language.v`. -/
+def ectx_lang (Λ : EctxLanguage) : Language :=
+  -- assemble the language structure from the ectx components
+  { expr := Λ.expr
+    val := Λ.val
+    state := Λ.state
+    observation := Λ.observation
+    of_val := Λ.of_val
+    to_val := Λ.to_val
+    prim_step := ectx_prim_step Λ
+    mixin := {
+      to_of_val := Λ.mixin.to_of_val
+      of_to_val := Λ.mixin.of_to_val
+      val_stuck := ectx_lang_val_stuck (Λ := Λ)
+    } }
+
+/-! ## Base-Level Lemmas -/
+
+/-- Coq: `fill_not_val` in `ectx_language.v`. -/
+theorem fill_not_val (K : Λ.ectx) (e : Λ.expr) :
+    Λ.to_val e = none → Λ.to_val (Λ.fill K e) = none :=
+  by
+    -- use `fill_val` to contradict value-ness after filling
+    intro hnone
+    cases hto : Λ.to_val (Λ.fill K e) with
+    | none => rfl
+    | some v =>
+        have hval : ∃ v, Λ.to_val (Λ.fill K e) = some v := ⟨v, hto⟩
+        rcases fill_val (Λ := Λ) K e hval with ⟨v', hv'⟩
+        have : False := by
+          -- contradict non-value by discriminating `none = some`
+          cases hnone.symm.trans hv'
+        exact (False.elim this)
+
+/-- Coq: `base_reducible_no_obs_reducible` in `ectx_language.v`. -/
+theorem base_reducible_no_obs_base_reducible (e : Λ.expr) (σ : Λ.state) :
+    base_reducible_no_obs e σ → base_reducible e σ :=
+  by
+    -- widen the witness by adding empty observations
+    rintro ⟨e', σ', efs, hstep⟩
+    exact ⟨[], e', σ', efs, hstep⟩
+
+/-- Coq: `not_base_reducible` in `ectx_language.v`. -/
+theorem not_base_reducible (e : Λ.expr) (σ : Λ.state) :
+    ¬base_reducible e σ ↔ base_irreducible e σ :=
+  by
+    -- unfold and push negation through the existential
+    constructor
+    · intro h κ e' σ' efs hstep
+      exact h ⟨κ, e', σ', efs, hstep⟩
+    · intro h hred
+      rcases hred with ⟨κ, e', σ', efs, hstep⟩
+      exact h κ e' σ' efs hstep
+
+/-- Helper: a base step in a context forces the context to be empty
+when the hole itself can step. -/
+private theorem ctx_empty_of_base_steps (K : Λ.ectx) (e1' : Λ.expr) (σ1 : Λ.state)
+    (κ1 : List Λ.observation) (e2r : Λ.expr) (σ2r : Λ.state) (efsr : List Λ.expr)
+    (κ2 : List Λ.observation) (e2' : Λ.expr) (σ2 : Λ.state) (efs : List Λ.expr) :
+    Λ.base_step (Λ.fill K e1') σ1 κ1 e2r σ2r efsr →
+    Λ.base_step e1' σ1 κ2 e2' σ2 efs →
+    K = Λ.empty_ectx := by
+  -- use `base_ctx_step_val` and rule out the value case
+  intro hctx hstep
+  have hval := base_ctx_step_val (Λ := Λ) K e1' σ1 κ1 e2r σ2r efsr hctx
+  cases hval with
+  | inl hsome =>
+      rcases hsome with ⟨v, hv⟩
+      have hnv : Λ.to_val e1' = none :=
+        val_base_stuck' (Λ := Λ) e1' σ1 κ2 e2' σ2 efs hstep
+      have : False := by
+        -- contradict the non-value hypothesis by discriminating constructors
+        cases hnv.symm.trans hv
+      exact (False.elim this)
+  | inr hK => exact hK
+
+/-- Decomposition into base redex and context is unique.
+Coq: `base_redex_unique` in `ectx_language.v`. -/
+theorem base_redex_unique (K K' : Λ.ectx) (e e' : Λ.expr) (σ : Λ.state) :
+    Λ.fill K e = Λ.fill K' e' →
+    base_reducible e σ →
+    base_reducible e' σ →
+    K = Λ.comp_ectx K' Λ.empty_ectx ∧ e = e' :=
+  by
+    -- compare decompositions via `step_by_val` and rule out value cases
+    intro hEq hred hred'
+    rcases hred with ⟨κ, e2, σ2, efs, hstep⟩
+    rcases hred' with ⟨κ', e2', σ2', efs', hstep'⟩
+    have hnv' : Λ.to_val e' = none :=
+      val_base_stuck' (Λ := Λ) e' σ κ' e2' σ2' efs' hstep'
+    obtain ⟨K'', hK⟩ :=
+      step_by_val (Λ := Λ) K' K e' e σ κ e2 σ2 efs hEq.symm hnv' hstep
+    have he' : e' = Λ.fill K'' e :=
+      fill_eq_of_step_by_val (Λ := Λ) K' K K'' e' e hEq.symm hK
+    have hctx : Λ.base_step (Λ.fill K'' e) σ κ' e2' σ2' efs' := by
+      -- transport the base step along `he'`
+      simpa [he'] using hstep'
+    have hK'' : K'' = Λ.empty_ectx :=
+      ctx_empty_of_base_steps (Λ := Λ) K'' e σ κ' e2' σ2' efs' κ e2 σ2 efs hctx hstep
+    refine ⟨?_, ?_⟩
+    · simpa [hK''] using hK
+    · simpa [hK'', fill_empty] using he'.symm
+
+/-- Coq: `base_prim_step` in `ectx_language.v`. -/
+theorem base_prim_step (e1 : Λ.expr) (σ1 : Λ.state) (κ : List Λ.observation)
+    (e2 : Λ.expr) (σ2 : Λ.state) (efs : List Λ.expr) :
+    Λ.base_step e1 σ1 κ e2 σ2 efs → ectx_prim_step Λ e1 σ1 κ e2 σ2 efs :=
+  by
+    -- embed a base step as a prim step using the empty context
+    intro hstep
+    -- show the equality witnesses using `fill_empty`
+    refine ectx_prim_step.ectx_step (Λ := Λ) (K := Λ.empty_ectx)
+      (e1' := e1) (e2' := e2) (σ1 := σ1) (κ := κ) (σ2 := σ2) (efs := efs)
+      (e1 := e1) (e2 := e2) ?_ ?_ hstep
+    · simp [fill_empty]
+    · simp [fill_empty]
+
+/-- Coq: `base_step_not_stuck` in `ectx_language.v`. -/
+theorem base_step_not_stuck' (e : Λ.expr) (σ : Λ.state)
+    (κ : List Λ.observation) (e' : Λ.expr) (σ' : Λ.state) (efs : List Λ.expr) :
+    Λ.base_step e σ κ e' σ' efs → not_stuck (Λ := ectx_lang Λ) e σ :=
+  by
+    -- base steps give reducibility in the induced language
+    intro hstep
+    refine Or.inr ?_
+    exact ⟨κ, e', σ', efs, base_prim_step (Λ := Λ) e σ κ e' σ' efs hstep⟩
+
+/-- Coq: `fill_prim_step` in `ectx_language.v`. -/
+theorem fill_prim_step (K : Λ.ectx) (e1 : Λ.expr) (σ1 : Λ.state)
+    (κ : List Λ.observation) (e2 : Λ.expr) (σ2 : Λ.state) (efs : List Λ.expr) :
+    ectx_prim_step Λ e1 σ1 κ e2 σ2 efs →
+    ectx_prim_step Λ (Λ.fill K e1) σ1 κ (Λ.fill K e2) σ2 efs :=
+  by
+    -- compose the context of the step with the outer context `K`
+    intro hstep
+    cases hstep with
+    | ectx_step K' e1' e2' σ1 κ σ2 efs e1 e2 hEq1 hEq2 hbase =>
+        have hfill1 : Λ.fill K e1 = Λ.fill (Λ.comp_ectx K K') e1' := by
+          -- rewrite with the inner context and compose
+          simp [hEq1, fill_comp]
+        have hfill2 : Λ.fill K e2 = Λ.fill (Λ.comp_ectx K K') e2' := by
+          -- rewrite with the inner context and compose
+          simp [hEq2, fill_comp]
+        exact ectx_prim_step.ectx_step (Λ := Λ) (K := Λ.comp_ectx K K')
+          (e1' := e1') (e2' := e2') (σ1 := σ1) (κ := κ) (σ2 := σ2)
+          (efs := efs) (e1 := Λ.fill K e1) (e2 := Λ.fill K e2) hfill1 hfill2 hbase
+
+/-- Coq: `ectx_step'` in `ectx_language.v`. -/
+theorem ectx_step' (K : Λ.ectx) (e1 : Λ.expr) (σ1 : Λ.state) (κ : List Λ.observation)
+    (e2 : Λ.expr) (σ2 : Λ.state) (efs : List Λ.expr) :
+    Λ.base_step e1 σ1 κ e2 σ2 efs →
+    ectx_prim_step Λ (Λ.fill K e1) σ1 κ (Λ.fill K e2) σ2 efs :=
+  by
+    -- combine the base step with context filling
+    intro hstep
+    exact fill_prim_step (Λ := Λ) K e1 σ1 κ e2 σ2 efs
+      (base_prim_step (Λ := Λ) e1 σ1 κ e2 σ2 efs hstep)
+
+/-- Coq: `fill_reducible` in `ectx_language.v`. -/
+theorem fill_reducible' (K : Λ.ectx) (e : Λ.expr) (σ : Λ.state) :
+    reducible (Λ := ectx_lang Λ) e σ → reducible (Λ := ectx_lang Λ) (Λ.fill K e) σ :=
+  by
+    -- lift a primitive step through the outer evaluation context
+    rintro ⟨κ, e', σ', efs, hstep⟩
+    exact ⟨κ, Λ.fill K e', σ', efs, fill_prim_step (Λ := Λ) K e σ κ e' σ' efs hstep⟩
+
+/-- Coq: `fill_reducible_no_obs` in `ectx_language.v`. -/
+theorem fill_reducible_no_obs' (K : Λ.ectx) (e : Λ.expr) (σ : Λ.state) :
+    reducible_no_obs (Λ := ectx_lang Λ) e σ →
+    reducible_no_obs (Λ := ectx_lang Λ) (Λ.fill K e) σ :=
+  by
+    -- lift a no-observation step through the outer evaluation context
+    rintro ⟨e', σ', efs, hstep⟩
+    exact ⟨Λ.fill K e', σ', efs, fill_prim_step (Λ := Λ) K e σ [] e' σ' efs hstep⟩
+
+/-- Coq: `base_prim_reducible` in `ectx_language.v`. -/
+theorem base_prim_reducible (e : Λ.expr) (σ : Λ.state) :
+    base_reducible e σ → reducible (Λ := ectx_lang Λ) e σ :=
+  by
+    -- package a base step as a primitive step
+    rintro ⟨κ, e', σ', efs, hstep⟩
+    exact ⟨κ, e', σ', efs, base_prim_step (Λ := Λ) e σ κ e' σ' efs hstep⟩
+
+/-- Coq: `base_prim_reducible_no_obs` in `ectx_language.v`. -/
+theorem base_prim_reducible_no_obs (e : Λ.expr) (σ : Λ.state) :
+    base_reducible_no_obs e σ → reducible_no_obs (Λ := ectx_lang Λ) e σ :=
+  by
+    -- package a base step with no observations as a primitive step
+    rintro ⟨e', σ', efs, hstep⟩
+    exact ⟨e', σ', efs, base_prim_step (Λ := Λ) e σ [] e' σ' efs hstep⟩
+
+/-- Coq: `base_prim_fill_reducible` in `ectx_language.v`. -/
+theorem base_prim_fill_reducible (e : Λ.expr) (K : Λ.ectx) (σ : Λ.state) :
+    base_reducible e σ → reducible (Λ := ectx_lang Λ) (Λ.fill K e) σ :=
+  by
+    -- combine base reducibility with `fill_reducible'`
+    intro hred
+    exact fill_reducible' (Λ := Λ) K e σ (base_prim_reducible (Λ := Λ) e σ hred)
+
+/-- Coq: `base_prim_fill_reducible_no_obs` in `ectx_language.v`. -/
+theorem base_prim_fill_reducible_no_obs (e : Λ.expr) (K : Λ.ectx) (σ : Λ.state) :
+    base_reducible_no_obs e σ → reducible_no_obs (Λ := ectx_lang Λ) (Λ.fill K e) σ :=
+  by
+    -- combine base reducibility (no observations) with `fill_reducible_no_obs'`
+    intro hred
+    exact fill_reducible_no_obs' (Λ := Λ) K e σ (base_prim_reducible_no_obs (Λ := Λ) e σ hred)
+
+/-- Coq: `base_prim_irreducible` in `ectx_language.v`. -/
+theorem base_prim_irreducible (e : Λ.expr) (σ : Λ.state) :
+    irreducible (Λ := ectx_lang Λ) e σ → base_irreducible e σ :=
+  by
+    -- any base step would lift to a primitive step
+    intro hir κ e' σ' efs hstep
+    exact hir κ e' σ' efs (base_prim_step (Λ := Λ) e σ κ e' σ' efs hstep)
+
+/-- Coq: `prim_base_reducible` in `ectx_language.v`. -/
+theorem prim_base_reducible (e : Λ.expr) (σ : Λ.state) :
+    reducible (Λ := ectx_lang Λ) e σ → sub_redexes_are_values e → base_reducible e σ :=
+  by
+    -- extract the base redex and use `sub_redexes_are_values` to force root position
+    rintro ⟨κ, e', σ', efs, hstep⟩ hsub
+    rcases ectx_prim_step_inv (Λ := Λ) e σ κ e' σ' efs hstep with
+      ⟨K, e1', e2', hEq1, hEq2, hbase⟩
+    have hnv : Λ.to_val e1' = none :=
+      val_base_stuck' (Λ := Λ) e1' σ κ e2' σ' efs hbase
+    have hK : K = Λ.empty_ectx := hsub K e1' hEq1 hnv
+    refine ⟨κ, e2', σ', efs, ?_⟩
+    simpa [hK, fill_empty, hEq1] using hbase
+
+/-- Coq: `prim_base_irreducible` in `ectx_language.v`. -/
+theorem prim_base_irreducible (e : Λ.expr) (σ : Λ.state) :
+    base_irreducible e σ → sub_redexes_are_values e → irreducible (Λ := ectx_lang Λ) e σ :=
+  by
+    -- reduce to `prim_base_reducible` and use contradiction
+    intro hbase hsub κ e' σ' efs hstep
+    have hred : base_reducible e σ :=
+      prim_base_reducible (Λ := Λ) e σ ⟨κ, e', σ', efs, hstep⟩ hsub
+    rcases hred with ⟨κ0, e0, σ0, efs0, hstep0⟩
+    exact hbase κ0 e0 σ0 efs0 hstep0
+
+/-- Coq: `base_stuck_stuck` in `ectx_language.v`. -/
+theorem base_stuck_stuck (e : Λ.expr) (σ : Λ.state) :
+    base_stuck e σ → sub_redexes_are_values e → stuck (Λ := ectx_lang Λ) e σ :=
+  by
+    -- combine base stuckness with irreducibility lifting
+    intro hst hsub
+    refine ⟨hst.1, ?_⟩
+    exact prim_base_irreducible (Λ := Λ) e σ hst.2 hsub
+
+/-- Base atomicity for an ectx language.
+Coq: `base_atomic` in `ectx_language.v`. -/
+def base_atomic (a : Atomicity) (e : Λ.expr) : Prop :=
+  -- characterize atomicity directly on base steps
+  ∀ σ κ e' σ' efs, Λ.base_step e σ κ e' σ' efs →
+    match a with
+    | .weaklyAtomic => irreducible (Λ := ectx_lang Λ) e' σ'
+    | .stronglyAtomic => ∃ v, Λ.to_val e' = some v
+
+/-- Base-atomic + sub-redexes-are-values implies `Atomic`.
+Coq: `ectx_language_atomic` in `ectx_language.v`. -/
+theorem ectx_language_atomic (a : Atomicity) (e : Λ.expr) :
+    (∀ σ κ e' σ' efs, Λ.base_step e σ κ e' σ' efs →
+      match a with
+      | .weaklyAtomic => irreducible (Λ := ectx_lang Λ) e' σ'
+      | .stronglyAtomic => ∃ v, Λ.to_val e' = some v) →
+    sub_redexes_are_values e →
+    Atomic (Λ := ectx_lang Λ) a e :=
+  by
+    -- reduce atomicity to the base step at the root
+    intro hatomic hsub
+    refine ⟨?_⟩
+    intro σ e' κ σ' efs hstep
+    rcases ectx_prim_step_inv (Λ := Λ) e σ κ e' σ' efs hstep with
+      ⟨K, e1', e2', hEq1, hEq2, hbase⟩
+    have hnv : Λ.to_val e1' = none :=
+      val_base_stuck' (Λ := Λ) e1' σ κ e2' σ' efs hbase
+    have hK : K = Λ.empty_ectx := hsub K e1' hEq1 hnv
+    have he : e = e1' := by
+      -- reduce to the empty context
+      simpa [hK, fill_empty] using hEq1
+    have hbase' : Λ.base_step e σ κ e2' σ' efs := by
+      -- rewrite the base step along `he`
+      simpa [he] using hbase
+    have hres := hatomic σ κ e2' σ' efs hbase'
+    simpa [hK, fill_empty, hEq2] using hres
+
+/-- Coq: `base_reducible_prim_step_ctx` in `ectx_language.v`. -/
+theorem base_reducible_prim_step_ctx (K : Λ.ectx) (e1 : Λ.expr) (σ1 : Λ.state)
+    (κ : List Λ.observation) (e2 : Λ.expr) (σ2 : Λ.state) (efs : List Λ.expr) :
+    base_reducible e1 σ1 →
+    ectx_prim_step Λ (Λ.fill K e1) σ1 κ e2 σ2 efs →
+    ∃ e2', e2 = Λ.fill K e2' ∧ Λ.base_step e1 σ1 κ e2' σ2 efs := by
+  -- peel the prim step and align contexts using `step_by_val`
+  intro hred hstep
+  rcases hred with ⟨κr, e2r, σ2r, efsr, hbase⟩
+  rcases ectx_prim_step_inv (Λ := Λ) (Λ.fill K e1) σ1 κ e2 σ2 efs hstep with
+    ⟨K', e1', e2', hEq1, hEq2, hstep'⟩
+  have hnv : Λ.to_val e1 = none :=
+    val_base_stuck' (Λ := Λ) e1 σ1 κr e2r σ2r efsr hbase
+  obtain ⟨K'', hK'⟩ :=
+    step_by_val (Λ := Λ) K K' e1 e1' σ1 κ e2' σ2 efs hEq1 hnv hstep'
+  have he1 : e1 = Λ.fill K'' e1' :=
+    fill_eq_of_step_by_val (Λ := Λ) K K' K'' e1 e1' hEq1 hK'
+  have hctx : Λ.base_step (Λ.fill K'' e1') σ1 κr e2r σ2r efsr := by
+    -- rewrite the base step along `he1`
+    simpa [he1] using hbase
+  have hK'' : K'' = Λ.empty_ectx :=
+    ctx_empty_of_base_steps (Λ := Λ) K'' e1' σ1 κr e2r σ2r efsr κ e2' σ2 efs hctx hstep'
+  refine ⟨e2', ?_, ?_⟩
+  · -- simplify the composed context using `fill_comp` and `fill_empty`
+    have hEq2' : e2 = Λ.fill (Λ.comp_ectx K K'') e2' := by simpa [hK'] using hEq2
+    have hEq2'' : e2 = Λ.fill K (Λ.fill K'' e2') := by simpa [fill_comp] using hEq2'
+    simpa [hK'', fill_empty] using hEq2''
+  · -- transport the base step using `he1`
+    simpa [he1, hK'', fill_empty] using hstep'
+
+/-- Coq: `base_reducible_prim_step` in `ectx_language.v`. -/
+theorem base_reducible_prim_step (e1 : Λ.expr) (σ1 : Λ.state)
+    (κ : List Λ.observation) (e2 : Λ.expr) (σ2 : Λ.state) (efs : List Λ.expr) :
+    base_reducible e1 σ1 →
+    ectx_prim_step Λ e1 σ1 κ e2 σ2 efs →
+    Λ.base_step e1 σ1 κ e2 σ2 efs :=
+  by
+    -- specialize `base_reducible_prim_step_ctx` to the empty context
+    intro hred hstep
+    have hstep' : ectx_prim_step Λ (Λ.fill Λ.empty_ectx e1) σ1 κ e2 σ2 efs := by
+      -- rewrite the source expression with `fill_empty`
+      simpa [fill_empty] using hstep
+    rcases base_reducible_prim_step_ctx (Λ := Λ) Λ.empty_ectx e1 σ1 κ e2 σ2 efs hred hstep' with
+      ⟨e2', hEq, hbase⟩
+    have hEq' : e2 = e2' := by
+      -- simplify the empty context equality
+      simpa [fill_empty] using hEq
+    simpa [hEq'] using hbase
+
+/-- Every evaluation context is a `LanguageCtx`.
+Coq: `ectx_lang_ctx` in `ectx_language.v`. -/
+theorem ectx_lang_ctx (K : Λ.ectx) : LanguageCtx (Λ := ectx_lang Λ) (Λ.fill K) :=
+  by
+    -- show `fill` preserves non-values, lifts steps, and supports inversion
+    refine ⟨?_, ?_, ?_⟩
+    · intro e hnv
+      exact fill_not_val (Λ := Λ) K e hnv
+    · intro e1 σ1 κ e2 σ2 efs hstep
+      exact fill_prim_step (Λ := Λ) K e1 σ1 κ e2 σ2 efs hstep
+    · intro e1' σ1 κ e2 σ2 efs hnv hstep
+      rcases ectx_prim_step_inv (Λ := Λ) (Λ.fill K e1') σ1 κ e2 σ2 efs hstep with
+        ⟨K', e1'', e2'', hEq1, hEq2, hbase⟩
+      obtain ⟨K'', hK'⟩ :=
+        step_by_val (Λ := Λ) K K' e1' e1'' σ1 κ e2'' σ2 efs hEq1 hnv hbase
+      have he1 : e1' = Λ.fill K'' e1'' :=
+        fill_eq_of_step_by_val (Λ := Λ) K K' K'' e1' e1'' hEq1 hK'
+      refine ⟨Λ.fill K'' e2'', ?_, ?_⟩
+      · -- rewrite the target using context composition
+        simpa [hK', fill_comp] using hEq2
+      · -- rebuild the prim step at the smaller context
+        exact ectx_prim_step.ectx_step (Λ := Λ) (K := K'') (e1' := e1'')
+          (e2' := e2'') (σ1 := σ1) (κ := κ) (σ2 := σ2) (efs := efs)
+          (e1 := e1') (e2 := Λ.fill K'' e2'') he1 rfl hbase
+
+/-! ## Pure Base Steps -/
+
+/-- A pure base step: deterministic, state-independent, no observations, no forks.
+Coq: `pure_base_step` in `ectx_language.v`. -/
+structure PureBaseStep (e1 e2 : Λ.expr) : Prop where
+  /-- The expression is base-reducible with no observations in any state. -/
+  pure_base_step_safe : ∀ σ1, base_reducible_no_obs e1 σ1
+  /-- The step is deterministic and pure. -/
+  pure_base_step_det : ∀ σ1 κ e2' σ2 efs,
+    Λ.base_step e1 σ1 κ e2' σ2 efs →
+    κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs = []
+
+/-- A pure base step gives a pure step.
+Coq: `pure_base_step_pure_step` in `ectx_language.v`. -/
+theorem pure_base_step_pure_step (e1 e2 : Λ.expr) :
+    PureBaseStep e1 e2 → PureStep (Λ := ectx_lang Λ) e1 e2 :=
+  by
+    -- lift base purity to primitive purity via `base_prim_step`
+    intro h
+    refine ⟨?_, ?_⟩
+    · intro σ1
+      rcases h.pure_base_step_safe σ1 with ⟨e', σ', efs, hstep⟩
+      exact ⟨e', σ', efs, base_prim_step (Λ := Λ) e1 σ1 [] e' σ' efs hstep⟩
+    · intro σ1 κ e2' σ2 efs hstep
+      have hred : base_reducible e1 σ1 :=
+        base_reducible_no_obs_base_reducible (Λ := Λ) e1 σ1 (h.pure_base_step_safe σ1)
+      have hbase := base_reducible_prim_step (Λ := Λ) e1 σ1 κ e2' σ2 efs hred hstep
+      exact h.pure_base_step_det σ1 κ e2' σ2 efs hbase
+
+/-- Coq: `pure_exec_fill` in `ectx_language.v`. -/
+theorem pure_exec_fill (K : Λ.ectx) (φ : Prop) (n : Nat) (e1 e2 : Λ.expr) :
+    PureExec (Λ := ectx_lang Λ) φ n e1 e2 →
+    PureExec (Λ := ectx_lang Λ) φ n (Λ.fill K e1) (Λ.fill K e2) :=
+  by
+    -- reuse the generic `pure_exec_ctx` with the `LanguageCtx` instance
+    intro h
+    have _ : LanguageCtx (Λ := ectx_lang Λ) (Λ.fill K) := ectx_lang_ctx (Λ := Λ) K
+    simpa using (pure_exec_ctx (Λ := ectx_lang Λ) (K := Λ.fill K) φ n e1 e2 h)
+
+end Iris.ProgramLogic
diff --git a/src/Iris/ProgramLogic/EctxLifting.lean b/src/Iris/ProgramLogic/EctxLifting.lean
new file mode 100644
index 00000000..03707d01
--- /dev/null
+++ b/src/Iris/ProgramLogic/EctxLifting.lean
@@ -0,0 +1,222 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.ProgramLogic.EctxLanguage
+import Iris.ProgramLogic.Lifting
+
+/-! # Ectx Lifting Lemmas
+
+Reference: `iris/program_logic/ectx_lifting.v`
+
+Derived lifting lemmas for evaluation-context based languages. These lift
+base steps (rather than primitive steps) to the weakest precondition,
+using the decomposition provided by `EctxLanguage`.
+
+## Simplifications
+
+This port omits later credit support. The `£ 1` parameter from the Coq
+version is dropped.
+
+## Main Results
+
+- `wp_lift_base_step_fupd` — lift a base step with fupd
+- `wp_lift_base_step` — lift a base step
+- `wp_lift_base_stuck` — stuck at base level
+- `wp_lift_pure_base_stuck` — pure base stuck
+- `wp_lift_atomic_base_step_fupd` — atomic base step with fupd
+- `wp_lift_atomic_base_step` — atomic base step
+- `wp_lift_atomic_base_step_no_fork_fupd` — atomic base step, no fork, fupd
+- `wp_lift_atomic_base_step_no_fork` — atomic base step, no fork
+- `wp_lift_pure_det_base_step_no_fork` — deterministic pure base step
+-/
+
+namespace Iris.ProgramLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI Iris.BaseLogic
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M] [DecidableEq Positive]
+variable [FiniteMapLaws Positive M] [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+variable {Λ : EctxLanguage}
+variable [inst : IrisGS (ectx_lang Λ) GF]
+variable {W : WsatGS GF}
+
+/-! ## Base Step Lifting -/
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Lift a base step with fancy update. Wraps `wp_lift_step_fupd` by
+converting base reducibility to prim reducibility via `base_prim_reducible`.
+Coq: `wp_lift_base_step_fupd` in `ectx_lifting.v`. -/
+theorem wp_lift_base_step_fupd (s : Stuckness) (E : Iris.Set Positive)
+    (Φ : (ectx_lang Λ).val → IProp GF) (e1 : Λ.expr)
+    (hv : Λ.to_val e1 = none) :
+    wp_pre (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s (wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s) E e1 Φ
+    ⊢ wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s E e1 Φ :=
+  by
+    -- base-step lifting is the generic step rule for `ectx_lang`
+    simpa using wp_lift_step_fupd (Λ := ectx_lang Λ) (M := M) (F := F) (W := W)
+      (s := s) (E := E) (Φ := Φ) (e1 := e1) hv
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Lift a base step.
+Coq: `wp_lift_base_step` in `ectx_lifting.v`. -/
+theorem wp_lift_base_step (s : Stuckness) (E : Iris.Set Positive)
+    (Φ : (ectx_lang Λ).val → IProp GF) (e1 : Λ.expr)
+    (hv : Λ.to_val e1 = none) :
+    wp_pre (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s (wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s) E e1 Φ
+    ⊢ wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s E e1 Φ :=
+  by
+    -- reuse the pure step lemma on the derived language
+    simpa using wp_lift_step (Λ := ectx_lang Λ) (M := M) (F := F) (W := W)
+      (s := s) (E := E) (Φ := Φ) (e1 := e1) hv
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Lift a base-stuck expression.
+Coq: `wp_lift_base_stuck` in `ectx_lifting.v`. -/
+theorem wp_lift_base_stuck (E : Iris.Set Positive)
+    (Φ : (ectx_lang Λ).val → IProp GF) (e : Λ.expr)
+    (hv : Λ.to_val e = none)
+    (hsub : sub_redexes_are_values e)
+    (hstuck : ∀ σ, base_stuck e σ) :
+    BIBase.pure True ⊢ wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) .maybeStuck E e Φ :=
+  by
+    -- reduce to the primitive stuckness lemma via `base_stuck_stuck`
+    have hstuck' : ∀ σ, stuck (Λ := ectx_lang Λ) e σ := by
+      intro σ; exact base_stuck_stuck (Λ := Λ) e σ (hstuck σ) hsub
+    exact wp_lift_stuck (Λ := ectx_lang Λ) (M := M) (F := F) (W := W)
+      (_s := .maybeStuck) (E := E) (Φ := Φ) (e := e) hv hstuck'
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Lift a pure base-stuck expression.
+Coq: `wp_lift_pure_base_stuck` in `ectx_lifting.v`. -/
+theorem wp_lift_pure_base_stuck [Inhabited Λ.state]
+    (E : Iris.Set Positive) (Φ : (ectx_lang Λ).val → IProp GF) (e : Λ.expr)
+    (hv : Λ.to_val e = none)
+    (hsub : sub_redexes_are_values e)
+    (hstuck : ∀ σ, base_stuck e σ) :
+    BIBase.pure True ⊢ wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) .maybeStuck E e Φ :=
+  by
+    -- reuse the non-pure base-stuck lifting rule
+    exact wp_lift_base_stuck (Λ := Λ) (M := M) (F := F) (W := W)
+      (E := E) (Φ := Φ) (e := e) hv hsub hstuck
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Lift an atomic base step with fancy update.
+Coq: `wp_lift_atomic_base_step_fupd` in `ectx_lifting.v`. -/
+theorem wp_lift_atomic_base_step_fupd (s : Stuckness) (E1 E2 : Iris.Set Positive)
+    (Φ : (ectx_lang Λ).val → IProp GF) (e1 : Λ.expr)
+    (hv : Λ.to_val e1 = none) :
+    E1 = E2 →
+    wp_pre (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s (wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s) E1 e1
+      (fun v => uPred_fupd (M := M) (F := F) W E2 E1 (Φ v))
+    ⊢ wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s E1 e1 Φ :=
+  by
+    -- mask-changing atomic step (simplified to equality)
+    intro hE
+    simpa using wp_lift_atomic_step_fupd (Λ := ectx_lang Λ) (M := M) (F := F) (W := W)
+      (s := s) (E1 := E1) (E2 := E2) (Φ := Φ) (e1 := e1) hv hE
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Lift an atomic base step.
+Coq: `wp_lift_atomic_base_step` in `ectx_lifting.v`. -/
+theorem wp_lift_atomic_base_step (s : Stuckness) (E : Iris.Set Positive)
+    (Φ : (ectx_lang Λ).val → IProp GF) (e1 : Λ.expr)
+    (hv : Λ.to_val e1 = none) :
+    wp_pre (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s (wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s) E e1 Φ
+    ⊢ wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s E e1 Φ :=
+  by
+    -- atomic case is identical to the generic step rule here
+    simpa using wp_lift_atomic_step (Λ := ectx_lang Λ) (M := M) (F := F) (W := W)
+      (s := s) (E := E) (Φ := Φ) (e1 := e1) hv
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Lift an atomic base step with no fork and fancy update.
+Coq: `wp_lift_atomic_base_step_no_fork_fupd` in `ectx_lifting.v`. -/
+theorem wp_lift_atomic_base_step_no_fork_fupd (s : Stuckness) (E1 E2 : Iris.Set Positive)
+    (Φ : (ectx_lang Λ).val → IProp GF) (e1 : Λ.expr)
+    (hv : Λ.to_val e1 = none) :
+    E1 = E2 →
+    wp_pre (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s (wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s) E1 e1
+      (fun v => uPred_fupd (M := M) (F := F) W E2 E1 (Φ v))
+    ⊢ wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s E1 e1 Φ :=
+  by
+    -- same proof as the general atomic base-step rule
+    intro hE
+    simpa using wp_lift_atomic_base_step_fupd (Λ := Λ) (M := M) (F := F) (W := W)
+      (s := s) (E1 := E1) (E2 := E2) (Φ := Φ) (e1 := e1) hv hE
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Lift an atomic base step with no fork.
+Coq: `wp_lift_atomic_base_step_no_fork` in `ectx_lifting.v`. -/
+theorem wp_lift_atomic_base_step_no_fork (s : Stuckness) (E : Iris.Set Positive)
+    (Φ : (ectx_lang Λ).val → IProp GF) (e1 : Λ.expr)
+    (hv : Λ.to_val e1 = none) :
+    wp_pre (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s (wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s) E e1 Φ
+    ⊢ wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s E e1 Φ :=
+  by
+    -- no-fork variant collapses to the same step rule here
+    simpa using wp_lift_atomic_base_step (Λ := Λ) (M := M) (F := F) (W := W)
+      (s := s) (E := E) (Φ := Φ) (e1 := e1) hv
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Lift a deterministic pure base step with no fork.
+Coq: `wp_lift_pure_det_base_step_no_fork` in `ectx_lifting.v`. -/
+theorem wp_lift_pure_det_base_step_no_fork [Inhabited Λ.state]
+    (s : Stuckness) (E : Iris.Set Positive)
+    (Φ : (ectx_lang Λ).val → IProp GF) (e1 e2 : Λ.expr)
+    (hv : Λ.to_val e1 = none)
+    (hred : ∀ σ1, base_reducible e1 σ1)
+    (hstep : ∀ σ1 κ e2' σ2 efs',
+      Λ.base_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) :
+    BIBase.later (wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s E e2 Φ)
+    ⊢ wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s E e1 Φ :=
+  by
+    -- reduce to the primitive deterministic step lemma
+    have hstep' : ∀ σ1 κ e2' σ2 efs',
+        (ectx_lang Λ).prim_step e1 σ1 κ e2' σ2 efs' →
+          κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = [] := by
+      intro σ1 κ e2' σ2 efs' hprim
+      have hbase :
+          Λ.base_step e1 σ1 κ e2' σ2 efs' :=
+        base_reducible_prim_step (Λ := Λ) e1 σ1 κ e2' σ2 efs' (hred σ1) hprim
+      exact hstep σ1 κ e2' σ2 efs' hbase
+    -- register the inhabited instance for the derived language
+    have inst' : Inhabited (ectx_lang Λ).state := by
+      simpa using (inferInstance : Inhabited Λ.state)
+    have _ := inst'
+    -- discharge the safety obligation directly for the derived language
+    refine wp_lift_pure_det_step_no_fork (Λ := ectx_lang Λ) (M := M) (F := F) (W := W)
+      (s := s) (E := E) (Φ := Φ) (e1 := e1) (e2 := e2) ?_ hstep'
+    intro σ1; cases s with
+    | notStuck =>
+        -- derive reducibility from the base-reducible hypothesis
+        exact base_prim_reducible (Λ := Λ) e1 σ1 (hred σ1)
+    | maybeStuck =>
+        -- align `to_val` with the derived language
+        simpa using hv
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Simplified variant of `wp_lift_pure_det_base_step_no_fork`.
+Coq: `wp_lift_pure_det_base_step_no_fork'` in `ectx_lifting.v`. -/
+theorem wp_lift_pure_det_base_step_no_fork' [Inhabited Λ.state]
+    (s : Stuckness) (E : Iris.Set Positive)
+    (Φ : (ectx_lang Λ).val → IProp GF) (e1 e2 : Λ.expr)
+    (hv : Λ.to_val e1 = none)
+    (hred : ∀ σ1, base_reducible e1 σ1)
+    (hstep : ∀ σ1 κ e2' σ2 efs',
+      Λ.base_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) :
+    BIBase.later (wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s E e2 Φ)
+    ⊢ wp (W := W) (M := M) (F := F) (Λ := ectx_lang Λ) s E e1 Φ :=
+  by
+    -- reuse the unprimed deterministic base-step lemma
+    simpa using wp_lift_pure_det_base_step_no_fork (Λ := Λ) (M := M) (F := F) (W := W)
+      (s := s) (E := E) (Φ := Φ) (e1 := e1) (e2 := e2) hv hred hstep
+
+end Iris.ProgramLogic
diff --git a/src/Iris/ProgramLogic/Language.lean b/src/Iris/ProgramLogic/Language.lean
new file mode 100644
index 00000000..9ff6c580
--- /dev/null
+++ b/src/Iris/ProgramLogic/Language.lean
@@ -0,0 +1,550 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.Algebra.OFE
+
+/-! # Language Interface
+
+Reference: `iris/program_logic/language.v`
+
+Abstract language interface that the weakest precondition is parameterized over.
+A `Language` packages expression, value, state, and observation types together
+with an injection `of_val`/`to_val` and a primitive step relation `prim_step`.
+
+## Main Definitions
+
+- `Language` — structure bundling expr, val, state, observation, of_val, to_val, prim_step
+- `LanguageCtx` — evaluation context: preserves values, lifts steps, inverts steps
+- `Atomic` — expression that reduces to a value (or irreducible) in one step
+- `reducible`, `irreducible`, `stuck`, `not_stuck` — stepping predicates
+- `pure_step` — deterministic, state-independent step
+- `PureExec` — typeclass for pure execution
+-/
+
+namespace Iris.ProgramLogic
+
+/-! ## Language Mixin -/
+
+/-- Axioms that a language must satisfy.
+Coq: `LanguageMixin` in `language.v`. -/
+structure LanguageMixin (expr val : Type) (state : Type) (observation : Type)
+    (of_val : val → expr) (to_val : expr → Option val)
+    (prim_step : expr → state → List observation → expr → state → List expr → Prop) where
+  /-- `to_val (of_val v) = some v` -/
+  to_of_val : ∀ v, to_val (of_val v) = some v
+  /-- `to_val e = some v → of_val v = e` -/
+  of_to_val : ∀ e v, to_val e = some v → of_val v = e
+  /-- Values do not step. -/
+  val_stuck : ∀ e σ κ e' σ' efs, prim_step e σ κ e' σ' efs → to_val e = none
+
+/-! ## Language Structure -/
+
+/-- A programming language: expressions, values, state, observations, and a
+step relation satisfying the language mixin axioms.
+Coq: `language` in `language.v`. -/
+structure Language where
+  /-- Expression type -/
+  expr : Type
+  /-- Value type -/
+  val : Type
+  /-- State type -/
+  state : Type
+  /-- Observation type -/
+  observation : Type
+  /-- Inject a value into an expression -/
+  of_val : val → expr
+  /-- Extract a value from an expression (if it is one) -/
+  to_val : expr → Option val
+  /-- Primitive step relation -/
+  prim_step : expr → state → List observation → expr → state → List expr → Prop
+  /-- The mixin axioms hold -/
+  mixin : LanguageMixin expr val state observation of_val to_val prim_step
+
+variable {Λ : Language}
+
+/-! ## Basic Lemmas -/
+
+/-- Coq: `to_of_val` in `language.v`. -/
+theorem to_of_val (v : Λ.val) : Λ.to_val (Λ.of_val v) = some v :=
+  Λ.mixin.to_of_val v
+
+/-- Coq: `of_to_val` in `language.v`. -/
+theorem of_to_val (e : Λ.expr) (v : Λ.val) :
+    Λ.to_val e = some v → Λ.of_val v = e :=
+  Λ.mixin.of_to_val e v
+
+/-- Coq: `val_stuck` in `language.v`. -/
+theorem val_stuck (e : Λ.expr) (σ : Λ.state) (κ : List Λ.observation)
+    (e' : Λ.expr) (σ' : Λ.state) (efs : List Λ.expr) :
+    Λ.prim_step e σ κ e' σ' efs → Λ.to_val e = none :=
+  Λ.mixin.val_stuck e σ κ e' σ' efs
+
+/-! ## Stepping Predicates -/
+
+/-- An expression is reducible if it can take a step.
+Coq: `reducible` in `language.v`. -/
+def reducible (e : Λ.expr) (σ : Λ.state) : Prop :=
+  ∃ κ e' σ' efs, Λ.prim_step e σ κ e' σ' efs
+
+/-- Reducible without observations.
+Coq: `reducible_no_obs` in `language.v`. -/
+def reducible_no_obs (e : Λ.expr) (σ : Λ.state) : Prop :=
+  ∃ e' σ' efs, Λ.prim_step e σ [] e' σ' efs
+
+/-- An expression is irreducible if it cannot take any step.
+Coq: `irreducible` in `language.v`. -/
+def irreducible (e : Λ.expr) (σ : Λ.state) : Prop :=
+  ∀ κ e' σ' efs, ¬Λ.prim_step e σ κ e' σ' efs
+
+/-- An expression is stuck if it is not a value and is irreducible.
+Coq: `stuck` in `language.v`. -/
+def stuck (e : Λ.expr) (σ : Λ.state) : Prop :=
+  Λ.to_val e = none ∧ irreducible e σ
+
+/-- An expression is not stuck if it is a value or reducible.
+Coq: `not_stuck` in `language.v`. -/
+def not_stuck (e : Λ.expr) (σ : Λ.state) : Prop :=
+  (∃ v, Λ.to_val e = some v) ∨ reducible e σ
+
+/-- Coq: `reducible_not_val` in `language.v`. -/
+theorem reducible_not_val (e : Λ.expr) (σ : Λ.state) :
+    reducible e σ → Λ.to_val e = none :=
+  by
+  -- unpack the step and use `val_stuck` to rule out values
+  rintro ⟨κ, e', σ', efs, hstep⟩
+  exact val_stuck (e := e) (σ := σ) (κ := κ) (e' := e') (σ' := σ') (efs := efs) hstep
+
+/-- Coq: `reducible_no_obs_reducible` in `language.v`. -/
+theorem reducible_no_obs_reducible (e : Λ.expr) (σ : Λ.state) :
+    reducible_no_obs e σ → reducible e σ :=
+  by
+  -- lift the no-observation step into the general reducible witness
+  rintro ⟨e', σ', efs, hstep⟩
+  exact ⟨[], e', σ', efs, hstep⟩
+
+/-- Coq: `val_irreducible` in `language.v`. -/
+theorem val_irreducible (e : Λ.expr) (σ : Λ.state) :
+    (∃ v, Λ.to_val e = some v) → irreducible e σ :=
+  by
+  -- a value cannot step, since any step would contradict `to_val`
+  rintro ⟨v, hv⟩ κ e' σ' efs hstep
+  have hnone : Λ.to_val e = none :=
+    val_stuck (e := e) (σ := σ) (κ := κ) (e' := e') (σ' := σ') (efs := efs) hstep
+  have : False := by
+    simp [hv] at hnone
+  exact this.elim
+
+/-- Coq: `of_val_inj` in `language.v`. -/
+theorem of_val_inj : Function.Injective (@Language.of_val Λ) := by
+  -- compare `to_val` on both sides to recover equality of values
+  intro v v' h
+  have h' : Λ.to_val (Λ.of_val v) = Λ.to_val (Λ.of_val v') := by
+    simp [h]
+  have : some v = some v' := by simpa [to_of_val] using h'
+  exact Option.some.inj this
+
+/-- Coq: `of_to_val_flip` in `language.v`. -/
+theorem of_to_val_flip (v : Λ.val) (e : Λ.expr) :
+    Λ.of_val v = e → Λ.to_val e = some v := by
+  -- rewrite and use `to_of_val`
+  intro h
+  simpa [h] using (to_of_val (Λ := Λ) v)
+
+/-- Coq: `not_reducible` in `language.v`. -/
+theorem not_reducible (e : Λ.expr) (σ : Λ.state) :
+    ¬reducible e σ ↔ irreducible e σ :=
+  by
+  -- unfold `reducible` and push negation through the existential
+  constructor
+  · intro h κ e' σ' efs hstep
+    exact h ⟨κ, e', σ', efs, hstep⟩
+  · intro h hred
+    rcases hred with ⟨κ, e', σ', efs, hstep⟩
+    exact h κ e' σ' efs hstep
+
+/-- Coq: `not_not_stuck` in `language.v`. -/
+theorem not_not_stuck (e : Λ.expr) (σ : Λ.state) :
+    ¬not_stuck e σ ↔ stuck e σ := by
+  -- use the definitions of `stuck` and `not_stuck`
+  constructor
+  · intro h
+    have hval : Λ.to_val e = none := by
+      -- otherwise `e` would be a value and hence not stuck
+      cases hto : Λ.to_val e with
+      | none => rfl
+      | some v =>
+          exact (h (Or.inl ⟨v, hto⟩)).elim
+    refine ⟨hval, ?_⟩
+    intro κ e' σ' efs hstep
+    exact h (Or.inr ⟨κ, e', σ', efs, hstep⟩)
+  · intro h hns
+    cases hns with
+  | inl hval =>
+      rcases hval with ⟨v, hv⟩
+      have : False := by
+        simp [h.1] at hv
+      exact this.elim
+    | inr hred =>
+        rcases hred with ⟨κ, e', σ', efs, hstep⟩
+        exact h.2 κ e' σ' efs hstep
+
+/-! ## Atomicity -/
+
+/-- Atomicity levels for expressions.
+Coq: `atomicity` in `language.v`. -/
+inductive Atomicity where
+  | stronglyAtomic
+  | weaklyAtomic
+
+/-- Stuckness levels.
+Coq: `stuckness` in Iris BI. -/
+inductive Stuckness where
+  | notStuck
+  | maybeStuck
+
+/-- Map stuckness to atomicity.
+Coq: `stuckness_to_atomicity` in `language.v`. -/
+def stuckness_to_atomicity : Stuckness → Atomicity
+  | .maybeStuck => .stronglyAtomic
+  | .notStuck => .weaklyAtomic
+
+/-- An expression is atomic if every step results in a value (strong)
+or an irreducible expression (weak).
+Coq: `Atomic` in `language.v`. -/
+class Atomic (a : Atomicity) (e : Λ.expr) : Prop where
+  atomic : ∀ σ e' κ σ' efs,
+    Λ.prim_step e σ κ e' σ' efs →
+    match a with
+    | .weaklyAtomic => irreducible e' σ'
+    | .stronglyAtomic => ∃ v, Λ.to_val e' = some v
+
+/-- Coq: `strongly_atomic_atomic` in `language.v`. -/
+theorem strongly_atomic_atomic (e : Λ.expr) (a : Atomicity)
+    [Atomic Atomicity.stronglyAtomic e] : Atomic a e :=
+  by
+  -- strong atomicity implies the weak form by `val_irreducible`
+  refine ⟨?_⟩
+  intro σ e' κ σ' efs hstep
+  have hstrong :
+      ∃ v, Λ.to_val e' = some v :=
+    Atomic.atomic (a := Atomicity.stronglyAtomic) (e := e) σ e' κ σ' efs hstep
+  cases a with
+  | stronglyAtomic => exact hstrong
+  | weaklyAtomic =>
+      exact val_irreducible (e := e') (σ := σ') hstrong
+
+/-! ## Language Context -/
+
+/-- An evaluation context: a function on expressions that preserves
+non-values, lifts steps, and supports step inversion.
+Coq: `LanguageCtx` in `language.v`. -/
+class LanguageCtx (K : Λ.expr → Λ.expr) where
+  /-- Contexts preserve non-values. -/
+  fill_not_val : ∀ e, Λ.to_val e = none → Λ.to_val (K e) = none
+  /-- Contexts lift steps. -/
+  fill_step : ∀ e1 σ1 κ e2 σ2 efs,
+    Λ.prim_step e1 σ1 κ e2 σ2 efs →
+    Λ.prim_step (K e1) σ1 κ (K e2) σ2 efs
+  /-- Step inversion through contexts. -/
+  fill_step_inv : ∀ e1' σ1 κ e2 σ2 efs,
+    Λ.to_val e1' = none → Λ.prim_step (K e1') σ1 κ e2 σ2 efs →
+    ∃ e2', e2 = K e2' ∧ Λ.prim_step e1' σ1 κ e2' σ2 efs
+
+instance language_ctx_id (Λ : Language) : LanguageCtx (Λ := Λ) (fun e => e) := by
+  -- identity context preserves values and steps by reflexivity
+  refine ⟨?_, ?_, ?_⟩
+  · intro e h; simpa using h
+  · intro e1 σ1 κ e2 σ2 efs hstep; simpa using hstep
+  · intro e1' σ1 κ e2 σ2 efs _hval hstep
+    exact ⟨e2, rfl, hstep⟩
+
+/-- Coq: `reducible_fill` in `language.v`. -/
+theorem reducible_fill (K : Λ.expr → Λ.expr) [LanguageCtx K]
+    (e : Λ.expr) (σ : Λ.state) :
+    reducible e σ → reducible (K e) σ :=
+  by
+  -- lift the primitive step through the evaluation context
+  rintro ⟨κ, e', σ', efs, hstep⟩
+  exact ⟨κ, K e', σ', efs,
+    LanguageCtx.fill_step (K := K) (e1 := e) (σ1 := σ) (κ := κ)
+      (e2 := e') (σ2 := σ') (efs := efs) hstep⟩
+
+/-- Coq: `reducible_fill_inv` in `language.v`. -/
+theorem reducible_fill_inv (K : Λ.expr → Λ.expr) [LanguageCtx K]
+    (e : Λ.expr) (σ : Λ.state) :
+    Λ.to_val e = none → reducible (K e) σ → reducible e σ :=
+  by
+  -- invert the context step to recover a step of the hole expression
+  intro hval hred
+  rcases hred with ⟨κ, e', σ', efs, hstep⟩
+  rcases LanguageCtx.fill_step_inv (K := K) (e1' := e) (σ1 := σ)
+    (κ := κ) (e2 := e') (σ2 := σ') (efs := efs) hval hstep with
+    ⟨e2', _hEq, hstep'⟩
+  exact ⟨κ, e2', σ', efs, hstep'⟩
+
+/-- Coq: `reducible_no_obs_fill` in `language.v`. -/
+theorem reducible_no_obs_fill (K : Λ.expr → Λ.expr) [LanguageCtx K]
+    (e : Λ.expr) (σ : Λ.state) :
+    reducible_no_obs e σ → reducible_no_obs (K e) σ := by
+  -- lift the no-observation step through the context
+  rintro ⟨e', σ', efs, hstep⟩
+  exact ⟨K e', σ', efs,
+    LanguageCtx.fill_step (K := K) (e1 := e) (σ1 := σ) (κ := [])
+      (e2 := e') (σ2 := σ') (efs := efs) hstep⟩
+
+/-- Coq: `reducible_no_obs_fill_inv` in `language.v`. -/
+theorem reducible_no_obs_fill_inv (K : Λ.expr → Λ.expr) [LanguageCtx K]
+    (e : Λ.expr) (σ : Λ.state) :
+    Λ.to_val e = none → reducible_no_obs (K e) σ → reducible_no_obs e σ := by
+  -- invert a context step with empty observations
+  intro hval hred
+  rcases hred with ⟨e', σ', efs, hstep⟩
+  rcases LanguageCtx.fill_step_inv (K := K) (e1' := e) (σ1 := σ)
+    (κ := []) (e2 := e') (σ2 := σ') (efs := efs) hval hstep with
+    ⟨e2', _hEq, hstep'⟩
+  exact ⟨e2', σ', efs, hstep'⟩
+
+/-- Coq: `irreducible_fill` in `language.v`. -/
+theorem irreducible_fill (K : Λ.expr → Λ.expr) [LanguageCtx K]
+    (e : Λ.expr) (σ : Λ.state) :
+    Λ.to_val e = none → irreducible e σ → irreducible (K e) σ :=
+  by
+  -- any step of `K e` would invert to a step of `e`
+  intro hval hir κ e' σ' efs hstep
+  rcases LanguageCtx.fill_step_inv (K := K) (e1' := e) (σ1 := σ)
+    (κ := κ) (e2 := e') (σ2 := σ') (efs := efs) hval hstep with
+    ⟨e2', _hEq, hstep'⟩
+  exact hir κ e2' σ' efs hstep'
+
+/-- Coq: `irreducible_fill_inv` in `language.v`. -/
+theorem irreducible_fill_inv (K : Λ.expr → Λ.expr) [LanguageCtx K]
+    (e : Λ.expr) (σ : Λ.state) :
+    irreducible (K e) σ → irreducible e σ := by
+  -- any step of `e` would lift to a step of `K e`
+  intro hir κ e' σ' efs hstep
+  exact hir κ (K e') σ' efs
+    (LanguageCtx.fill_step (K := K) (e1 := e) (σ1 := σ)
+      (κ := κ) (e2 := e') (σ2 := σ') (efs := efs) hstep)
+
+/-- Coq: `not_stuck_fill_inv` in `language.v`. -/
+theorem not_stuck_fill_inv (K : Λ.expr → Λ.expr) [LanguageCtx K]
+    (e : Λ.expr) (σ : Λ.state) :
+    not_stuck (K e) σ → not_stuck e σ := by
+  -- split into value or reducible cases for the context expression
+  intro hns
+  cases hns with
+  | inl hval =>
+      cases hto : Λ.to_val e with
+      | some v =>
+          exact Or.inl ⟨v, hto⟩
+      | none =>
+          have hnone : Λ.to_val (K e) = none :=
+            LanguageCtx.fill_not_val (K := K) e hto
+          rcases hval with ⟨v, hv⟩
+          -- contradict `to_val (K e) = none`
+          have : False := by
+            simp [hv] at hnone
+          exact this.elim
+  | inr hred =>
+      cases hto : Λ.to_val e with
+      | some v =>
+          exact Or.inl ⟨v, hto⟩
+      | none =>
+          exact Or.inr (reducible_fill_inv (K := K) (e := e) (σ := σ) hto hred)
+
+/-- Coq: `stuck_fill` in `language.v`. -/
+theorem stuck_fill (K : Λ.expr → Λ.expr) [LanguageCtx K]
+    (e : Λ.expr) (σ : Λ.state) :
+    stuck e σ → stuck (K e) σ := by
+  -- use the contrapositive formulation of stuckness
+  intro hst
+  have hns : ¬not_stuck e σ := (not_not_stuck (Λ := Λ) (e := e) (σ := σ)).2 hst
+  have hnsK : ¬not_stuck (K e) σ := by
+    intro hnsK
+    exact hns (not_stuck_fill_inv (K := K) (e := e) (σ := σ) hnsK)
+  exact (not_not_stuck (Λ := Λ) (e := K e) (σ := σ)).1 hnsK
+
+/-! ## Pure Steps -/
+
+/-- A pure step: deterministic, state-independent, no observations, no forks.
+Coq: `pure_step` in `language.v`. -/
+structure PureStep (e1 e2 : Λ.expr) : Prop where
+  /-- The expression is reducible in any state with no observations. -/
+  pure_step_safe : ∀ σ1, ∃ e' σ' efs, Λ.prim_step e1 σ1 [] e' σ' efs
+  /-- The step is deterministic and pure. -/
+  pure_step_det : ∀ σ1 κ e2' σ2 efs,
+    Λ.prim_step e1 σ1 κ e2' σ2 efs →
+    κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs = []
+
+/-! ## Small-Step Iteration -/
+
+/-- `n`-step iteration of a relation. -/
+inductive rel_nsteps {α : Type _} (R : α → α → Prop) : Nat → α → α → Prop
+  | refl (a : α) : rel_nsteps (R := R) 0 a a
+  | step {n : Nat} {a b c : α} :
+      R a b → rel_nsteps (R := R) n b c → rel_nsteps (R := R) (n + 1) a c
+
+/-- Typeclass for pure execution of `n` steps.
+Coq: `PureExec` in `language.v`. -/
+class PureExec (φ : Prop) (n : Nat) (e1 e2 : Λ.expr) : Prop where
+  pure_exec : φ → rel_nsteps (R := PureStep) n e1 e2
+
+/-- Coq: `pure_step_ctx` in `language.v`. -/
+theorem pure_step_ctx (K : Λ.expr → Λ.expr) [LanguageCtx K]
+    {e1 e2 : Λ.expr} :
+    PureStep e1 e2 → PureStep (K e1) (K e2) := by
+  -- lift safety/determinism through the evaluation context
+  intro h
+  refine ⟨?_, ?_⟩
+  · intro σ1
+    rcases h.pure_step_safe σ1 with ⟨e', σ', efs, hstep⟩
+    exact ⟨K e', σ', efs,
+      LanguageCtx.fill_step (K := K) (e1 := e1) (σ1 := σ1) (κ := [])
+        (e2 := e') (σ2 := σ') (efs := efs) hstep⟩
+  · intro σ1 κ e2' σ2 efs hstep
+    have hnone : Λ.to_val e1 = none := by
+      rcases h.pure_step_safe σ1 with ⟨e', σ', efs', hstep'⟩
+      exact val_stuck (e := e1) (σ := σ1) (κ := []) (e' := e') (σ' := σ') (efs := efs') hstep'
+    rcases LanguageCtx.fill_step_inv (K := K) (e1' := e1) (σ1 := σ1)
+      (κ := κ) (e2 := e2') (σ2 := σ2) (efs := efs) hnone hstep with
+      ⟨e2'', hEq, hstep'⟩
+    rcases h.pure_step_det σ1 κ e2'' σ2 efs hstep' with ⟨hκ, hσ, hE, hfs⟩
+    refine ⟨hκ, hσ, ?_, hfs⟩
+    have : e2' = K e2 := by
+      calc
+        e2' = K e2'' := hEq
+        _ = K e2 := by
+          simp [hE]
+    exact this
+
+/-- Coq: `pure_step_nsteps_ctx` in `language.v`. -/
+theorem pure_step_nsteps_ctx (K : Λ.expr → Λ.expr) [LanguageCtx K]
+    (n : Nat) (e1 e2 : Λ.expr) :
+    rel_nsteps (R := PureStep) n e1 e2 →
+      rel_nsteps (R := PureStep) n (K e1) (K e2) := by
+  -- map each pure step through the context
+  intro h
+  induction h with
+  | refl _ => exact rel_nsteps.refl _
+  | step hstep hrest ih =>
+      exact rel_nsteps.step (R := PureStep) (pure_step_ctx (K := K) hstep) ih
+
+/-- Coq: `pure_exec_ctx` in `language.v`. -/
+theorem pure_exec_ctx (K : Λ.expr → Λ.expr) [LanguageCtx K]
+    (φ : Prop) (n : Nat) (e1 e2 : Λ.expr) :
+    PureExec (Λ := Λ) φ n e1 e2 → PureExec (Λ := Λ) φ n (K e1) (K e2) := by
+  -- lift the witness for `PureExec` through `pure_step_nsteps_ctx`
+  intro h
+  refine ⟨?_⟩
+  intro hφ
+  exact pure_step_nsteps_ctx (K := K) (n := n) (e1 := e1) (e2 := e2) (h.pure_exec hφ)
+
+/-! ## Values via Typeclasses -/
+
+/-- A hint that an expression is a value.
+Coq: `IntoVal` in `language.v`. -/
+class IntoVal (e : Λ.expr) (v : Λ.val) : Prop where
+  into_val : Λ.of_val v = e
+
+/-- An expression that can be viewed as a value.
+Coq: `AsVal` in `language.v`. -/
+class AsVal (e : Λ.expr) : Prop where
+  as_val : ∃ v, Λ.of_val v = e
+
+/-- Coq: `as_val_is_Some` in `language.v`. -/
+theorem as_val_is_Some (e : Λ.expr) :
+    (∃ v, Λ.of_val v = e) → ∃ v, Λ.to_val e = some v := by
+  -- rewrite through `of_val` and use `to_of_val`
+  rintro ⟨v, hv⟩
+  refine ⟨v, ?_⟩
+  simpa [hv] using (to_of_val (Λ := Λ) v)
+
+/-! ## Configuration and Multi-Step -/
+
+/-- A configuration is a thread pool and a state.
+Coq: `cfg` in `language.v`. -/
+def cfg (Λ : Language) := List Λ.expr × Λ.state
+
+/-- Single step of the thread pool.
+Coq: `step` in `language.v`. -/
+inductive step : cfg Λ → List Λ.observation → cfg Λ → Prop where
+  | step_atomic (e1 : Λ.expr) (σ1 : Λ.state) (e2 : Λ.expr)
+      (σ2 : Λ.state) (efs : List Λ.expr)
+      (t1 t2 : List Λ.expr) (κ : List Λ.observation) :
+    Λ.prim_step e1 σ1 κ e2 σ2 efs →
+    step (t1 ++ [e1] ++ t2, σ1) κ (t1 ++ [e2] ++ t2 ++ efs, σ2)
+
+/-- Multi-step execution with accumulated observations.
+Coq: `nsteps` in `language.v`. -/
+inductive nsteps : Nat → cfg Λ → List Λ.observation → cfg Λ → Prop where
+  | nsteps_refl (ρ : cfg Λ) :
+      nsteps 0 ρ [] ρ
+  | nsteps_l (n : Nat) (ρ1 ρ2 ρ3 : cfg Λ) (κ κs : List Λ.observation) :
+      step ρ1 κ ρ2 →
+      nsteps n ρ2 κs ρ3 →
+      nsteps (n + 1) ρ1 (κ ++ κs) ρ3
+
+/-- Append a single step to the right of an `nsteps` chain. -/
+theorem nsteps_snoc {n : Nat} {ρ1 ρ2 : cfg Λ} {κs : List Λ.observation} :
+    nsteps (Λ := Λ) n ρ1 κs ρ2 →
+    ∀ {ρ3 κ}, step (Λ := Λ) ρ2 κ ρ3 →
+      nsteps (Λ := Λ) (n + 1) ρ1 (κs ++ κ) ρ3 := by
+  intro hsteps
+  induction hsteps with
+  | nsteps_refl ρ =>
+      intro ρ3 κ hstep
+      simpa using
+        (nsteps.nsteps_l (Λ := Λ) 0 ρ ρ3 ρ3 κ [] hstep
+          (nsteps.nsteps_refl (Λ := Λ) ρ3))
+  | nsteps_l n ρ1 ρ2 ρ3 κ κs hstep hrest ih =>
+      intro ρ4 κ' hstep'
+      have ih' := ih (ρ3 := ρ4) (κ := κ') hstep'
+      have hsteps' :
+          nsteps (Λ := Λ) (n + 1 + 1) ρ1 (κ ++ (κs ++ κ')) ρ4 :=
+        nsteps.nsteps_l (Λ := Λ) (n := n + 1) ρ1 ρ2 ρ4 κ (κs ++ κ') hstep ih'
+      simpa [List.append_assoc, Nat.add_assoc] using hsteps'
+
+/-- Erased step: forget observations.
+Coq: `erased_step` in `language.v`. -/
+def erased_step (ρ1 ρ2 : cfg Λ) : Prop :=
+  ∃ κ, step ρ1 κ ρ2
+
+/-- Reflexive-transitive closure of a relation. -/
+inductive rtc {α : Type _} (R : α → α → Prop) : α → α → Prop
+  | refl (a : α) : rtc R a a
+  | tail {a b c : α} : rtc R a b → R b c → rtc R a c
+
+private theorem rtc_trans {α : Type _} {R : α → α → Prop} {a b c : α} :
+    rtc (R := R) a b → rtc (R := R) b c → rtc (R := R) a c := by
+  -- append a tail of steps to the front chain
+  intro hab hbc
+  induction hbc with
+  | refl => exact hab
+  | tail hprev hstep ih => exact rtc.tail ih hstep
+
+/-- `rtc` of erased steps corresponds to some `nsteps`.
+Coq: `erased_steps_nsteps` in `language.v`. -/
+theorem erased_steps_nsteps (ρ1 ρ2 : cfg Λ) :
+    rtc (erased_step (Λ := Λ)) ρ1 ρ2 ↔ ∃ n κs, nsteps (Λ := Λ) n ρ1 κs ρ2 := by
+  -- unfold both directions by induction on `rtc`/`nsteps`
+  constructor
+  · intro h
+    induction h with
+    | refl =>
+        exact ⟨0, [], nsteps.nsteps_refl (Λ := Λ) ρ1⟩
+    | tail hprev hstep ih =>
+        rcases ih with ⟨n, κs, hsteps⟩
+        rcases hstep with ⟨κ, hstep⟩
+        exact ⟨n + 1, κs ++ κ, nsteps_snoc (Λ := Λ) hsteps hstep⟩
+  · rintro ⟨n, κs, hsteps⟩
+    induction hsteps with
+    | nsteps_refl ρ =>
+        exact rtc.refl (R := erased_step (Λ := Λ)) ρ
+    | nsteps_l n ρ1 ρ2 ρ3 κ κs hstep hrest ih =>
+        have h01 : rtc (R := erased_step (Λ := Λ)) ρ1 ρ2 :=
+          rtc.tail (R := erased_step (Λ := Λ)) (rtc.refl (R := erased_step (Λ := Λ)) ρ1) ⟨κ, hstep⟩
+        exact rtc_trans (R := erased_step (Λ := Λ)) h01 ih
+
+end Iris.ProgramLogic
diff --git a/src/Iris/ProgramLogic/Lifting.lean b/src/Iris/ProgramLogic/Lifting.lean
new file mode 100644
index 00000000..6b6665f4
--- /dev/null
+++ b/src/Iris/ProgramLogic/Lifting.lean
@@ -0,0 +1,861 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.ProgramLogic.WeakestPre
+
+/-! # Lifting Lemmas
+
+Reference: `iris/program_logic/lifting.v`
+
+The lifting lemmas serve to lift the rules of the operational semantics
+to the program logic. They connect the primitive step relation of the
+language to the weakest precondition.
+
+## Simplifications
+
+This port omits later credit support. The `£ 1` and `step_fupdN`
+infrastructure from the Coq version is dropped. The `num_laters_per_step`
+is fixed to 0.
+
+## Main Results
+
+- `wp_lift_step_fupd` — lift a single step to WP (with fupd)
+- `wp_lift_step` — lift a single step to WP
+- `wp_lift_stuck` — stuck expression satisfies any WP at `maybeStuck`
+- `wp_lift_pure_step_no_fork` — lift a pure, fork-free step
+- `wp_lift_atomic_step_fupd` — lift an atomic step with fupd
+- `wp_lift_atomic_step` — lift an atomic step
+- `wp_lift_pure_det_step_no_fork` — lift a deterministic pure step
+- `wp_lift_pure_stuck` — pure stuck expression
+-/
+
+namespace Iris.ProgramLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI Iris.BaseLogic
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M] [DecidableEq Positive]
+variable [FiniteMapLaws Positive M] [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+variable {Λ : Language}
+variable [inst : IrisGS Λ GF]
+variable {W : WsatGS GF}
+
+/-! ## FUpd Helpers -/
+
+private noncomputable abbrev fupd' (W : WsatGS GF)
+    (E1 E2 : Iris.Set Positive) (P : IPropWsat GF M F) : IPropWsat GF M F :=
+  uPred_fupd (M := M) (F := F) W E1 E2 P
+
+private abbrev maskEmpty : Iris.Set Positive := fun _ => False
+
+private abbrev fork_post : Λ.val → IPropWsat GF M F :=
+  (IrisGS.fork_post (Λ := Λ) (GF := GF) : Λ.val → IPropWsat GF M F)
+
+private abbrev state_interp (σ : Λ.state) (ns : Nat)
+    (κs : List Λ.observation) (nt : Nat) : IPropWsat GF M F :=
+  (IrisGS.state_interp (Λ := Λ) (GF := GF) σ ns κs nt : IPropWsat GF M F)
+
+private abbrev stuckness_pred (s : Stuckness) (e : Λ.expr) (σ : Λ.state) : Prop :=
+  match s with
+  | .notStuck => reducible e σ
+  | .maybeStuck => True
+
+/-! ## BI Abbreviations -/
+
+private abbrev ipure (φ : Prop) : IPropWsat GF M F :=
+  -- specialize `pure` to `IProp`
+  BIBase.pure (PROP := IPropWsat GF M F) φ
+
+private abbrev iwand (P Q : IPropWsat GF M F) : IPropWsat GF M F :=
+  -- specialize wand to `IProp`
+  BIBase.wand (PROP := IPropWsat GF M F) P Q
+
+private abbrev isep (P Q : IPropWsat GF M F) : IPropWsat GF M F :=
+  -- specialize `∗` to `IProp`
+  BIBase.sep (PROP := IPropWsat GF M F) P Q
+
+private abbrev ilater (P : IPropWsat GF M F) : IPropWsat GF M F :=
+  -- specialize `▷` to `IProp`
+  BIBase.later (PROP := IPropWsat GF M F) P
+
+private abbrev iforall {A} (Φ : A → IPropWsat GF M F) : IPropWsat GF M F :=
+  -- specialize `∀` to `IProp`
+  BIBase.forall (PROP := IPropWsat GF M F) Φ
+
+private noncomputable abbrev wp_fork (W : WsatGS GF)
+    (s : Stuckness) (ef : Λ.expr) : IPropWsat GF M F :=
+  -- fork postcondition in the universal mask
+  wp (W := W) s Iris.Set.univ ef (fork_post (M := M) (F := F))
+
+private noncomputable abbrev fork_posts (W : WsatGS GF)
+    (s : Stuckness) (efs : List Λ.expr) : IPropWsat GF M F :=
+  -- combine forked thread WPs
+  big_sepL (fun _ ef => wp_fork W s ef) efs
+
+private noncomputable abbrev step_post (W : WsatGS GF) (s : Stuckness) (E : Iris.Set Positive)
+    (Φ : Λ.val → IPropWsat GF M F) (σ2 : Λ.state)
+    (ns : Nat) (κs : List Λ.observation) (nt : Nat)
+    (e2 : Λ.expr) (efs : List Λ.expr) : IPropWsat GF M F :=
+  -- postcondition after a single step with forks
+  ilater
+    (isep (state_interp (M := M) (F := F) σ2 (ns + 1) κs (efs.length + nt))
+      (isep (wp (W := W) s E e2 Φ)
+        (fork_posts W s efs)))
+
+private abbrev pure_step_cont_pred (W : WsatGS GF) (s : Stuckness) (E : Iris.Set Positive)
+    (e1 : Λ.expr) (Φ : Λ.val → IPropWsat GF M F) : IPropWsat GF M F :=
+  -- standard pure-step continuation predicate
+  iforall fun κ : List Λ.observation =>
+    iforall fun e2 : Λ.expr =>
+      iforall fun efs : List Λ.expr =>
+        iforall fun σ : Λ.state =>
+          iwand (ipure (Λ.prim_step e1 σ κ e2 σ efs))
+            (wp (W := W) s E e2 Φ)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Helper: frame a wand through a fancy update. -/
+private theorem fupd_wand_r (E1 E2 : Iris.Set Positive) (P Q : IPropWsat GF M F) :
+    BIBase.sep (fupd' W E1 E2 P) (BIBase.wand P Q) ⊢
+      fupd' W E1 E2 Q :=
+  by
+    -- frame the wand inside, then eliminate it under `Iris.BaseLogic.fupd_mono`
+    refine (Iris.BaseLogic.fupd_frame_r (W := W)
+      (M := M) (F := F) (E1 := E1) (E2 := E2) (P := P)
+      (Q := BIBase.wand P Q)).trans ?_
+    exact Iris.BaseLogic.fupd_mono (W := W)
+      (M := M) (F := F) (E1 := E1) (E2 := E2)
+      (P := BIBase.sep P (BIBase.wand P Q)) (Q := Q)
+      (wand_elim_r (P := P) (Q := Q))
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Helper: open a mask using a closing wand.
+Coq: `fupd_mask_intro` (proofmode lemma). -/
+private theorem fupd_mask_intro (E1 E2 : Iris.Set Positive) (h : Subset E2 E1)
+    (P : IPropWsat GF M F) :
+    BIBase.wand (fupd' W E2 E1 (BIBase.emp : IPropWsat GF M F)) P ⊢
+      fupd' W E1 E2 P :=
+  by
+    -- open the mask using `Iris.BaseLogic.fupd_mask_subseteq`, then apply the wand inside
+    have hopen :
+        (True : IPropWsat GF M F) ⊢
+          fupd' W E1 E2
+            (fupd' W E2 E1 (BIBase.emp : IPropWsat GF M F)) :=
+      Iris.BaseLogic.fupd_mask_subseteq (W := W)
+        (M := M) (F := F) (E1 := E1) (E2 := E2) h
+    refine (true_sep_2 (PROP := IPropWsat GF M F)
+      (P := BIBase.wand (fupd' W E2 E1 (BIBase.emp : IPropWsat GF M F)) P)).trans ?_
+    refine (sep_mono hopen .rfl).trans ?_
+    exact fupd_wand_r (E1 := E1) (E2 := E2)
+      (P := fupd' W E2 E1 (BIBase.emp : IPropWsat GF M F)) (Q := P)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+private theorem fupd_close_emp (E : Iris.Set Positive) (P : IPropWsat GF M F) :
+    BIBase.sep (fupd' W maskEmpty E (BIBase.emp : IPropWsat GF M F)) P ⊢
+      fupd' W maskEmpty E P :=
+  by
+    -- frame `P` under the update, then drop `emp`
+    refine (Iris.BaseLogic.fupd_frame_r (W := W)
+      (M := M) (F := F) (E1 := maskEmpty) (E2 := E) (P := (BIBase.emp : IPropWsat GF M F))
+      (Q := P)).trans ?_
+    exact Iris.BaseLogic.fupd_mono (W := W)
+      (M := M) (F := F) (E1 := maskEmpty) (E2 := E)
+      (P := BIBase.sep (BIBase.emp : IPropWsat GF M F) P) (Q := P) (emp_sep (P := P)).1
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+private theorem fupd_intro (E : Iris.Set Positive) (P : IPropWsat GF M F) :
+    P ⊢ fupd' W E E P :=
+  by
+    -- introduce a nested update, then collapse it
+    have hsubset : Subset E E := by
+      intro _ h; exact h
+    have hmask :=
+      Iris.BaseLogic.fupd_intro_mask (W := W)
+        (M := M) (F := F) (E1 := E) (E2 := E) hsubset (P := P)
+    exact hmask.trans <|
+      Iris.BaseLogic.fupd_trans (W := W)
+        (M := M) (F := F) (E1 := E) (E2 := E) (E3 := E) (P := P)
+
+/-! ## Pure Helpers -/
+
+omit [DecidableEq Positive] in
+private theorem pure_step_val_none [Inhabited Λ.state]
+    (s : Stuckness) (e1 : Λ.expr)
+    (hsafe : ∀ σ1, match s with
+      | .notStuck => reducible e1 σ1
+      | .maybeStuck => Λ.to_val e1 = none) :
+    Λ.to_val e1 = none :=
+  by
+    -- pick a concrete state and extract non-valueness
+    cases s with
+    | notStuck =>
+        have hred := hsafe (default : Λ.state)
+        exact reducible_not_val (Λ := Λ) e1 _ hred
+    | maybeStuck =>
+        exact hsafe (default : Λ.state)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+private theorem pure_step_wand {s : Stuckness} {E : Iris.Set Positive}
+    {Φ : Λ.val → IPropWsat GF M F} {e1 : Λ.expr}
+    (κ : List Λ.observation) (e2 : Λ.expr) (efs : List Λ.expr) (σ : Λ.state) :
+    pure_step_cont_pred W s E e1 Φ ⊢
+      iwand (ipure (Λ.prim_step e1 σ κ e2 σ efs))
+      (wp (W := W) s E e2 Φ) :=
+  by
+    -- specialize the nested `∀` binders
+    refine (forall_elim (PROP := IPropWsat GF M F)
+      (Ψ := fun κ => iforall fun e2 : Λ.expr => iforall fun efs : List Λ.expr =>
+        iforall fun σ : Λ.state =>
+          iwand (ipure (Λ.prim_step e1 σ κ e2 σ efs))
+            (wp (W := W) s E e2 Φ)) κ).trans ?_
+    refine (forall_elim (PROP := IPropWsat GF M F)
+      (Ψ := fun e2 => iforall fun efs : List Λ.expr => iforall fun σ : Λ.state =>
+        iwand (ipure (Λ.prim_step e1 σ κ e2 σ efs))
+          (wp (W := W) s E e2 Φ)) e2).trans ?_
+    refine (forall_elim (PROP := IPropWsat GF M F)
+      (Ψ := fun efs => iforall fun σ : Λ.state =>
+        iwand (ipure (Λ.prim_step e1 σ κ e2 σ efs))
+          (wp (W := W) s E e2 Φ)) efs).trans ?_
+    exact forall_elim (PROP := IPropWsat GF M F)
+      (Ψ := fun σ => iwand (ipure (Λ.prim_step e1 σ κ e2 σ efs))
+        (wp (W := W) s E e2 Φ)) σ
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+private theorem later_wp_of_step {s : Stuckness} {E : Iris.Set Positive}
+    {Φ : Λ.val → IPropWsat GF M F} {e1 : Λ.expr}
+    (κ : List Λ.observation) (e2 : Λ.expr) (efs : List Λ.expr) (σ : Λ.state) :
+    isep (ilater (pure_step_cont_pred W s E e1 Φ))
+      (ipure (Λ.prim_step e1 σ κ e2 σ efs)) ⊢
+      ilater (wp (W := W) s E e2 Φ) :=
+  by
+    -- push the wand under `▷` and apply it to the stepped proof
+    have hwand :
+        ilater (pure_step_cont_pred W s E e1 Φ) ⊢
+          iwand (ilater (ipure (Λ.prim_step e1 σ κ e2 σ efs)))
+            (ilater (wp (W := W) s E e2 Φ)) := by
+      refine (later_mono (PROP := IPropWsat GF M F)
+        (pure_step_wand (s := s) (E := E) (e1 := e1)
+          (Φ := Φ) (κ := κ) (e2 := e2) (efs := efs) (σ := σ))).trans ?_
+      exact later_wand (PROP := IPropWsat GF M F)
+        (P := ipure (Λ.prim_step e1 σ κ e2 σ efs))
+        (Q := wp (W := W) s E e2 Φ)
+    have hstep : ipure (Λ.prim_step e1 σ κ e2 σ efs) ⊢
+        ilater (ipure (Λ.prim_step e1 σ κ e2 σ efs)) :=
+      later_intro (PROP := IPropWsat GF M F)
+    refine ((sep_comm (P := ilater (pure_step_cont_pred W s E e1 Φ))
+      (Q := ipure (Λ.prim_step e1 σ κ e2 σ efs))).1).trans ?_
+    refine (sep_mono hstep hwand).trans ?_
+    exact wand_elim_r (PROP := IPropWsat GF M F)
+
+omit [UFraction F] [FiniteMap Positive M] [HeapFiniteMap Positive M]
+  [ElemG GF (InvF GF M F)]
+  [DecidableEq Positive]
+  [ElemG GF (COFE.constOF CoPsetDisj)]
+  [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem later_state_interp_step
+    (σ : Λ.state) (ns : Nat) (κ : List Λ.observation)
+    (κs : List Λ.observation) (nt : Nat) (hκ : κ = []) :
+    (inst.state_interp σ ns (κ ++ κs) nt : IPropWsat GF M F) ⊢
+      BIBase.later (PROP := IPropWsat GF M F)
+        (inst.state_interp σ (ns + 1) κs nt : IPropWsat GF M F) :=
+  by
+    -- rewrite the trace and apply monotonicity under `▷`
+    subst hκ
+    exact (inst.state_interp_mono (σ := σ) (ns := ns) (κs := κs) (nt := nt)).trans
+      (later_intro (PROP := IPropWsat GF M F))
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+private theorem pure_step_later {s : Stuckness} {E : Iris.Set Positive}
+    {Φ : Λ.val → IPropWsat GF M F} {e1 : Λ.expr}
+    (σ : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt : Nat) (e2 : Λ.expr) :
+    isep
+        (isep (ilater (pure_step_cont_pred W s E e1 Φ))
+          (ipure (Λ.prim_step e1 σ [] e2 σ [])))
+        (state_interp σ ns κs nt) ⊢
+      ilater
+        (isep (state_interp σ (ns + 1) κs nt)
+          (wp (W := W) s E e2 Φ)) :=
+  by
+    -- combine the stepped WP with the monotone state interpretation
+    have hwp :=
+      later_wp_of_step (W := W) (s := s) (E := E) (e1 := e1) (Φ := Φ)
+        (κ := []) (e2 := e2) (efs := []) (σ := σ)
+    have hstate :=
+      later_state_interp_step (GF := GF) (M := M) (F := F)
+        (σ := σ) (ns := ns) (κ := []) (κs := κs) (nt := nt) rfl
+    have hsep : isep
+        (isep (ilater (pure_step_cont_pred W s E e1 Φ))
+          (ipure (Λ.prim_step e1 σ [] e2 σ [])))
+        (state_interp σ ns κs nt) ⊢
+        isep (ilater (wp (W := W) s E e2 Φ))
+          (ilater (state_interp σ (ns + 1) κs nt)) :=
+      sep_mono hwp hstate
+    refine hsep.trans ?_
+    refine ((sep_comm (P := ilater (wp (W := W) s E e2 Φ))
+      (Q := ilater (state_interp σ (ns + 1) κs nt))).1).trans ?_
+    exact (later_sep (PROP := IPropWsat GF M F)
+      (P := state_interp σ (ns + 1) κs nt)
+      (Q := wp (W := W) s E e2 Φ)).2
+
+omit [UFraction F] [FiniteMap Positive M] [HeapFiniteMap Positive M]
+  [ElemG GF (InvF GF M F)]
+  [DecidableEq Positive]
+  [ElemG GF (COFE.constOF CoPsetDisj)]
+  [ElemG GF (COFE.constOF GSetDisj)]
+  [IrisGS Λ GF] in
+private theorem pure_step_stuckness (s : Stuckness) (e1 : Λ.expr)
+    (hsafe : ∀ σ1, match s with
+      | .notStuck => reducible e1 σ1
+      | .maybeStuck => Λ.to_val e1 = none)
+    (σ : Λ.state) :
+    (True : IPropWsat GF M F) ⊢ ipure (stuckness_pred s e1 σ) :=
+  by
+    -- discharge the stuckness predicate using `hsafe`
+    cases s with
+    | notStuck =>
+        -- stuckness reduces to reducibility in the not-stuck case
+        exact pure_intro (hsafe σ)
+    | maybeStuck =>
+        exact pure_intro trivial
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+private theorem later_add_emp {s : Stuckness} {E : Iris.Set Positive}
+    {Φ : Λ.val → IPropWsat GF M F} (σ : Λ.state) (ns : Nat)
+    (κs : List Λ.observation) (nt : Nat) (e2 : Λ.expr) :
+    ilater (isep (state_interp σ (ns + 1) κs nt)
+        (wp (W := W) s E e2 Φ)) ⊢
+      ilater (isep (state_interp σ (ns + 1) κs nt)
+        (isep (wp (W := W) s E e2 Φ) (BIBase.emp : IPropWsat GF M F))) :=
+  by
+    -- add `emp` under `▷` using `sep_emp`
+    have hemp :
+        isep (state_interp σ (ns + 1) κs nt)
+            (wp (W := W) s E e2 Φ) ⊢
+          isep (state_interp σ (ns + 1) κs nt)
+            (isep (wp (W := W) s E e2 Φ) (BIBase.emp : IPropWsat GF M F)) :=
+      sep_mono .rfl
+        (sep_emp (PROP := IPropWsat GF M F) (P := wp (W := W) s E e2 Φ)).2
+    exact later_mono (PROP := IPropWsat GF M F) hemp
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+private theorem fupd_later_add_emp {s : Stuckness} {E : Iris.Set Positive}
+    {Φ : Λ.val → IPropWsat GF M F} (σ : Λ.state) (ns : Nat)
+    (κs : List Λ.observation) (nt : Nat) (e2 : Λ.expr) :
+    fupd' W maskEmpty E
+        (ilater (isep (state_interp σ (ns + 1) κs nt)
+          (wp (W := W) s E e2 Φ))) ⊢
+      fupd' W maskEmpty E
+        (ilater (isep (state_interp σ (ns + 1) κs nt)
+          (isep (wp (W := W) s E e2 Φ) (BIBase.emp : IPropWsat GF M F)))) :=
+  by
+    -- lift `later_add_emp` through the fancy update
+    exact Iris.BaseLogic.fupd_mono (W := W)
+      (M := M) (F := F) (E1 := maskEmpty) (E2 := E)
+      (P := ilater (isep (state_interp σ (ns + 1) κs nt)
+        (wp (W := W) s E e2 Φ)))
+      (Q := ilater (isep (state_interp σ (ns + 1) κs nt)
+        (isep (wp (W := W) s E e2 Φ) (BIBase.emp : IPropWsat GF M F))))
+      (later_add_emp (s := s) (E := E) (Φ := Φ)
+        (σ := σ) (ns := ns) (κs := κs) (nt := nt) (e2 := e2))
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+private theorem pure_step_cont_close {s : Stuckness} {E : Iris.Set Positive}
+    {Φ : Λ.val → IPropWsat GF M F} {e1 : Λ.expr}
+    (σ : Λ.state) (ns : Nat) (κs : List Λ.observation) (nt : Nat) (e2 : Λ.expr) :
+    isep
+        (isep (ilater (pure_step_cont_pred W s E e1 Φ))
+          (isep (state_interp σ ns κs nt)
+            (fupd' W maskEmpty E (BIBase.emp : IPropWsat GF M F))))
+        (ipure (Λ.prim_step e1 σ [] e2 σ [])) ⊢
+      fupd' W maskEmpty E
+        (ilater
+          (isep (state_interp σ (ns + 1) κs nt)
+            (isep (wp (W := W) s E e2 Φ)
+              (BIBase.emp : IPropWsat GF M F)))) :=
+  by
+    -- reorder, apply the later postcondition, then close the mask
+    refine ((sep_right_comm (P := ilater (pure_step_cont_pred W s E e1 Φ))
+      (Q := isep (state_interp σ ns κs nt)
+        (fupd' W maskEmpty E (BIBase.emp : IPropWsat GF M F)))
+      (R := ipure (Λ.prim_step e1 σ [] e2 σ []))).1).trans ?_
+    refine (sep_assoc (P := isep (ilater (pure_step_cont_pred W s E e1 Φ))
+      (ipure (Λ.prim_step e1 σ [] e2 σ [])))
+      (Q := state_interp σ ns κs nt)
+      (R := fupd' W maskEmpty E (BIBase.emp : IPropWsat GF M F))).2.trans ?_
+    refine (sep_mono (pure_step_later (s := s) (E := E) (e1 := e1)
+      (Φ := Φ) (σ := σ) (ns := ns) (κs := κs) (nt := nt) (e2 := e2)) .rfl).trans ?_
+    refine ((sep_comm (P := ilater
+      (isep (state_interp σ (ns + 1) κs nt)
+        (wp (W := W) s E e2 Φ)))
+      (Q := fupd' W maskEmpty E (BIBase.emp : IPropWsat GF M F))).1).trans ?_
+    refine (fupd_close_emp (E := E) (P := ilater
+      (isep (state_interp σ (ns + 1) κs nt)
+        (wp (W := W) s E e2 Φ)))).trans ?_
+    exact fupd_later_add_emp (s := s) (E := E) (Φ := Φ)
+      (σ := σ) (ns := ns) (κs := κs) (nt := nt) (e2 := e2)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+private theorem pure_step_cont {s : Stuckness} {E : Iris.Set Positive}
+    {Φ : Λ.val → IPropWsat GF M F} {e1 : Λ.expr}
+    (hstep : ∀ κ σ1 e2 σ2 efs, Λ.prim_step e1 σ1 κ e2 σ2 efs →
+      κ = [] ∧ σ2 = σ1 ∧ efs = [])
+    (σ : Λ.state) (ns : Nat) (κ : List Λ.observation)
+    (κs : List Λ.observation) (nt : Nat) :
+    isep (ilater (pure_step_cont_pred W s E e1 Φ))
+      (isep (state_interp σ ns (κ ++ κs) nt)
+        (fupd' W maskEmpty E (BIBase.emp : IPropWsat GF M F))) ⊢
+      iforall fun e2 : Λ.expr =>
+        iforall fun σ2 : Λ.state =>
+          iforall fun efs : List Λ.expr =>
+            iwand (ipure (Λ.prim_step e1 σ κ e2 σ2 efs))
+              (fupd' W maskEmpty E
+                (step_post W (s := s) (E := E) (Φ := Φ)
+                  (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt) (e2 := e2) (efs := efs))) :=
+  by
+    -- build the continuation by eliminating the pure step
+    refine forall_intro ?_; intro e2
+    refine forall_intro ?_; intro σ2
+    refine forall_intro ?_; intro efs
+    refine wand_intro ?_
+    refine (pure_elim (φ := Λ.prim_step e1 σ κ e2 σ2 efs)
+      (Q := isep (isep
+        (ilater (pure_step_cont_pred W s E e1 Φ))
+        (isep (state_interp σ ns (κ ++ κs) nt)
+          (fupd' W maskEmpty E (BIBase.emp : IPropWsat GF M F))))
+        (ipure (Λ.prim_step e1 σ κ e2 σ2 efs))) ?_ ?_)
+    · -- expose the pure step from the frame
+      exact sep_elim_r
+    intro hprim
+    rcases hstep κ σ e2 σ2 efs hprim with ⟨hκ, hσ, hfs⟩
+    subst hκ; subst hσ; subst hfs
+    -- simplify the fork postcondition for the empty fork list
+    simp [step_post, fork_posts]
+    exact pure_step_cont_close
+      (s := s) (E := E) (e1 := e1) (Φ := Φ)
+      (σ := σ2) (ns := ns) (κs := κs) (nt := nt) (e2 := e2)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+private theorem pure_step_pre_wand {s : Stuckness} {E : Iris.Set Positive}
+    {Φ : Λ.val → IPropWsat GF M F} {e1 : Λ.expr}
+    (hsafe : ∀ σ1, match s with
+      | .notStuck => reducible e1 σ1
+      | .maybeStuck => Λ.to_val e1 = none)
+    (hstep : ∀ κ σ1 e2 σ2 efs, Λ.prim_step e1 σ1 κ e2 σ2 efs →
+      κ = [] ∧ σ2 = σ1 ∧ efs = [])
+    (σ : Λ.state) (ns : Nat) (κ : List Λ.observation)
+    (κs : List Λ.observation) (nt : Nat) :
+    isep (ilater (pure_step_cont_pred W s E e1 Φ))
+      (isep (state_interp σ ns (κ ++ κs) nt)
+        (fupd' W maskEmpty E (BIBase.emp : IPropWsat GF M F))) ⊢
+      isep (ipure (stuckness_pred s e1 σ))
+        (iforall fun e2 : Λ.expr =>
+          iforall fun σ2 : Λ.state =>
+            iforall fun efs : List Λ.expr =>
+              iwand (ipure (Λ.prim_step e1 σ κ e2 σ2 efs))
+                (fupd' W maskEmpty E
+                  (step_post W (s := s) (E := E) (Φ := Φ)
+                    (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt) (e2 := e2) (efs := efs)))) :=
+  by
+    -- add the pure stuckness fact and reuse the step continuation
+    -- specialize the stuckness and step continuations to this language instance
+    have hpure :=
+      pure_step_stuckness (Λ := Λ) (GF := GF) (M := M) (F := F)
+        (s := s) (e1 := e1)
+      hsafe (σ := σ)
+    have hcont :=
+      pure_step_cont (W := W)
+        (s := s) (E := E) (e1 := e1) (Φ := Φ)
+        hstep (σ := σ) (ns := ns) (κ := κ) (κs := κs) (nt := nt)
+    refine (true_sep_2 (PROP := IPropWsat GF M F)
+      (P := isep
+        (ilater (pure_step_cont_pred W s E e1 Φ))
+        (isep (state_interp σ ns (κ ++ κs) nt)
+          (fupd' W maskEmpty E (BIBase.emp : IPropWsat GF M F))))).trans ?_
+    exact sep_mono hpure hcont
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+private theorem pure_step_pre {s : Stuckness} {E : Iris.Set Positive}
+    {Φ : Λ.val → IPropWsat GF M F} {e1 : Λ.expr}
+    (hsafe : ∀ σ1, match s with
+      | .notStuck => reducible e1 σ1
+      | .maybeStuck => Λ.to_val e1 = none)
+    (hstep : ∀ κ σ1 e2 σ2 efs, Λ.prim_step e1 σ1 κ e2 σ2 efs →
+      κ = [] ∧ σ2 = σ1 ∧ efs = [])
+    (σ : Λ.state) (ns : Nat) (κ : List Λ.observation)
+    (κs : List Λ.observation) (nt : Nat) :
+    ilater (pure_step_cont_pred W s E e1 Φ) ⊢
+      iwand (state_interp σ ns (κ ++ κs) nt)
+        (fupd' W E maskEmpty
+          (isep (ipure (stuckness_pred s e1 σ))
+            (iforall fun e2 : Λ.expr =>
+              iforall fun σ2 : Λ.state =>
+                iforall fun efs : List Λ.expr =>
+                  iwand (ipure (Λ.prim_step e1 σ κ e2 σ2 efs))
+                    (fupd' W maskEmpty E
+                      (step_post W (s := s) (E := E) (Φ := Φ)
+                        (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt) (e2 := e2)
+                        (efs := efs)))))) :=
+  by
+    -- open the mask and use the pure-step continuation
+    have hsubset : Subset maskEmpty E := by
+      intro _ h; exact h.elim
+    refine wand_intro ?_
+    let Q : IPropWsat GF M F :=
+      iforall fun e2 : Λ.expr =>
+        iforall fun σ2 : Λ.state =>
+          iforall fun efs : List Λ.expr =>
+            iwand (ipure (Λ.prim_step e1 σ κ e2 σ2 efs))
+              (fupd' W maskEmpty E
+                (step_post W (s := s) (E := E) (Φ := Φ)
+                  (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt) (e2 := e2) (efs := efs)))
+    have hmask :=
+      fupd_mask_intro (W := W)
+        (E1 := E) (E2 := maskEmpty) hsubset
+        (P := isep (ipure (stuckness_pred s e1 σ)) Q)
+    have hwand :
+        isep (ilater (pure_step_cont_pred W s E e1 Φ))
+            (state_interp σ ns (κ ++ κs) nt) ⊢
+          iwand (fupd' W maskEmpty E (BIBase.emp : IPropWsat GF M F))
+            (isep (ipure (stuckness_pred s e1 σ)) Q) := by
+      refine wand_intro ?_
+      -- reassociate to match `pure_step_pre_wand`'s expected framing
+      refine (sep_assoc (P := ilater (pure_step_cont_pred W s E e1 Φ))
+        (Q := state_interp σ ns (κ ++ κs) nt)
+        (R := fupd' W maskEmpty E (BIBase.emp : IPropWsat GF M F))).1.trans ?_
+      exact pure_step_pre_wand
+        (s := s) (E := E) (e1 := e1) (Φ := Φ)
+        hsafe hstep (σ := σ) (ns := ns) (κ := κ) (κs := κs) (nt := nt)
+    exact hwand.trans hmask
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+private theorem pure_step_wp_pre {s : Stuckness} {E : Iris.Set Positive}
+    {Φ : Λ.val → IPropWsat GF M F} {e1 : Λ.expr}
+    (hsafe : ∀ σ1, match s with
+      | .notStuck => reducible e1 σ1
+      | .maybeStuck => Λ.to_val e1 = none)
+    (hstep : ∀ κ σ1 e2 σ2 efs, Λ.prim_step e1 σ1 κ e2 σ2 efs →
+      κ = [] ∧ σ2 = σ1 ∧ efs = []) :
+    (hv : Λ.to_val e1 = none) →
+    ilater (pure_step_cont_pred W s E e1 Φ) ⊢
+      wp_pre (W := W) s (wp (W := W) s) E e1 Φ :=
+  by
+    -- unfold the non-value branch and assemble the binders
+    intro hv
+    -- unfold the WP precondition for the non-value case
+    simp [wp_pre, hv]
+    refine forall_intro ?_; intro σ
+    refine forall_intro ?_; intro ns
+    refine forall_intro ?_; intro κ
+    refine forall_intro ?_; intro κs
+    refine forall_intro ?_; intro nt
+    exact pure_step_pre (s := s) (E := E) (e1 := e1) (Φ := Φ)
+      hsafe hstep (σ := σ) (ns := ns) (κ := κ) (κs := κs) (nt := nt)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+private theorem pure_det_to_cont {s : Stuckness} {E : Iris.Set Positive}
+    {Φ : Λ.val → IPropWsat GF M F} {e1 e2 : Λ.expr}
+    (hstep : ∀ σ1 κ e2' σ2 efs', Λ.prim_step e1 σ1 κ e2' σ2 efs' →
+      κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) :
+    wp (W := W) s E e2 Φ ⊢
+      iforall fun κ : List Λ.observation =>
+        iforall fun e2' : Λ.expr =>
+          iforall fun efs : List Λ.expr =>
+            iforall fun σ : Λ.state =>
+              iwand (ipure (Λ.prim_step e1 σ κ e2' σ efs))
+                (wp (W := W) s E e2' Φ) :=
+  by
+    -- build the deterministic continuation by rewriting `e2'`
+    refine forall_intro ?_; intro κ
+    refine forall_intro ?_; intro e2'
+    refine forall_intro ?_; intro efs
+    refine forall_intro ?_; intro σ
+    refine wand_intro ?_
+    refine (pure_elim (φ := Λ.prim_step e1 σ κ e2' σ efs)
+      (Q := BIBase.sep (wp (W := W) s E e2 Φ)
+        (BIBase.pure (Λ.prim_step e1 σ κ e2' σ efs))) ?_ ?_)
+    · -- expose the pure step from the frame
+      exact sep_elim_r
+    intro hprim
+    rcases hstep σ κ e2' σ efs hprim with ⟨_, _, he2, _⟩
+    subst he2
+    exact sep_elim_l
+
+omit [UFraction F] [FiniteMap Positive M] [HeapFiniteMap Positive M]
+  [ElemG GF (InvF GF M F)]
+  [DecidableEq Positive]
+  [ElemG GF (COFE.constOF CoPsetDisj)]
+  [ElemG GF (COFE.constOF GSetDisj)]
+  [IrisGS Λ GF] in
+private theorem prim_step_elim (e : Λ.expr) (σ : Λ.state) (κ : List Λ.observation)
+    (e2 : Λ.expr) (σ2 : Λ.state) (efs : List Λ.expr) (hstuck : stuck e σ)
+    (P : IPropWsat GF M F) :
+    BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs) ⊢ P :=
+  by
+    -- eliminate a primitive step using irreducibility from stuckness
+    refine pure_elim' ?_
+    intro hstep
+    exact False.elim (hstuck.2 κ e2 σ2 efs hstep)
+
+omit [UFraction F] [FiniteMap Positive M] [HeapFiniteMap Positive M]
+  [ElemG GF (InvF GF M F)]
+  [DecidableEq Positive]
+  [ElemG GF (COFE.constOF CoPsetDisj)]
+  [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem pure_true_sep (Q : IPropWsat GF M F) (hQ : (True : IPropWsat GF M F) ⊢ Q) :
+    ipure True ⊢ isep (ipure True) Q :=
+  by
+    -- turn `pure True` into `True`, then build the separating conjunction
+    have hpt : ipure True ⊢ (True : IPropWsat GF M F) := (pure_true trivial).1
+    have hQ' : ipure True ⊢ Q := hpt.trans hQ
+    have hsep : ipure True ⊢ (True : IPropWsat GF M F) ∗ Q :=
+      hQ'.trans (true_sep_2 (PROP := IPropWsat GF M F) (P := Q))
+    have htp : (True : IPropWsat GF M F) ⊢ ipure True := (pure_true trivial).2
+    exact hsep.trans (sep_mono htp .rfl)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+private theorem stuck_cont (E : Iris.Set Positive) (Φ : Λ.val → IPropWsat GF M F)
+    (e : Λ.expr) (σ : Λ.state) (ns nt : Nat)
+    (κ : List Λ.observation) (κs : List Λ.observation)
+    (hstuck : stuck e σ) :
+    (True : IPropWsat GF M F) ⊢
+      iforall fun e2 : Λ.expr =>
+        iforall fun σ2 : Λ.state =>
+          iforall fun efs : List Λ.expr =>
+            iwand (ipure (Λ.prim_step e σ κ e2 σ2 efs))
+              (fupd' W maskEmpty E
+                (step_post W (s := .maybeStuck) (E := E) (Φ := Φ)
+                  (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt) (e2 := e2) (efs := efs))) :=
+  by
+    -- build the continuation by eliminating impossible primitive steps
+    refine forall_intro (PROP := IPropWsat GF M F) ?_; intro e2
+    refine forall_intro (PROP := IPropWsat GF M F) ?_; intro σ2
+    refine forall_intro (PROP := IPropWsat GF M F) ?_; intro efs
+    refine wand_intro ?_
+    refine (sep_elim_r (PROP := IPropWsat GF M F)
+      (P := ipure True) (Q := BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs))).trans ?_
+    let P : IPropWsat GF M F :=
+      fupd' W maskEmpty E
+        (step_post W (s := .maybeStuck) (E := E) (Φ := Φ)
+          (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt) (e2 := e2) (efs := efs))
+    exact prim_step_elim (Λ := Λ) (e := e) (σ := σ) (κ := κ)
+      (e2 := e2) (σ2 := σ2) (efs := efs) hstuck (P := P)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+private theorem wp_pre_stuck (E : Iris.Set Positive)
+    (Φ : Λ.val → IPropWsat GF M F) (e : Λ.expr)
+    (hv : Λ.to_val e = none) (hstuck : ∀ σ, stuck e σ) :
+    ipure True ⊢
+      wp_pre (W := W) .maybeStuck (wp (W := W) .maybeStuck) E e Φ :=
+  by
+    -- unfold the non-value branch and build the continuation from stuckness
+    have hsubset : Subset maskEmpty E := by intro _ h; exact h.elim
+    -- unfold the non-value branch of `wp_pre`
+    simp [wp_pre, hv]
+    refine forall_intro (PROP := IPropWsat GF M F) ?_; intro σ
+    refine forall_intro (PROP := IPropWsat GF M F) ?_; intro ns
+    refine forall_intro (PROP := IPropWsat GF M F) ?_; intro κ
+    refine forall_intro (PROP := IPropWsat GF M F) ?_; intro κs
+    refine forall_intro (PROP := IPropWsat GF M F) ?_; intro nt
+    refine wand_intro ?_
+    let Q : IPropWsat GF M F :=
+      iforall fun e2 : Λ.expr =>
+        iforall fun σ2 : Λ.state =>
+          iforall fun efs : List Λ.expr =>
+            iwand (ipure (Λ.prim_step e σ κ e2 σ2 efs))
+              (fupd' W maskEmpty E
+                (step_post W (s := .maybeStuck) (E := E) (Φ := Φ)
+                  (σ2 := σ2) (ns := ns) (κs := κs) (nt := nt) (e2 := e2) (efs := efs)))
+    have hQ : (True : IPropWsat GF M F) ⊢ Q := by
+      simpa [Q] using stuck_cont (E := E) (Φ := Φ)
+        (e := e) (σ := σ) (ns := ns) (nt := nt) (κ := κ) (κs := κs) (hstuck := hstuck σ)
+    have hsep : ipure True ⊢ isep (ipure True) Q :=
+      pure_true_sep (Q := Q) hQ
+    have hmask : ipure True ⊢ fupd' W E maskEmpty
+        (isep (ipure True) Q) := by
+      -- build the wand required to open the mask, then apply `fupd_mask_intro`
+      have hwand : ipure True ⊢
+          BIBase.wand
+            (fupd' W maskEmpty E (BIBase.emp : IPropWsat GF M F))
+            (isep (ipure True) Q) := by
+        refine wand_intro ?_
+        exact (sep_elim_l (P := ipure True)
+          (Q := fupd' W maskEmpty E (BIBase.emp : IPropWsat GF M F))).trans hsep
+      exact hwand.trans
+        (fupd_mask_intro (W := W) (E1 := E) (E2 := maskEmpty)
+          hsubset (P := isep (ipure True) Q))
+    exact (sep_elim_l (P := ipure True)
+      (Q := state_interp σ ns (κ ++ κs) nt)).trans hmask
+
+/-! ## Core Lifting Lemmas -/
+
+/-- Lift a single step to WP with fupd. Unfolds the WP fixpoint one step.
+The hypothesis must provide state interpretation update and recursive WP
+for the continuation, with a `▷` guarding the post-step obligation.
+Coq: `wp_lift_step_fupd` in `lifting.v`. -/
+noncomputable def wp_lift_step_fupd (s : Stuckness) (E : Iris.Set Positive)
+    (Φ : Λ.val → IPropWsat GF M F) (e1 : Λ.expr)
+    (hv : Λ.to_val e1 = none) :
+    wp_pre (W := W) s (wp (W := W) s) E e1 Φ ⊢ wp (W := W) s E e1 Φ :=
+  by
+    -- unfold the fixpoint once and use `hv` to select the step case
+    simpa [wp_pre, hv] using
+      (wp_unfold (W := W)
+        (s := s) (E := E) (e := e1) (Φ := Φ)).2
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Lift a single step to WP. Like `wp_lift_step_fupd` but with `▷`
+before the continuation rather than fupd.
+Coq: `wp_lift_step` in `lifting.v`. -/
+theorem wp_lift_step (s : Stuckness) (E : Iris.Set Positive)
+    (Φ : Λ.val → IPropWsat GF M F) (e1 : Λ.expr)
+    (hv : Λ.to_val e1 = none) :
+    wp_pre (W := W) s (wp (W := W) s) E e1 Φ ⊢ wp (W := W) s E e1 Φ :=
+  by
+    -- the non-fupd variant is definitionally the same in this port
+    simpa using wp_lift_step_fupd (s := s) (E := E) (Φ := Φ) (e1 := e1) hv
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Lift a stuck expression: if `e` is stuck in every reachable state,
+then `WP e @ E ?{{ Φ }}` holds.
+Coq: `wp_lift_stuck` in `lifting.v`. -/
+theorem wp_lift_stuck (_s : Stuckness) (E : Iris.Set Positive)
+    (Φ : Λ.val → IPropWsat GF M F) (e : Λ.expr)
+    (hv : Λ.to_val e = none)
+    (hstuck : ∀ σ, stuck e σ) :
+    ipure True ⊢ wp (W := W) .maybeStuck E e Φ :=
+  by
+    -- fold the constructed `wp_pre` back into `wp`
+    exact (wp_pre_stuck (E := E) (Φ := Φ)
+      (e := e) hv hstuck).trans
+      (wp_lift_step_fupd (s := .maybeStuck) (E := E) (Φ := Φ) (e1 := e) hv)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Lift a pure, fork-free step.
+Coq: `wp_lift_pure_step_no_fork` in `lifting.v`. -/
+theorem wp_lift_pure_step_no_fork [Inhabited Λ.state]
+    (s : Stuckness) (E : Iris.Set Positive)
+    (Φ : Λ.val → IPropWsat GF M F) (e1 : Λ.expr)
+    (hsafe : ∀ σ1, match s with
+      | .notStuck => reducible e1 σ1
+      | .maybeStuck => Λ.to_val e1 = none)
+    (hstep : ∀ κ σ1 e2 σ2 efs, Λ.prim_step e1 σ1 κ e2 σ2 efs →
+      κ = [] ∧ σ2 = σ1 ∧ efs = []) :
+    ilater
+      (iforall fun κ : List Λ.observation =>
+        iforall fun e2 : Λ.expr =>
+          iforall fun efs : List Λ.expr =>
+            iforall fun σ : Λ.state =>
+              iwand (ipure (Λ.prim_step e1 σ κ e2 σ efs))
+                (wp (W := W) s E e2 Φ))
+    ⊢ wp (W := W) s E e1 Φ :=
+  by
+    -- unfold the fixpoint and discharge the pure-step precondition
+    have hv : Λ.to_val e1 = none :=
+      pure_step_val_none (Λ := Λ) (s := s) (e1 := e1) hsafe
+    have hpre :
+        ilater
+          (iforall fun κ : List Λ.observation =>
+            iforall fun e2 : Λ.expr =>
+              iforall fun efs : List Λ.expr =>
+                iforall fun σ : Λ.state =>
+                  iwand (ipure (Λ.prim_step e1 σ κ e2 σ efs))
+                    (wp (W := W) s E e2 Φ)) ⊢
+          wp_pre (W := W) s (wp (W := W) s) E e1 Φ :=
+      pure_step_wp_pre (s := s) (E := E) (e1 := e1) (Φ := Φ)
+        hsafe hstep hv
+    exact hpre.trans <|
+      wp_lift_step (s := s) (E := E) (Φ := Φ) (e1 := e1) hv
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Lift an atomic step with fancy update.
+Coq: `wp_lift_atomic_step_fupd` in `lifting.v`. -/
+theorem wp_lift_atomic_step_fupd (s : Stuckness) (E1 E2 : Iris.Set Positive)
+    (Φ : Λ.val → IPropWsat GF M F) (e1 : Λ.expr)
+    (hv : Λ.to_val e1 = none) :
+    E1 = E2 →
+    wp_pre (W := W) s (wp (W := W) s) E1 e1
+      (fun v => uPred_fupd (M := M) (F := F) W E2 E1 (Φ v))
+    ⊢ wp (W := W) s E1 e1 Φ :=
+  by
+    -- reduce to the non-atomic step rule and absorb the postcondition update
+    intro hE
+    subst hE
+    have hstep :=
+      wp_lift_step_fupd (W := W) (M := M) (F := F)
+        (s := s) (E := E1) (Φ := fun v =>
+          uPred_fupd (M := M) (F := F) W E1 E1 (Φ v))
+        (e1 := e1) hv
+    exact hstep.trans <|
+      wp_fupd (W := W)
+        (s := s) (E := E1) (e := e1) (Φ := Φ)
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Lift an atomic step.
+Coq: `wp_lift_atomic_step` in `lifting.v`. -/
+theorem wp_lift_atomic_step (s : Stuckness) (E : Iris.Set Positive)
+    (Φ : Λ.val → IPropWsat GF M F) (e1 : Λ.expr)
+    (hv : Λ.to_val e1 = none) :
+    wp_pre (W := W) s (wp (W := W) s) E e1 Φ ⊢ wp (W := W) s E e1 Φ :=
+  by
+    -- atomic steps are handled by the generic step lemma in this port
+    simpa using wp_lift_step_fupd
+      (s := s) (E := E) (Φ := Φ) (e1 := e1) hv
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Lift a deterministic pure step with no fork.
+Coq: `wp_lift_pure_det_step_no_fork` in `lifting.v`. -/
+theorem wp_lift_pure_det_step_no_fork [Inhabited Λ.state]
+    (s : Stuckness) (E : Iris.Set Positive)
+    (Φ : Λ.val → IPropWsat GF M F) (e1 e2 : Λ.expr)
+    (hsafe : ∀ σ1, match s with
+      | .notStuck => reducible e1 σ1
+      | .maybeStuck => Λ.to_val e1 = none)
+    (hstep : ∀ σ1 κ e2' σ2 efs', Λ.prim_step e1 σ1 κ e2' σ2 efs' →
+      κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) :
+    ilater (wp (W := W) s E e2 Φ)
+    ⊢ wp (W := W) s E e1 Φ :=
+  by
+    -- specialize the deterministic continuation and reuse `wp_lift_pure_step_no_fork`
+    have hstep' :
+        ∀ κ σ1 e2' σ2 efs, Λ.prim_step e1 σ1 κ e2' σ2 efs →
+          κ = [] ∧ σ2 = σ1 ∧ efs = [] := by
+      -- drop the deterministic `e2` equality
+      intro κ σ1 e2' σ2 efs hprim
+      rcases hstep σ1 κ e2' σ2 efs hprim with ⟨hκ, hσ, _, hfs⟩
+      exact ⟨hκ, hσ, hfs⟩
+    have hcont :
+        ilater (wp (W := W) s E e2 Φ) ⊢
+          ilater
+            (iforall fun κ : List Λ.observation =>
+              iforall fun e2' : Λ.expr =>
+                iforall fun efs : List Λ.expr =>
+                  iforall fun σ : Λ.state =>
+                    iwand (ipure (Λ.prim_step e1 σ κ e2' σ efs))
+                      (wp (W := W) s E e2' Φ)) :=
+      later_mono (PROP := IPropWsat GF M F)
+        (pure_det_to_cont (s := s) (E := E) (e1 := e1)
+        (e2 := e2) (Φ := Φ) hstep)
+    exact hcont.trans <|
+      wp_lift_pure_step_no_fork
+        (s := s) (E := E) (Φ := Φ) (e1 := e1) hsafe hstep'
+
+omit [DecidableEq Positive] [FiniteMapLaws Positive M] in
+/-- Lift a pure stuck expression.
+Coq: `wp_lift_pure_stuck` in `lifting.v`. -/
+theorem wp_lift_pure_stuck [Inhabited Λ.state]
+    (E : Iris.Set Positive) (Φ : Λ.val → IPropWsat GF M F) (e : Λ.expr)
+    (hstuck : ∀ σ, stuck e σ) :
+    ipure True ⊢ wp (W := W) .maybeStuck E e Φ :=
+  by
+    -- derive non-valueness from stuckness and reuse `wp_lift_stuck`
+    have hv : Λ.to_val e = none := (hstuck (default : Λ.state)).1
+    exact wp_lift_stuck
+      (_s := .maybeStuck) (E := E) (Φ := Φ) (e := e) hv hstuck
+
+end Iris.ProgramLogic
diff --git a/src/Iris/ProgramLogic/WeakestPre.lean b/src/Iris/ProgramLogic/WeakestPre.lean
new file mode 100644
index 00000000..468d8b0f
--- /dev/null
+++ b/src/Iris/ProgramLogic/WeakestPre.lean
@@ -0,0 +1,3682 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+import Iris.BaseLogic.Lib.FancyUpdates
+import Iris.ProgramLogic.Language
+import Iris.ProofMode.Tactics
+import Iris.BI.DerivedLawsLater
+
+/-! # Weakest Precondition
+
+Reference: `iris/program_logic/weakestpre.v`
+
+The weakest precondition `WP e @ s; E {{ Φ }}` asserts that expression `e`,
+starting in mask `E` with stuckness `s`, either:
+- is a value `v` satisfying `|={E}=> Φ v`, or
+- can take a step, and after stepping the WP holds recursively.
+
+The fixpoint is well-founded because the recursive occurrence is guarded
+under `▷` (via the step-taking fancy update `|={∅}▷=>^n`).
+
+## Definition
+
+```
+wp_pre W s wp W E e Φ :=
+  match to_val e with
+  | Some v => |={E}=> Φ v
+  | None => ∀ σ ns κ κs nt,
+      state_interp σ ns (κ ++ κs) nt ={E,∅}=∗
+        ⌜if s is NotStuck then reducible e σ else True⌝ ∗
+        ∀ e2 σ2 efs, ⌜prim_step e σ κ e2 σ2 efs⌝ ={∅}▷=∗^(S n) |={∅,E}=>
+        state_interp σ2 (S ns) κs (length efs + nt) ∗
+        wp W E e2 Φ ∗
+        [∗ list] ef ∈ efs, wp W ⊤ ef fork_post
+  end
+```
+
+## Main Results
+
+- `wp_value_fupd` — value case: `WP of_val v @ s; E {{ Φ }} ⊣⊢ |={E}=> Φ v`
+- `wp_strong_mono` — monotonicity in stuckness, mask, and postcondition
+- `wp_bind` — compositionality via evaluation contexts
+- `wp_frame_l` / `wp_frame_r` — frame rules
+- `wp_fupd` — absorb postcondition update
+- `wp_wand` — weakening postcondition via wand
+
+## Simplifications
+
+This port omits later credit support and the `step_fupdN` infrastructure.
+The `num_laters_per_step` is fixed to 0 (one later per step).
+-/
+
+namespace Iris.ProgramLogic
+
+open Iris Iris.Algebra Iris.Std Iris.BI Iris.BaseLogic
+
+variable {GF : BundledGFunctors} {M : Type _ → Type _} {F : Type _}
+variable [UFraction F]
+variable [FiniteMap Positive M] [HeapFiniteMap Positive M]
+variable [ElemG GF (InvF GF M F)]
+variable [ElemG GF (COFE.constOF CoPsetDisj)]
+variable [ElemG GF (COFE.constOF GSetDisj)]
+
+variable {Λ : Language}
+
+/-! ## Iris Ghost State for WP -/
+
+/-- The Iris ghost state typeclass for the weakest precondition.
+Packages the state interpretation, fork postcondition, and per-step laters.
+Coq: `irisGS_gen` in `weakestpre.v`. -/
+class IrisGS (Λ : Language) (GF : BundledGFunctors) where
+  /-- World satisfaction witness. -/
+  wsatGS : WsatGS GF
+  /-- State interpretation invariant: `state → step_count → observations → num_forks → iProp`. -/
+  state_interp : Λ.state → Nat → List Λ.observation → Nat → IProp GF
+  /-- Fixed postcondition for forked threads. -/
+  fork_post : Λ.val → IProp GF
+  /-- State interpretation is monotone in step count.
+  Full version uses `uPred_fupd wsatGS ∅ ∅ (state_interp σ (ns+1) κs nt)`;
+  simplified here to avoid threading `M`/`F` into the class. -/
+  state_interp_mono : ∀ σ ns κs nt,
+    state_interp σ ns κs nt ⊢ state_interp σ (ns + 1) κs nt
+
+variable [inst : IrisGS Λ GF]
+variable {W : WsatGS GF}
+
+private noncomputable abbrev fupd' (W : WsatGS GF)
+    (E1 E2 : Iris.Set Positive) (P : IPropWsat GF M F) : IPropWsat GF M F :=
+  uPred_fupd (M := M) (F := F) W E1 E2 P
+
+private abbrev maskEmpty : Iris.Set Positive := fun _ => False
+
+private theorem fupd_idem (E : Iris.Set Positive) (P : IPropWsat GF M F) :
+    fupd' W E E
+        (fupd' W E E P) ⊢
+      fupd' W E E P := by
+  simpa using
+    (Iris.BaseLogic.fupd_trans (W := W) (M := M) (F := F)
+      (E1 := E) (E2 := E) (E3 := E) (P := P))
+
+private theorem fupd_intro (E : Iris.Set Positive) (P : IPropWsat GF M F) :
+    P ⊢ fupd' W E E P := by
+  have hsubset : Subset E E := by
+    intro _ hx; exact hx
+  have hintro :=
+    Iris.BaseLogic.fupd_intro_mask (W := W) (M := M) (F := F)
+      (E1 := E) (E2 := E) hsubset (P := P)
+  have htrans :=
+    Iris.BaseLogic.fupd_trans (W := W) (M := M) (F := F)
+      (E1 := E) (E2 := E) (E3 := E) (P := P)
+  exact hintro.trans htrans
+
+private abbrev maskDiff (E1 E2 : Iris.Set Positive) : Iris.Set Positive :=
+  -- points in `E2` but not in `E1`
+  fun i => E2 i ∧ ¬E1 i
+
+private theorem fupd_mask_mono (E1 E2 : Iris.Set Positive) (h : Subset E1 E2)
+    (P : IPropWsat GF M F) :
+    fupd' W E1 E1 P ⊢
+      fupd' W E2 E2 P := by
+  -- frame the mask difference, then rejoin
+  let Ef : Iris.Set Positive := maskDiff E1 E2
+  have hdisj : CoPset.Disjoint (mask E1) (mask Ef) := by
+    intro i hboth
+    exact hboth.2.2 hboth.1
+  have hunion : Iris.union E1 Ef = E2 := by
+    funext i
+    apply propext
+    constructor
+    · intro h'
+      cases h' with
+      | inl hE1 => exact h i hE1
+      | inr hEf => exact hEf.1
+    · intro hE2
+      by_cases hE1 : E1 i
+      · exact Or.inl hE1
+      · exact Or.inr ⟨hE2, hE1⟩
+  have hframe :=
+    Iris.BaseLogic.fupd_mask_frame_r (W := W) (M := M) (F := F)
+      (E1 := E1) (E2 := E1) (Ef := Ef) (P := P) hdisj
+  have hframe' :
+      fupd' W E1 E1 P ⊢
+      fupd' W (Iris.union E1 Ef) (Iris.union E1 Ef) P := by
+    simpa [Iris.union] using hframe
+  simpa [hunion] using hframe'
+
+private theorem fupd_close_mask (E1 E2 : Iris.Set Positive) (P : IPropWsat GF M F) :
+    fupd' W maskEmpty E1
+        (BIBase.sep P (fupd' W E1 E2 (BIBase.emp : IProp GF))) ⊢
+      fupd' W maskEmpty E2 P := by
+  -- close the mask using the framed update and `Iris.BaseLogic.fupd_trans`
+  have hframe :
+      BIBase.sep (fupd' W E1 E2 (BIBase.emp : IProp GF)) P ⊢
+        fupd' W E1 E2 P := by
+    have hmono :
+        fupd' W E1 E2 (BIBase.sep (BIBase.emp : IProp GF) P) ⊢
+          fupd' W E1 E2 P :=
+      Iris.BaseLogic.fupd_mono (W := W) (M := M) (F := F)
+        (E1 := E1) (E2 := E2)
+        (P := BIBase.sep (BIBase.emp : IProp GF) P) (Q := P) (emp_sep (P := P)).1
+    exact (Iris.BaseLogic.fupd_frame_r (W := W)
+      (M := M) (F := F) (E1 := E1) (E2 := E2)
+      (P := BIBase.emp) (Q := P)).trans hmono
+  have hframe' :
+      BIBase.sep P (fupd' W E1 E2 (BIBase.emp : IProp GF)) ⊢
+        fupd' W E1 E2 P := by
+    exact sep_symm.trans hframe
+  have hmono :
+      fupd' W maskEmpty E1
+          (BIBase.sep P (fupd' W E1 E2 (BIBase.emp : IProp GF))) ⊢
+        fupd' W maskEmpty E1
+          (fupd' W E1 E2 P) :=
+    Iris.BaseLogic.fupd_mono (W := W) (M := M) (F := F)
+      (E1 := maskEmpty) (E2 := E1)
+      (P := BIBase.sep P (fupd' W E1 E2 (BIBase.emp : IProp GF)))
+      (Q := fupd' W E1 E2 P) hframe'
+  exact hmono.trans <|
+    Iris.BaseLogic.fupd_trans (W := W) (M := M) (F := F)
+      (E1 := maskEmpty) (E2 := E1) (E3 := E2) (P := P)
+
+private theorem fupd_mask_subseteq_apply (E1 E2 : Iris.Set Positive)
+    (h : Subset E1 E2) (P : IPropWsat GF M F) :
+    fupd' W E1 maskEmpty P ⊢
+      fupd' W E2 maskEmpty
+        (BIBase.sep P (fupd' W E1 E2 (BIBase.emp : IProp GF))) := by
+  -- open the larger mask, frame the computation, then re-close
+  have hclose : (True : IProp GF) ⊢
+      fupd' W E2 E1
+        (fupd' W E1 E2 (BIBase.emp : IProp GF)) :=
+    Iris.BaseLogic.fupd_mask_subseteq (W := W) (M := M) (F := F)
+      (E1 := E2) (E2 := E1) h
+  refine (true_sep_2 (PROP := IProp GF) (P := fupd' W E1 maskEmpty P)).trans ?_
+  refine (sep_mono hclose .rfl).trans ?_
+  refine (Iris.BaseLogic.fupd_frame_r (W := W) (M := M) (F := F)
+    (E1 := E2) (E2 := E1)
+    (P := fupd' W E1 E2 (BIBase.emp : IProp GF))
+    (Q := fupd' W E1 maskEmpty P)).trans ?_
+  refine (Iris.BaseLogic.fupd_mono (W := W) (M := M) (F := F)
+    (E1 := E2) (E2 := E1) (P := _)
+    (Q := fupd' W E1 maskEmpty
+      (BIBase.sep P (fupd' W E1 E2 (BIBase.emp : IProp GF)))) ?_).trans ?_
+  · -- move the closing update inside the inner `fupd`
+    refine (sep_symm.trans ?_)
+    exact Iris.BaseLogic.fupd_frame_r (W := W) (M := M) (F := F)
+      (E1 := E1) (E2 := maskEmpty)
+      (P := P) (Q := fupd' W E1 E2 (BIBase.emp : IProp GF))
+  -- compose the nested updates to close the mask
+  exact Iris.BaseLogic.fupd_trans (W := W) (M := M) (F := F)
+    (E1 := E2) (E2 := E1) (E3 := maskEmpty)
+    (P := BIBase.sep P (fupd' W E1 E2 (BIBase.emp : IProp GF)))
+
+private theorem fupd_forall {A : Type _} (E1 E2 : Iris.Set Positive)
+    (Φ : A → IPropWsat GF M F) :
+    fupd' W E1 E2 (BIBase.forall Φ) ⊢
+      BIBase.forall fun a => fupd' W E1 E2 (Φ a) := by
+  -- commute `fupd` with `∀` using monotonicity
+  refine forall_intro ?_; intro a
+  have hmono :
+      BIBase.forall Φ ⊢ Φ a :=
+    forall_elim (PROP := IProp GF) (Ψ := Φ) a
+  exact (Iris.BaseLogic.fupd_mono (W := W) (M := M) (F := F)
+    (E1 := E1) (E2 := E2) (P := BIBase.forall Φ) (Q := Φ a) hmono)
+
+private theorem fupd_wand (E1 E2 : Iris.Set Positive)
+    (P Q : IPropWsat GF M F) :
+    fupd' W E1 E2 (BIBase.wand P Q) ⊢
+      BIBase.wand P (fupd' W E1 E2 Q) := by
+  -- frame a premise through the update, then eliminate the wand
+  refine wand_intro ?_
+  have hframe :
+      BIBase.sep (fupd' W E1 E2 (BIBase.wand P Q)) P ⊢
+        fupd' W E1 E2 (BIBase.sep (BIBase.wand P Q) P) :=
+    Iris.BaseLogic.fupd_frame_r (W := W) (M := M) (F := F)
+      (E1 := E1) (E2 := E2) (P := BIBase.wand P Q) (Q := P)
+  have hmono :
+      BIBase.sep (BIBase.wand P Q) P ⊢ Q :=
+    wand_elim_l (P := P) (Q := Q)
+  exact (hframe.trans
+    (Iris.BaseLogic.fupd_mono (W := W) (M := M) (F := F)
+      (E1 := E1) (E2 := E2)
+      (P := BIBase.sep (BIBase.wand P Q) P) (Q := Q) hmono))
+
+/-! ## WP Helpers -/
+
+private abbrev fork_post : Λ.val → IPropWsat GF M F :=
+  (inst.fork_post : Λ.val → IPropWsat GF M F)
+
+private abbrev state_interp (σ : Λ.state) (ns : Nat)
+    (κs : List Λ.observation) (nt : Nat) : IPropWsat GF M F :=
+  (inst.state_interp σ ns κs nt : IPropWsat GF M F)
+
+private abbrev stuckness_pred (s : Stuckness) (e : Λ.expr) (σ : Λ.state) : Prop :=
+  match s with
+  | .notStuck => reducible e σ
+  | .maybeStuck => True
+
+/-- Order on stuckness: `notStuck` is stronger than `maybeStuck`. -/
+def stuckness_le : Stuckness → Stuckness → Prop
+  | .notStuck, _ => True
+  | .maybeStuck, .maybeStuck => True
+  | .maybeStuck, .notStuck => False
+
+private theorem stuckness_pred_mono {s1 s2 : Stuckness}
+    (h : stuckness_le s1 s2) (e : Λ.expr) (σ : Λ.state) :
+    stuckness_pred s1 e σ → stuckness_pred s2 e σ := by
+  -- check the two stuckness cases directly
+  cases s1 <;> cases s2 <;> simp [stuckness_pred, stuckness_le] at h ⊢
+
+/-! ## WP Pre-fixpoint -/
+
+/-- Non-value case of the WP pre-fixpoint.
+Coq: non-value branch of `wp_pre W` in `weakestpre.v`. -/
+noncomputable def wp_pre_step (W : WsatGS GF)
+    (s : Stuckness)
+    (wp : Iris.Set Positive → Λ.expr → (Λ.val → IPropWsat GF M F) → IPropWsat GF M F)
+    (E : Iris.Set Positive) (e : Λ.expr) (Φ : Λ.val → IPropWsat GF M F) : IPropWsat GF M F :=
+  -- quantify over the machine state and require a step + recursive WP
+  BIBase.forall fun σ : Λ.state =>
+    BIBase.forall fun ns : Nat =>
+      BIBase.forall fun κ : List Λ.observation =>
+        BIBase.forall fun κs : List Λ.observation =>
+          BIBase.forall fun nt : Nat =>
+            BIBase.wand (state_interp σ ns (κ ++ κs) nt) <|
+              fupd' W E maskEmpty <|
+                BIBase.sep (BIBase.pure (stuckness_pred s e σ)) <|
+                  BIBase.forall fun e2 : Λ.expr =>
+                    BIBase.forall fun σ2 : Λ.state =>
+                      BIBase.forall fun efs : List Λ.expr =>
+                        BIBase.wand (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs)) <|
+                          fupd' W maskEmpty E <|
+                            BIBase.later <|
+                              BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt)) <|
+                                BIBase.sep (wp E e2 Φ)
+                                  (big_sepL (fun _ ef => wp Iris.Set.univ ef fork_post) efs)
+
+/-- The pre-fixpoint for weakest preconditions. Takes the recursive `wp W` as
+a parameter. In the value case, returns `|={E}=> Φ v`. In the step case,
+requires stepping and recursive WP for the continuation.
+Coq: `wp_pre W` in `weakestpre.v`. -/
+noncomputable def wp_pre (W : WsatGS GF)
+    (s : Stuckness)
+    (wp : Iris.Set Positive → Λ.expr → (Λ.val → IPropWsat GF M F) → IPropWsat GF M F)
+    (E : Iris.Set Positive) (e : Λ.expr) (Φ : Λ.val → IPropWsat GF M F) : IPropWsat GF M F :=
+  match Λ.to_val e with
+  | some v => fupd' W E E (Φ v)
+  | none => wp_pre_step W s wp E e Φ
+
+private noncomputable abbrev wp_pre_s (W : WsatGS GF)
+    (s : Stuckness)
+    (wp : Iris.Set Positive → Λ.expr → (Λ.val → IPropWsat GF M F) → IPropWsat GF M F)
+    (E : Iris.Set Positive) (e : Λ.expr) (Φ : Λ.val → IPropWsat GF M F) : IPropWsat GF M F :=
+  wp_pre W s wp E e Φ
+
+private theorem wp_pre_contractive (W : WsatGS GF) (s : Stuckness) :
+    OFE.Contractive (fun (wp :
+      Iris.Set Positive → Λ.expr → (Λ.val → IPropWsat GF M F) → IPropWsat GF M F) =>
+      wp_pre W s wp) := by
+  -- the recursive calls are guarded by `▷`, so contractiveness holds
+  refine ⟨?_⟩
+  intro n wp wp' _hwp E e Φ
+  cases hto : Λ.to_val e with
+  | some v =>
+      -- value case does not depend on the recursive argument
+      simp [wp_pre, hto]
+  | none =>
+      -- non-value case: unfold and push non-expansiveness under binders/`▷`
+      simp [wp_pre, hto, wp_pre_step]
+      refine (forall_ne (PROP := IProp GF)) ?_
+      intro σ
+      refine (forall_ne (PROP := IProp GF)) ?_
+      intro ns
+      refine (forall_ne (PROP := IProp GF)) ?_
+      intro κ
+      refine (forall_ne (PROP := IProp GF)) ?_
+      intro κs
+      refine (forall_ne (PROP := IProp GF)) ?_
+      intro nt
+      refine (wand_ne.ne .rfl ?_)
+      refine (uPred_fupd_ne (W := W) (M := M) (F := F)
+        (E1 := E) (E2 := maskEmpty)).ne ?_
+      refine (sep_ne.ne .rfl ?_)
+      refine (forall_ne (PROP := IProp GF)) ?_
+      intro e2
+      refine (forall_ne (PROP := IProp GF)) ?_
+      intro σ2
+      refine (forall_ne (PROP := IProp GF)) ?_
+      intro efs
+      refine (wand_ne.ne .rfl ?_)
+      -- the recursive calls are under `▷`, making the function contractive
+      have hcont : OFE.DistLater n
+          (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+            (BIBase.sep (wp E e2 Φ)
+              (big_sepL (fun _ ef => wp Iris.Set.univ ef fork_post) efs)))
+          (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+            (BIBase.sep (wp' E e2 Φ)
+              (big_sepL (fun _ ef => wp' Iris.Set.univ ef fork_post) efs))) := by
+        intro m hm
+        have hwp_main : wp E e2 Φ ≡{m}≡ wp' E e2 Φ := (_hwp m hm) E e2 Φ
+        have hwp_fork :
+            ∀ (i : Nat) ef, efs[i]? = some ef →
+              wp Iris.Set.univ ef fork_post ≡{m}≡ wp' Iris.Set.univ ef fork_post := by
+          -- the forked WPs are pointwise related by the IH
+          intro _ ef _
+          exact (_hwp m hm) Iris.Set.univ ef fork_post
+        have hbig :
+            big_sepL (fun _ ef => wp Iris.Set.univ ef fork_post) efs ≡{m}≡
+              big_sepL (fun _ ef => wp' Iris.Set.univ ef fork_post) efs :=
+          big_sepL_ne (PROP := IProp GF)
+            (Φ := fun _ ef => wp Iris.Set.univ ef fork_post)
+            (Ψ := fun _ ef => wp' Iris.Set.univ ef fork_post) (l := efs) hwp_fork
+        have hsep :
+            BIBase.sep (wp E e2 Φ)
+                (big_sepL (fun _ ef => wp Iris.Set.univ ef fork_post) efs) ≡{m}≡
+              BIBase.sep (wp' E e2 Φ)
+                (big_sepL (fun _ ef => wp' Iris.Set.univ ef fork_post) efs) :=
+          sep_ne.ne hwp_main hbig
+        exact sep_ne.ne .rfl hsep
+      have hlater :
+          BIBase.later
+              (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                (BIBase.sep (wp E e2 Φ)
+                  (big_sepL (fun _ ef => wp Iris.Set.univ ef fork_post) efs))) ≡{n}≡
+            BIBase.later
+              (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                (BIBase.sep (wp' E e2 Φ)
+                  (big_sepL (fun _ ef => wp' Iris.Set.univ ef fork_post) efs))) :=
+        (OFE.Contractive.distLater_dist
+          (f := BIBase.later (PROP := IProp GF)) hcont)
+      exact (uPred_fupd_ne (W := W) (M := M) (F := F)
+        (E1 := maskEmpty) (E2 := E)).ne hlater
+
+private noncomputable abbrev wp_pre_all (W : WsatGS GF)
+    (wp : Stuckness → Iris.Set Positive → Λ.expr → (Λ.val → IPropWsat GF M F) → IPropWsat GF M F)
+    (s : Stuckness) : Iris.Set Positive → Λ.expr → (Λ.val → IPropWsat GF M F) → IPropWsat GF M F :=
+  fun E e Φ => wp_pre W s (wp s) E e Φ
+
+private theorem wp_pre_all_contractive (W : WsatGS GF) :
+    OFE.Contractive (fun (wp :
+      Stuckness → Iris.Set Positive → Λ.expr → (Λ.val → IPropWsat GF M F) → IPropWsat GF M F) =>
+      wp_pre_all W wp) := by
+  -- contractiveness follows pointwise from `wp_pre_contractive`
+  refine ⟨?_⟩
+  intro n wp wp' hwp s E e Φ
+  have hwp_s : OFE.DistLater n (wp s) (wp' s) := by
+    intro m hm; exact hwp m hm s
+  exact (wp_pre_contractive W s).distLater_dist
+    hwp_s E e Φ
+
+/-! ## WP Fixpoint -/
+
+/-- The weakest precondition, defined as the fixpoint of `wp_pre W`.
+The fixpoint is well-founded because `wp_pre W` is contractive: the
+recursive call to `wp W` appears under `▷`.
+Coq: `wp_def` in `weakestpre.v`. -/
+noncomputable def wp (W : WsatGS GF)
+    (s : Stuckness) (E : Iris.Set Positive)
+    (e : Λ.expr) (Φ : Λ.val → IPropWsat GF M F) : IPropWsat GF M F :=
+  let WpF :
+      (Stuckness → Iris.Set Positive → Λ.expr → (Λ.val → IPropWsat GF M F) → IPropWsat GF M F) -c>
+      (Stuckness → Iris.Set Positive → Λ.expr → (Λ.val → IPropWsat GF M F) → IPropWsat GF M F) :=
+    { f := fun wp => wp_pre_all W wp,
+      contractive := wp_pre_all_contractive W }
+  (OFE.ContractiveHom.fixpoint WpF) s E e Φ
+
+private noncomputable abbrev wp_s (W : WsatGS GF) (s : Stuckness) :
+    Iris.Set Positive → Λ.expr → (Λ.val → IPropWsat GF M F) → IPropWsat GF M F :=
+  wp W s
+
+/-! ## Unfold -/
+
+/-- Unfold the WP fixpoint one step.
+Coq: `wp_unfold` in `weakestpre.v`. -/
+theorem wp_unfold (s : Stuckness) (E : Iris.Set Positive)
+    (e : Λ.expr) (Φ : Λ.val → IPropWsat GF M F) :
+    wp_s W s E e Φ ⊣⊢
+      wp_pre W s (wp_s W s)
+        E e Φ :=
+  by
+  -- unfold the fixpoint equation and specialize it to `E`, `e`, and `Φ`
+  let WpF :
+      (Stuckness → Iris.Set Positive → Λ.expr → (Λ.val → IPropWsat GF M F) → IPropWsat GF M F) -c>
+      (Stuckness → Iris.Set Positive → Λ.expr → (Λ.val → IPropWsat GF M F) → IPropWsat GF M F) :=
+    { f := fun wp => wp_pre_all W wp,
+      contractive := wp_pre_all_contractive W }
+  have hfix :
+      (OFE.ContractiveHom.fixpoint WpF) s E e Φ ≡
+        wp_pre W s
+          (OFE.ContractiveHom.fixpoint WpF s) E e Φ := by
+    -- `fixpoint_unfold` gives equivalence on the whole function, specialize it
+    have h := (fixpoint_unfold (f := WpF))
+    simpa [WpF] using (h s E e Φ)
+  -- convert OFE equivalence to `⊣⊢` and unfold `wp W`
+  simpa [wp_s, wp, WpF] using (BI.equiv_iff (PROP := IProp GF)).1 hfix
+
+/-! ## Core Rules -/
+
+/-- Value case: `WP of_val v @ s; E {{ Φ }} ⊣⊢ |={E}=> Φ v`.
+Coq: `wp_value_fupd' W` in `weakestpre.v`. -/
+theorem wp_value_fupd (s : Stuckness) (E : Iris.Set Positive)
+    (Φ : Λ.val → IPropWsat GF M F) (v : Λ.val) :
+    wp_s W s E (Λ.of_val v) Φ ⊣⊢
+      fupd' W E E (Φ v) :=
+  by
+  -- unfold the WP and simplify the value case
+  have h := wp_unfold (W := W) (s := s) (E := E)
+    (e := Λ.of_val v) (Φ := Φ)
+  simpa [wp_pre, to_of_val] using h
+
+private abbrev wp_post (W : WsatGS GF) (E : Iris.Set Positive)
+    (Φ Ψ : Λ.val → IPropWsat GF M F) : IPropWsat GF M F :=
+  BIBase.forall fun v =>
+    BIBase.wand (Φ v)
+      (fupd' W E E (Ψ v))
+
+private theorem wp_post_fork :
+    (BIBase.pure True : IPropWsat GF M F) ⊢
+      wp_post (Λ := Λ) W Iris.Set.univ
+        (fork_post (Λ := Λ)) (fork_post (Λ := Λ)) := by
+  -- build the postcondition transformer for forked threads
+  refine forall_intro ?_; intro v
+  refine wand_intro ?_
+  -- drop the `True` frame before introducing the update
+  refine (sep_elim_r (PROP := IProp GF) (P := (BIBase.pure True : IProp GF)) (Q := fork_post v)).trans ?_
+  exact fupd_intro (E := Iris.Set.univ) (P := fork_post v)
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem later_big_sepL {A : Type _}
+    (Φ : Nat → A → IProp GF) (l : List A) :
+    BIBase.later (big_sepL Φ l) ⊣⊢
+      big_sepL (fun i x => BIBase.later (Φ i x)) l := by
+  -- distribute `▷` over the list spine using `later_sep`
+  induction l generalizing Φ with
+  | nil =>
+      -- base case: `▷ emp ⊣⊢ emp`
+      simpa [big_sepL_nil] using (later_emp (PROP := IProp GF))
+  | cons x xs ih =>
+      -- use IH on the shifted predicate for the tail
+      have ih' := ih (Φ := fun n x => Φ (n + 1) x)
+      -- inductive step: split/merge over head and tail
+      refine ⟨?_, ?_⟩
+      · simp [big_sepL_cons]
+        refine (later_sep (PROP := IProp GF) (P := Φ 0 x)
+          (Q := big_sepL (fun n => Φ (n + 1)) xs)).1.trans ?_
+        exact sep_mono .rfl ih'.1
+      · simp [big_sepL_cons]
+        refine (sep_mono .rfl ih'.2).trans ?_
+        exact (later_sep (PROP := IProp GF) (P := Φ 0 x)
+          (Q := big_sepL (fun n => Φ (n + 1)) xs)).2
+
+omit inst in
+private theorem wp_strong_mono_value
+    (E1 E2 : Iris.Set Positive) (Φ Ψ : Λ.val → IPropWsat GF M F)
+    (v : Λ.val) (hE : Subset E1 E2) :
+    BIBase.sep (fupd' W E1 E1 (Φ v))
+        (wp_post W E2 Φ Ψ) ⊢
+      fupd' W E2 E2 (Ψ v) := by
+  -- push the postcondition transformer through the masked update
+  have hΦv :
+      wp_post W E2 Φ Ψ ⊢
+        BIBase.wand (Φ v)
+          (fupd' W E2 E2 (Ψ v)) :=
+    forall_elim (PROP := IProp GF)
+      (Ψ := fun v => BIBase.wand (Φ v)
+        (fupd' W E2 E2 (Ψ v))) v
+  have hpost :
+      BIBase.sep (Φ v)
+          (wp_post W E2 Φ Ψ) ⊢
+        fupd' W E2 E2 (Ψ v) :=
+    (sep_mono .rfl hΦv).trans
+      (wand_elim_r (P := Φ v)
+        (Q := fupd' W E2 E2 (Ψ v)))
+  have hmask :
+      fupd' W E1 E1 (Φ v) ⊢
+        fupd' W E2 E2 (Φ v) :=
+    fupd_mask_mono (E1 := E1) (E2 := E2) hE (P := Φ v)
+  have hframe :
+      BIBase.sep (fupd' W E2 E2 (Φ v))
+          (wp_post W E2 Φ Ψ) ⊢
+        fupd' W E2 E2
+          (BIBase.sep (Φ v)
+            (wp_post W E2 Φ Ψ)) :=
+    Iris.BaseLogic.fupd_frame_r (W := W)
+      (M := M) (F := F) (E1 := E2) (E2 := E2) (P := Φ v)
+      (Q := wp_post W E2 Φ Ψ)
+  have hmono :
+      fupd' W E2 E2
+          (BIBase.sep (Φ v)
+            (wp_post W E2 Φ Ψ)) ⊢
+        fupd' W E2 E2
+          (fupd' W E2 E2 (Ψ v)) :=
+    Iris.BaseLogic.fupd_mono (W := W)
+      (M := M) (F := F) (E1 := E2) (E2 := E2)
+      (P := BIBase.sep (Φ v)
+        (wp_post W E2 Φ Ψ))
+      (Q := fupd' W E2 E2 (Ψ v)) hpost
+  have hcollapse :
+      fupd' W E2 E2
+          (fupd' W E2 E2 (Ψ v)) ⊢
+        fupd' W E2 E2 (Ψ v) :=
+    fupd_idem (E := E2) (P := Ψ v)
+  exact (sep_mono hmask .rfl).trans (hframe.trans (hmono.trans hcollapse))
+
+private def wp_strong_mono_body : IPropWsat GF M F :=
+  -- strong monotonicity packaged as an Iris proposition
+  BIBase.forall (fun s1 : Stuckness =>
+    BIBase.forall (fun s2 : Stuckness =>
+      BIBase.forall (fun E1 : Iris.Set Positive =>
+        BIBase.forall (fun E2 : Iris.Set Positive =>
+          BIBase.forall (fun e : Λ.expr =>
+            BIBase.forall (fun Φ : Λ.val → IPropWsat GF M F =>
+              BIBase.forall (fun Ψ : Λ.val → IPropWsat GF M F =>
+                BIBase.wand (BIBase.pure (stuckness_le s1 s2))
+                  (BIBase.wand (BIBase.pure (Subset E1 E2))
+                    (BIBase.wand (wp_s W s1 E1 e Φ)
+                      (BIBase.wand (wp_post W E2 Φ Ψ)
+                        (wp_s W s2 E2 e Ψ)))))))))))
+
+private theorem wp_strong_mono_body_elim
+    (s1 s2 : Stuckness) (E1 E2 : Iris.Set Positive)
+    (e : Λ.expr) (Φ Ψ : Λ.val → IPropWsat GF M F) :
+    wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W) ⊢
+      BIBase.wand (BIBase.pure (stuckness_le s1 s2))
+        (BIBase.wand (BIBase.pure (Subset E1 E2))
+          (BIBase.wand (wp_s W s1 E1 e Φ)
+            (BIBase.wand (wp_post W E2 Φ Ψ)
+              (wp_s W s2 E2 e Ψ)))) := by
+  -- eliminate the binders of `wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W)`
+  refine (forall_elim (PROP := IProp GF) (Ψ := fun s1 => _) s1).trans ?_
+  refine (forall_elim (PROP := IProp GF) (Ψ := fun s2 => _) s2).trans ?_
+  refine (forall_elim (PROP := IProp GF) (Ψ := fun E1 => _) E1).trans ?_
+  refine (forall_elim (PROP := IProp GF) (Ψ := fun E2 => _) E2).trans ?_
+  refine (forall_elim (PROP := IProp GF) (Ψ := fun e => _) e).trans ?_
+  refine (forall_elim (PROP := IProp GF) (Ψ := fun Φ => _) Φ).trans ?_
+  exact (forall_elim (PROP := IProp GF) (Ψ := fun Ψ => _) Ψ)
+
+private theorem wp_strong_mono_body_later_elim
+    (s1 s2 : Stuckness) (E1 E2 : Iris.Set Positive)
+    (e : Λ.expr) (Φ Ψ : Λ.val → IPropWsat GF M F) :
+    BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W)) ⊢
+      BIBase.later
+        (BIBase.wand (BIBase.pure (stuckness_le s1 s2))
+          (BIBase.wand (BIBase.pure (Subset E1 E2))
+            (BIBase.wand (wp_s W s1 E1 e Φ)
+              (BIBase.wand (wp_post W E2 Φ Ψ)
+                (wp_s W s2 E2 e Ψ))))) := by
+  -- lift the non-later elimination through `▷`
+  exact later_mono (wp_strong_mono_body_elim (s1 := s1) (s2 := s2) (E1 := E1) (E2 := E2) (e := e) (Φ := Φ) (Ψ := Ψ))
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem later_wand_elim (P Q : IProp GF) :
+    BIBase.sep (BIBase.later (BIBase.wand P Q)) (BIBase.later P) ⊢
+      BIBase.later Q := by
+  -- push `▷` through the wand, then eliminate it
+  have hwand := later_wand (PROP := IProp GF) (P := P) (Q := Q)
+  exact (sep_mono hwand .rfl).trans (wand_elim_l (PROP := IProp GF))
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem sep_later_intro (P Q : IProp GF) (h : (True : IProp GF) ⊢ P) :
+    Q ⊢ BIBase.sep (BIBase.later P) Q := by
+  -- add `True`, then replace it with a `▷` fact
+  refine (true_sep_2 (PROP := IProp GF) (P := Q)).trans ?_
+  refine (sep_mono ?_ .rfl)
+  exact h.trans later_intro
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem sep_later_pure_intro (φ : Prop) (h : φ) (P : IProp GF) :
+    P ⊢ BIBase.sep (BIBase.later (BIBase.pure φ)) P := by
+  -- specialize `sep_later_intro` to a pure fact
+  exact sep_later_intro (P := BIBase.pure φ) (Q := P) (h := pure_intro h)
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem wp_strong_mono_later_pure
+    (φ : Prop) (hφ : φ) (Q R : IProp GF) :
+    BIBase.sep (BIBase.later (BIBase.wand (BIBase.pure φ) Q)) R ⊢
+      BIBase.sep (BIBase.later Q) R := by
+  -- insert `▷⌜φ⌝` and eliminate the wand under `▷`
+  have hframe := sep_later_pure_intro (φ := φ) hφ (P := R)
+  refine (sep_mono .rfl hframe).trans ?_
+  refine (sep_assoc (P := BIBase.later (BIBase.wand (BIBase.pure φ) Q))
+    (Q := BIBase.later (BIBase.pure φ)) (R := R)).2.trans ?_
+  exact sep_mono (later_wand_elim (P := BIBase.pure φ) (Q := Q)) .rfl
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem wp_strong_mono_later_pures
+    (φ ψ : Prop) (hφ : φ) (hψ : ψ) (Q R : IProp GF) :
+    BIBase.sep (BIBase.later (BIBase.wand (BIBase.pure φ) (BIBase.wand (BIBase.pure ψ) Q))) R ⊢
+      BIBase.sep (BIBase.later Q) R := by
+  -- eliminate the two pure premises one after another
+  have h1 := wp_strong_mono_later_pure (φ := φ) hφ
+    (Q := BIBase.wand (BIBase.pure ψ) Q) (R := R)
+  have h2 := wp_strong_mono_later_pure (φ := ψ) hψ (Q := Q) (R := R)
+  exact h1.trans h2
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem wp_strong_mono_later_twice (P Q R : IProp GF) :
+    BIBase.sep (BIBase.later (BIBase.wand P (BIBase.wand Q R)))
+        (BIBase.sep (BIBase.later P) (BIBase.later Q)) ⊢
+      BIBase.later R := by
+  -- reassociate and eliminate both wands under `▷`
+  have hassoc :=
+    (sep_assoc (P := BIBase.later (BIBase.wand P (BIBase.wand Q R)))
+      (Q := BIBase.later P) (R := BIBase.later Q)).2
+  refine hassoc.trans ?_
+  refine (sep_mono (later_wand_elim (P := P) (Q := BIBase.wand Q R)) .rfl).trans ?_
+  exact later_wand_elim (P := Q) (Q := R)
+
+private theorem wp_strong_mono_later
+    (s1 s2 : Stuckness) (E1 E2 : Iris.Set Positive)
+    (e : Λ.expr) (Φ Ψ : Λ.val → IPropWsat GF M F)
+    (hS : stuckness_le s1 s2) (hE : Subset E1 E2) :
+    BIBase.sep
+        (BIBase.intuitionistically
+          (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+        (BIBase.sep (BIBase.later (wp_s W s1 E1 e Φ))
+          (BIBase.later (wp_post W E2 Φ Ψ))) ⊢
+      BIBase.later (wp_s W s2 E2 e Ψ) := by
+  -- unwrap the intuitionistic hypothesis and discharge the pure premises under `▷`
+  have hIH :
+      BIBase.sep
+          (BIBase.intuitionistically
+            (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+          (BIBase.sep (BIBase.later (wp_s W s1 E1 e Φ))
+            (BIBase.later (wp_post W E2 Φ Ψ))) ⊢
+        BIBase.sep
+          (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W)))
+          (BIBase.sep (BIBase.later (wp_s W s1 E1 e Φ))
+            (BIBase.later (wp_post W E2 Φ Ψ))) :=
+    sep_mono (intuitionistically_elim (PROP := IProp GF)) .rfl
+  let rest :=
+    BIBase.wand (wp_s W s1 E1 e Φ)
+      (BIBase.wand (wp_post W E2 Φ Ψ)
+        (wp_s W s2 E2 e Ψ))
+  have hwand :
+      BIBase.sep
+          (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W)))
+          (BIBase.sep (BIBase.later (wp_s W s1 E1 e Φ))
+            (BIBase.later (wp_post W E2 Φ Ψ))) ⊢
+        BIBase.sep
+          (BIBase.later
+            (BIBase.wand (BIBase.pure (stuckness_le s1 s2))
+              (BIBase.wand (BIBase.pure (Subset E1 E2)) rest)))
+          (BIBase.sep (BIBase.later (wp_s W s1 E1 e Φ))
+            (BIBase.later (wp_post W E2 Φ Ψ))) :=
+    sep_mono (wp_strong_mono_body_later_elim (s1 := s1) (s2 := s2) (E1 := E1) (E2 := E2) (e := e) (Φ := Φ) (Ψ := Ψ)) .rfl
+  have hpure :
+      BIBase.sep
+          (BIBase.later
+            (BIBase.wand (BIBase.pure (stuckness_le s1 s2))
+              (BIBase.wand (BIBase.pure (Subset E1 E2)) rest)))
+          (BIBase.sep (BIBase.later (wp_s W s1 E1 e Φ))
+            (BIBase.later (wp_post W E2 Φ Ψ))) ⊢
+        BIBase.sep (BIBase.later rest)
+          (BIBase.sep (BIBase.later (wp_s W s1 E1 e Φ))
+            (BIBase.later (wp_post W E2 Φ Ψ))) :=
+    wp_strong_mono_later_pures (φ := stuckness_le s1 s2) (ψ := Subset E1 E2) hS hE
+      (Q := rest)
+      (R := BIBase.sep (BIBase.later (wp_s W s1 E1 e Φ))
+        (BIBase.later (wp_post W E2 Φ Ψ)))
+  have hmain :
+      BIBase.sep (BIBase.later rest)
+          (BIBase.sep (BIBase.later (wp_s W s1 E1 e Φ))
+            (BIBase.later (wp_post W E2 Φ Ψ))) ⊢
+        BIBase.later (wp_s W s2 E2 e Ψ) :=
+    wp_strong_mono_later_twice
+      (P := wp_s W s1 E1 e Φ)
+      (Q := wp_post W E2 Φ Ψ)
+      (R := wp_s W s2 E2 e Ψ)
+  exact hIH.trans (hwand.trans (hpure.trans hmain))
+
+private theorem wp_strong_mono_fork_later
+    (s1 s2 : Stuckness) (ef : Λ.expr)
+    (hS : stuckness_le s1 s2) :
+    (BIBase.sep
+        (BIBase.intuitionistically
+          (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+        (BIBase.later (wp_s W s1 Iris.Set.univ ef fork_post)) :
+        IPropWsat GF M F) ⊢
+      (BIBase.later (wp_s W s2 Iris.Set.univ ef fork_post) :
+        IPropWsat GF M F) := by
+  -- insert the fork postcondition and reuse `wp_strong_mono_later`
+  have hpost :
+      (True : IProp GF) ⊢
+        wp_post (Λ := Λ) W Iris.Set.univ
+          (fork_post (Λ := Λ)) (fork_post (Λ := Λ)) :=
+    wp_post_fork (M := M) (F := F) (Λ := Λ) (W := W)
+  have hadd :
+      BIBase.sep
+          (BIBase.intuitionistically
+            (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+          (BIBase.later (wp_s W s1 Iris.Set.univ ef fork_post)) ⊢
+        BIBase.sep
+          (BIBase.intuitionistically
+            (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+          (BIBase.sep
+            (BIBase.later (wp_s W s1 Iris.Set.univ ef fork_post))
+            (BIBase.later (wp_post (Λ := Λ) W Iris.Set.univ (fork_post (Λ := Λ)) (fork_post (Λ := Λ))))) := by
+    refine (sep_later_intro (P := wp_post (Λ := Λ) W Iris.Set.univ (fork_post (Λ := Λ)) (fork_post (Λ := Λ)))
+      (Q := BIBase.sep
+        (BIBase.intuitionistically
+          (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+        (BIBase.later (wp_s W s1 Iris.Set.univ ef fork_post)))
+      hpost).trans ?_
+    refine (sep_comm
+      (P := BIBase.later (wp_post (Λ := Λ) W Iris.Set.univ (fork_post (Λ := Λ)) (fork_post (Λ := Λ))))
+      (Q := BIBase.sep
+        (BIBase.intuitionistically
+          (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+        (BIBase.later (wp_s W s1 Iris.Set.univ ef fork_post)))).1.trans ?_
+    exact (sep_assoc
+      (P := BIBase.intuitionistically
+        (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+      (Q := BIBase.later (wp_s W s1 Iris.Set.univ ef fork_post))
+      (R := BIBase.later (wp_post (Λ := Λ) W Iris.Set.univ (fork_post (Λ := Λ)) (fork_post (Λ := Λ))))).1
+  have hmain := wp_strong_mono_later (GF := GF) (Λ := Λ) (W := W)
+    (s1 := s1) (s2 := s2) (E1 := Iris.Set.univ) (E2 := Iris.Set.univ)
+    (e := ef) (Φ := fork_post (M := M) (F := F)) (Ψ := fork_post (M := M) (F := F))
+      hS (by intro _ hx; exact hx)
+  exact hadd.trans hmain
+
+private theorem wp_strong_mono_forks_later_aux
+    (s1 s2 : Stuckness) (efs : List Λ.expr) (hS : stuckness_le s1 s2) :
+    (BIBase.sep
+        (BIBase.intuitionistically
+          (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+        (big_sepL (fun _ ef =>
+          BIBase.later (wp_s W s1 Iris.Set.univ ef fork_post)) efs) :
+        IPropWsat GF M F) ⊢
+      (big_sepL (fun _ ef =>
+        BIBase.later (wp_s W s2 Iris.Set.univ ef fork_post)) efs :
+        IPropWsat GF M F) := by
+  -- push the intuitionistic IH down the list, duplicating it for head/tail
+  induction efs with
+  | nil =>
+      simpa [big_sepL_nil] using
+        (sep_elim_r (P := BIBase.intuitionistically
+          (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+          (Q := (BIBase.emp : IProp GF)))
+  | cons ef efs ih =>
+      simp [big_sepL_cons]
+      have hdup :
+          BIBase.intuitionistically
+              (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))) ⊢
+            BIBase.sep
+              (BIBase.intuitionistically
+                (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+              (BIBase.intuitionistically
+                (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W)))) :=
+        (intuitionistically_sep_idem
+          (P := BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W)))).2
+      have hcomm :
+          BIBase.sep
+              (BIBase.sep
+                (BIBase.intuitionistically
+                  (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+                (BIBase.intuitionistically
+                  (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W)))))
+              (BIBase.sep
+                (BIBase.later
+                  (wp_s W s1 Iris.Set.univ ef fork_post))
+                (big_sepL (fun _ ef =>
+                  BIBase.later (wp_s W s1 Iris.Set.univ ef fork_post)) efs)) ⊢
+            BIBase.sep
+              (BIBase.sep
+                (BIBase.intuitionistically
+                  (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+                (BIBase.later
+                  (wp_s W s1 Iris.Set.univ ef fork_post)))
+              (BIBase.sep
+                (BIBase.intuitionistically
+                  (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+                (big_sepL (fun _ ef =>
+                  BIBase.later (wp_s W s1 Iris.Set.univ ef fork_post)) efs)) :=
+        (sep_sep_sep_comm (PROP := IProp GF)
+          (P := BIBase.intuitionistically
+            (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+          (Q := BIBase.intuitionistically
+            (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+          (R := BIBase.later
+            (wp_s W s1 Iris.Set.univ ef fork_post))
+          (S := big_sepL (fun _ ef =>
+            BIBase.later (wp_s W s1 Iris.Set.univ ef fork_post)) efs)).1
+      refine (sep_mono hdup .rfl).trans (hcomm.trans ?_)
+      refine sep_mono ?_ ih
+      exact wp_strong_mono_fork_later (s1 := s1) (s2 := s2) (ef := ef) hS
+
+private theorem wp_strong_mono_forks_later
+    (s1 s2 : Stuckness) (efs : List Λ.expr) (hS : stuckness_le s1 s2) :
+    (BIBase.sep
+        (BIBase.intuitionistically
+          (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+        (BIBase.later (big_sepL (fun _ ef =>
+          wp_s W s1 Iris.Set.univ ef fork_post) efs)) :
+        IPropWsat GF M F) ⊢
+      (BIBase.later (big_sepL (fun _ ef =>
+        wp_s W s2 Iris.Set.univ ef fork_post) efs) :
+        IPropWsat GF M F) := by
+  -- distribute `▷` over the forked WPs, use the list lemma, then rewrap
+  refine (sep_mono .rfl (later_big_sepL
+    (Φ := fun _ ef =>
+      wp_s W s1 Iris.Set.univ ef fork_post)
+    (l := efs)).1).trans ?_
+  refine (wp_strong_mono_forks_later_aux (s1 := s1) (s2 := s2) (efs := efs) hS).trans ?_
+  exact (later_big_sepL
+    (Φ := fun _ ef =>
+      wp_s W s2 Iris.Set.univ ef fork_post)
+    (l := efs)).2
+
+private abbrev wp_pre_view (W : WsatGS GF)
+    (s : Stuckness) (E : Iris.Set Positive) (e : Λ.expr) (Φ : Λ.val → IPropWsat GF M F)
+    (σ : Λ.state) (ns : Nat) (κ κs : List Λ.observation) (nt : Nat) :
+    IPropWsat GF M F :=
+  BIBase.wand (state_interp σ ns (κ ++ κs) nt)
+    (fupd' W E maskEmpty
+      (BIBase.sep (BIBase.pure (stuckness_pred s e σ))
+        (BIBase.forall fun e2 : Λ.expr =>
+          BIBase.forall fun σ2 : Λ.state =>
+            BIBase.forall fun efs : List Λ.expr =>
+              BIBase.wand (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs))
+                (fupd' W maskEmpty E
+                  (BIBase.later
+                    (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                      (BIBase.sep (wp_s W s E e2 Φ)
+                        (big_sepL (fun _ ef =>
+                          wp_s W s Iris.Set.univ ef fork_post)
+                          efs))))))))
+
+private theorem wp_pre_elim
+    (s : Stuckness) (E : Iris.Set Positive) (e : Λ.expr) (Φ : Λ.val → IPropWsat GF M F)
+    (σ : Λ.state) (ns : Nat) (κ κs : List Λ.observation) (nt : Nat)
+    (hto : Λ.to_val e = none) :
+    wp_pre_s W s
+        (wp_s W s) E e Φ ⊢
+      wp_pre_view W s E e Φ σ ns κ κs nt := by
+  -- specialize the binders in `wp_pre W` to expose the state interpretation
+  have hσ :=
+    forall_elim (PROP := IProp GF)
+      (Ψ := fun σ =>
+        BIBase.forall fun ns =>
+          BIBase.forall fun κ =>
+            BIBase.forall fun κs =>
+              BIBase.forall fun nt =>
+                wp_pre_view W s E e Φ σ ns κ κs nt) σ
+  have hns :=
+    forall_elim (PROP := IProp GF)
+      (Ψ := fun ns =>
+        BIBase.forall fun κ =>
+          BIBase.forall fun κs =>
+            BIBase.forall fun nt =>
+              wp_pre_view W s E e Φ σ ns κ κs nt) ns
+  have hκ :=
+    forall_elim (PROP := IProp GF)
+      (Ψ := fun κ =>
+        BIBase.forall fun κs =>
+          BIBase.forall fun nt =>
+            wp_pre_view W s E e Φ σ ns κ κs nt) κ
+  have hκs :=
+    forall_elim (PROP := IProp GF)
+      (Ψ := fun κs =>
+        BIBase.forall fun nt =>
+          wp_pre_view W s E e Φ σ ns κ κs nt) κs
+  have hnt :=
+    forall_elim (PROP := IProp GF)
+      (Ψ := fun nt =>
+        wp_pre_view W s E e Φ σ ns κ κs nt) nt
+  simpa [wp_pre, hto, wp_pre_step, wp_pre_view] using
+    hσ.trans (hns.trans (hκ.trans (hκs.trans hnt)))
+
+private theorem wp_strong_mono_step
+    (s1 s2 : Stuckness) (E1 E2 : Iris.Set Positive)
+    (e : Λ.expr) (Φ Ψ : Λ.val → IPropWsat GF M F)
+    (hS : stuckness_le s1 s2) (hE : Subset E1 E2)
+    (hto : Λ.to_val e = none) :
+    BIBase.sep
+        (BIBase.intuitionistically
+          (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+        (BIBase.sep
+          (wp_pre_s W s1
+            (wp_s W s1) E1 e Φ)
+          (wp_post W E2 Φ Ψ)) ⊢
+      wp_pre_s W s2
+        (wp_s W s2) E2 e Ψ := by
+  -- unfold the non-value branch and transform the continuation
+  simp [wp_pre, hto, wp_pre_step]
+  refine forall_intro (PROP := IProp GF) ?_; intro σ
+  refine forall_intro (PROP := IProp GF) ?_; intro ns
+  refine forall_intro (PROP := IProp GF) ?_; intro κ
+  refine forall_intro (PROP := IProp GF) ?_; intro κs
+  refine forall_intro (PROP := IProp GF) ?_; intro nt
+  refine wand_intro ?_
+  let IH : IPropWsat GF M F :=
+    BIBase.intuitionistically
+      (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W)))
+  let Q1 : IPropWsat GF M F :=
+    BIBase.forall fun e2 : Λ.expr =>
+      BIBase.forall fun σ2 : Λ.state =>
+        BIBase.forall fun efs : List Λ.expr =>
+          BIBase.wand (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs))
+            (fupd' W maskEmpty E1
+              (BIBase.later
+                (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                  (BIBase.sep (wp_s W s1 E1 e2 Φ)
+                    (big_sepL (fun _ ef =>
+                      wp_s W s1 Iris.Set.univ ef fork_post)
+                      efs)))))
+  let Q2 : IPropWsat GF M F :=
+    BIBase.forall fun e2 : Λ.expr =>
+      BIBase.forall fun σ2 : Λ.state =>
+        BIBase.forall fun efs : List Λ.expr =>
+          BIBase.wand (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs))
+            (fupd' W maskEmpty E2
+              (BIBase.later
+                (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                  (BIBase.sep (wp_s W s2 E2 e2 Ψ)
+                    (big_sepL (fun _ ef =>
+                      wp_s W s2 Iris.Set.univ ef fork_post)
+                      efs)))))
+  let P0 : IPropWsat GF M F :=
+    BIBase.sep (BIBase.pure (stuckness_pred s1 e σ)) Q1
+  let P1 : IPropWsat GF M F :=
+    BIBase.sep P0
+      (BIBase.sep
+        (wp_post W E2 Φ Ψ) IH)
+  -- open the left WP using the state interpretation
+  have hpre :
+      BIBase.sep
+          (wp_pre_s W s1
+            (wp_s W s1) E1 e Φ)
+          (state_interp σ ns (κ ++ κs) nt) ⊢
+        fupd' W E1 maskEmpty P0 := by
+    have hview :=
+      wp_pre_elim (W := W) (s := s1) (E := E1) (e := e) (Φ := Φ)
+        (σ := σ) (ns := ns) (κ := κ) (κs := κs) (nt := nt) hto
+    exact (sep_mono hview .rfl).trans (wand_elim_l (PROP := IProp GF))
+  -- widen the mask and add the closing update
+  have hmask :=
+    fupd_mask_subseteq_apply (W := W) (E1 := E1) (E2 := E2) hE
+      (P := P1)
+  -- transform the post-step continuation and close the mask
+  have hpost_pure :
+      BIBase.sep P1
+          (fupd' W E1 E2 (BIBase.emp : IProp GF)) ⊢
+        BIBase.sep (BIBase.pure (stuckness_pred s2 e σ)) Q2 := by
+    -- rearrange to expose the pure premise and continuation
+    have hassoc :
+        BIBase.sep P1
+            (fupd' W E1 E2 (BIBase.emp : IProp GF)) ⊢
+          BIBase.sep (BIBase.pure (stuckness_pred s1 e σ))
+            (BIBase.sep Q1
+              (BIBase.sep
+                (BIBase.sep
+                  (wp_post W E2 Φ Ψ) IH)
+                (fupd' W E1 E2 (BIBase.emp : IProp GF)))) := by
+      -- expand `P1` and reassociate to expose the pure premise
+      dsimp [P1, P0]
+      refine (sep_assoc (PROP := IProp GF)
+        (P := BIBase.sep (BIBase.pure (stuckness_pred s1 e σ)) Q1)
+        (Q := BIBase.sep
+          (wp_post W E2 Φ Ψ) IH)
+        (R := fupd' W E1 E2
+          (BIBase.emp : IProp GF))).1.trans ?_
+      exact (sep_assoc (PROP := IProp GF)
+        (P := BIBase.pure (stuckness_pred s1 e σ))
+        (Q := Q1)
+        (R := BIBase.sep
+          (BIBase.sep
+            (wp_post W E2 Φ Ψ) IH)
+          (fupd' W E1 E2
+            (BIBase.emp : IProp GF)))).1
+    refine hassoc.trans ?_
+    refine (sep_mono (PROP := IProp GF)
+      (P := BIBase.pure (stuckness_pred s1 e σ))
+      (Q := BIBase.pure (stuckness_pred s2 e σ))
+      (P' := BIBase.sep Q1
+        (BIBase.sep
+          (BIBase.sep
+            (wp_post W E2 Φ Ψ) IH)
+          (fupd' W E1 E2 (BIBase.emp : IProp GF))))
+      (Q' := Q2)
+      (pure_mono (PROP := IProp GF)
+        (stuckness_pred_mono (s1 := s1) (s2 := s2) hS e σ)) ?_)
+    -- now show `Q1 ∗ wp_post W ∗ IH ⊢ Q2`
+    refine forall_intro (PROP := IProp GF) ?_; intro e2
+    refine forall_intro (PROP := IProp GF) ?_; intro σ2
+    refine forall_intro (PROP := IProp GF) ?_; intro efs
+    refine wand_intro ?_
+    -- apply the step continuation and frame IH/wp_post
+    have hstep :
+        BIBase.sep Q1 (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs)) ⊢
+          fupd' W maskEmpty E1
+            (BIBase.later
+              (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                (BIBase.sep (wp_s W s1 E1 e2 Φ)
+                  (big_sepL (fun _ ef =>
+                    wp_s W s1 Iris.Set.univ ef fork_post)
+                    efs)))) := by
+      have h1 :=
+        forall_elim (PROP := IProp GF)
+          (Ψ := fun e2 : Λ.expr =>
+            BIBase.forall fun σ2 : Λ.state =>
+              BIBase.forall fun efs : List Λ.expr =>
+                BIBase.wand (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs))
+                  (fupd' W maskEmpty E1
+                    (BIBase.later
+                      (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                        (BIBase.sep (wp_s W s1 E1 e2 Φ)
+                          (big_sepL (fun _ ef =>
+                            wp_s W s1 Iris.Set.univ ef fork_post)
+                            efs)))))) e2
+      have h2 :=
+        forall_elim (PROP := IProp GF)
+          (Ψ := fun σ2 : Λ.state =>
+            BIBase.forall fun efs : List Λ.expr =>
+              BIBase.wand (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs))
+                (fupd' W maskEmpty E1
+                  (BIBase.later
+                    (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                      (BIBase.sep (wp_s W s1 E1 e2 Φ)
+                        (big_sepL (fun _ ef =>
+                          wp_s W s1 Iris.Set.univ ef fork_post)
+                          efs)))))) σ2
+      have h3 :=
+        forall_elim (PROP := IProp GF)
+          (Ψ := fun efs : List Λ.expr =>
+            BIBase.wand (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs))
+              (fupd' W maskEmpty E1
+                (BIBase.later
+                  (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                    (BIBase.sep (wp_s W s1 E1 e2 Φ)
+                      (big_sepL (fun _ ef =>
+                        wp_s W s1 Iris.Set.univ ef fork_post)
+                        efs)))))) efs
+      have h123 := h1.trans (h2.trans h3)
+      exact (sep_mono h123 .rfl).trans (wand_elim_l (PROP := IProp GF))
+    have hswap :
+        BIBase.sep
+            (BIBase.sep Q1
+              (BIBase.sep
+                (wp_post W E2 Φ Ψ) IH))
+            (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs)) ⊢
+          BIBase.sep
+            (BIBase.sep Q1 (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs)))
+            (BIBase.sep
+              (wp_post W E2 Φ Ψ) IH) := by
+      exact (sep_right_comm (PROP := IProp GF)
+        (P := Q1)
+        (Q := BIBase.sep
+          (wp_post W E2 Φ Ψ) IH)
+        (R := BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs))).1
+    have hframe0 :
+        BIBase.sep
+            (fupd' W maskEmpty E1
+              (BIBase.later
+                (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                  (BIBase.sep (wp_s W s1 E1 e2 Φ)
+                    (big_sepL (fun _ ef =>
+                      wp_s W s1 Iris.Set.univ ef fork_post)
+                      efs)))))
+            (BIBase.sep
+              (wp_post W E2 Φ Ψ) IH) ⊢
+          fupd' W maskEmpty E1
+            (BIBase.sep
+              (BIBase.later
+                (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                  (BIBase.sep (wp_s W s1 E1 e2 Φ)
+                    (big_sepL (fun _ ef =>
+                      wp_s W s1 Iris.Set.univ ef fork_post)
+                      efs))))
+              (BIBase.sep
+                (wp_post W E2 Φ Ψ) IH)) :=
+      Iris.BaseLogic.fupd_frame_r 
+        (E1 := maskEmpty) (E2 := E1)
+        (P := BIBase.later
+          (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+            (BIBase.sep (wp_s W s1 E1 e2 Φ)
+              (big_sepL (fun _ ef =>
+                wp_s W s1 Iris.Set.univ ef fork_post)
+                efs))))
+        (Q := BIBase.sep
+          (wp_post W E2 Φ Ψ) IH)
+    -- frame the closing update through the step
+    have hframe :
+        BIBase.sep
+            (fupd' W maskEmpty E1
+              (BIBase.sep
+                (BIBase.later
+                  (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                    (BIBase.sep (wp_s W s1 E1 e2 Φ)
+                      (big_sepL (fun _ ef =>
+                        wp_s W s1 Iris.Set.univ ef fork_post)
+                        efs))))
+                (BIBase.sep
+                  (wp_post W E2 Φ Ψ) IH)))
+            (fupd' W E1 E2 (BIBase.emp : IProp GF)) ⊢
+          fupd' W maskEmpty E1
+            (BIBase.sep
+              (BIBase.sep
+                (BIBase.later
+                  (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                    (BIBase.sep (wp_s W s1 E1 e2 Φ)
+                      (big_sepL (fun _ ef =>
+                        wp_s W s1 Iris.Set.univ ef fork_post)
+                        efs))))
+                (BIBase.sep
+                  (wp_post W E2 Φ Ψ) IH))
+              (fupd' W E1 E2 (BIBase.emp : IProp GF))) :=
+      Iris.BaseLogic.fupd_frame_r 
+        (E1 := maskEmpty) (E2 := E1)
+        (P := BIBase.sep
+          (BIBase.later
+            (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+              (BIBase.sep (wp_s W s1 E1 e2 Φ)
+                (big_sepL (fun _ ef =>
+                  wp_s W s1 Iris.Set.univ ef fork_post)
+                  efs))))
+          (BIBase.sep
+            (wp_post W E2 Φ Ψ) IH))
+        (Q := fupd' W E1 E2 (BIBase.emp : IProp GF))
+    have hmono :
+        BIBase.sep
+            (BIBase.later
+              (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                (BIBase.sep (wp_s W s1 E1 e2 Φ)
+                  (big_sepL (fun _ ef =>
+                    wp_s W s1 Iris.Set.univ ef fork_post)
+                    efs))))
+            (BIBase.sep
+              (wp_post W E2 Φ Ψ) IH) ⊢
+          BIBase.later
+            (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+              (BIBase.sep (wp_s W s2 E2 e2 Ψ)
+                (big_sepL (fun _ ef =>
+                  wp_s W s2 Iris.Set.univ ef fork_post)
+                  efs))) := by
+      -- use the intuitionistic Löb hypothesis for the main and forked WPs
+      have hmain :
+          BIBase.sep
+              (BIBase.intuitionistically
+                (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+              (BIBase.sep
+                (BIBase.later (wp_s W s1 E1 e2 Φ))
+                (BIBase.later (wp_post W E2 Φ Ψ))) ⊢
+            BIBase.later (wp_s W s2 E2 e2 Ψ) :=
+        wp_strong_mono_later (s1 := s1) (s2 := s2) (E1 := E1) (E2 := E2)
+          (e := e2) (Φ := Φ) (Ψ := Ψ) hS hE
+      have hfork :
+          BIBase.sep
+              (BIBase.intuitionistically
+                (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))))
+              (BIBase.later (big_sepL (fun _ ef =>
+                wp_s W s1 Iris.Set.univ ef fork_post) efs)) ⊢
+            BIBase.later (big_sepL (fun _ ef =>
+              wp_s W s2 Iris.Set.univ ef fork_post) efs) :=
+        wp_strong_mono_forks_later (s1 := s1) (s2 := s2) (efs := efs) hS
+      have hcont :
+          BIBase.sep
+              (BIBase.sep
+                (wp_post W E2 Φ Ψ) IH)
+              (BIBase.later
+                (BIBase.sep (wp_s W s1 E1 e2 Φ)
+                  (big_sepL (fun _ ef =>
+                    wp_s W s1 Iris.Set.univ ef fork_post)
+                    efs))) ⊢
+            BIBase.later
+              (BIBase.sep (wp_s W s2 E2 e2 Ψ)
+                (big_sepL (fun _ ef =>
+                  wp_s W s2 Iris.Set.univ ef fork_post)
+                  efs)) := by
+        -- turn `wp_post` into `▷ wp_post` and split the later continuation
+        have hpostlater :
+            BIBase.sep
+                (wp_post W E2 Φ Ψ) IH ⊢
+              BIBase.sep
+                (BIBase.later
+                  (wp_post W E2 Φ Ψ)) IH :=
+          sep_mono (later_intro (PROP := IProp GF)
+            (P := wp_post W E2 Φ Ψ)) .rfl
+        refine (sep_mono hpostlater (later_sep (PROP := IProp GF)
+          (P := wp_s W s1 E1 e2 Φ)
+          (Q := big_sepL (fun _ ef =>
+            wp_s W s1 Iris.Set.univ ef fork_post) efs)).1).trans ?_
+        -- now: (▷ wp_post W ∗ IH) ∗ (▷ wp_s1 ∗ ▷ big_sepL)
+        have hdup :
+            IH ⊢ BIBase.sep IH IH :=
+          (intuitionistically_sep_idem
+            (P := BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W)))).2
+        refine (sep_assoc (PROP := IProp GF)
+          (P := BIBase.later
+            (wp_post W E2 Φ Ψ))
+          (Q := IH)
+          (R := BIBase.sep
+            (BIBase.later (wp_s W s1 E1 e2 Φ))
+            (BIBase.later (big_sepL (fun _ ef =>
+              wp_s W s1 Iris.Set.univ ef fork_post)
+              efs)))).1.trans ?_
+        refine (sep_mono .rfl (sep_mono hdup .rfl)).trans ?_
+        refine (sep_mono .rfl (sep_sep_sep_comm (PROP := IProp GF)
+          (P := IH)
+          (Q := IH)
+          (R := BIBase.later (wp_s W s1 E1 e2 Φ))
+          (S := BIBase.later (big_sepL (fun _ ef =>
+            wp_s W s1 Iris.Set.univ ef fork_post)
+            efs))).1).trans ?_
+        -- regroup for `hmain` and `hfork`
+        refine (sep_assoc (PROP := IProp GF)
+          (P := BIBase.later
+            (wp_post W E2 Φ Ψ))
+          (Q := BIBase.sep IH
+            (BIBase.later (wp_s W s1 E1 e2 Φ)))
+          (R := BIBase.sep IH
+            (BIBase.later (big_sepL (fun _ ef =>
+              wp_s W s1 Iris.Set.univ ef fork_post)
+              efs)))).2.trans ?_
+        have hleft :
+            BIBase.sep
+                (BIBase.later
+                  (wp_post W E2 Φ Ψ))
+                (BIBase.sep IH
+                  (BIBase.later (wp_s W s1 E1 e2 Φ))) ⊢
+              BIBase.sep IH
+                (BIBase.sep
+                  (BIBase.later (wp_s W s1 E1 e2 Φ))
+                  (BIBase.later
+                    (wp_post W E2 Φ Ψ))) := by
+          refine (sep_left_comm (PROP := IProp GF)
+            (P := BIBase.later
+              (wp_post W E2 Φ Ψ))
+            (Q := IH)
+            (R := BIBase.later (wp_s W s1 E1 e2 Φ))).1.trans ?_
+          refine (sep_assoc (PROP := IProp GF)
+            (P := IH)
+            (Q := BIBase.later
+              (wp_post W E2 Φ Ψ))
+            (R := BIBase.later (wp_s W s1 E1 e2 Φ))).2.trans ?_
+          refine (sep_right_comm (PROP := IProp GF)
+            (P := IH)
+            (Q := BIBase.later
+              (wp_post W E2 Φ Ψ))
+            (R := BIBase.later (wp_s W s1 E1 e2 Φ))).1.trans ?_
+          exact (sep_assoc (PROP := IProp GF)
+            (P := IH)
+            (Q := BIBase.later (wp_s W s1 E1 e2 Φ))
+            (R := BIBase.later
+              (wp_post W E2 Φ Ψ))).1
+        refine (sep_mono hleft .rfl).trans ?_
+        refine (sep_mono hmain hfork).trans ?_
+        exact (later_sep (PROP := IProp GF)
+          (P := wp_s W s2 E2 e2 Ψ)
+          (Q := big_sepL (fun _ ef =>
+            wp_s W s2 Iris.Set.univ ef fork_post)
+            efs)).2
+      -- split state and continuation, apply `hcont`, then reassemble
+      refine (sep_mono (later_sep (PROP := IProp GF)
+        (P := state_interp σ2 (ns + 1) κs (efs.length + nt))
+        (Q := BIBase.sep (wp_s W s1 E1 e2 Φ)
+          (big_sepL (fun _ ef =>
+            wp_s W s1 Iris.Set.univ ef fork_post) efs))).1 .rfl).trans ?_
+      refine (sep_right_comm (PROP := IProp GF)
+        (P := BIBase.later (state_interp σ2 (ns + 1) κs (efs.length + nt)))
+        (Q := BIBase.later
+          (BIBase.sep (wp_s W s1 E1 e2 Φ)
+            (big_sepL (fun _ ef =>
+              wp_s W s1 Iris.Set.univ ef fork_post) efs)))
+        (R := BIBase.sep
+          (wp_post W E2 Φ Ψ) IH)).1.trans ?_
+      refine (sep_assoc (PROP := IProp GF)
+        (P := BIBase.later (state_interp σ2 (ns + 1) κs (efs.length + nt)))
+        (Q := BIBase.sep
+          (wp_post W E2 Φ Ψ) IH)
+        (R := BIBase.later
+          (BIBase.sep (wp_s W s1 E1 e2 Φ)
+            (big_sepL (fun _ ef =>
+              wp_s W s1 Iris.Set.univ ef fork_post) efs)))).1.trans ?_
+      refine (sep_mono .rfl hcont).trans ?_
+      exact (later_sep (PROP := IProp GF)
+        (P := state_interp σ2 (ns + 1) κs (efs.length + nt))
+        (Q := BIBase.sep (wp_s W s2 E2 e2 Ψ)
+          (big_sepL (fun _ ef =>
+            wp_s W s2 Iris.Set.univ ef fork_post) efs))).2
+    -- apply the step continuation, frame `wp_post`/IH and the closing update
+    have hprep :
+        BIBase.sep
+            (BIBase.sep Q1
+              (BIBase.sep
+                (BIBase.sep
+                  (wp_post W E2 Φ Ψ) IH)
+                (fupd' W E1 E2 (BIBase.emp : IProp GF))))
+            (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs)) ⊢
+          BIBase.sep
+            (BIBase.sep
+              (BIBase.sep Q1 (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs)))
+              (BIBase.sep
+                (wp_post W E2 Φ Ψ) IH))
+            (fupd' W E1 E2 (BIBase.emp : IProp GF)) := by
+      have hassoc :
+          BIBase.sep
+              (BIBase.sep Q1
+                (BIBase.sep
+                  (BIBase.sep
+                    (wp_post W E2 Φ Ψ) IH)
+                  (fupd' W E1 E2 (BIBase.emp : IProp GF))))
+              (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs)) ⊢
+            BIBase.sep
+              (BIBase.sep
+                (BIBase.sep Q1
+                  (BIBase.sep
+                    (wp_post W E2 Φ Ψ) IH))
+                (fupd' W E1 E2 (BIBase.emp : IProp GF)))
+              (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs)) :=
+        sep_mono (sep_assoc (PROP := IProp GF)
+          (P := Q1)
+          (Q := BIBase.sep
+            (wp_post W E2 Φ Ψ) IH)
+          (R := fupd' W E1 E2 (BIBase.emp : IProp GF))).2 .rfl
+      have hswap_f :
+          BIBase.sep
+              (BIBase.sep
+                (BIBase.sep Q1
+                  (BIBase.sep
+                    (wp_post W E2 Φ Ψ) IH))
+                (fupd' W E1 E2 (BIBase.emp : IProp GF)))
+              (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs)) ⊢
+            BIBase.sep
+              (BIBase.sep
+                (BIBase.sep Q1
+                  (BIBase.sep
+                    (wp_post W E2 Φ Ψ) IH))
+                (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs)))
+              (fupd' W E1 E2 (BIBase.emp : IProp GF)) :=
+        (sep_right_comm (PROP := IProp GF)
+          (P := BIBase.sep Q1
+            (BIBase.sep
+              (wp_post W E2 Φ Ψ) IH))
+          (Q := fupd' W E1 E2 (BIBase.emp : IProp GF))
+          (R := BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs))).1
+      have hswap2 :
+          BIBase.sep
+              (BIBase.sep
+                (BIBase.sep Q1
+                  (BIBase.sep
+                    (wp_post W E2 Φ Ψ) IH))
+                (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs)))
+              (fupd' W E1 E2 (BIBase.emp : IProp GF)) ⊢
+            BIBase.sep
+              (BIBase.sep
+                (BIBase.sep Q1 (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs)))
+                (BIBase.sep
+                  (wp_post W E2 Φ Ψ) IH))
+              (fupd' W E1 E2 (BIBase.emp : IProp GF)) :=
+        sep_mono hswap .rfl
+      exact hassoc.trans (hswap_f.trans hswap2)
+    refine hprep.trans ?_
+    refine (sep_mono (sep_mono hstep .rfl) .rfl).trans ?_
+    refine (sep_mono hframe0 .rfl).trans ?_
+    -- close the mask after updating the continuation
+    have hmid :
+        fupd' W maskEmpty E1
+            (BIBase.sep
+              (BIBase.sep
+                (BIBase.later
+                  (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                    (BIBase.sep (wp_s W s1 E1 e2 Φ)
+                      (big_sepL (fun _ ef =>
+                        wp_s W s1 Iris.Set.univ ef fork_post)
+                        efs))))
+                (BIBase.sep
+                  (wp_post W E2 Φ Ψ) IH))
+              (fupd' W E1 E2 (BIBase.emp : IProp GF))) ⊢
+          fupd' W maskEmpty E1
+            (BIBase.sep
+              (BIBase.later
+                (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                  (BIBase.sep (wp_s W s2 E2 e2 Ψ)
+                    (big_sepL (fun _ ef =>
+                      wp_s W s2 Iris.Set.univ ef fork_post)
+                      efs))))
+              (fupd' W E1 E2 (BIBase.emp : IProp GF))) :=
+      Iris.BaseLogic.fupd_mono 
+        (E1 := maskEmpty) (E2 := E1)
+        (P := BIBase.sep
+          (BIBase.sep
+            (BIBase.later
+              (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                (BIBase.sep (wp_s W s1 E1 e2 Φ)
+                  (big_sepL (fun _ ef =>
+                    wp_s W s1 Iris.Set.univ ef fork_post)
+                    efs))))
+            (BIBase.sep
+              (wp_post W E2 Φ Ψ) IH))
+          (fupd' W E1 E2 (BIBase.emp : IProp GF)))
+        (Q := BIBase.sep
+          (BIBase.later
+            (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+              (BIBase.sep (wp_s W s2 E2 e2 Ψ)
+                (big_sepL (fun _ ef =>
+                  wp_s W s2 Iris.Set.univ ef fork_post)
+                  efs))))
+          (fupd' W E1 E2 (BIBase.emp : IProp GF)))
+        (sep_mono hmono .rfl)
+    have hclose :
+        fupd' W maskEmpty E1
+            (BIBase.sep
+              (BIBase.later
+                (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                  (BIBase.sep (wp_s W s2 E2 e2 Ψ)
+                    (big_sepL (fun _ ef =>
+                      wp_s W s2 Iris.Set.univ ef fork_post)
+                      efs))))
+              (fupd' W E1 E2 (BIBase.emp : IProp GF))) ⊢
+          fupd' W maskEmpty E2
+            (BIBase.later
+              (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                (BIBase.sep (wp_s W s2 E2 e2 Ψ)
+                  (big_sepL (fun _ ef =>
+                    wp_s W s2 Iris.Set.univ ef fork_post)
+                    efs)))) :=
+      fupd_close_mask (E1 := E1) (E2 := E2)
+        (P := BIBase.later
+          (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+            (BIBase.sep (wp_s W s2 E2 e2 Ψ)
+              (big_sepL (fun _ ef =>
+                wp_s W s2 Iris.Set.univ ef fork_post)
+                efs))))
+    exact hframe.trans (hmid.trans hclose)
+  have hpost :
+      fupd' W E2 maskEmpty
+          (BIBase.sep P1
+            (fupd' W E1 E2 (BIBase.emp : IProp GF))) ⊢
+        fupd' W E2 maskEmpty
+          (BIBase.sep (BIBase.pure (stuckness_pred s2 e σ)) Q2) :=
+    Iris.BaseLogic.fupd_mono 
+      (E1 := E2) (E2 := maskEmpty)
+      (P := BIBase.sep P1
+        (fupd' W E1 E2 (BIBase.emp : IProp GF)))
+      (Q := BIBase.sep (BIBase.pure (stuckness_pred s2 e σ)) Q2) hpost_pure
+  have hperm :
+      BIBase.sep
+          (BIBase.sep IH
+            (BIBase.sep (wp_pre_s W s1
+              (wp_s W s1) E1 e Φ)
+              (wp_post W E2 Φ Ψ)))
+          (state_interp σ ns (κ ++ κs) nt) ⊢
+        BIBase.sep
+          (BIBase.sep
+            (wp_pre_s W s1
+              (wp_s W s1) E1 e Φ)
+            (state_interp σ ns (κ ++ κs) nt))
+          (BIBase.sep
+            (wp_post W E2 Φ Ψ) IH) := by
+    have h1 :
+        BIBase.sep
+            (BIBase.sep IH
+              (BIBase.sep (wp_pre_s W s1
+                (wp_s W s1) E1 e Φ)
+                (wp_post W E2 Φ Ψ)))
+            (state_interp σ ns (κ ++ κs) nt) ⊢
+          BIBase.sep
+            (BIBase.sep
+              (BIBase.sep IH
+                (wp_pre_s W s1
+                  (wp_s W s1) E1 e Φ))
+              (wp_post W E2 Φ Ψ))
+            (state_interp σ ns (κ ++ κs) nt) :=
+      sep_mono (sep_assoc (PROP := IProp GF)
+        (P := IH)
+        (Q := wp_pre_s W s1
+          (wp_s W s1) E1 e Φ)
+        (R := wp_post W E2 Φ Ψ)).2 .rfl
+    have h2 :
+        BIBase.sep
+            (BIBase.sep
+              (BIBase.sep IH
+                (wp_pre_s W s1
+                  (wp_s W s1) E1 e Φ))
+              (wp_post W E2 Φ Ψ))
+            (state_interp σ ns (κ ++ κs) nt) ⊢
+          BIBase.sep
+            (BIBase.sep IH
+              (wp_post W E2 Φ Ψ))
+            (BIBase.sep
+              (wp_pre_s W s1
+                (wp_s W s1) E1 e Φ)
+              (state_interp σ ns (κ ++ κs) nt)) := by
+      have h2a :
+          BIBase.sep
+              (BIBase.sep
+                (BIBase.sep IH
+                  (wp_pre_s W s1
+                    (wp_s W s1) E1 e Φ))
+                (wp_post W E2 Φ Ψ))
+              (state_interp σ ns (κ ++ κs) nt) ⊢
+            BIBase.sep
+              (BIBase.sep IH
+                (wp_pre_s W s1
+                  (wp_s W s1) E1 e Φ))
+              (BIBase.sep
+                (wp_post W E2 Φ Ψ)
+                (state_interp σ ns (κ ++ κs) nt)) :=
+        (sep_assoc (PROP := IProp GF)
+          (P := BIBase.sep IH
+            (wp_pre_s W s1
+              (wp_s W s1) E1 e Φ))
+          (Q := wp_post W E2 Φ Ψ)
+          (R := state_interp σ ns (κ ++ κs) nt)).1
+      have h2b :
+          BIBase.sep
+              (BIBase.sep IH
+                (wp_pre_s W s1
+                  (wp_s W s1) E1 e Φ))
+              (BIBase.sep
+                (wp_post W E2 Φ Ψ)
+                (state_interp σ ns (κ ++ κs) nt)) ⊢
+            BIBase.sep
+              (BIBase.sep IH
+                (wp_post W E2 Φ Ψ))
+              (BIBase.sep
+                (wp_pre_s W s1
+                  (wp_s W s1) E1 e Φ)
+                (state_interp σ ns (κ ++ κs) nt)) :=
+        (sep_sep_sep_comm (PROP := IProp GF)
+          (P := IH)
+          (Q := wp_pre_s W s1
+            (wp_s W s1) E1 e Φ)
+          (R := wp_post W E2 Φ Ψ)
+          (S := state_interp σ ns (κ ++ κs) nt)).1
+      exact h2a.trans h2b
+    have h3 :
+        BIBase.sep
+            (BIBase.sep IH
+              (wp_post W E2 Φ Ψ))
+            (BIBase.sep
+              (wp_pre_s W s1
+                (wp_s W s1) E1 e Φ)
+              (state_interp σ ns (κ ++ κs) nt)) ⊢
+          BIBase.sep
+            (BIBase.sep
+              (wp_pre_s W s1
+                (wp_s W s1) E1 e Φ)
+              (state_interp σ ns (κ ++ κs) nt))
+            (BIBase.sep
+              (wp_post W E2 Φ Ψ) IH) := by
+      refine (sep_comm (PROP := IProp GF)
+        (P := BIBase.sep IH
+          (wp_post W E2 Φ Ψ))
+        (Q := BIBase.sep
+          (wp_pre_s W s1
+            (wp_s W s1) E1 e Φ)
+          (state_interp σ ns (κ ++ κs) nt))).1.trans ?_
+      refine sep_mono .rfl ?_
+      exact (sep_comm (PROP := IProp GF)
+        (P := IH)
+        (Q := wp_post W E2 Φ Ψ)).1
+    exact h1.trans (h2.trans h3)
+  have hframe_pre :
+      BIBase.sep
+          (fupd' W E1 maskEmpty P0)
+          (BIBase.sep
+            (wp_post W E2 Φ Ψ) IH) ⊢
+        fupd' W E1 maskEmpty P1 := by
+    simpa [P1] using
+      (Iris.BaseLogic.fupd_frame_r 
+        (E1 := E1) (E2 := maskEmpty)
+        (P := P0)
+        (Q := BIBase.sep
+          (wp_post W E2 Φ Ψ) IH))
+  have hpre' :
+      BIBase.sep
+          (BIBase.sep
+            (wp_pre_s W s1
+              (wp_s W s1) E1 e Φ)
+            (state_interp σ ns (κ ++ κs) nt))
+          (BIBase.sep
+            (wp_post W E2 Φ Ψ) IH) ⊢
+        fupd' W E1 maskEmpty P1 :=
+    (sep_mono hpre .rfl).trans hframe_pre
+  -- rewrite the `wp_pre W` unfoldings in the framed chain
+  have hperm' := by
+    -- use the non-value unfolding to align with the goal
+    simpa [wp_pre, hto, wp_pre_step] using hperm
+  have hpre'' := by
+    -- again, unfold the non-value case to match the goal shape
+    simpa [wp_pre, hto, wp_pre_step] using hpre'
+  exact hperm'.trans (hpre''.trans (hmask.trans hpost))
+
+/-! ## Strong Monotonicity (Löb) -/
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem pure_sep_elim_left (φ : Prop) (P : IProp GF) :
+    BIBase.sep (BIBase.pure φ) P ⊢ BIBase.pure φ := by
+  -- pure is absorbing, so it can be extracted from a separating conjunction
+  exact sep_elim_l (P := BIBase.pure φ) (Q := P)
+
+omit [ElemG GF (COFE.constOF CoPsetDisj)] [ElemG GF (COFE.constOF GSetDisj)] in
+private theorem pure_sep_elim_second (φ ψ : Prop) (P : IProp GF) :
+    BIBase.sep (BIBase.pure φ) (BIBase.sep (BIBase.pure ψ) P) ⊢ BIBase.pure ψ := by
+  -- commute to put the second pure on the left, then eliminate it
+  have hswap :
+      BIBase.sep (BIBase.pure φ) (BIBase.sep (BIBase.pure ψ) P) ⊢
+        BIBase.sep (BIBase.pure ψ) (BIBase.sep (BIBase.pure φ) P) := by
+    refine (sep_comm (PROP := IProp GF)
+      (P := BIBase.pure φ) (Q := BIBase.sep (BIBase.pure ψ) P)).1.trans ?_
+    refine (sep_assoc (PROP := IProp GF)
+      (P := BIBase.pure ψ) (Q := P) (R := BIBase.pure φ)).1.trans ?_
+    refine sep_mono .rfl ?_
+    exact (sep_comm (PROP := IProp GF) (P := P) (Q := BIBase.pure φ)).1
+  exact hswap.trans (pure_sep_elim_left (φ := ψ) (P := BIBase.sep (BIBase.pure φ) P))
+
+private theorem wp_strong_mono_body_step :
+    (BIBase.intuitionistically
+        (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W))) :
+        IPropWsat GF M F) ⊢
+      (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W) : IPropWsat GF M F) := by
+  -- prove the body pointwise and use the non-value step lemma
+  refine forall_intro (PROP := IProp GF) ?_; intro s1
+  refine forall_intro (PROP := IProp GF) ?_; intro s2
+  refine forall_intro (PROP := IProp GF) ?_; intro E1
+  refine forall_intro (PROP := IProp GF) ?_; intro E2
+  refine forall_intro (PROP := IProp GF) ?_; intro e
+  refine forall_intro (PROP := IProp GF) ?_; intro Φ
+  refine forall_intro (PROP := IProp GF) ?_; intro Ψ
+  refine wand_intro ?_
+  refine wand_intro ?_
+  refine wand_intro ?_
+  refine wand_intro ?_
+  have hwpΦ :
+      wp_s W s1 E1 e Φ ⊢
+        wp_pre_s W s1
+          (wp_s W s1) E1 e Φ :=
+    (wp_unfold (s := s1) (E := E1) (e := e) (Φ := Φ)).1
+  have hwpΨ :
+      wp_pre_s W s2
+          (wp_s W s2) E2 e Ψ ⊢
+        wp_s W s2 E2 e Ψ :=
+    (wp_unfold (s := s2) (E := E2) (e := e) (Φ := Ψ)).2
+  -- frame `wp_pre W` conversion under the pure assumptions
+  have hpre :
+      BIBase.sep (BIBase.pure (stuckness_le s1 s2))
+          (BIBase.sep (BIBase.pure (Subset E1 E2))
+            (BIBase.sep (wp_s W s1 E1 e Φ)
+              (wp_post W E2 Φ Ψ))) ⊢
+        BIBase.sep (BIBase.pure (stuckness_le s1 s2))
+          (BIBase.sep (BIBase.pure (Subset E1 E2))
+            (BIBase.sep (wp_pre_s W s1
+                (wp_s W s1) E1 e Φ)
+              (wp_post W E2 Φ Ψ))) :=
+    (sep_mono .rfl <| sep_mono .rfl <| sep_mono hwpΦ .rfl)
+  let IH : IPropWsat GF M F :=
+    BIBase.intuitionistically
+      (BIBase.later (wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W)))
+  -- reassociate the left context, then apply the `wp_pre W` unfolding
+  have hassoc0 :
+      BIBase.sep
+          (BIBase.sep
+            (BIBase.sep
+              (BIBase.sep IH (BIBase.pure (stuckness_le s1 s2)))
+              (BIBase.pure (Subset E1 E2)))
+            (wp_s W s1 E1 e Φ))
+          (wp_post W E2 Φ Ψ) ⊢
+        BIBase.sep IH
+          (BIBase.sep (BIBase.pure (stuckness_le s1 s2))
+            (BIBase.sep (BIBase.pure (Subset E1 E2))
+              (BIBase.sep (wp_s W s1 E1 e Φ)
+                (wp_post W E2 Φ Ψ)))) := by
+    -- reassociate to group `wp_s W`/`wp_post`, then expose `IH`
+    refine (sep_assoc (PROP := IProp GF)
+      (P := BIBase.sep
+        (BIBase.sep IH (BIBase.pure (stuckness_le s1 s2)))
+        (BIBase.pure (Subset E1 E2)))
+      (Q := wp_s W s1 E1 e Φ)
+      (R := wp_post W E2 Φ Ψ)).1.trans ?_
+    refine (sep_assoc (PROP := IProp GF)
+      (P := BIBase.sep IH (BIBase.pure (stuckness_le s1 s2)))
+      (Q := BIBase.pure (Subset E1 E2))
+      (R := BIBase.sep (wp_s W s1 E1 e Φ)
+        (wp_post W E2 Φ Ψ))).1.trans ?_
+    exact (sep_assoc (PROP := IProp GF)
+      (P := IH)
+      (Q := BIBase.pure (stuckness_le s1 s2))
+      (R := BIBase.sep (BIBase.pure (Subset E1 E2))
+        (BIBase.sep (wp_s W s1 E1 e Φ)
+          (wp_post W E2 Φ Ψ)))).1
+  refine hassoc0.trans ?_
+  refine (sep_mono .rfl hpre).trans ?_
+  -- consume the pure assumptions and apply the step lemma
+  refine (pure_elim (φ := stuckness_le s1 s2)
+    (h1 := (sep_elim_r (PROP := IProp GF)
+      (P := IH)
+      (Q := BIBase.sep (BIBase.pure (stuckness_le s1 s2))
+        (BIBase.sep (BIBase.pure (Subset E1 E2))
+          (BIBase.sep (wp_pre_s W s1
+              (wp_s W s1) E1 e Φ)
+            (wp_post W E2 Φ Ψ))))).trans
+      (pure_sep_elim_left (φ := stuckness_le s1 s2)
+        (P := BIBase.sep (BIBase.pure (Subset E1 E2))
+          (BIBase.sep (wp_pre_s W s1
+              (wp_s W s1) E1 e Φ)
+            (wp_post W E2 Φ Ψ)))))
+    (h2 := ?_)).trans hwpΨ
+  intro hS
+  refine (pure_elim (φ := Subset E1 E2)
+    (h1 := (sep_elim_r (PROP := IProp GF)
+      (P := IH)
+      (Q := BIBase.sep (BIBase.pure (stuckness_le s1 s2))
+        (BIBase.sep (BIBase.pure (Subset E1 E2))
+          (BIBase.sep (wp_pre_s W s1
+              (wp_s W s1) E1 e Φ)
+            (wp_post W E2 Φ Ψ))))).trans
+      (pure_sep_elim_second (φ := stuckness_le s1 s2) (ψ := Subset E1 E2)
+        (P := BIBase.sep (wp_pre_s W s1
+            (wp_s W s1) E1 e Φ)
+          (wp_post W E2 Φ Ψ))))
+    (h2 := ?_))
+  intro hE
+  have hstep :
+      BIBase.sep IH
+        (BIBase.sep (wp_pre_s W s1
+            (wp_s W s1) E1 e Φ)
+          (wp_post W E2 Φ Ψ)) ⊢
+      wp_pre_s W s2
+        (wp_s W s2) E2 e Ψ := by
+    cases hto : Λ.to_val e with
+    | some v =>
+        have hpre' :
+            wp_pre_s W s1
+                (wp_s W s1) E1 e Φ ⊢
+              fupd' W E1 E1 (Φ v) := by
+          simp [wp_pre, hto]
+        have hval :=
+          (sep_mono hpre' .rfl).trans
+            (wp_strong_mono_value (E1 := E1) (E2 := E2) (Φ := Φ) (Ψ := Ψ) (v := v) hE)
+        have hpost' :
+            fupd' W E2 E2 (Ψ v) ⊢
+              wp_pre_s W s2
+                (wp_s W s2) E2 e Ψ := by
+          simp [wp_pre, hto]
+        have hmain := hval.trans hpost'
+        exact (sep_elim_r (PROP := IProp GF)
+          (P := IH)
+          (Q := BIBase.sep (wp_pre_s W s1
+              (wp_s W s1) E1 e Φ)
+            (wp_post W E2 Φ Ψ))).trans hmain
+    | none =>
+        exact wp_strong_mono_step (s1 := s1) (s2 := s2) (E1 := E1) (E2 := E2)
+          (e := e) (Φ := Φ) (Ψ := Ψ) hS hE hto
+  -- thread the framed conversion and apply the step result
+  have hdrop_pures :
+      BIBase.sep (BIBase.pure (stuckness_le s1 s2))
+          (BIBase.sep (BIBase.pure (Subset E1 E2))
+            (BIBase.sep (wp_pre_s W s1
+                (wp_s W s1) E1 e Φ)
+              (wp_post W E2 Φ Ψ))) ⊢
+        BIBase.sep (wp_pre_s W s1
+            (wp_s W s1) E1 e Φ)
+          (wp_post W E2 Φ Ψ) := by
+    refine (sep_elim_r (PROP := IProp GF)
+      (P := BIBase.pure (stuckness_le s1 s2))
+      (Q := BIBase.sep (BIBase.pure (Subset E1 E2))
+        (BIBase.sep (wp_pre_s W s1
+            (wp_s W s1) E1 e Φ)
+          (wp_post W E2 Φ Ψ)))).trans ?_
+    exact sep_elim_r (PROP := IProp GF)
+      (P := BIBase.pure (Subset E1 E2))
+      (Q := BIBase.sep (wp_pre_s W s1
+          (wp_s W s1) E1 e Φ)
+        (wp_post W E2 Φ Ψ))
+  have hdrop :
+      BIBase.sep IH
+          (BIBase.sep (BIBase.pure (stuckness_le s1 s2))
+            (BIBase.sep (BIBase.pure (Subset E1 E2))
+              (BIBase.sep (wp_pre_s W s1
+                  (wp_s W s1) E1 e Φ)
+                (wp_post W E2 Φ Ψ)))) ⊢
+        BIBase.sep IH
+          (BIBase.sep (wp_pre_s W s1
+              (wp_s W s1) E1 e Φ)
+            (wp_post W E2 Φ Ψ)) :=
+    sep_mono .rfl hdrop_pures
+  exact hdrop.trans hstep
+
+private theorem wp_strong_mono_body_loeb :
+    (True : IPropWsat GF M F) ⊢
+      wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W) := by
+  -- apply Loeb to the monotonicity body
+  let P : IPropWsat GF M F := wp_strong_mono_body (M := M) (F := F) (Λ := Λ) (W := W)
+  have hstep : BIBase.intuitionistically (BIBase.later P) ⊢ P :=
+    wp_strong_mono_body_step
+  have hstep_box :
+      BIBase.intuitionistically (BIBase.later P) ⊢
+        BIBase.intuitionistically P :=
+    intuitionistically_intro' (P := BIBase.later P) (Q := P) hstep
+  have hlater :
+      BIBase.later (BIBase.intuitionistically P) ⊢
+        BIBase.intuitionistically (BIBase.later P) :=
+    (later_intuitionistically (PROP := IProp GF) (P := P)).2
+  have hloop :
+      BIBase.later (BIBase.intuitionistically P) ⊢
+        BIBase.intuitionistically P :=
+    hlater.trans hstep_box
+  have hloeb :
+      (True : IProp GF) ⊢ BIBase.intuitionistically P :=
+    BILoeb.loeb_weak (PROP := IProp GF) (P := BIBase.intuitionistically P) hloop
+  exact hloeb.trans (intuitionistically_elim (PROP := IProp GF) (P := P))
+
+/-- Strong monotonicity: transform postcondition (same stuckness and mask).
+Coq: `wp_strong_mono` in `weakestpre.v`. -/
+theorem wp_strong_mono (s1 s2 : Stuckness) (E1 E2 : Iris.Set Positive)
+    (e : Λ.expr) (Φ Ψ : Λ.val → IPropWsat GF M F) :
+    stuckness_le s1 s2 →
+    Subset E1 E2 →
+    wp_s W s1 E1 e Φ ⊢
+      BIBase.wand
+        (wp_post W E2 Φ Ψ)
+        (wp_s W s2 E2 e Ψ) := by
+  intro hS hE
+  let Hw : IProp GF :=
+    BIBase.wand (BIBase.pure (stuckness_le s1 s2))
+      (BIBase.wand (BIBase.pure (Subset E1 E2))
+        (BIBase.wand (wp_s W s1 E1 e Φ)
+          (BIBase.wand (wp_post W E2 Φ Ψ)
+            (wp_s W s2 E2 e Ψ))))
+  let P0 : IProp GF :=
+    BIBase.sep (BIBase.pure (stuckness_le s1 s2))
+      (BIBase.sep (BIBase.pure (Subset E1 E2))
+        (BIBase.sep (wp_s W s1 E1 e Φ)
+          (wp_post W E2 Φ Ψ)))
+  have hW :
+      (True : IProp GF) ⊢ Hw :=
+    (wp_strong_mono_body_loeb ).trans
+      (wp_strong_mono_body_elim (s1 := s1) (s2 := s2) (E1 := E1) (E2 := E2)
+        (e := e) (Φ := Φ) (Ψ := Ψ))
+  have hS' : (True : IProp GF) ⊢ BIBase.pure (stuckness_le s1 s2) := pure_intro hS
+  have hE' : (True : IProp GF) ⊢ BIBase.pure (Subset E1 E2) := pure_intro hE
+  have hframeS :
+      BIBase.sep (wp_s W s1 E1 e Φ)
+          (wp_post W E2 Φ Ψ) ⊢
+        BIBase.sep (BIBase.pure (stuckness_le s1 s2))
+          (BIBase.sep (wp_s W s1 E1 e Φ)
+            (wp_post W E2 Φ Ψ)) := by
+    refine (true_sep_2 (PROP := IProp GF)
+      (P := BIBase.sep (wp_s W s1 E1 e Φ)
+        (wp_post W E2 Φ Ψ))).trans ?_
+    exact sep_mono hS' .rfl
+  have hframe :
+      BIBase.sep (wp_s W s1 E1 e Φ)
+          (wp_post W E2 Φ Ψ) ⊢ P0 := by
+    refine hframeS.trans ?_
+    refine (true_sep_2 (PROP := IProp GF)
+      (P := BIBase.sep (BIBase.pure (stuckness_le s1 s2))
+        (BIBase.sep (wp_s W s1 E1 e Φ)
+          (wp_post W E2 Φ Ψ)))).trans ?_
+    refine (sep_mono hE' .rfl).trans ?_
+    exact (sep_left_comm (PROP := IProp GF)
+      (P := BIBase.pure (Subset E1 E2))
+      (Q := BIBase.pure (stuckness_le s1 s2))
+      (R := BIBase.sep (wp_s W s1 E1 e Φ)
+        (wp_post W E2 Φ Ψ))).1
+  have happly :
+      BIBase.sep Hw P0 ⊢
+        wp_s W s2 E2 e Ψ := by
+    refine (sep_assoc (PROP := IProp GF)
+      (P := Hw) (Q := BIBase.pure (stuckness_le s1 s2))
+      (R := BIBase.sep (BIBase.pure (Subset E1 E2))
+        (BIBase.sep (wp_s W s1 E1 e Φ)
+          (wp_post W E2 Φ Ψ)))).2.trans ?_
+    refine (sep_mono (wand_elim_l (PROP := IProp GF)) .rfl).trans ?_
+    refine (sep_assoc (PROP := IProp GF)
+      (P := BIBase.wand (BIBase.pure (Subset E1 E2))
+        (BIBase.wand (wp_s W s1 E1 e Φ)
+          (BIBase.wand (wp_post W E2 Φ Ψ)
+            (wp_s W s2 E2 e Ψ))))
+      (Q := BIBase.pure (Subset E1 E2))
+      (R := BIBase.sep (wp_s W s1 E1 e Φ)
+        (wp_post W E2 Φ Ψ))).2.trans ?_
+    refine (sep_mono (wand_elim_l (PROP := IProp GF)) .rfl).trans ?_
+    refine (sep_assoc (PROP := IProp GF)
+      (P := BIBase.wand (wp_s W s1 E1 e Φ)
+        (BIBase.wand (wp_post W E2 Φ Ψ)
+          (wp_s W s2 E2 e Ψ)))
+      (Q := wp_s W s1 E1 e Φ)
+      (R := wp_post W E2 Φ Ψ)).2.trans ?_
+    refine (sep_mono (wand_elim_l (PROP := IProp GF)) .rfl).trans ?_
+    exact wand_elim_l (PROP := IProp GF)
+  refine wand_intro ?_
+  refine hframe.trans ?_
+  refine (true_sep_2 (PROP := IProp GF) (P := P0)).trans ?_
+  exact (sep_mono hW .rfl).trans happly
+
+/-- Fancy update can be absorbed into WP.
+Coq: `fupd_wp` in `weakestpre.v`. -/
+theorem fupd_wp (s : Stuckness) (E : Iris.Set Positive)
+    (e : Λ.expr) (Φ : Λ.val → IPropWsat GF M F) :
+    fupd' W E E
+      (wp_s W s E e Φ) ⊢
+    wp_s W s E e Φ :=
+  by
+  have hwp_pre :
+      wp_s W s E e Φ ⊢
+        wp_pre_s W s
+          (wp_s W s) E e Φ :=
+    (wp_unfold (s := s) (E := E) (e := e) (Φ := Φ)).1
+  have hwp :
+      wp_pre_s W s
+          (wp_s W s) E e Φ ⊢
+        wp_s W s E e Φ :=
+    (wp_unfold (s := s) (E := E) (e := e) (Φ := Φ)).2
+  refine (Iris.BaseLogic.fupd_mono 
+    (E1 := E) (E2 := E)
+    (P := wp_s W s E e Φ)
+    (Q := wp_pre_s W s
+      (wp_s W s) E e Φ) hwp_pre).trans ?_
+  have hcollapse :
+      fupd' W E E
+          (wp_pre_s W s
+            (wp_s W s) E e Φ) ⊢
+        wp_pre_s W s
+          (wp_s W s) E e Φ := by
+    cases hto : Λ.to_val e with
+    | some v =>
+        simpa [wp_pre, hto] using
+          (fupd_idem (E := E) (P := Φ v))
+    | none =>
+        -- push the outer update through binders and collapse the nested update
+        simp [wp_pre, hto, wp_pre_step]
+        let Qcont (σ : Λ.state) (ns : Nat) (κ : List Λ.observation)
+            (κs : List Λ.observation) (nt : Nat) : IPropWsat GF M F :=
+          BIBase.forall fun e2 : Λ.expr =>
+            BIBase.forall fun σ2 : Λ.state =>
+              BIBase.forall fun efs : List Λ.expr =>
+                BIBase.wand (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs)) <|
+                  fupd' W maskEmpty E <|
+                    BIBase.later <|
+                      BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt)) <|
+                        BIBase.sep (wp_s W s E e2 Φ)
+                          (big_sepL (fun _ ef =>
+                            wp_s W s Iris.Set.univ ef fork_post)
+                            efs)
+        let Pσ (σ : Λ.state) : IPropWsat GF M F :=
+          BIBase.forall fun ns : Nat =>
+            BIBase.forall fun κ : List Λ.observation =>
+              BIBase.forall fun κs : List Λ.observation =>
+                BIBase.forall fun nt : Nat =>
+                  BIBase.wand (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt) <|
+                    fupd' W E maskEmpty <|
+                      BIBase.sep (BIBase.pure (stuckness_pred s e σ))
+                        (Qcont σ ns κ κs nt)
+        have hσ :
+            fupd' W E E (BIBase.forall Pσ) ⊢
+              BIBase.forall fun a => fupd' W E E (Pσ a) := by
+          simpa using
+            (fupd_forall (A := Λ.state) (E1 := E) (E2 := E) (Φ := Pσ))
+        refine hσ.trans ?_
+        refine forall_intro (PROP := IProp GF) ?_; intro σ
+        have hσ' :=
+          forall_elim (PROP := IProp GF)
+            (Ψ := fun σ => fupd' W E E (Pσ σ)) σ
+        refine hσ'.trans ?_
+        let Pns (ns : Nat) : IPropWsat GF M F :=
+          BIBase.forall fun κ : List Λ.observation =>
+            BIBase.forall fun κs : List Λ.observation =>
+              BIBase.forall fun nt : Nat =>
+                BIBase.wand (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt) <|
+                  fupd' W E maskEmpty <|
+                    BIBase.sep (BIBase.pure (stuckness_pred s e σ))
+                      (Qcont σ ns κ κs nt)
+        have hns :
+            fupd' W E E (BIBase.forall Pns) ⊢
+              BIBase.forall fun a => fupd' W E E (Pns a) := by
+          simpa using
+            (fupd_forall (A := Nat) (E1 := E) (E2 := E) (Φ := Pns))
+        refine hns.trans ?_
+        refine forall_intro (PROP := IProp GF) ?_; intro ns
+        have hns' :=
+          forall_elim (PROP := IProp GF)
+            (Ψ := fun ns => fupd' W E E (Pns ns)) ns
+        refine hns'.trans ?_
+        let Pκ (κ : List Λ.observation) : IPropWsat GF M F :=
+          BIBase.forall fun κs : List Λ.observation =>
+            BIBase.forall fun nt : Nat =>
+              BIBase.wand (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt) <|
+                fupd' W E maskEmpty <|
+                  BIBase.sep (BIBase.pure (stuckness_pred s e σ))
+                    (Qcont σ ns κ κs nt)
+        have hκ :
+            fupd' W E E (BIBase.forall Pκ) ⊢
+              BIBase.forall fun a => fupd' W E E (Pκ a) := by
+          simpa using
+            (fupd_forall (A := List Λ.observation) (E1 := E) (E2 := E) (Φ := Pκ))
+        refine hκ.trans ?_
+        refine forall_intro (PROP := IProp GF) ?_; intro κ
+        have hκ' :=
+          forall_elim (PROP := IProp GF)
+            (Ψ := fun κ => fupd' W E E (Pκ κ)) κ
+        refine hκ'.trans ?_
+        let Pκs (κs : List Λ.observation) : IPropWsat GF M F :=
+          BIBase.forall fun nt : Nat =>
+            BIBase.wand (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt) <|
+              fupd' W E maskEmpty <|
+                BIBase.sep (BIBase.pure (stuckness_pred s e σ))
+                  (Qcont σ ns κ κs nt)
+        have hκs :
+            fupd' W E E (BIBase.forall Pκs) ⊢
+              BIBase.forall fun a => fupd' W E E (Pκs a) := by
+          simpa using
+            (fupd_forall (A := List Λ.observation) (E1 := E) (E2 := E) (Φ := Pκs))
+        refine hκs.trans ?_
+        refine forall_intro (PROP := IProp GF) ?_; intro κs
+        have hκs' :=
+          forall_elim (PROP := IProp GF)
+            (Ψ := fun κs => fupd' W E E (Pκs κs)) κs
+        refine hκs'.trans ?_
+        let Pnt (nt : Nat) : IPropWsat GF M F :=
+          BIBase.wand (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt) <|
+            fupd' W E maskEmpty <|
+              BIBase.sep (BIBase.pure (stuckness_pred s e σ))
+                (Qcont σ ns κ κs nt)
+        have hnt :
+            fupd' W E E (BIBase.forall Pnt) ⊢
+              BIBase.forall fun a => fupd' W E E (Pnt a) := by
+          simpa using
+            (fupd_forall (A := Nat) (E1 := E) (E2 := E) (Φ := Pnt))
+        refine hnt.trans ?_
+        refine forall_intro (PROP := IProp GF) ?_; intro nt
+        have hnt' :=
+          forall_elim (PROP := IProp GF)
+            (Ψ := fun nt => fupd' W E E (Pnt nt)) nt
+        refine hnt'.trans ?_
+        -- collapse the outer `fupd` under the wand
+        let Pstep : IProp GF :=
+          BIBase.sep (BIBase.pure (stuckness_pred s e σ))
+            (Qcont σ ns κ κs nt)
+        refine (fupd_wand (E1 := E) (E2 := E)
+          (P := state_interp σ ns (κ ++ κs) nt)
+          (Q := fupd' W E maskEmpty Pstep)).trans ?_
+        refine (wand_mono_r (PROP := IProp GF) ?_)
+        exact Iris.BaseLogic.fupd_trans 
+          (E1 := E) (E2 := E) (E3 := maskEmpty) (P := Pstep)
+  exact hcollapse.trans hwp
+
+/-- Postcondition update can be absorbed.
+Coq: `wp_fupd` in `weakestpre.v`. -/
+theorem wp_fupd (s : Stuckness) (E : Iris.Set Positive)
+    (e : Λ.expr) (Φ : Λ.val → IPropWsat GF M F) :
+    wp_s W s E e
+      (fun v => fupd' W E E (Φ v)) ⊢
+    wp_s W s E e Φ :=
+  by
+  -- apply strong monotonicity with the identity postcondition transformer
+  have hS : stuckness_le s s := by
+    cases s <;> simp [stuckness_le]
+  have hE : Subset E E := by
+    intro i hi; exact hi
+  have hmono :=
+    wp_strong_mono (W := W) (s1 := s) (s2 := s) (E1 := E) (E2 := E) (e := e)
+      (Φ := fun v => fupd' W E E (Φ v))
+      (Ψ := Φ) hS hE
+  have hpost :
+      (True : IProp GF) ⊢
+        wp_post W E
+          (fun v => fupd' W E E (Φ v)) Φ := by
+    -- the postcondition transformer is just `P -∗ P`
+    refine forall_intro ?_; intro v
+    exact wand_rfl
+  have hframe :
+      wp_s W s E e
+          (fun v => fupd' W E E (Φ v)) ⊢
+        BIBase.sep
+          (wp_post W E
+            (fun v => fupd' W E E (Φ v)) Φ)
+          (wp_s W s E e
+            (fun v => fupd' W E E (Φ v))) := by
+    -- insert the transformer via `True`
+    refine (true_sep_2 (PROP := IProp GF)
+      (P := wp_s W s E e
+        (fun v => fupd' W E E (Φ v)))).trans ?_
+    exact sep_mono hpost .rfl
+  refine hframe.trans ?_
+  refine (sep_mono (PROP := IProp GF)
+    (P := wp_post W E
+      (fun v => fupd' W E E (Φ v)) Φ)
+    (Q := wp_post W E
+      (fun v => fupd' W E E (Φ v)) Φ)
+    (P' := wp_s W s E e
+      (fun v => fupd' W E E (Φ v)))
+    (Q' := BIBase.wand
+      (wp_post W E
+        (fun v => fupd' W E E (Φ v)) Φ)
+      (wp_s W s E e Φ)) .rfl hmono).trans ?_
+  exact wand_elim_r (PROP := IProp GF)
+
+/-- Bind rule: compositionality via evaluation contexts.
+Coq: `wp_bind` in `weakestpre.v`. -/
+theorem wp_bind (K : Λ.expr → Λ.expr) [LanguageCtx K]
+    (s : Stuckness) (E : Iris.Set Positive)
+    (e : Λ.expr) (Φ : Λ.val → IPropWsat GF M F) :
+    wp_s W s E e
+      (fun v => wp_s W s E (K (Λ.of_val v)) Φ) ⊢
+    wp_s W s E (K e) Φ :=
+  by
+  let post : Λ.val → IPropWsat GF M F :=
+    fun v => wp_s W s E (K (Λ.of_val v)) Φ
+  let P : IPropWsat GF M F :=
+    BIBase.forall fun E =>
+      BIBase.forall fun e =>
+        BIBase.forall fun Φ =>
+          BIBase.wand
+            (wp_s W s E e
+              (fun v => wp_s W s E (K (Λ.of_val v)) Φ))
+            (wp_s W s E (K e) Φ)
+  have hPelim (E : Iris.Set Positive) (e : Λ.expr) (Φ : Λ.val → IPropWsat GF M F) :
+      P ⊢ BIBase.wand
+        (wp_s W s E e
+          (fun v => wp_s W s E (K (Λ.of_val v)) Φ))
+        (wp_s W s E (K e) Φ) := by
+    refine (forall_elim (PROP := IProp GF) (Ψ := fun E => _) E).trans ?_
+    refine (forall_elim (PROP := IProp GF) (Ψ := fun e => _) e).trans ?_
+    exact (forall_elim (PROP := IProp GF) (Ψ := fun Φ => _) Φ)
+  have hstep : BIBase.intuitionistically (BIBase.later P) ⊢ P := by
+    refine forall_intro (PROP := IProp GF) ?_; intro E
+    refine forall_intro (PROP := IProp GF) ?_; intro e
+    refine forall_intro (PROP := IProp GF) ?_; intro Φ
+    cases hto : Λ.to_val e with
+    | some v =>
+        have hval :
+            wp_s W s E e
+                (fun v => wp_s W s E (K (Λ.of_val v)) Φ) ⊢
+              wp_s W s E (K e) Φ := by
+          have hstep :
+              fupd' W E E
+                  (wp_s W s E (K (Λ.of_val v)) Φ) ⊢
+                wp_s W s E (K (Λ.of_val v)) Φ :=
+            fupd_wp (s := s) (E := E)
+              (e := K (Λ.of_val v)) (Φ := Φ)
+          have hK : K e = K (Λ.of_val v) := by
+            simp [of_to_val e v hto]
+          have hwpK' :
+              wp_s W s E (K (Λ.of_val v)) Φ ⊢
+                wp_s W s E (K e) Φ := by
+            simp [hK]
+          have hpre :
+              wp_pre_s W s
+                  (wp_s W s) E e
+                  (fun v =>
+                    wp_s W s E (K (Λ.of_val v)) Φ) ⊢
+                fupd' W E E
+                  (wp_s W s E (K (Λ.of_val v)) Φ) := by
+            simp [wp_pre, hto]
+          have hwp :
+              wp_s W s E e
+                  (fun v => wp_s W s E (K (Λ.of_val v)) Φ) ⊢
+                wp_pre_s W s
+                  (wp_s W s) E e
+                  (fun v =>
+                    wp_s W s E (K (Λ.of_val v)) Φ) :=
+            (wp_unfold (s := s) (E := E) (e := e)
+              (Φ := fun v =>
+                wp_s W s E (K (Λ.of_val v)) Φ)).1
+          exact hwp.trans (hpre.trans (hstep.trans hwpK'))
+        have htrue :
+            (True : IProp GF) ⊢ BIBase.wand
+              (wp_s W s E e
+                (fun v => wp_s W s E (K (Λ.of_val v)) Φ))
+              (wp_s W s E (K e) Φ) := by
+          refine wand_intro (PROP := IProp GF) ?_
+          -- drop `True`, then use the value case
+          exact (sep_elim_r (PROP := IProp GF) (P := (BIBase.pure True))
+            (Q := wp_s W s E e
+              (fun v => wp_s W s E (K (Λ.of_val v)) Φ))).trans
+            hval
+        exact (true_intro (P := BIBase.intuitionistically (BIBase.later P))).trans htrue
+    | none =>
+        let IH : IPropWsat GF M F :=
+          BIBase.intuitionistically (BIBase.later P)
+        refine wand_intro (PROP := IProp GF) ?_
+        have hwp :
+            wp_s W s E e
+                (fun v => wp_s W s E (K (Λ.of_val v)) Φ) ⊢
+              wp_pre_s W s
+                (wp_s W s) E e
+                (fun v =>
+                  wp_s W s E (K (Λ.of_val v)) Φ) :=
+          (wp_unfold (s := s) (E := E) (e := e)
+            (Φ := fun v =>
+              wp_s W s E (K (Λ.of_val v)) Φ)).1
+        have hwpK :
+            wp_pre_s W s
+                (wp_s W s) E (K e) Φ ⊢
+              wp_s W s E (K e) Φ :=
+          (wp_unfold (s := s) (E := E) (e := K e) (Φ := Φ)).2
+        refine (sep_mono (PROP := IProp GF) .rfl hwp).trans ?_
+        have htoK : Λ.to_val (K e) = none :=
+          LanguageCtx.fill_not_val (K := K) e hto
+        have hpre :
+            BIBase.sep IH
+                (wp_pre_s W s
+                  (wp_s W s) E e
+                  (fun v =>
+                    wp_s W s E (K (Λ.of_val v)) Φ)) ⊢
+              wp_pre_s W s
+                (wp_s W s) E (K e) Φ := by
+          -- unfold only the right-hand `wp_pre W`
+          simp [wp_pre, htoK, wp_pre_step]
+          -- specialize the right-hand binders
+          refine forall_intro (PROP := IProp GF) ?_; intro σ
+          refine forall_intro (PROP := IProp GF) ?_; intro ns
+          refine forall_intro (PROP := IProp GF) ?_; intro κ
+          refine forall_intro (PROP := IProp GF) ?_; intro κs
+          refine forall_intro (PROP := IProp GF) ?_; intro nt
+          -- open the left wp_pre W
+          have hview :=
+            wp_pre_elim (W := W) (s := s) (E := E) (e := e)
+              (Φ := fun v =>
+                wp_s W s E (K (Λ.of_val v)) Φ)
+              (σ := σ) (ns := ns) (κ := κ) (κs := κs) (nt := nt) hto
+          have hleft :
+              BIBase.sep IH
+                  (wp_pre_s W s
+                    (wp_s W s) E e
+                    (fun v =>
+                      wp_s W s E (K (Λ.of_val v)) Φ)) ⊢
+                BIBase.sep IH
+                  (wp_pre_view W s E e
+                    (fun v =>
+                      wp_s W s E (K (Λ.of_val v)) Φ)
+                    σ ns κ κs nt) :=
+            sep_mono (PROP := IProp GF) .rfl hview
+          refine hleft.trans ?_
+          -- now show the view for `K e`
+          let Q1 : IPropWsat GF M F :=
+            BIBase.forall fun e2 : Λ.expr =>
+              BIBase.forall fun σ2 : Λ.state =>
+                BIBase.forall fun efs : List Λ.expr =>
+                  BIBase.wand (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs))
+                    (fupd' W maskEmpty E
+                      (BIBase.later
+                        (BIBase.sep (state_interp (M := M) (F := F) σ2 (ns + 1) κs (efs.length + nt))
+                          (BIBase.sep
+                            (wp_s W s E e2
+                              (fun v =>
+                                wp_s W s E
+                                  (K (Λ.of_val v)) Φ))
+                            (big_sepL (fun _ ef =>
+                              wp_s W s
+                                Iris.Set.univ ef fork_post) efs)))))
+          let Q2 : IPropWsat GF M F :=
+            BIBase.forall fun e2 : Λ.expr =>
+              BIBase.forall fun σ2 : Λ.state =>
+                BIBase.forall fun efs : List Λ.expr =>
+                  BIBase.wand (BIBase.pure (Λ.prim_step (K e) σ κ e2 σ2 efs))
+                    (fupd' W maskEmpty E
+                      (BIBase.later
+                        (BIBase.sep (state_interp (M := M) (F := F) σ2 (ns + 1) κs (efs.length + nt))
+                          (BIBase.sep
+                            (wp_s W s E e2 Φ)
+                            (big_sepL (fun _ ef =>
+                              wp_s W s
+                                Iris.Set.univ ef fork_post) efs)))))
+          let P0 : IPropWsat GF M F :=
+            BIBase.sep (BIBase.pure (stuckness_pred s e σ)) Q1
+          let P1 : IPropWsat GF M F :=
+            BIBase.sep (BIBase.pure (stuckness_pred s (K e) σ)) Q2
+          -- unfold the view and prove the step relation
+          dsimp [wp_pre_view, Q1, Q2, P0, P1]
+          refine wand_intro (PROP := IProp GF) ?_
+          -- reorder to apply the left wand
+          have hassoc :
+              BIBase.sep (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt)
+                  (BIBase.sep IH
+                    (BIBase.wand (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt)
+                      (fupd' W E maskEmpty P0))) ⊢
+                BIBase.sep IH
+                  (BIBase.sep (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt)
+                    (BIBase.wand (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt)
+                      (fupd' W E maskEmpty P0))) := by
+            simpa [sep_assoc] using
+              (sep_left_comm (PROP := IProp GF)
+                (P := state_interp (M := M) (F := F) σ ns (κ ++ κs) nt) (Q := IH)
+                (R := BIBase.wand (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt)
+                  (fupd' W E maskEmpty P0))).1
+          have hpre :
+              BIBase.sep (state_interp σ ns (κ ++ κs) nt)
+                  (BIBase.wand (state_interp σ ns (κ ++ κs) nt)
+                    (fupd' W E maskEmpty P0)) ⊢
+                fupd' W E maskEmpty P0 := by
+            simpa using
+              (wand_elim_r (PROP := IProp GF)
+                (P := state_interp σ ns (κ ++ κs) nt)
+                (Q := fupd' W E maskEmpty P0))
+          have hpre' :
+              BIBase.sep (state_interp σ ns (κ ++ κs) nt)
+                  (BIBase.sep IH
+                    (BIBase.wand (state_interp σ ns (κ ++ κs) nt)
+                      (fupd' W E maskEmpty P0))) ⊢
+                BIBase.sep IH (fupd' W E maskEmpty P0) := by
+            exact hassoc.trans (sep_mono (PROP := IProp GF) .rfl hpre)
+          have hswap :
+              BIBase.sep IH (fupd' W E maskEmpty P0) ⊢
+                BIBase.sep (fupd' W E maskEmpty P0) IH :=
+            (sep_comm (PROP := IProp GF)
+              (P := IH)
+              (Q := fupd' W E maskEmpty P0)).1
+          have hpre'' :
+              BIBase.sep (state_interp σ ns (κ ++ κs) nt)
+                  (BIBase.sep IH
+                    (BIBase.wand (state_interp σ ns (κ ++ κs) nt)
+                      (fupd' W E maskEmpty P0))) ⊢
+                BIBase.sep (fupd' W E maskEmpty P0) IH :=
+            hpre'.trans hswap
+          have hframe :
+              BIBase.sep (fupd' W E maskEmpty P0) IH ⊢
+                fupd' W E maskEmpty (BIBase.sep P0 IH) :=
+            Iris.BaseLogic.fupd_frame_r 
+              (E1 := E) (E2 := maskEmpty)
+              (P := P0) (Q := IH)
+          have hpred :
+              ∀ σ, stuckness_pred s e σ → stuckness_pred s (K e) σ := by
+            intro σ
+            cases s <;> simp [stuckness_pred]
+            · intro hred
+              exact reducible_fill (K := K) e σ hred
+          have hQ :
+              BIBase.sep Q1 IH ⊢ Q2 := by
+            refine forall_intro (PROP := IProp GF) ?_; intro e2
+            refine forall_intro (PROP := IProp GF) ?_; intro σ2
+            refine forall_intro (PROP := IProp GF) ?_; intro efs
+            refine wand_intro (PROP := IProp GF) ?_
+            -- turn the step of `K e` into a step of `e`
+            have hstep_ex :
+                BIBase.pure (Λ.prim_step (K e) σ κ e2 σ2 efs) ⊢
+                  BIBase.pure (∃ e2', e2 = K e2' ∧ Λ.prim_step e σ κ e2' σ2 efs) :=
+              pure_mono (PROP := IProp GF) <| by
+                intro hstep
+                exact LanguageCtx.fill_step_inv (K := K) (e1' := e) (σ1 := σ) (κ := κ)
+                  (e2 := e2) (σ2 := σ2) (efs := efs) hto hstep
+            have h1 :
+                BIBase.sep (BIBase.sep Q1 IH)
+                    (BIBase.pure (Λ.prim_step (K e) σ κ e2 σ2 efs)) ⊢
+                  BIBase.pure (∃ e2', e2 = K e2' ∧
+                    Λ.prim_step e σ κ e2' σ2 efs) := by
+              refine (sep_mono (PROP := IProp GF) .rfl hstep_ex).trans ?_
+              refine (sep_comm (PROP := IProp GF)
+                (P := BIBase.sep Q1 IH)
+                (Q := BIBase.pure (∃ e2', e2 = K e2' ∧
+                  Λ.prim_step e σ κ e2' σ2 efs))).1.trans ?_
+              exact pure_sep_elim_left (φ := ∃ e2', e2 = K e2' ∧
+                Λ.prim_step e σ κ e2' σ2 efs) (P := BIBase.sep Q1 IH)
+            refine pure_elim (φ := ∃ e2', e2 = K e2' ∧ Λ.prim_step e σ κ e2' σ2 efs)
+              (h1 := h1) ?_
+            intro hstep
+            rcases hstep with ⟨e2', heq, hstep⟩
+            have hdrop :
+                BIBase.sep (BIBase.sep Q1 IH)
+                    (BIBase.pure (∃ e2', e2 = K e2' ∧
+                      Λ.prim_step e σ κ e2' σ2 efs)) ⊢
+                  BIBase.sep Q1 IH := by
+              refine (sep_comm (PROP := IProp GF)
+                (P := BIBase.sep Q1 IH)
+                (Q := BIBase.pure (∃ e2', e2 = K e2' ∧
+                  Λ.prim_step e σ κ e2' σ2 efs))).1.trans ?_
+              exact sep_elim_r (PROP := IProp GF)
+                (P := BIBase.pure (∃ e2', e2 = K e2' ∧
+                  Λ.prim_step e σ κ e2' σ2 efs))
+                (Q := BIBase.sep Q1 IH)
+            have hstep_pure :
+                (True : IProp GF) ⊢ BIBase.pure (Λ.prim_step e σ κ e2' σ2 efs) :=
+              pure_intro hstep
+            have hinsert :
+                BIBase.sep Q1 IH ⊢
+                  BIBase.sep (BIBase.pure (Λ.prim_step e σ κ e2' σ2 efs))
+                    (BIBase.sep Q1 IH) := by
+              refine (true_sep_2 (PROP := IProp GF) (P := BIBase.sep Q1 IH)).trans ?_
+              exact sep_mono (PROP := IProp GF) hstep_pure .rfl
+            have hswap :
+                BIBase.sep (BIBase.pure (Λ.prim_step e σ κ e2' σ2 efs))
+                    (BIBase.sep Q1 IH) ⊢
+                  BIBase.sep (BIBase.sep Q1
+                      (BIBase.pure (Λ.prim_step e σ κ e2' σ2 efs))) IH := by
+              refine (sep_left_comm (PROP := IProp GF)
+                (P := BIBase.pure (Λ.prim_step e σ κ e2' σ2 efs))
+                (Q := Q1) (R := IH)).1.trans ?_
+              exact (sep_assoc (PROP := IProp GF)
+                (P := Q1) (Q := BIBase.pure (Λ.prim_step e σ κ e2' σ2 efs))
+                (R := IH)).2
+            have hcont :
+                BIBase.sep Q1 (BIBase.pure (Λ.prim_step e σ κ e2' σ2 efs)) ⊢
+                  fupd' W maskEmpty E
+                    (BIBase.later
+                      (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                        (BIBase.sep
+                          (wp_s W s E e2'
+                            (fun v =>
+                              wp_s W s E
+                                (K (Λ.of_val v)) Φ))
+                          (big_sepL (fun _ ef =>
+                            wp_s W s
+                              Iris.Set.univ ef fork_post) efs)))) := by
+              have h1 :=
+                forall_elim (PROP := IProp GF)
+                  (Ψ := fun e2 : Λ.expr =>
+                    BIBase.forall fun σ2 : Λ.state =>
+                      BIBase.forall fun efs : List Λ.expr =>
+                        BIBase.wand (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs))
+                          (fupd' W maskEmpty E
+                            (BIBase.later
+                              (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                                (BIBase.sep
+                                  (wp_s W s E e2
+                                    (fun v =>
+                                      wp_s W s E
+                                        (K (Λ.of_val v)) Φ))
+                                  (big_sepL (fun _ ef =>
+                                    wp_s W s
+                                      Iris.Set.univ ef fork_post) efs)))))) e2'
+              have h2 :=
+                forall_elim (PROP := IProp GF)
+                  (Ψ := fun σ2 : Λ.state =>
+                    BIBase.forall fun efs : List Λ.expr =>
+                      BIBase.wand (BIBase.pure (Λ.prim_step e σ κ e2' σ2 efs))
+                        (fupd' W maskEmpty E
+                          (BIBase.later
+                            (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                              (BIBase.sep
+                                (wp_s W s E e2'
+                                  (fun v =>
+                                    wp_s W s E
+                                      (K (Λ.of_val v)) Φ))
+                                (big_sepL (fun _ ef =>
+                                  wp_s W s
+                                    Iris.Set.univ ef fork_post) efs)))))) σ2
+              have h3 :=
+                forall_elim (PROP := IProp GF)
+                  (Ψ := fun efs : List Λ.expr =>
+                    BIBase.wand (BIBase.pure (Λ.prim_step e σ κ e2' σ2 efs))
+                      (fupd' W maskEmpty E
+                        (BIBase.later
+                          (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                            (BIBase.sep
+                              (wp_s W s E e2'
+                                (fun v =>
+                                  wp_s W s E
+                                    (K (Λ.of_val v)) Φ))
+                              (big_sepL (fun _ ef =>
+                                wp_s W s
+                                  Iris.Set.univ ef fork_post) efs)))))) efs
+              have h123 := h1.trans (h2.trans h3)
+              exact (sep_mono (PROP := IProp GF) h123 .rfl).trans
+                (wand_elim_l (PROP := IProp GF))
+            -- use the continuation and thread IH through the later
+            have happly :
+                BIBase.sep (BIBase.sep Q1 (BIBase.pure (Λ.prim_step e σ κ e2' σ2 efs))) IH ⊢
+                  BIBase.sep
+                    (fupd' W maskEmpty E
+                      (BIBase.later
+                        (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                          (BIBase.sep
+                            (wp_s W s E e2'
+                              (fun v =>
+                                wp_s W s E
+                                  (K (Λ.of_val v)) Φ))
+                            (big_sepL (fun _ ef =>
+                              wp_s W s
+                                Iris.Set.univ ef fork_post) efs)))))
+                    IH :=
+              sep_mono (PROP := IProp GF) hcont .rfl
+            have hframe :
+                BIBase.sep
+                    (fupd' W maskEmpty E
+                      (BIBase.later
+                        (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                          (BIBase.sep
+                            (wp_s W s E e2'
+                              (fun v =>
+                                wp_s W s E
+                                  (K (Λ.of_val v)) Φ))
+                            (big_sepL (fun _ ef =>
+                              wp_s W s
+                                Iris.Set.univ ef fork_post) efs)))))
+                    IH ⊢
+                  fupd' W maskEmpty E
+                    (BIBase.sep
+                      (BIBase.later
+                        (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                          (BIBase.sep
+                            (wp_s W s E e2'
+                              (fun v =>
+                                wp_s W s E
+                                  (K (Λ.of_val v)) Φ))
+                            (big_sepL (fun _ ef =>
+                              wp_s W s
+                                Iris.Set.univ ef fork_post) efs))))
+                      IH) :=
+              Iris.BaseLogic.fupd_frame_r 
+                (E1 := maskEmpty) (E2 := E)
+                (P := BIBase.later
+                  (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                    (BIBase.sep
+                      (wp_s W s E e2'
+                        (fun v =>
+                          wp_s W s E
+                            (K (Λ.of_val v)) Φ))
+                      (big_sepL (fun _ ef =>
+                        wp_s W s
+                          Iris.Set.univ ef fork_post) efs))))
+                (Q := IH)
+            have hIHlater :
+                BIBase.sep IH
+                    (BIBase.later
+                      (wp_s W s E e2'
+                        (fun v =>
+                          wp_s W s E
+                            (K (Λ.of_val v)) Φ))) ⊢
+                  BIBase.later
+                    (wp_s W s E (K e2') Φ) := by
+              have hPelim' :
+                  BIBase.later P ⊢ BIBase.later
+                    (BIBase.wand
+                      (wp_s W s E e2'
+                        (fun v =>
+                          wp_s W s E
+                            (K (Λ.of_val v)) Φ))
+                      (wp_s W s E (K e2') Φ)) :=
+                later_mono (hPelim (E := E) (e := e2') (Φ := Φ))
+              have hwand :
+                  IH ⊢ BIBase.later
+                    (BIBase.wand
+                      (wp_s W s E e2'
+                        (fun v =>
+                          wp_s W s E
+                            (K (Λ.of_val v)) Φ))
+                      (wp_s W s E (K e2') Φ)) :=
+                (intuitionistically_elim (PROP := IProp GF) (P := BIBase.later P)).trans hPelim'
+              exact (sep_mono (PROP := IProp GF) hwand .rfl).trans
+                (later_wand_elim (P := wp_s W s E e2'
+                  (fun v =>
+                    wp_s W s E
+                      (K (Λ.of_val v)) Φ))
+                  (Q := wp_s W s E (K e2') Φ))
+            have hinner :
+                BIBase.sep
+                    (BIBase.later
+                      (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                        (BIBase.sep
+                          (wp_s W s E e2'
+                            (fun v =>
+                              wp_s W s E
+                                (K (Λ.of_val v)) Φ))
+                          (big_sepL (fun _ ef =>
+                            wp_s W s
+                              Iris.Set.univ ef fork_post) efs))))
+                    IH ⊢
+                  BIBase.later
+                    (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                      (BIBase.sep
+                        (wp_s W s E (K e2') Φ)
+                        (big_sepL (fun _ ef =>
+                          wp_s W s
+                            Iris.Set.univ ef fork_post) efs))) := by
+              -- split the later and use IH on the main WP
+              refine (sep_mono (PROP := IProp GF)
+                (later_sep (PROP := IProp GF)
+                  (P := state_interp σ2 (ns + 1) κs (efs.length + nt))
+                  (Q := BIBase.sep
+                    (wp_s W s E e2'
+                      (fun v =>
+                        wp_s W s E
+                          (K (Λ.of_val v)) Φ))
+                    (big_sepL (fun _ ef =>
+                      wp_s W s
+                        Iris.Set.univ ef fork_post) efs))).1 .rfl).trans ?_
+              refine (sep_assoc (PROP := IProp GF)
+                (P := BIBase.later (state_interp σ2 (ns + 1) κs (efs.length + nt)))
+                (Q := BIBase.later
+                  (BIBase.sep
+                    (wp_s W s E e2'
+                      (fun v =>
+                        wp_s W s E
+                          (K (Λ.of_val v)) Φ))
+                    (big_sepL (fun _ ef =>
+                      wp_s W s
+                        Iris.Set.univ ef fork_post) efs)))
+                (R := IH)).1.trans ?_
+              -- handle the continuation part
+              have hcont :
+                  BIBase.sep
+                      (BIBase.later
+                        (BIBase.sep
+                          (wp_s W s E e2'
+                            (fun v =>
+                              wp_s W s E
+                                (K (Λ.of_val v)) Φ))
+                          (big_sepL (fun _ ef =>
+                            wp_s W s
+                              Iris.Set.univ ef fork_post) efs)))
+                      IH ⊢
+                    BIBase.later
+                      (BIBase.sep
+                        (wp_s W s E (K e2') Φ)
+                        (big_sepL (fun _ ef =>
+                          wp_s W s
+                            Iris.Set.univ ef fork_post) efs)) := by
+                refine (sep_mono (PROP := IProp GF)
+                  (later_sep (PROP := IProp GF)
+                    (P := wp_s W s E e2'
+                      (fun v =>
+                        wp_s W s E
+                          (K (Λ.of_val v)) Φ))
+                    (Q := big_sepL (fun _ ef =>
+                      wp_s W s
+                        Iris.Set.univ ef fork_post) efs)).1 .rfl).trans ?_
+                refine (sep_assoc (PROP := IProp GF)
+                  (P := BIBase.later
+                    (wp_s W s E e2'
+                      (fun v =>
+                        wp_s W s E
+                          (K (Λ.of_val v)) Φ)))
+                  (Q := BIBase.later
+                    (big_sepL (fun _ ef =>
+                      wp_s W s
+                        Iris.Set.univ ef fork_post) efs))
+                  (R := IH)).1.trans ?_
+                -- move IH next to the main WP
+                have hswap :
+                    BIBase.sep
+                        (BIBase.later
+                          (wp_s W s E e2'
+                            (fun v =>
+                              wp_s W s E
+                                (K (Λ.of_val v)) Φ)))
+                        (BIBase.sep
+                          (BIBase.later
+                            (big_sepL (fun _ ef =>
+                              wp_s W s
+                                Iris.Set.univ ef fork_post) efs))
+                          IH) ⊢
+                      BIBase.sep
+                        (BIBase.sep IH
+                          (BIBase.later
+                            (wp_s W s E e2'
+                              (fun v =>
+                                wp_s W s E
+                                  (K (Λ.of_val v)) Φ))))
+                        (BIBase.later
+                          (big_sepL (fun _ ef =>
+                            wp_s W s
+                              Iris.Set.univ ef fork_post) efs)) := by
+                  refine (sep_assoc (PROP := IProp GF)
+                    (P := BIBase.later
+                      (wp_s W s E e2'
+                        (fun v =>
+                          wp_s W s E
+                            (K (Λ.of_val v)) Φ)))
+                    (Q := BIBase.later
+                      (big_sepL (fun _ ef =>
+                        wp_s W s
+                          Iris.Set.univ ef fork_post) efs))
+                    (R := IH)).2.trans ?_
+                  refine (sep_right_comm (PROP := IProp GF)
+                    (P := BIBase.later
+                      (wp_s W s E e2'
+                        (fun v =>
+                          wp_s W s E
+                            (K (Λ.of_val v)) Φ)))
+                    (Q := BIBase.later
+                      (big_sepL (fun _ ef =>
+                        wp_s W s
+                          Iris.Set.univ ef fork_post) efs))
+                    (R := IH)).1.trans ?_
+                  -- swap inside the left component
+                  exact (sep_mono (PROP := IProp GF)
+                    (sep_comm (PROP := IProp GF)
+                      (P := BIBase.later
+                        (wp_s W s E e2'
+                          (fun v =>
+                            wp_s W s E
+                              (K (Λ.of_val v)) Φ)))
+                      (Q := IH)).1 .rfl)
+                refine hswap.trans ?_
+                refine (sep_mono (PROP := IProp GF) (hIHlater) .rfl).trans ?_
+                exact (later_sep (PROP := IProp GF)
+                  (P := wp_s W s E (K e2') Φ)
+                  (Q := big_sepL (fun _ ef =>
+                    wp_s W s
+                      Iris.Set.univ ef fork_post) efs)).2
+              -- combine the state part and the continuation
+              refine (sep_mono (PROP := IProp GF) .rfl hcont).trans ?_
+              exact (later_sep (PROP := IProp GF)
+                (P := state_interp σ2 (ns + 1) κs (efs.length + nt))
+                (Q := BIBase.sep
+                  (wp_s W s E (K e2') Φ)
+                  (big_sepL (fun _ ef =>
+                    wp_s W s
+                      Iris.Set.univ ef fork_post) efs))).2
+            have hmono :
+                fupd' W maskEmpty E
+                    (BIBase.sep
+                      (BIBase.later
+                        (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                          (BIBase.sep
+                            (wp_s W s E e2'
+                              (fun v =>
+                                wp_s W s E
+                                  (K (Λ.of_val v)) Φ))
+                            (big_sepL (fun _ ef =>
+                              wp_s W s
+                                Iris.Set.univ ef fork_post) efs))))
+                      IH) ⊢
+                  fupd' W maskEmpty E
+                    (BIBase.later
+                      (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                        (BIBase.sep
+                          (wp_s W s E (K e2') Φ)
+                          (big_sepL (fun _ ef =>
+                            wp_s W s
+                              Iris.Set.univ ef fork_post) efs)))) :=
+              Iris.BaseLogic.fupd_mono 
+                (E1 := maskEmpty) (E2 := E)
+                (P := BIBase.sep
+                  (BIBase.later
+                    (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                      (BIBase.sep
+                        (wp_s W s E e2'
+                          (fun v =>
+                            wp_s W s E
+                              (K (Λ.of_val v)) Φ))
+                        (big_sepL (fun _ ef =>
+                          wp_s W s
+                            Iris.Set.univ ef fork_post) efs))))
+                  IH)
+                (Q := BIBase.later
+                  (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                    (BIBase.sep
+                      (wp_s W s E (K e2') Φ)
+                      (big_sepL (fun _ ef =>
+                        wp_s W s
+                          Iris.Set.univ ef fork_post) efs)))) hinner
+            have hfinal' :=
+              hdrop.trans (hinsert.trans (hswap.trans (happly.trans (hframe.trans hmono))))
+            have hfinal :=
+              (sep_mono (PROP := IProp GF) .rfl hstep_ex).trans hfinal'
+            simpa [heq] using hfinal
+          have hpost :
+              BIBase.sep P0 IH ⊢ P1 := by
+            dsimp [P0, P1]
+            refine (sep_assoc (PROP := IProp GF)
+              (P := BIBase.pure (stuckness_pred s e σ)) (Q := Q1) (R := IH)).1.trans ?_
+            exact sep_mono (PROP := IProp GF)
+              (pure_mono (PROP := IProp GF) (hpred σ)) hQ
+          have hmono :
+              fupd' W E maskEmpty (BIBase.sep P0 IH) ⊢
+                fupd' W E maskEmpty P1 :=
+            Iris.BaseLogic.fupd_mono 
+              (E1 := E) (E2 := maskEmpty)
+              (P := BIBase.sep P0 IH) (Q := P1) hpost
+          -- commute to match the `state_interp ∗ (IH ∗ wand)` ordering
+          have hswap0 :
+              BIBase.sep (BIBase.sep IH
+                    (BIBase.wand (state_interp σ ns (κ ++ κs) nt)
+                      (fupd' W E maskEmpty P0)))
+                (state_interp σ ns (κ ++ κs) nt) ⊢
+                BIBase.sep (state_interp σ ns (κ ++ κs) nt)
+                  (BIBase.sep IH
+                    (BIBase.wand (state_interp σ ns (κ ++ κs) nt)
+                      (fupd' W E maskEmpty P0))) :=
+            (sep_comm (PROP := IProp GF)
+              (P := BIBase.sep IH
+                (BIBase.wand (state_interp σ ns (κ ++ κs) nt)
+                  (fupd' W E maskEmpty P0)))
+              (Q := state_interp σ ns (κ ++ κs) nt)).1
+          exact hswap0.trans (hpre''.trans (hframe.trans hmono))
+        exact hpre.trans hwpK
+  have hstep_box :
+      BIBase.intuitionistically (BIBase.later P) ⊢ BIBase.intuitionistically P :=
+    intuitionistically_intro' (P := BIBase.later P) (Q := P) hstep
+  have hlater :
+      BIBase.later (BIBase.intuitionistically P) ⊢
+        BIBase.intuitionistically (BIBase.later P) :=
+    (later_intuitionistically (PROP := IProp GF) (P := P)).2
+  have hloop :
+      BIBase.later (BIBase.intuitionistically P) ⊢ BIBase.intuitionistically P :=
+    hlater.trans hstep_box
+  have hloeb :
+      (True : IProp GF) ⊢ BIBase.intuitionistically P :=
+    BILoeb.loeb_weak (PROP := IProp GF) (P := BIBase.intuitionistically P) hloop
+  have hP : (True : IProp GF) ⊢ P :=
+    hloeb.trans (intuitionistically_elim (PROP := IProp GF) (P := P))
+  have hwand :
+      (True : IProp GF) ⊢
+        BIBase.wand
+          (wp_s W s E e
+            (fun v => wp_s W s E (K (Λ.of_val v)) Φ))
+          (wp_s W s E (K e) Φ) :=
+    hP.trans (hPelim (E := E) (e := e) (Φ := Φ))
+  have hframe :
+      wp_s W s E e
+          (fun v => wp_s W s E (K (Λ.of_val v)) Φ) ⊢
+        BIBase.sep
+          (BIBase.wand
+            (wp_s W s E e
+              (fun v => wp_s W s E
+                (K (Λ.of_val v)) Φ))
+            (wp_s W s E (K e) Φ))
+          (wp_s W s E e
+            (fun v => wp_s W s E (K (Λ.of_val v)) Φ)) := by
+    refine (true_sep_2 (PROP := IProp GF)
+      (P := wp_s W s E e
+        (fun v => wp_s W s E
+          (K (Λ.of_val v)) Φ))).trans ?_
+    exact sep_mono (PROP := IProp GF) hwand .rfl
+  exact hframe.trans (wand_elim_l (PROP := IProp GF))
+
+/-- Inverse bind rule.
+Coq: `wp_bind_inv` in `weakestpre.v`. -/
+theorem wp_bind_inv (K : Λ.expr → Λ.expr) [LanguageCtx K]
+    (s : Stuckness) (E : Iris.Set Positive)
+    (e : Λ.expr) (Φ : Λ.val → IPropWsat GF M F) :
+    wp_s W s E (K e) Φ ⊢
+    wp_s W s E e
+      (fun v => wp_s W s E (K (Λ.of_val v)) Φ) :=
+  by
+  let post : Λ.val → IPropWsat GF M F :=
+    fun v => wp_s W s E (K (Λ.of_val v)) Φ
+  let P : IPropWsat GF M F :=
+    BIBase.forall fun E =>
+      BIBase.forall fun e =>
+        BIBase.forall fun Φ =>
+          BIBase.wand
+            (wp_s W s E (K e) Φ)
+            (wp_s W s E e
+              (fun v => wp_s W s E (K (Λ.of_val v)) Φ))
+  have hPelim (E : Iris.Set Positive) (e : Λ.expr) (Φ : Λ.val → IPropWsat GF M F) :
+      P ⊢ BIBase.wand
+        (wp_s W s E (K e) Φ)
+        (wp_s W s E e
+          (fun v => wp_s W s E (K (Λ.of_val v)) Φ)) := by
+    refine (forall_elim (PROP := IProp GF) (Ψ := fun E => _) E).trans ?_
+    refine (forall_elim (PROP := IProp GF) (Ψ := fun e => _) e).trans ?_
+    exact (forall_elim (PROP := IProp GF) (Ψ := fun Φ => _) Φ)
+  have hstep : BIBase.intuitionistically (BIBase.later P) ⊢ P := by
+    refine forall_intro (PROP := IProp GF) ?_; intro E
+    refine forall_intro (PROP := IProp GF) ?_; intro e
+    refine forall_intro (PROP := IProp GF) ?_; intro Φ
+    cases hto : Λ.to_val e with
+    | some v =>
+        have hval :
+            wp_s W s E (K e) Φ ⊢
+              wp_s W s E e
+                (fun v => wp_s W s E
+                  (K (Λ.of_val v)) Φ) := by
+          have hK : K e = K (Λ.of_val v) := by
+            simp [of_to_val e v hto]
+          have hpre :
+              wp_s W s E (K e) Φ ⊢
+                fupd' W E E
+                  (wp_s W s E (K (Λ.of_val v)) Φ) := by
+            simpa [hK] using
+              (fupd_intro (E := E)
+                (P := wp_s W s E
+                  (K (Λ.of_val v)) Φ))
+          have hpre' :
+              wp_s W s E (K e) Φ ⊢
+                wp_pre_s W s
+                  (wp_s W s) E e
+                  (fun v => wp_s W s E
+                    (K (Λ.of_val v)) Φ) := by
+            simpa [wp_pre, hto] using hpre
+          have hwp :
+              wp_pre_s W s
+                  (wp_s W s) E e
+                  (fun v => wp_s W s E
+                    (K (Λ.of_val v)) Φ) ⊢
+                wp_s W s E e
+                  (fun v => wp_s W s E
+                    (K (Λ.of_val v)) Φ) :=
+            (wp_unfold (s := s) (E := E) (e := e)
+              (Φ := fun v => wp_s W s E
+                (K (Λ.of_val v)) Φ)).2
+          exact hpre'.trans hwp
+        have htrue :
+            (True : IProp GF) ⊢ BIBase.wand
+              (wp_s W s E (K e) Φ)
+              (wp_s W s E e
+                (fun v => wp_s W s E
+                  (K (Λ.of_val v)) Φ)) := by
+          refine wand_intro (PROP := IProp GF) ?_
+          exact (sep_elim_r (PROP := IProp GF) (P := (BIBase.pure True))
+            (Q := wp_s W s E (K e) Φ)).trans
+            hval
+        exact (true_intro (P := BIBase.intuitionistically (BIBase.later P))).trans htrue
+    | none =>
+        let IH : IPropWsat GF M F :=
+          BIBase.intuitionistically (BIBase.later P)
+        refine wand_intro (PROP := IProp GF) ?_
+        have hwp :
+            wp_s W s E (K e) Φ ⊢
+              wp_pre_s W s
+                (wp_s W s) E (K e) Φ :=
+          (wp_unfold (s := s) (E := E)
+            (e := K e) (Φ := Φ)).1
+        have hwpK :
+            wp_pre_s W s
+                (wp_s W s) E e
+                (fun v => wp_s W s E
+                  (K (Λ.of_val v)) Φ) ⊢
+              wp_s W s E e
+                (fun v => wp_s W s E
+                  (K (Λ.of_val v)) Φ) :=
+          (wp_unfold (s := s) (E := E) (e := e)
+            (Φ := fun v => wp_s W s E
+              (K (Λ.of_val v)) Φ)).2
+        refine (sep_mono (PROP := IProp GF) .rfl hwp).trans ?_
+        have htoK : Λ.to_val (K e) = none :=
+          LanguageCtx.fill_not_val (K := K) e hto
+        have hpre :
+            BIBase.sep IH
+                (wp_pre_s W s
+                  (wp_s W s) E (K e) Φ) ⊢
+              wp_pre_s W s
+                (wp_s W s) E e
+                (fun v => wp_s W s E
+                  (K (Λ.of_val v)) Φ) := by
+          -- unfold only the right-hand `wp_pre W`
+          simp [wp_pre, hto, wp_pre_step]
+          refine forall_intro (PROP := IProp GF) ?_; intro σ
+          refine forall_intro (PROP := IProp GF) ?_; intro ns
+          refine forall_intro (PROP := IProp GF) ?_; intro κ
+          refine forall_intro (PROP := IProp GF) ?_; intro κs
+          refine forall_intro (PROP := IProp GF) ?_; intro nt
+          have hview :=
+            wp_pre_elim (W := W) (s := s) (E := E) (e := K e) (Φ := Φ)
+              (σ := σ) (ns := ns) (κ := κ) (κs := κs) (nt := nt) htoK
+          have hleft :
+              BIBase.sep IH
+                  (wp_pre_s W s
+                    (wp_s W s) E (K e) Φ) ⊢
+                BIBase.sep IH
+                  (wp_pre_view W s E (K e) Φ
+                    σ ns κ κs nt) :=
+            sep_mono (PROP := IProp GF) .rfl hview
+          refine hleft.trans ?_
+          let Q1 : IPropWsat GF M F :=
+            BIBase.forall fun e2 : Λ.expr =>
+              BIBase.forall fun σ2 : Λ.state =>
+                BIBase.forall fun efs : List Λ.expr =>
+                  BIBase.wand (BIBase.pure (Λ.prim_step (K e) σ κ e2 σ2 efs))
+                    (fupd' W maskEmpty E
+                      (BIBase.later
+                        (BIBase.sep (state_interp (M := M) (F := F) σ2 (ns + 1) κs (efs.length + nt))
+                          (BIBase.sep
+                            (wp_s W s E e2 Φ)
+                            (big_sepL (fun _ ef =>
+                              wp_s W s
+                                Iris.Set.univ ef fork_post) efs)))))
+          let Q2 : IPropWsat GF M F :=
+            BIBase.forall fun e2 : Λ.expr =>
+              BIBase.forall fun σ2 : Λ.state =>
+                BIBase.forall fun efs : List Λ.expr =>
+                  BIBase.wand (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs))
+                    (fupd' W maskEmpty E
+                      (BIBase.later
+                        (BIBase.sep (state_interp (M := M) (F := F) σ2 (ns + 1) κs (efs.length + nt))
+                          (BIBase.sep
+                            (wp_s W s E e2
+                              (fun v =>
+                                wp_s W s E
+                                  (K (Λ.of_val v)) Φ))
+                            (big_sepL (fun _ ef =>
+                              wp_s W s
+                                Iris.Set.univ ef fork_post) efs)))))
+          let P0 : IPropWsat GF M F :=
+            BIBase.sep (BIBase.pure (stuckness_pred s (K e) σ)) Q1
+          let P1 : IPropWsat GF M F :=
+            BIBase.sep (BIBase.pure (stuckness_pred s e σ)) Q2
+          dsimp [wp_pre_view, Q1, Q2, P0, P1]
+          refine wand_intro (PROP := IProp GF) ?_
+          have hassoc :
+              BIBase.sep (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt)
+                  (BIBase.sep IH
+                    (BIBase.wand (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt)
+                      (fupd' W E maskEmpty P0))) ⊢
+                BIBase.sep IH
+                  (BIBase.sep (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt)
+                    (BIBase.wand (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt)
+                      (fupd' W E maskEmpty P0))) := by
+            simpa [sep_assoc] using
+              (sep_left_comm (PROP := IProp GF)
+                (P := state_interp (M := M) (F := F) σ ns (κ ++ κs) nt) (Q := IH)
+                (R := BIBase.wand (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt)
+                  (fupd' W E maskEmpty P0))).1
+          have hpre0 :
+              BIBase.sep (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt)
+                  (BIBase.wand (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt)
+                    (fupd' W E maskEmpty P0)) ⊢
+                fupd' W E maskEmpty P0 := by
+            simpa using
+              (wand_elim_r (PROP := IProp GF)
+                (P := state_interp (M := M) (F := F) σ ns (κ ++ κs) nt)
+                (Q := fupd' W E maskEmpty P0))
+          have hpre' :
+              BIBase.sep (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt)
+                  (BIBase.sep IH
+                    (BIBase.wand (state_interp (M := M) (F := F) σ ns (κ ++ κs) nt)
+                      (fupd' W E maskEmpty P0))) ⊢
+                BIBase.sep IH (fupd' W E maskEmpty P0) := by
+            exact hassoc.trans (sep_mono (PROP := IProp GF) .rfl hpre0)
+          have hswap :
+              BIBase.sep IH (fupd' W E maskEmpty P0) ⊢
+                BIBase.sep (fupd' W E maskEmpty P0) IH :=
+            (sep_comm (PROP := IProp GF)
+              (P := IH)
+              (Q := fupd' W E maskEmpty P0)).1
+          have hpre'' :
+              BIBase.sep (state_interp σ ns (κ ++ κs) nt)
+                  (BIBase.sep IH
+                    (BIBase.wand (state_interp σ ns (κ ++ κs) nt)
+                      (fupd' W E maskEmpty P0))) ⊢
+                BIBase.sep (fupd' W E maskEmpty P0) IH :=
+            hpre'.trans hswap
+          have hframe :
+              BIBase.sep (fupd' W E maskEmpty P0) IH ⊢
+                fupd' W E maskEmpty (BIBase.sep P0 IH) :=
+            Iris.BaseLogic.fupd_frame_r 
+              (E1 := E) (E2 := maskEmpty)
+              (P := P0) (Q := IH)
+          have hpred :
+              ∀ σ, stuckness_pred s (K e) σ → stuckness_pred s e σ := by
+            intro σ
+            cases s <;> simp [stuckness_pred]
+            · intro hred
+              exact reducible_fill_inv (K := K) e σ hto hred
+          have hQ :
+              BIBase.sep Q1 IH ⊢ Q2 := by
+            refine forall_intro (PROP := IProp GF) ?_; intro e2
+            refine forall_intro (PROP := IProp GF) ?_; intro σ2
+            refine forall_intro (PROP := IProp GF) ?_; intro efs
+            refine wand_intro (PROP := IProp GF) ?_
+            -- lift the step through the context
+            have hstepK :
+                BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs) ⊢
+                  BIBase.pure (Λ.prim_step (K e) σ κ (K e2) σ2 efs) :=
+              pure_mono (PROP := IProp GF) <| by
+                intro hstep
+                exact LanguageCtx.fill_step (K := K) (e1 := e) (σ1 := σ) (κ := κ)
+                  (e2 := e2) (σ2 := σ2) (efs := efs) hstep
+            have hcont :
+                BIBase.sep Q1 (BIBase.pure (Λ.prim_step (K e) σ κ (K e2) σ2 efs)) ⊢
+                  fupd' W maskEmpty E
+                    (BIBase.later
+                      (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                        (BIBase.sep
+                          (wp_s W s E (K e2) Φ)
+                          (big_sepL (fun _ ef =>
+                            wp_s W s
+                              Iris.Set.univ ef fork_post) efs)))) := by
+              have h1 :=
+                forall_elim (PROP := IProp GF)
+                  (Ψ := fun e2 : Λ.expr =>
+                    BIBase.forall fun σ2 : Λ.state =>
+                      BIBase.forall fun efs : List Λ.expr =>
+                        BIBase.wand (BIBase.pure (Λ.prim_step (K e) σ κ e2 σ2 efs))
+                          (fupd' W maskEmpty E
+                            (BIBase.later
+                              (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                                (BIBase.sep
+                                  (wp_s W s E e2 Φ)
+                                  (big_sepL (fun _ ef =>
+                                    wp_s W s
+                                      Iris.Set.univ ef fork_post) efs)))))) (K e2)
+              have h2 :=
+                forall_elim (PROP := IProp GF)
+                  (Ψ := fun σ2 : Λ.state =>
+                    BIBase.forall fun efs : List Λ.expr =>
+                      BIBase.wand (BIBase.pure (Λ.prim_step (K e) σ κ (K e2) σ2 efs))
+                        (fupd' W maskEmpty E
+                          (BIBase.later
+                            (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                              (BIBase.sep
+                                (wp_s W s E (K e2) Φ)
+                                (big_sepL (fun _ ef =>
+                                  wp_s W s
+                                    Iris.Set.univ ef fork_post) efs)))))) σ2
+              have h3 :=
+                forall_elim (PROP := IProp GF)
+                  (Ψ := fun efs : List Λ.expr =>
+                    BIBase.wand (BIBase.pure (Λ.prim_step (K e) σ κ (K e2) σ2 efs))
+                      (fupd' W maskEmpty E
+                        (BIBase.later
+                          (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                            (BIBase.sep
+                              (wp_s W s E (K e2) Φ)
+                              (big_sepL (fun _ ef =>
+                                wp_s W s
+                                  Iris.Set.univ ef fork_post) efs)))))) efs
+              have h123 := h1.trans (h2.trans h3)
+              exact (sep_mono (PROP := IProp GF) h123 .rfl).trans
+                (wand_elim_l (PROP := IProp GF))
+            have happly :
+                BIBase.sep (BIBase.sep Q1 IH) (BIBase.pure (Λ.prim_step e σ κ e2 σ2 efs)) ⊢
+                  BIBase.sep
+                    (fupd' W maskEmpty E
+                      (BIBase.later
+                        (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                          (BIBase.sep
+                            (wp_s W s E (K e2) Φ)
+                            (big_sepL (fun _ ef =>
+                              wp_s W s
+                                Iris.Set.univ ef fork_post) efs)))))
+                    IH := by
+              refine (sep_mono (PROP := IProp GF) .rfl hstepK).trans ?_
+              -- swap IH to apply the continuation
+              have hswap :
+                  BIBase.sep (BIBase.sep Q1 IH)
+                      (BIBase.pure (Λ.prim_step (K e) σ κ (K e2) σ2 efs)) ⊢
+                    BIBase.sep (BIBase.sep Q1
+                        (BIBase.pure (Λ.prim_step (K e) σ κ (K e2) σ2 efs))) IH :=
+                (sep_right_comm (PROP := IProp GF) (P := Q1) (Q := IH)
+                  (R := BIBase.pure (Λ.prim_step (K e) σ κ (K e2) σ2 efs))).1
+              exact hswap.trans (sep_mono (PROP := IProp GF) hcont .rfl)
+            have hframe :
+                BIBase.sep
+                    (fupd' W maskEmpty E
+                      (BIBase.later
+                        (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                          (BIBase.sep
+                            (wp_s W s E (K e2) Φ)
+                            (big_sepL (fun _ ef =>
+                              wp_s W s
+                                Iris.Set.univ ef fork_post) efs)))))
+                    IH ⊢
+                  fupd' W maskEmpty E
+                    (BIBase.sep
+                      (BIBase.later
+                        (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                          (BIBase.sep
+                            (wp_s W s E (K e2) Φ)
+                            (big_sepL (fun _ ef =>
+                              wp_s W s
+                                Iris.Set.univ ef fork_post) efs))))
+                      IH) :=
+              Iris.BaseLogic.fupd_frame_r 
+                (E1 := maskEmpty) (E2 := E)
+                (P := BIBase.later
+                  (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                    (BIBase.sep
+                      (wp_s W s E (K e2) Φ)
+                      (big_sepL (fun _ ef =>
+                        wp_s W s
+                          Iris.Set.univ ef fork_post) efs))))
+                (Q := IH)
+            have hIHlater :
+                BIBase.sep IH
+                    (BIBase.later
+                      (wp_s W s E (K e2) Φ)) ⊢
+                  BIBase.later
+                    (wp_s W s E e2
+                      (fun v =>
+                        wp_s W s E
+                          (K (Λ.of_val v)) Φ)) := by
+              have hPelim' :
+                  BIBase.later P ⊢ BIBase.later
+                    (BIBase.wand
+                      (wp_s W s E (K e2) Φ)
+                      (wp_s W s E e2
+                        (fun v =>
+                          wp_s W s E
+                            (K (Λ.of_val v)) Φ))) :=
+                later_mono (hPelim (E := E) (e := e2) (Φ := Φ))
+              have hwand :
+                  IH ⊢ BIBase.later
+                    (BIBase.wand
+                      (wp_s W s E (K e2) Φ)
+                      (wp_s W s E e2
+                        (fun v =>
+                          wp_s W s E
+                            (K (Λ.of_val v)) Φ))) :=
+                (intuitionistically_elim (PROP := IProp GF) (P := BIBase.later P)).trans hPelim'
+              exact (sep_mono (PROP := IProp GF) hwand .rfl).trans
+                (later_wand_elim (P := wp_s W s E (K e2) Φ)
+                  (Q := wp_s W s E e2
+                    (fun v =>
+                      wp_s W s E
+                        (K (Λ.of_val v)) Φ)))
+            have hinner :
+                BIBase.sep
+                    (BIBase.later
+                      (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                        (BIBase.sep
+                          (wp_s W s E (K e2) Φ)
+                          (big_sepL (fun _ ef =>
+                            wp_s W s
+                              Iris.Set.univ ef fork_post) efs))))
+                    IH ⊢
+                  BIBase.later
+                    (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                      (BIBase.sep
+                        (wp_s W s E e2
+                          (fun v =>
+                            wp_s W s E
+                              (K (Λ.of_val v)) Φ))
+                        (big_sepL (fun _ ef =>
+                          wp_s W s
+                            Iris.Set.univ ef fork_post) efs))) := by
+              refine (sep_mono (PROP := IProp GF)
+                (later_sep (PROP := IProp GF)
+                  (P := state_interp σ2 (ns + 1) κs (efs.length + nt))
+                  (Q := BIBase.sep
+                    (wp_s W s E (K e2) Φ)
+                    (big_sepL (fun _ ef =>
+                      wp_s W s
+                        Iris.Set.univ ef fork_post) efs))).1 .rfl).trans ?_
+              refine (sep_assoc (PROP := IProp GF)
+                (P := BIBase.later (state_interp σ2 (ns + 1) κs (efs.length + nt)))
+                (Q := BIBase.later
+                  (BIBase.sep
+                    (wp_s W s E (K e2) Φ)
+                    (big_sepL (fun _ ef =>
+                      wp_s W s
+                        Iris.Set.univ ef fork_post) efs)))
+                (R := IH)).1.trans ?_
+              have hcont :
+                  BIBase.sep
+                      (BIBase.later
+                        (BIBase.sep
+                          (wp_s W s E (K e2) Φ)
+                          (big_sepL (fun _ ef =>
+                            wp_s W s
+                              Iris.Set.univ ef fork_post) efs)))
+                      IH ⊢
+                    BIBase.later
+                      (BIBase.sep
+                        (wp_s W s E e2
+                          (fun v =>
+                            wp_s W s E
+                              (K (Λ.of_val v)) Φ))
+                        (big_sepL (fun _ ef =>
+                          wp_s W s
+                            Iris.Set.univ ef fork_post) efs)) := by
+                refine (sep_mono (PROP := IProp GF)
+                  (later_sep (PROP := IProp GF)
+                    (P := wp_s W s E (K e2) Φ)
+                    (Q := big_sepL (fun _ ef =>
+                      wp_s W s
+                        Iris.Set.univ ef fork_post) efs)).1 .rfl).trans ?_
+                refine (sep_assoc (PROP := IProp GF)
+                  (P := BIBase.later
+                    (wp_s W s E (K e2) Φ))
+                  (Q := BIBase.later
+                    (big_sepL (fun _ ef =>
+                      wp_s W s
+                        Iris.Set.univ ef fork_post) efs))
+                  (R := IH)).1.trans ?_
+                -- move IH next to the main WP
+                have hswap :
+                    BIBase.sep
+                        (BIBase.later
+                          (wp_s W s E (K e2) Φ))
+                        (BIBase.sep
+                          (BIBase.later
+                            (big_sepL (fun _ ef =>
+                              wp_s W s
+                                Iris.Set.univ ef fork_post) efs))
+                          IH) ⊢
+                      BIBase.sep
+                        (BIBase.sep IH
+                          (BIBase.later
+                            (wp_s W s E (K e2) Φ)))
+                        (BIBase.later
+                          (big_sepL (fun _ ef =>
+                            wp_s W s
+                              Iris.Set.univ ef fork_post) efs)) := by
+                  refine (sep_assoc (PROP := IProp GF)
+                    (P := BIBase.later
+                      (wp_s W s E (K e2) Φ))
+                    (Q := BIBase.later
+                      (big_sepL (fun _ ef =>
+                        wp_s W s
+                          Iris.Set.univ ef fork_post) efs))
+                    (R := IH)).2.trans ?_
+                  refine (sep_right_comm (PROP := IProp GF)
+                    (P := BIBase.later
+                      (wp_s W s E (K e2) Φ))
+                    (Q := BIBase.later
+                      (big_sepL (fun _ ef =>
+                        wp_s W s
+                          Iris.Set.univ ef fork_post) efs))
+                    (R := IH)).1.trans ?_
+                  exact (sep_mono (PROP := IProp GF)
+                    (sep_comm (PROP := IProp GF)
+                      (P := BIBase.later
+                        (wp_s W s E (K e2) Φ))
+                      (Q := IH)).1 .rfl)
+                refine hswap.trans ?_
+                refine (sep_mono (PROP := IProp GF) hIHlater .rfl).trans ?_
+                exact (later_sep (PROP := IProp GF)
+                  (P := wp_s W s E e2
+                    (fun v =>
+                      wp_s W s E
+                        (K (Λ.of_val v)) Φ))
+                  (Q := big_sepL (fun _ ef =>
+                    wp_s W s
+                      Iris.Set.univ ef fork_post) efs)).2
+              refine (sep_mono (PROP := IProp GF) .rfl hcont).trans ?_
+              exact (later_sep (PROP := IProp GF)
+                (P := state_interp σ2 (ns + 1) κs (efs.length + nt))
+                (Q := BIBase.sep
+                  (wp_s W s E e2
+                    (fun v =>
+                      wp_s W s E
+                        (K (Λ.of_val v)) Φ))
+                  (big_sepL (fun _ ef =>
+                    wp_s W s
+                      Iris.Set.univ ef fork_post) efs))).2
+            have hmono :
+                fupd' W maskEmpty E
+                    (BIBase.sep
+                      (BIBase.later
+                        (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                          (BIBase.sep
+                            (wp_s W s E (K e2) Φ)
+                            (big_sepL (fun _ ef =>
+                              wp_s W s
+                                Iris.Set.univ ef fork_post) efs))))
+                      IH) ⊢
+                  fupd' W maskEmpty E
+                    (BIBase.later
+                      (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                        (BIBase.sep
+                          (wp_s W s E e2
+                            (fun v =>
+                              wp_s W s E
+                                (K (Λ.of_val v)) Φ))
+                          (big_sepL (fun _ ef =>
+                            wp_s W s
+                              Iris.Set.univ ef fork_post) efs)))) :=
+              Iris.BaseLogic.fupd_mono 
+                (E1 := maskEmpty) (E2 := E)
+                (P := BIBase.sep
+                  (BIBase.later
+                    (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                      (BIBase.sep
+                        (wp_s W s E (K e2) Φ)
+                        (big_sepL (fun _ ef =>
+                          wp_s W s
+                            Iris.Set.univ ef fork_post) efs))))
+                  IH)
+                (Q := BIBase.later
+                  (BIBase.sep (state_interp σ2 (ns + 1) κs (efs.length + nt))
+                    (BIBase.sep
+                      (wp_s W s E e2
+                        (fun v =>
+                          wp_s W s E
+                            (K (Λ.of_val v)) Φ))
+                      (big_sepL (fun _ ef =>
+                        wp_s W s
+                          Iris.Set.univ ef fork_post) efs)))) hinner
+            exact (happly.trans (hframe.trans hmono))
+          have hpost :
+              BIBase.sep P0 IH ⊢ P1 := by
+            dsimp [P0, P1]
+            refine (sep_assoc (PROP := IProp GF)
+              (P := BIBase.pure (stuckness_pred s (K e) σ)) (Q := Q1) (R := IH)).1.trans ?_
+            exact sep_mono (PROP := IProp GF)
+              (pure_mono (PROP := IProp GF) (hpred σ)) hQ
+          have hmono :
+              fupd' W E maskEmpty (BIBase.sep P0 IH) ⊢
+                fupd' W E maskEmpty P1 :=
+            Iris.BaseLogic.fupd_mono 
+              (E1 := E) (E2 := maskEmpty)
+              (P := BIBase.sep P0 IH) (Q := P1) hpost
+          have hswap0 :
+              BIBase.sep (BIBase.sep IH
+                    (BIBase.wand (state_interp σ ns (κ ++ κs) nt)
+                      (fupd' W E maskEmpty P0)))
+                (state_interp σ ns (κ ++ κs) nt) ⊢
+                BIBase.sep (state_interp σ ns (κ ++ κs) nt)
+                  (BIBase.sep IH
+                    (BIBase.wand (state_interp σ ns (κ ++ κs) nt)
+                      (fupd' W E maskEmpty P0))) :=
+            (sep_comm (PROP := IProp GF)
+              (P := BIBase.sep IH
+                (BIBase.wand (state_interp σ ns (κ ++ κs) nt)
+                  (fupd' W E maskEmpty P0)))
+              (Q := state_interp σ ns (κ ++ κs) nt)).1
+          exact hswap0.trans (hpre''.trans (hframe.trans hmono))
+        exact hpre.trans hwpK
+  have hstep_box :
+      BIBase.intuitionistically (BIBase.later P) ⊢ BIBase.intuitionistically P :=
+    intuitionistically_intro' (P := BIBase.later P) (Q := P) hstep
+  have hlater :
+      BIBase.later (BIBase.intuitionistically P) ⊢
+        BIBase.intuitionistically (BIBase.later P) :=
+    (later_intuitionistically (PROP := IProp GF) (P := P)).2
+  have hloop :
+      BIBase.later (BIBase.intuitionistically P) ⊢ BIBase.intuitionistically P :=
+    hlater.trans hstep_box
+  have hloeb :
+      (True : IProp GF) ⊢ BIBase.intuitionistically P :=
+    BILoeb.loeb_weak (PROP := IProp GF) (P := BIBase.intuitionistically P) hloop
+  have hP : (True : IProp GF) ⊢ P :=
+    hloeb.trans (intuitionistically_elim (PROP := IProp GF) (P := P))
+  have hwand :
+      (True : IProp GF) ⊢
+        BIBase.wand
+          (wp_s W s E (K e) Φ)
+          (wp_s W s E e
+            (fun v => wp_s W s E
+              (K (Λ.of_val v)) Φ)) :=
+    hP.trans (hPelim (E := E) (e := e) (Φ := Φ))
+  have hframe :
+      wp_s W s E (K e) Φ ⊢
+        BIBase.sep
+          (BIBase.wand
+            (wp_s W s E (K e) Φ)
+            (wp_s W s E e
+              (fun v => wp_s W s E
+                (K (Λ.of_val v)) Φ)))
+          (wp_s W s E (K e) Φ) := by
+    refine (true_sep_2 (PROP := IProp GF)
+      (P := wp_s W s E (K e) Φ)).trans ?_
+    exact sep_mono (PROP := IProp GF) hwand .rfl
+  exact hframe.trans (wand_elim_l (PROP := IProp GF))
+
+/-! ## Derived Rules -/
+
+/-- Monotonicity in postcondition.
+Coq: `wp_mono` in `weakestpre.v`. -/
+theorem wp_mono (s : Stuckness) (E : Iris.Set Positive)
+    (e : Λ.expr) (Φ Ψ : Λ.val → IPropWsat GF M F)
+    (h : ∀ v, Φ v ⊢ Ψ v) :
+    wp_s W s E e Φ ⊢
+      wp_s W s E e Ψ :=
+  by
+  -- use strong monotonicity with a pure postcondition transformer
+  have hS : stuckness_le s s := by
+    cases s <;> simp [stuckness_le]
+  have hE : Subset E E := by
+    intro i hi; exact hi
+  have hmono :=
+    wp_strong_mono (W := W) (s1 := s) (s2 := s) (E1 := E) (E2 := E) (e := e)
+      (Φ := Φ) (Ψ := Ψ) hS hE
+  have hpost :
+      (True : IProp GF) ⊢ wp_post W E Φ Ψ := by
+    -- lift the pointwise entailment under `fupd`
+    refine forall_intro ?_; intro v
+    have hΦ :
+        Φ v ⊢ fupd' W E E (Ψ v) :=
+      (h v).trans
+        (fupd_intro (E := E) (P := Ψ v))
+    exact (wand_rfl (P := Φ v)).trans
+      (wand_mono_r (PROP := IProp GF) (h := hΦ))
+  have hframe :
+      wp_s W s E e Φ ⊢
+        BIBase.sep
+          (wp_post W E Φ Ψ)
+          (wp_s W s E e Φ) := by
+    -- add the postcondition transformer via `True`
+    refine (true_sep_2 (PROP := IProp GF)
+      (P := wp_s W s E e Φ)).trans ?_
+    exact sep_mono hpost .rfl
+  refine hframe.trans ?_
+  refine (sep_mono (PROP := IProp GF)
+    (P := wp_post W E Φ Ψ)
+    (Q := wp_post W E Φ Ψ)
+    (P' := wp_s W s E e Φ)
+    (Q' := BIBase.wand
+      (wp_post W E Φ Ψ)
+      (wp_s W s E e Ψ)) .rfl hmono).trans ?_
+  exact wand_elim_r (PROP := IProp GF)
+
+/-- Frame rule (left).
+Coq: `wp_frame_l` in `weakestpre.v`. -/
+theorem wp_frame_l (s : Stuckness) (E : Iris.Set Positive)
+    (e : Λ.expr) (Φ : Λ.val → IPropWsat GF M F) (R : IProp GF) :
+    BIBase.sep R (wp_s W s E e Φ) ⊢
+    wp_s W s E e (fun v => BIBase.sep R (Φ v)) :=
+  by
+  -- use strong monotonicity and frame `R` into the postcondition
+  have hS : stuckness_le s s := by
+    cases s <;> simp [stuckness_le]
+  have hE : Subset E E := by
+    intro i hi; exact hi
+  have hmono :=
+    wp_strong_mono (W := W) (s1 := s) (s2 := s) (E1 := E) (E2 := E) (e := e)
+      (Φ := Φ) (Ψ := fun v => BIBase.sep R (Φ v)) hS hE
+  have hpost :
+      R ⊢
+        wp_post W E Φ
+          (fun v => BIBase.sep R (Φ v)) := by
+    -- build the transformer `Φ v -∗ |={E}=> R ∗ Φ v` from `R`
+    refine forall_intro ?_; intro v
+    refine wand_intro ?_
+    exact fupd_intro (E := E)
+      (P := BIBase.sep R (Φ v))
+  have hframe :
+      BIBase.sep R (wp_s W s E e Φ) ⊢
+        BIBase.sep
+          (wp_post W E Φ
+            (fun v => BIBase.sep R (Φ v)))
+          (wp_s W s E e Φ) :=
+    sep_mono hpost .rfl
+  refine hframe.trans ?_
+  refine (sep_mono (PROP := IProp GF)
+    (P := wp_post W E Φ
+      (fun v => BIBase.sep R (Φ v)))
+    (Q := wp_post W E Φ
+      (fun v => BIBase.sep R (Φ v)))
+    (P' := wp_s W s E e Φ)
+    (Q' := BIBase.wand
+      (wp_post W E Φ
+        (fun v => BIBase.sep R (Φ v)))
+      (wp_s W s E e
+        (fun v => BIBase.sep R (Φ v)))) .rfl hmono).trans ?_
+  exact wand_elim_r (PROP := IProp GF)
+
+/-- Frame rule (right).
+Coq: `wp_frame_r` in `weakestpre.v`. -/
+theorem wp_frame_r (s : Stuckness) (E : Iris.Set Positive)
+    (e : Λ.expr) (Φ : Λ.val → IPropWsat GF M F) (R : IProp GF) :
+    BIBase.sep (wp_s W s E e Φ) R ⊢
+    wp_s W s E e (fun v => BIBase.sep (Φ v) R) :=
+  by
+  -- mirror the left frame rule using commutativity
+  have hS : stuckness_le s s := by
+    cases s <;> simp [stuckness_le]
+  have hE : Subset E E := by
+    intro i hi; exact hi
+  have hmono :=
+    wp_strong_mono (W := W) (s1 := s) (s2 := s) (E1 := E) (E2 := E) (e := e)
+      (Φ := Φ) (Ψ := fun v => BIBase.sep (Φ v) R) hS hE
+  have hpost :
+      R ⊢
+        wp_post W E Φ
+          (fun v => BIBase.sep (Φ v) R) := by
+    -- build the transformer `Φ v -∗ |={E}=> Φ v ∗ R` from `R`
+    refine forall_intro ?_; intro v
+    refine wand_intro ?_
+    exact (sep_comm (PROP := IProp GF)
+      (P := R) (Q := Φ v)).1.trans
+        (fupd_intro (E := E)
+          (P := BIBase.sep (Φ v) R))
+  have hswap :
+      BIBase.sep (wp_s W s E e Φ) R ⊢
+        BIBase.sep R (wp_s W s E e Φ) :=
+    (sep_comm (PROP := IProp GF)
+      (P := wp_s W s E e Φ) (Q := R)).1
+  have hframe :
+      BIBase.sep R (wp_s W s E e Φ) ⊢
+        BIBase.sep
+          (wp_post W E Φ
+            (fun v => BIBase.sep (Φ v) R))
+          (wp_s W s E e Φ) :=
+    sep_mono hpost .rfl
+  refine hswap.trans ?_
+  refine hframe.trans ?_
+  refine (sep_mono (PROP := IProp GF)
+    (P := wp_post W E Φ
+      (fun v => BIBase.sep (Φ v) R))
+    (Q := wp_post W E Φ
+      (fun v => BIBase.sep (Φ v) R))
+    (P' := wp_s W s E e Φ)
+    (Q' := BIBase.wand
+      (wp_post W E Φ
+        (fun v => BIBase.sep (Φ v) R))
+      (wp_s W s E e
+        (fun v => BIBase.sep (Φ v) R))) .rfl hmono).trans ?_
+  exact wand_elim_r (PROP := IProp GF)
+
+/-- Wand rule: weaken postcondition via wand.
+Coq: `wp_wand` in `weakestpre.v`. -/
+theorem wp_wand (s : Stuckness) (E : Iris.Set Positive)
+    (e : Λ.expr) (Φ Ψ : Λ.val → IPropWsat GF M F) :
+    wp_s W s E e Φ ⊢
+    BIBase.wand
+      (BIBase.forall fun v => BIBase.wand (Φ v) (Ψ v))
+      (wp_s W s E e Ψ) :=
+  by
+  -- use strong monotonicity and lift the wand under `fupd`
+  have hS : stuckness_le s s := by
+    cases s <;> simp [stuckness_le]
+  have hE : Subset E E := by
+    intro i hi; exact hi
+  have hmono :=
+    wp_strong_mono (W := W) (s1 := s) (s2 := s) (E1 := E) (E2 := E) (e := e)
+      (Φ := Φ) (Ψ := Ψ) hS hE
+  refine wand_intro ?_
+  -- turn the wand assumption into a `wp_post`, then eliminate
+  have hpost :
+      BIBase.forall (PROP := IProp GF) (fun v => BIBase.wand (Φ v) (Ψ v)) ⊢
+        wp_post W E Φ Ψ := by
+    refine forall_mono ?_; intro v
+    refine (wand_mono_r (PROP := IProp GF)) ?_
+    exact fupd_intro (E := E) (P := Ψ v)
+  -- swap to `H1 ∗ wp_s W` before applying the transformer
+  refine (sep_comm (PROP := IProp GF)
+    (P := wp_s W s E e Φ)
+    (Q := BIBase.forall (PROP := IProp GF) (fun v => BIBase.wand (Φ v) (Ψ v)))).1.trans ?_
+  refine (sep_mono hpost .rfl).trans ?_
+  refine (sep_mono (PROP := IProp GF)
+    (P := wp_post W E Φ Ψ)
+    (Q := wp_post W E Φ Ψ)
+    (P' := wp_s W s E e Φ)
+    (Q' := BIBase.wand
+      (wp_post W E Φ Ψ)
+      (wp_s W s E e Ψ)) .rfl hmono).trans ?_
+  exact wand_elim_r (PROP := IProp GF)
+
+/-- Atomic expression rule: open invariants around an atomic step.
+Coq: `wp_atomic` in `weakestpre.v`. -/
+theorem wp_atomic (s : Stuckness) (E1 E2 : Iris.Set Positive)
+    (e : Λ.expr) (Φ : Λ.val → IPropWsat GF M F)
+    [Atomic (match s with | .notStuck => .stronglyAtomic | .maybeStuck => .weaklyAtomic) e] :
+    E1 = E2 →
+    fupd' W E1 E2
+      (wp_s W s E2 e
+        (fun v => fupd' W E2 E1 (Φ v))) ⊢
+    wp_s W s E1 e Φ :=
+  by
+  intro hE
+  subst hE
+  refine (fupd_wp (s := s) (E := E1) (e := e)
+    (Φ := fun v => fupd' W E1 E1 (Φ v))).trans ?_
+  exact wp_fupd (s := s) (E := E1) (e := e) (Φ := Φ)
+
+end Iris.ProgramLogic
diff --git a/src/Iris/ProofMode/Classes.lean b/src/Iris/ProofMode/Classes.lean
index 9b135979..dcdf05d6 100644
--- a/src/Iris/ProofMode/Classes.lean
+++ b/src/Iris/ProofMode/Classes.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Lars König
 -/
 import Iris.BI
+import Iris.Std.Namespace
 import Iris.ProofMode.SynthInstance
 
 namespace Iris.ProofMode
@@ -147,4 +148,26 @@ class IntoExcept0 [BI PROP] (P : PROP) (Q : outParam PROP) where
   into_except0 : P ⊢ ◇ Q
 export IntoExcept0 (into_except0)
 
+/-! ## Invariants and Accessors -/
+
+/-- Extract the namespace associated with an invariant assertion. -/
+@[ipm_class]
+class IntoInv [BI PROP] (P : PROP) (N : outParam Namespace) : Prop where
+  -- marker class: no fields, only carries the namespace
+
+/-- Accessor packaging for proof mode elimination. -/
+def accessor [BI PROP] {X : Type _} (M1 M2 : PROP → PROP)
+    (α β : X → PROP) (mγ : X → Option PROP) : PROP :=
+  -- `default emp` (via `Option.getD`) when no closing shift is provided.
+  M1 (BIBase.exists fun x =>
+    BIBase.sep (α x)
+      (BIBase.wand (β x) (M2 (Option.getD (mγ x) (BIBase.emp)))))
+
+/-- Typeclass for assertions that can be turned into accessors. -/
+@[ipm_class]
+class IntoAcc [BI PROP] {X : Type _} (Pacc : PROP) (φ : Prop) (Pin : PROP)
+    (M1 M2 : PROP → PROP) (α β : X → PROP) (mγ : X → Option PROP) : Prop where
+  -- Produce an accessor under the required side-condition.
+  into_acc : φ → Pacc ⊢ Pin -∗ accessor M1 M2 α β mγ
+
 end Iris.ProofMode
diff --git a/src/Iris/ProofMode/Instances.lean b/src/Iris/ProofMode/Instances.lean
index 108e310c..954ecd93 100644
--- a/src/Iris/ProofMode/Instances.lean
+++ b/src/Iris/ProofMode/Instances.lean
@@ -109,6 +109,10 @@ instance intoForall_intuitionistically [BI PROP] (P : PROP) (Φ : α → PROP)
     [h : IntoForall P Φ] : IntoForall iprop(□ P) (fun a => iprop(□ (Φ a))) where
   into_forall := (intuitionistically_mono h.1).trans intuitionistically_forall_1
 
+instance intoForall_persistently [BI PROP] (P : PROP) (Φ : α → PROP)
+    [h : IntoForall P Φ] : IntoForall iprop(<pers> P) (fun a => iprop(<pers> (Φ a))) where
+  into_forall := (persistently_mono h.1).trans persistently_forall_1
+
 instance intoForall_wand_pure [BI PROP] (P Q : PROP) Φ
     [h : FromPure a P Φ] : IntoForall iprop(P -∗ Q) (fun _ : Φ => Q) where
   into_forall := forall_intro λ hΦ =>
@@ -141,6 +145,9 @@ instance fromExists_persistently [BI PROP] (P : PROP) (Φ : α → PROP) [h : Fr
   from_exists := persistently_exists.2.trans <| persistently_mono h.1
 
 -- IntoExists
+instance intoExists_base [BI PROP] (Φ : α → PROP) :
+    IntoExists (BIBase.exists Φ) Φ := ⟨.rfl⟩
+
 instance intoExists_exists [BI PROP] (Φ : α → PROP) : IntoExists (BI.exists Φ) Φ := ⟨.rfl⟩
 
 instance intoExists_pure (φ : α → Prop) [BI PROP] :
diff --git a/src/Iris/Std.lean b/src/Iris/Std.lean
index 1b2f1422..cbd6f172 100644
--- a/src/Iris/Std.lean
+++ b/src/Iris/Std.lean
@@ -1,12 +1,18 @@
+import Iris.Std.CoPset
 import Iris.Std.Classes
 import Iris.Std.Expr
+import Iris.Std.GSet
 import Iris.Std.Heap
 import Iris.Std.HeapInstances
 import Iris.Std.Infinite
+import Iris.Std.Namespace
 import Iris.Std.Nat
+import Iris.Std.Positive
 import Iris.Std.Prod
 import Iris.Std.Qq
 import Iris.Std.Rewrite
 import Iris.Std.Tactic
 import Iris.Std.TC
 import Iris.Std.Try
+import Iris.Std.FiniteMap
+import Iris.Std.List
diff --git a/src/Iris/Std/CoPset.lean b/src/Iris/Std/CoPset.lean
new file mode 100644
index 00000000..ce5c193a
--- /dev/null
+++ b/src/Iris/Std/CoPset.lean
@@ -0,0 +1,215 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+
+import Iris.Std.Positive
+
+/-! # Co-finite Powerset of Invariant Names
+
+Reference: `stdpp/theories/coPset.v`
+
+Invariant masks track which invariants are currently enabled or available for
+opening. A mask is a (potentially co-finite) set of invariant names. The fancy
+update modality `|={E1,E2}=> P` uses masks to prevent double-opening: opening
+an invariant removes its name from the mask, and closing it adds the name back.
+
+We use a predicate-based representation rather than a literal co-finite `Finset`.
+This is sufficient for mask reasoning and disjointness but does not provide
+decidable membership — classical decidability is used where needed.
+
+## Main Definitions
+
+- `CoPset` — set of invariant names, represented as a membership predicate
+- Set operations: `empty`, `top`, `union`, `inter`, `diff`, `compl`, `singleton`
+- Predicates: `Disjoint`, `Subset`
+
+## Main Results
+
+- `union_assoc`, `union_comm`, `empty_union` — union forms a commutative monoid
+- `subseteq_disjoint_union` — any subset decomposes into a disjoint union
+-/
+
+namespace Iris
+
+/-! ## Definition -/
+
+/-- Co-finite powerset of invariant names. Used for invariant masks. -/
+structure CoPset where
+  /-- Membership predicate. -/
+  mem : Positive → Prop
+
+namespace CoPset
+
+@[ext]
+theorem ext {s₁ s₂ : CoPset} (h : ∀ n, s₁.mem n ↔ s₂.mem n) : s₁ = s₂ := by
+  -- extensionality for predicate-based sets
+  cases s₁; cases s₂; simp only [mk.injEq]
+  exact funext fun n => propext (h n)
+
+/-! ## Basic Constructors -/
+
+def empty : CoPset := by
+  -- empty set: always false
+  exact ⟨fun _ => False⟩
+
+def top : CoPset := by
+  -- top set: always true
+  exact ⟨fun _ => True⟩
+
+def singleton (n : Positive) : CoPset := by
+  -- singleton membership
+  exact ⟨fun m => m = n⟩
+
+instance : EmptyCollection CoPset := ⟨empty⟩
+instance : Singleton Positive CoPset := ⟨singleton⟩
+
+/-! ## Set Operations -/
+
+def union (s₁ s₂ : CoPset) : CoPset := by
+  -- union membership via disjunction
+  exact ⟨fun n => s₁.mem n ∨ s₂.mem n⟩
+
+def inter (s₁ s₂ : CoPset) : CoPset := by
+  -- intersection membership via conjunction
+  exact ⟨fun n => s₁.mem n ∧ s₂.mem n⟩
+
+def diff (s₁ s₂ : CoPset) : CoPset := by
+  -- set difference: left membership and not right membership
+  exact ⟨fun n => s₁.mem n ∧ ¬s₂.mem n⟩
+
+def compl (s : CoPset) : CoPset := by
+  -- complement: negate membership
+  exact ⟨fun n => ¬s.mem n⟩
+
+instance : Union CoPset := ⟨union⟩
+instance : Inter CoPset := ⟨inter⟩
+instance : SDiff CoPset := ⟨diff⟩
+
+/-! ## Predicates -/
+
+/-- Two sets are disjoint if they share no elements. -/
+def Disjoint (s₁ s₂ : CoPset) : Prop := by
+  -- disjointness means no shared element
+  exact ∀ n, ¬(s₁.mem n ∧ s₂.mem n)
+
+/-- Subset relation. -/
+def Subset (s₁ s₂ : CoPset) : Prop := by
+  -- subset means elementwise implication
+  exact ∀ n, s₁.mem n → s₂.mem n
+
+instance : HasSubset CoPset := ⟨Subset⟩
+
+noncomputable instance (s₁ s₂ : CoPset) : Decidable (Disjoint s₁ s₂) := by
+  -- classical decidability for predicate-based disjointness
+  exact Classical.propDecidable _
+
+/-! ## Simp Lemmas -/
+
+@[simp] theorem mem_empty (n : Positive) : (∅ : CoPset).mem n ↔ False := by
+  -- unfold empty membership
+  rfl
+
+@[simp] theorem mem_top (n : Positive) : CoPset.top.mem n ↔ True := by
+  -- unfold top membership
+  rfl
+
+@[simp] theorem mem_singleton (n m : Positive) : ({m} : CoPset).mem n ↔ n = m := by
+  -- unfold singleton membership
+  rfl
+
+@[simp] theorem mem_union (s₁ s₂ : CoPset) (n : Positive) :
+    (s₁ ∪ s₂).mem n ↔ s₁.mem n ∨ s₂.mem n := by
+  -- unfold union membership
+  rfl
+
+@[simp] theorem mem_inter (s₁ s₂ : CoPset) (n : Positive) :
+    (s₁ ∩ s₂).mem n ↔ s₁.mem n ∧ s₂.mem n := by
+  -- unfold intersection membership
+  rfl
+
+@[simp] theorem mem_diff (s₁ s₂ : CoPset) (n : Positive) :
+    (s₁ \ s₂).mem n ↔ s₁.mem n ∧ ¬s₂.mem n := by
+  -- unfold difference membership
+  rfl
+
+@[simp] theorem mem_compl (s : CoPset) (n : Positive) :
+    s.compl.mem n ↔ ¬s.mem n := by
+  -- unfold complement membership
+  rfl
+
+/-! ## Set Algebra Laws -/
+
+theorem union_assoc (s₁ s₂ s₃ : CoPset) : s₁ ∪ s₂ ∪ s₃ = s₁ ∪ (s₂ ∪ s₃) := by
+  -- associativity of union via propositional associativity
+  ext n; simp [or_assoc]
+
+theorem union_comm (s₁ s₂ : CoPset) : s₁ ∪ s₂ = s₂ ∪ s₁ := by
+  -- commutativity of union via propositional commutativity
+  ext n; simp [or_comm]
+
+theorem union_empty (s : CoPset) : s ∪ ∅ = s := by
+  -- right identity of union
+  ext n; simp
+
+theorem empty_union (s : CoPset) : ∅ ∪ s = s := by
+  -- left identity of union
+  ext n; simp
+
+theorem union_idem (s : CoPset) : s ∪ s = s := by
+  -- idempotence of union
+  ext n; simp [or_self]
+
+/-! ## Subset Lemmas -/
+
+theorem subset_refl (s : CoPset) : s ⊆ s := by
+  -- subset reflexivity
+  intro _ h; exact h
+
+theorem subset_union_left (s₁ s₂ : CoPset) : s₁ ⊆ s₁ ∪ s₂ := by
+  -- left subset into union
+  intro _ h; exact Or.inl h
+
+theorem subset_union_right (s₁ s₂ : CoPset) : s₂ ⊆ s₁ ∪ s₂ := by
+  -- right subset into union
+  intro _ h; exact Or.inr h
+
+/-! ## Disjointness Lemmas -/
+
+theorem disjoint_comm {s₁ s₂ : CoPset} : Disjoint s₁ s₂ ↔ Disjoint s₂ s₁ := by
+  -- symmetry by swapping conjuncts
+  refine ⟨?_, ?_⟩
+  · intro h n hn
+    exact h n ⟨hn.2, hn.1⟩
+  · intro h n hn
+    exact h n ⟨hn.2, hn.1⟩
+
+
+theorem disjoint_empty_right (s : CoPset) : Disjoint s ∅ := by
+  -- empty set is disjoint on the right
+  intro _ hn; exact hn.2
+
+
+theorem disjoint_empty_left (s : CoPset) : Disjoint ∅ s := by
+  -- empty set is disjoint on the left
+  intro _ hn; exact hn.1
+
+/-- Any subset can be decomposed as a disjoint union with the set difference. -/
+theorem subseteq_disjoint_union {s₁ s₂ : CoPset} (h : s₁ ⊆ s₂) :
+    ∃ s₃, s₂ = s₁ ∪ s₃ ∧ Disjoint s₁ s₃ := by
+  -- choose the set difference as the disjoint complement
+  refine ⟨s₂ \ s₁, ?_, ?_⟩
+  · ext n; simp; constructor
+    · intro hn
+      by_cases h₁ : s₁.mem n
+      · exact Or.inl h₁
+      · exact Or.inr ⟨hn, h₁⟩
+    · rintro (h₁ | ⟨h₂, _⟩)
+      · exact h _ h₁
+      · exact h₂
+  · exact fun _ ⟨h₁, _, h₃⟩ => h₃ h₁
+
+end CoPset
+
+end Iris
diff --git a/src/Iris/Std/FiniteMap.lean b/src/Iris/Std/FiniteMap.lean
new file mode 100644
index 00000000..4385cdae
--- /dev/null
+++ b/src/Iris/Std/FiniteMap.lean
@@ -0,0 +1,1388 @@
+/-
+Copyright (c) 2026 Zongyuan Liu. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Zongyuan Liu
+-/
+
+import Iris.Std.List
+
+/-! ## Abstract Finite Map Interface
+
+This file defines an abstract interface for finite maps, inspired by stdpp's `fin_maps`. -/
+
+namespace Iris.Std
+
+/-- The type `M` represents a finite map from keys of type `K` to values of type `V`. -/
+class FiniteMap (K : outParam (Type u)) (M : Type u' → Type _) where
+  /-- Lookup a key in the map, returning `none` if not present.
+      Corresponds to Rocq's `lookup`. -/
+  get? : M V → K → Option V
+  /-- Insert or update a key-value pair.
+      Corresponds to Rocq's `insert`. -/
+  insert : M V → K → V → M V
+  /-- Remove a key from the map.
+      Corresponds to Rocq's `delete`. -/
+  delete : M V → K → M V
+  /-- The empty map. -/
+  empty : M V
+  /-- Convert the map to a list of key-value pairs.
+      Corresponds to Rocq's `map_to_list`. -/
+  toList : M V → List (K × V)
+  /-- Construct a map from a list of key-value pairs.
+      Corresponds to Rocq's `list_to_map`. -/
+  ofList : List (K × V) → M V
+  /-- Fold over all key-value pairs in the map.
+      The order of folding depends on the internal representation.
+      Corresponds to Rocq's `map_fold`. -/
+  fold {A : Type u'} : (K → V → A → A) → A → M V → A
+
+export FiniteMap (get? insert delete toList ofList fold)
+
+namespace FiniteMap
+
+variable {K : Type u} {V : Type u'} {M : Type u' → Type _} [FiniteMap K M]
+
+/-- Empty map instance for `∅` notation. -/
+instance : EmptyCollection (M V) := ⟨empty⟩
+
+/-- Singleton map containing exactly one key-value pair.
+    Corresponds to Rocq's `{[ i := x ]}` notation. -/
+def singleton (k : K) (v : V) : M V := insert ∅ k v
+
+/-- Union of two maps (left-biased: values from `m₁` take precedence).
+    Corresponds to Rocq's `m₁ ∪ m₂`. -/
+def union (m₁ m₂ : M V) : M V:=
+  (toList m₁).foldl (fun acc (k, v) => insert acc k v) m₂
+
+instance : Union (M V):= ⟨union⟩
+
+/-- Two maps have disjoint domains.
+    Corresponds to Rocq's `map_disjoint`. -/
+def disjoint (m₁ m₂ : M V) : Prop := ∀ k, ¬((get? m₁ k).isSome ∧ (get? m₂ k).isSome)
+
+/-- Submap relation: `m₁` is a submap of `m₂` if every key-value pair in `m₁` is also in `m₂`.
+    Corresponds to Rocq's `map_subseteq`. -/
+def submap (m₁ m₂ : M V) : Prop := ∀ k v, get? m₁ k = some v → get? m₂ k = some v
+
+instance : HasSubset (M V) := ⟨submap⟩
+
+/-- Map a function over all values in the map.
+    Corresponds to Rocq's `fmap` (notation `f <$> m`). -/
+def map (f : V → V') : M V → (M V') :=
+  fun m => ofList ((toList m).map (fun (k, v) => (k, f v)))
+
+/-- Filter and map: apply a function that can optionally drop entries.
+    Corresponds to Rocq's `omap`. -/
+def filterMap (f : V → Option V') : M V → M V' :=
+  fun m => ofList ((toList m).filterMap (fun (k, v) => (f v).map (k, ·)))
+
+/-- Filter entries by a predicate on key-value pairs.
+    Corresponds to Rocq's `filter`. -/
+def filter (φ : K → V → Bool) : M V → M V :=
+  fun m => ofList ((toList m).filter (fun (k, v) => φ k v))
+
+/-- Zip two maps with a combining function.
+    Corresponds to Rocq's `map_zip_with`. -/
+def zipWith {V' : Type _} {V'' : Type _} (f : V → V' → V'') (m₁ : M V) (m₂ : M V') : M V'' :=
+  ofList ((toList m₁).filterMap (fun (k, v) =>
+    match get? m₂ k with
+    | some v' => some (k, f v v')
+    | none => none))
+
+/-- Zip two maps: combine values at matching keys into pairs.
+    This is `zipWith Prod.mk`.
+    Corresponds to Rocq's `map_zip`. -/
+def zip (m₁ : M V) (m₂ : M V') : M (V × V') :=
+  zipWith Prod.mk m₁ m₂
+
+/-- Membership: a key is in the map if it has a value. -/
+def mem (m : M V) (k : K) : Prop := (get? m k).isSome
+
+/-- Difference: remove all keys in `m₂` from `m₁`.
+    Corresponds to Rocq's `map_difference`. -/
+def difference (m₁ m₂ : M V) : M V :=
+  ofList ((toList m₁).filter (fun (k, _) => (get? m₂ k).isNone))
+
+instance : SDiff (M V) := ⟨difference⟩
+
+/-- Transform keys of a map using an injective function.
+    Corresponds to Rocq's `kmap`. -/
+def kmap {K' : Type u} {M' : Type u' → _} [FiniteMap K' M'] (f : K → K') (m : M V) : (M' V) :=
+  ofList ((toList m).map (fun (k, v) => (f k, v)))
+
+/-- Convert a list to a map with sequential natural number keys starting from `start`.
+    Corresponds to Rocq's `map_seq`. -/
+def map_seq [FiniteMap Nat M] (start : Nat) (l : List V) : M V :=
+  ofList (l.mapIdx (fun i v => (start + i, v)))
+
+/-- Check if a key is the first key in the map's `toList` representation.
+    Corresponds to Rocq's `map_first_key`: `∃ x, map_to_list m !! 0 = Some (i,x)`. -/
+def firstKey (m : M V) (i : K) : Prop :=
+  ∃ x, (toList m).head? = some (i, x)
+
+/-- Corresponds to Rocq's `map_Forall`. -/
+def Forall (P : K → V → Prop) (m : M V) : Prop :=
+  ∀ k v, get? m k = some v → P k v
+
+end FiniteMap
+
+/-- Notation for singleton map: `{[k := v]}` -/
+scoped syntax "{[" term " := " term "]}" : term
+
+scoped macro_rules
+  | `({[$k := $v]}) => `(FiniteMap.singleton $k $v)
+
+/-- Notation for map disjointness: `m₁ ##ₘ m₂` -/
+scoped infix:50 " ##ₘ " => FiniteMap.disjoint
+
+/-- Membership instance for finite maps: `k ∈ m` means the key `k` is in the map `m`. -/
+instance  {K : Type u} {M : Type u' → Type _}  [inst : FiniteMap K M] : Membership K (M V) :=
+  ⟨fun (m : M V) (k : K) => (inst.get? m k).isSome⟩
+
+/-- Laws that a finite map implementation must satisfy. -/
+class FiniteMapLaws (K : (outParam (Type u))) (M : Type u' → Type _)
+    [DecidableEq K] [FiniteMap K M] where
+  /-- Corresponds to Rocq's `map_eq`. -/
+  ext : ∀ (m₁ m₂ : M V), (∀ i, get? m₁ i = get? m₂ i) → m₁ = m₂
+  /-- Corresponds to Rocq's `lookup_empty`. -/
+  get?_empty : ∀ k, get? (∅ : M V) k = none
+  /-- Corresponds to Rocq's `lookup_insert_eq`. -/
+  get?_insert_same : ∀ (m : M V) k v, get? (insert m k v) k = some v
+  /-- Corresponds to Rocq's `lookup_insert_ne`. -/
+  get?_insert_ne : ∀ (m : M V) k k' v, k ≠ k' → get? (insert m k v) k' = get? m k'
+  /-- Corresponds to Rocq's `lookup_delete_eq`. -/
+  get?_delete_same : ∀ (m : M V) k, get? (delete m k) k = none
+  /-- Corresponds to Rocq's `lookup_delete_ne`. -/
+  get?_delete_ne : ∀ (m : M V) k k', k ≠ k' → get? (delete m k) k' = get? m k'
+  /-- Corresponds to Rocq's `lookup_union`. -/
+  get?_union : ∀ (m₁ m₂ : M V) k,
+    get? (m₁ ∪ m₂) k = (get? m₁ k).orElse (fun _ => get? m₂ k)
+  /-- Corresponds to Rocq's `lookup_difference`. -/
+  get?_difference : ∀ (m₁ m₂ : M V) k,
+    get? (m₁ \ m₂) k = if (get? m₂ k).isSome then none else get? m₁ k
+  /-- Corresponds to Rocq's implicit behavior of `list_to_map`. -/
+  ofList_nil : (ofList [] : M V) = ∅
+  /-- Corresponds to Rocq's implicit behavior of `list_to_map`. -/
+  ofList_cons : ∀ (k : K) (v : V) (l : List (K × V)),
+    (ofList ((k, v) :: l) : M V) = insert (ofList l) k v
+  /-- Corresponds to Rocq's `map_to_list_spec`. -/
+  toList_spec (m : M V) :
+    (toList m).Nodup ∧ (∀ i x, (i, x) ∈ toList m ↔ get? m i = some x)
+  /-- Corresponds to Rocq's `map_ind`. -/
+  induction_on {P : M V → Prop}
+    (hemp : P ∅)
+    (hins : ∀ i x m, get? m i = none → P m → P (insert m i x))
+    (m : M V) : P m
+
+/-- Self-referential extended laws. -/
+class FiniteMapLawsSelf (K : outParam (Type u)) (M : Type u' → Type _)
+    [DecidableEq K] [FiniteMap K M] [FiniteMapLaws K M] where
+  /-- toList of filterMap is related to filterMap over toList. -/
+  toList_filterMap : ∀ (m : M V) (f : V → Option V),
+    (toList (FiniteMap.filterMap (M := M) f m)).Perm
+      ((toList m).filterMap (fun kv => (f kv.2).map (kv.1, ·)))
+  /-- toList of filter is related to filter over toList. -/
+  toList_filter : ∀ (m : M V) (φ : K → V → Bool),
+    (toList (FiniteMap.filter (M := M) φ m)).Perm
+      ((toList m).filter (fun kv => φ kv.1 kv.2))
+
+/-- Laws for kmap operation. -/
+class FiniteMapKmapLaws (K : outParam (Type u)) (K' : outParam (Type u)) (M : Type u' → Type _) (M' : Type u' → Type _)
+    [DecidableEq K] [DecidableEq K'] [FiniteMap K M] [FiniteMap K' M']
+    [FiniteMapLaws K M] [FiniteMapLaws K' M'] where
+  /-- toList of kmap is related to mapping over toList.
+      Corresponds to Rocq's `map_to_list_kmap`. -/
+  toList_kmap : ∀ (f : K → K') (m : M V),
+    (∀ {x y}, f x = f y → x = y) →  -- f is injective
+    (toList (FiniteMap.kmap (M' := M') f m)).Perm
+      ((toList m).map (fun (k, v) => (f k, v)))
+
+/-- Laws for map_seq operation. -/
+class FiniteMapSeqLaws (M : Type u → Type _) [FiniteMap Nat M] [FiniteMapLaws Nat M] where
+  /-- toList of map_seq is related to zip with sequence.
+      Corresponds to Rocq's `map_to_list_seq`. -/
+  toList_map_seq : ∀ (start : Nat) (l : List V),
+    (toList (FiniteMap.map_seq start l : M V)).Perm
+      (l.mapIdx (fun i v => ((i + start), v)))
+
+export FiniteMapLaws (ext
+get?_empty
+get?_insert_same get?_insert_ne
+get?_delete_same get?_delete_ne
+ofList_nil ofList_cons
+toList_spec
+induction_on)
+
+export FiniteMapLawsSelf (toList_filterMap toList_filter)
+export FiniteMapKmapLaws (toList_kmap)
+export FiniteMapSeqLaws (toList_map_seq)
+
+namespace FiniteMapLaws
+
+variable {K : Type u} {V : Type u'} {M : Type u' → Type _}
+variable [DecidableEq K] [FiniteMap K M] [FiniteMapLaws K M]
+
+private theorem mem_of_get?_ofList (l : List (K × V)) (k : K) (v : V) :
+    get? (ofList l : M V) k = some v → (k, v) ∈ l := by
+  intro h
+  induction l with
+  | nil =>
+    simp [ofList_nil, get?_empty] at h
+  | cons kv kvs ih =>
+    rw [ofList_cons] at h
+    by_cases heq : kv.1 = k
+    · have eq_val : kv.2 = v := by
+        rw [heq, get?_insert_same] at h
+        exact Option.some.inj h
+      have eq_kv : kv = (k, v) := by
+        ext
+        · exact heq
+        · exact eq_val
+      rw [← eq_kv]
+      exact List.Mem.head _
+    · rw [get?_insert_ne _ _ _ _ heq] at h
+      have := ih h
+      exact List.Mem.tail _ this
+
+
+/-- Corresponds to Rocq's `lookup_insert`. -/
+theorem get?_insert (m : M V) (k k' : K) (v : V) :
+    get? (insert m k v) k' = if k = k' then some v else get? m k' := by
+  split
+  · next h => rw [h, get?_insert_same]
+  · next h => exact get?_insert_ne m k k' v h
+
+/-- Corresponds to Rocq's `lookup_delete`. -/
+theorem get?_delete (m : M V) (k k' : K) :
+    get? (delete m k) k' = if k = k' then none else get? m k' := by
+  split
+  · next h => rw [h, get?_delete_same]
+  · next h => exact get?_delete_ne m k k' h
+
+/-- Corresponds to Rocq's `insert_delete_eq`. -/
+theorem get?_insert_delete (m : M V) (k k' : K) (v : V) :
+    get? (insert (delete m k) k v) k' = get? (insert m k v) k' := by
+  by_cases h : k = k'
+  · simp [h, get?_insert_same]
+  · simp [get?_insert_ne _ _ _ _ h, get?_delete_ne _ _ _ h]
+
+/-- Corresponds to Rocq's `NoDup_map_to_list`. -/
+theorem nodup_toList (m : M V): (toList m).Nodup := by
+   apply (toList_spec m).1
+
+/-- If a list has no duplicates and the projection is injective on list elements,
+    then the mapped list has no duplicates. -/
+theorem List.Nodup.map_of_injective {α β : Type _} {l : List α} {f : α → β}
+    (hnodup : l.Nodup) (hinj : ∀ a b, a ∈ l → b ∈ l → f a = f b → a = b) :
+    (l.map f).Nodup := by
+  induction l with
+  | nil => exact List.nodup_nil
+  | cons x xs ih =>
+    rw [List.map_cons, List.nodup_cons]
+    rw [List.nodup_cons] at hnodup
+    constructor
+    · intro hx_in
+      rw [List.mem_map] at hx_in
+      obtain ⟨y, hy_mem, hy_eq⟩ := hx_in
+      have hx_mem : x ∈ x :: xs := List.mem_cons_self
+      have hy_mem' : y ∈ x :: xs := List.mem_cons_of_mem x hy_mem
+      have : x = y := hinj x y hx_mem hy_mem' hy_eq.symm
+      subst this
+      exact hnodup.1 hy_mem
+    · apply ih hnodup.2
+      intro a b ha hb
+      exact hinj a b (List.mem_cons_of_mem x ha) (List.mem_cons_of_mem x hb)
+
+/-- Keys of toList have no duplicates. -/
+theorem nodup_toList_keys (m : M V) : (toList m).map Prod.fst |>.Nodup := by
+  apply List.Nodup.map_of_injective (nodup_toList m)
+  intro ⟨k₁, v₁⟩ ⟨k₂, v₂⟩ h1 h2 heq
+  simp at heq
+  obtain ⟨_, hmem⟩ := toList_spec (M := M) (K := K) (V := V) m
+  have hv1 : get? m k₁ = some v₁ := (hmem k₁ v₁).mp h1
+  have hv2 : get? m k₂ = some v₂ := (hmem k₂ v₂).mp h2
+  rw [heq] at hv1
+  rw [hv1] at hv2
+  cases hv2
+  ext <;> simp [heq]
+
+/-- Corresponds to Rocq's `elem_of_map_to_list`. -/
+theorem mem_toList (m : M V) : ∀ k v, (k, v) ∈ toList m ↔ get? m k = some v := by
+  apply (toList_spec m).2
+
+/-- Corresponds to Rocq's `elem_of_list_to_map_2`. -/
+theorem mem_of_mem_ofList (l : List (K × V)) (i : K) (x : V) :
+    get? (ofList l : M V) i = some x → (i, x) ∈ l := by
+  induction l with
+  | nil =>
+    intro h
+    rw [ofList_nil, get?_empty] at h
+    cases h
+  | cons kv l ih =>
+    intro h
+    obtain ⟨k, v⟩ := kv
+    rw [ofList_cons] at h
+    rw [get?_insert] at h
+    split at h
+    · next heq =>
+        cases h
+        rw [← heq]
+        simp [List.mem_cons]
+    · next hne =>
+        have : (i, x) ∈ l := ih h
+        exact List.mem_cons_of_mem _ this
+
+/-- Corresponds to Rocq's `elem_of_list_to_map_1`. -/
+theorem mem_ofList_of_mem (l : List (K × V)) (i : K) (x : V) :
+    (l.map Prod.fst).Nodup → (i, x) ∈ l → get? (ofList l : M V) i = some x := by
+  intro hnodup hmem
+  induction l with
+  | nil =>
+    simp at hmem
+  | cons kv l ih =>
+    obtain ⟨k, v⟩ := kv
+    rw [List.map_cons, List.nodup_cons] at hnodup
+    simp [List.mem_cons] at hmem
+    cases hmem with
+    | inl heq =>
+      obtain ⟨rfl, rfl⟩ := heq
+      rw [ofList_cons, get?_insert_same]
+    | inr hmem' =>
+      obtain ⟨hk_notin, hnodup_tail⟩ := hnodup
+      have hi_in : i ∈ l.map Prod.fst := by
+        rw [List.mem_map]
+        exact ⟨(i, x), hmem', rfl⟩
+      have hne : k ≠ i := by
+        intro heq
+        subst heq
+        exact hk_notin hi_in
+      have : get? (ofList l : M V) i = some x := ih hnodup_tail hmem'
+      rw [ofList_cons, get?_insert_ne _ _ _ _ hne, this]
+
+/-- Corresponds to Rocq's `elem_of_list_to_map` -/
+theorem mem_ofList (l : List (K × V)) i x (hnodup : (l.map Prod.fst).Nodup):
+   (i,x) ∈ l ↔ get? (ofList l : M V) i = some x := by
+    constructor
+    apply mem_ofList_of_mem; exact hnodup
+    apply mem_of_mem_ofList
+
+/-- Corresponds to Rocq's `list_to_map_inj`. -/
+theorem ofList_injective [DecidableEq V] (l1 l2 : List (K × V)) :
+    (l1.map Prod.fst).Nodup → (l2.map Prod.fst).Nodup →
+    (ofList l1 : M V) = ofList l2 → l1.Perm l2 := by
+  intro hnodup1 hnodup2 heq
+  have hnodup1' : l1.Nodup := List.nodup_of_nodup_map_fst l1 hnodup1
+  have hnodup2' : l2.Nodup := List.nodup_of_nodup_map_fst l2 hnodup2
+  haveI : DecidableEq (K × V) := inferInstance
+  apply List.perm_of_nodup_of_mem_iff hnodup1' hnodup2'
+  intro ⟨i, x⟩
+  rw [mem_ofList (M := M) (K := K) l1 i x hnodup1,
+      mem_ofList (M := M) (K := K) l2 i x hnodup2]
+  rw [heq]
+
+/-- Coresponds to Rocq's `list_to_map_to_list` -/
+theorem ofList_toList (m : M V) :
+    ofList (toList m) = m := by
+  apply ext (K := K)
+  intro i
+  cases heq : get? m i
+  · cases heq' : get? (ofList (toList m) : M V) i
+    · rfl
+    · rename_i val
+      have hmem : (i, val) ∈ toList m :=
+        (mem_ofList (M := M) (K := K) (toList m) i val (nodup_toList_keys m)).mpr heq'
+      have : get? m i = some val := (mem_toList m i val).mp hmem
+      rw [heq] at this
+      exact Option.noConfusion this
+  · rename_i val
+    have hmem : (i, val) ∈ toList m := (mem_toList m i val).mpr heq
+    have : get? (ofList (toList m) : M V) i = some val :=
+      (mem_ofList (M := M) (K := K) (toList m) i val (nodup_toList_keys m)).mp hmem
+    rw [this]
+
+  /-- Corresponds to Rocq's `map_to_list_to_map`. -/
+ theorem toList_ofList [DecidableEq V] : ∀ (l : List (K × V)), (l.map Prod.fst).Nodup →
+    (toList (ofList l : M V)).Perm l := by
+  intro l hnodup
+  apply ofList_injective (M := M) (K:=K)
+  · exact nodup_toList_keys (M := M) (K := K) (V := V) (ofList l)
+  · exact hnodup
+  rw [ofList_toList]
+
+/-- Two maps with the same get? behavior have permutation-equivalent toLists. -/
+theorem toList_perm_of_get?_eq [DecidableEq V] {m₁ m₂ : M V}
+    (h : ∀ k, get? m₁ k = get? m₂ k) : (toList m₁).Perm (toList m₂) := by
+  have hnodup₁ := nodup_toList (M := M) (K := K) (V := V) m₁
+  have hnodup₂ := nodup_toList (M := M) (K := K) (V := V) m₂
+  have hmem : ∀ kv, kv ∈ toList m₁ ↔ kv ∈ toList m₂ := by
+    intro ⟨k, v⟩
+    rw [mem_toList m₁ k v, mem_toList m₂ k v, h]
+  exact List.perm_of_nodup_of_mem_iff hnodup₁ hnodup₂ hmem
+
+/-- toList of insert and insert-after-delete are permutations of each other. -/
+theorem toList_insert_delete [DecidableEq V] (m : M V) (k : K) (v : V) :
+    (toList (insert m k v)).Perm (toList (insert (delete m k) k v)) :=
+  toList_perm_of_get?_eq (fun k' => (get?_insert_delete m k k' v).symm)
+
+/-- Singleton lookup for equal keys.
+    Corresponds to Rocq's `get?_singleton_same`. -/
+theorem get?_singleton_same (k : K) (v : V) :
+    get? ({[k := v]} : M V) k = some v := by
+  simp [FiniteMap.singleton, get?_insert_same]
+
+/-- Singleton lookup for different keys.
+    Corresponds to Rocq's `get?_singleton_ne`. -/
+theorem get?_singleton_ne (k k' : K) (v : V) (h : k ≠ k') :
+    get? ({[k := v]} : M V) k' = none := by
+  simp [FiniteMap.singleton, get?_insert_ne _ _ _ _ h, get?_empty]
+
+/-- Singleton lookup general case.
+    Corresponds to Rocq's `get?_singleton`. -/
+theorem get?_singleton (k k' : K) (v : V) :
+    get? ({[k := v]} : M V) k' = if k = k' then some v else none := by
+  split
+  · next h => rw [h, get?_singleton_same]
+  · next h => exact get?_singleton_ne k k' v h
+
+/-- Insert is idempotent for the same key-value.
+    Corresponds to Rocq's `insert_insert_eq`. -/
+theorem insert_insert (m : M V) (k : K) (v v' : V) :
+    get? (insert (insert m k v) k v') = get? (insert m k v' : M V) := by
+  funext k'
+  by_cases h : k = k'
+  · simp [h, get?_insert_same]
+  · simp [get?_insert_ne _ _ _ _ h]
+
+/-- Deleting from empty is empty.
+    Corresponds to Rocq's `delete_empty_eq`. -/
+theorem delete_empty_eq (k : K) :
+    get? (delete (∅ : M V) k) = get? (∅ : M V) := by
+  funext k'
+  by_cases h : k = k'
+  · simp [h, get?_delete_same, get?_empty]
+  · simp [get?_delete_ne _ _ _ h, get?_empty]
+
+/-- Corresponds to Rocq's `map_empty_subseteq`. -/
+theorem empty_subset (m : M V) : (∅ : M V) ⊆ m := by
+  intro k v h
+  simp [get?_empty] at h
+
+/-- Corresponds to Rocq's `map_disjoint_empty_l`. -/
+theorem disjoint_empty_left (m : M V) : (∅ : M V) ##ₘ m := by
+  intro k ⟨h₁, _⟩
+  simp [get?_empty] at h₁
+
+/-- Corresponds to Rocq's `lookup_insert_Some`. -/
+theorem get?_insert_some (m : M V) (i j : K) (x y : V) :
+    get? (insert m i x) j = some y ↔ (i = j ∧ x = y) ∨ (i ≠ j ∧ get? m j = some y) := by
+  rw [get?_insert]
+  split <;> simp_all
+
+/-- Corresponds to Rocq's `lookup_insert_is_Some`. -/
+theorem get?_insert_isSome (m : M V) (i j : K) (x : V) :
+    (get? (insert m i x) j).isSome ↔ i = j ∨ (i ≠ j ∧ (get? m j).isSome) := by
+  rw [get?_insert]
+  split <;> simp_all
+
+/-- Corresponds to Rocq's `lookup_insert_None`. -/
+theorem get?_insert_none (m : M V) (i j : K) (x : V) :
+    get? (insert m i x) j = none ↔ get? m j = none ∧ i ≠ j := by
+  rw [get?_insert]
+  split <;> simp_all
+
+/-- Corresponds to Rocq's `lookup_insert_rev`. -/
+theorem get?_insert_rev (m : M V) (i : K) (x y : V) :
+    get? (insert m i x) i = some y → x = y := by
+  simp [get?_insert_same]
+
+/-- Corresponds to Rocq's `insert_id`. -/
+theorem insert_get? (m : M V) (i : K) (x : V) :
+    get? m i = some x → (∀ k, get? (insert m i x) k = get? m k) := by
+  intro h k
+  by_cases hk : i = k
+  · subst hk; simp only [get?_insert_same, h]
+  · simp [get?_insert_ne _ _ _ _ hk]
+
+/-- Corresponds to Rocq's `lookup_delete_Some`. -/
+theorem get?_delete_some (m : M V) (i j : K) (y : V) :
+    get? (delete m i) j = some y ↔ i ≠ j ∧ get? m j = some y := by
+  rw [get?_delete]
+  split <;> simp_all
+
+/-- Corresponds to Rocq's `lookup_delete_is_Some`. -/
+theorem get?_delete_isSome (m : M V) (i j : K) :
+    (get? (delete m i) j).isSome ↔ i ≠ j ∧ (get? m j).isSome := by
+  rw [get?_delete]
+  split <;> simp_all
+
+/-- Corresponds to Rocq's `lookup_delete_None`. -/
+theorem get?_delete_none (m : M V) (i j : K) :
+    get? (delete m i) j = none ↔ i = j ∨ get? m j = none := by
+  rw [get?_delete]
+  split <;> simp_all
+
+/-- Corresponds to Rocq's `insert_delete_id`. -/
+theorem insert_delete_cancel (m : M V) (i : K) (x : V) :
+    get? m i = some x → insert (delete m i) i x = m := by
+  intro h
+  apply FiniteMapLaws.ext (M := M) (K := K) (V := V)
+  intro j
+  by_cases hij : i = j
+  · subst hij
+    simp [get?_insert_same, h]
+  · simp [get?_insert_ne _ _ _ _ hij, get?_delete_ne _ _ _ hij]
+
+  /-- Corresponds to Rocq's `map_to_list_empty`. -/
+theorem toList_empty : toList (∅ : M V) = [] := by
+  apply List.eq_nil_iff_forall_not_mem.mpr
+  intro ⟨i, x⟩ hmem
+  rw [mem_toList] at hmem
+  rw [get?_empty] at hmem
+  exact Option.noConfusion hmem
+
+  /-- Corresponds to Rocq's `map_to_list_insert`. -/
+theorem toList_insert [DecidableEq V] : ∀ (m : M V) k v, get? m k = none →
+    (toList (insert m k v)).Perm ((k, v) :: toList m) := by
+  intro m k v hk_none
+  apply ofList_injective (M := M) (K := K)
+  · exact nodup_toList_keys (insert m k v)
+  · rw [List.map_cons, List.nodup_cons]
+    constructor
+    · intro hk_in
+      rw [List.mem_map] at hk_in
+      obtain ⟨⟨k', v'⟩, hmem, hk_eq⟩ := hk_in
+      simp at hk_eq
+      subst hk_eq
+      have : get? m k' = some v' := (mem_toList m k' v').mp hmem
+      rw [hk_none] at this
+      exact Option.noConfusion this
+    · exact nodup_toList_keys m
+  · rw [ofList_toList]
+    rw [ofList_cons, ofList_toList]
+
+/-- Corresponds to Rocq's `map_to_list_delete`. -/
+theorem toList_delete [DecidableEq V] (m : M V) (k : K) (v : V) (h : get? m k = some v) :
+    (toList m).Perm ((k, v) :: toList (delete m k)) := by
+  have heq : toList m = toList (insert (delete m k) k v) := by
+    rw [insert_delete_cancel m k v h]
+  rw [heq]
+  apply toList_insert
+  exact get?_delete_same m k
+
+
+/-- Corresponds to Rocq's `delete_insert_id`. -/
+theorem delete_insert_cancel (m : M V) (i : K) (x : V) :
+    get? m i = none → delete (insert m i x) i = m := by
+  intro h
+  apply FiniteMapLaws.ext (M := M) (K := K) (V := V)
+  intro j
+  by_cases hij : i = j
+  · subst hij
+    simp [get?_delete_same, h]
+  · simp [get?_delete_ne _ _ _ hij, get?_insert_ne _ _ _ _ hij]
+
+/-- Empty map is characterized by all lookups returning none. -/
+theorem eq_empty_iff (m : M V) : m = ∅ ↔ ∀ k, get? m k = none := by
+  constructor
+  · intro h k
+    rw [h, get?_empty]
+  · intro h
+    apply FiniteMapLaws.ext (M := M) (K := K) (V := V)
+    intro k
+    rw [h, get?_empty]
+
+/-- Corresponds to Rocq's `delete_delete_eq`. -/
+theorem delete_delete_same (m : M V) (i : K) :
+    delete (delete m i) i = delete m i := by
+  apply FiniteMapLaws.ext (M := M) (K := K) (V := V)
+  intro j
+  by_cases hij : i = j
+  · subst hij
+    simp [get?_delete_same]
+  · simp [get?_delete_ne _ _ _ hij]
+
+/-- Corresponds to Rocq's `delete_delete`. -/
+theorem delete_delete_comm (m : M V) (i j : K) :
+    delete (delete m i) j = delete (delete m j) i := by
+  apply FiniteMapLaws.ext (M := M) (K := K) (V := V)
+  intro k
+  by_cases hik : i = k <;> by_cases hjk : j = k <;> simp [get?_delete, *]
+
+/-- Corresponds to Rocq's `delete_insert_ne`. -/
+theorem delete_insert_of_ne (m : M V) (i j : K) (x : V) :
+    i ≠ j → delete (insert m i x) j = insert (delete m j) i x := by
+  intro hij
+  apply FiniteMapLaws.ext (M := M) (K := K) (V := V)
+  intro k
+  by_cases hik : i = k <;> by_cases hjk : j = k
+  · subst hik hjk; exact absurd rfl hij
+  · subst hik; simp [get?_insert, get?_delete, hjk]
+  · subst hjk; simp [get?_insert, get?_delete, hik]
+  · simp [get?_insert, get?_delete, hik, hjk]
+
+/-- Corresponds to Rocq's `insert_delete_eq`. -/
+theorem insert_delete (m : M V) (i : K) (x : V) :
+    insert (delete m i) i x = insert m i x := by
+  apply FiniteMapLaws.ext (M := M) (K := K) (V := V)
+  intro j
+  by_cases hij : i = j
+  · subst hij
+    simp [get?_insert_same]
+  · simp [get?_insert_ne _ _ _ _ hij, get?_delete_ne _ _ _ hij]
+
+/-- Corresponds to Rocq's `insert_insert`. -/
+theorem insert_insert_comm (m : M V) (i j : K) (x y : V) :
+    i ≠ j → insert (insert m i x) j y = insert (insert m j y) i x := by
+  intro hij
+  apply FiniteMapLaws.ext (M := M) (K := K) (V := V)
+  intro k
+  by_cases hik : i = k <;> by_cases hjk : j = k
+  · subst hik hjk; exact absurd rfl hij
+  · subst hik; simp [get?_insert, hjk]
+  · subst hjk; simp [get?_insert, hik]
+  · simp [get?_insert, hik, hjk]
+
+/-- Corresponds to Rocq's `insert_insert_eq`. -/
+theorem insert_insert_same (m : M V) (i : K) (x y : V) :
+    insert (insert m i x) i y = insert m i y := by
+  apply FiniteMapLaws.ext (M := M) (K := K) (V := V)
+  intro j
+  by_cases hij : i = j
+  · subst hij
+    simp [get?_insert_same]
+  · simp [get?_insert_ne _ _ _ _ hij]
+
+/-- Corresponds to Rocq's `delete_empty`. -/
+theorem delete_empty_eq' (i : K) :
+    delete (∅ : M V) i = ∅ := by
+  apply FiniteMapLaws.ext (M := M) (K := K) (V := V)
+  intro j
+  simp [get?_delete, get?_empty]
+
+/-- Corresponds to Rocq's `delete_id`. -/
+theorem delete_of_get? (m : M V) (i : K) :
+    get? m i = none → delete m i = m := by
+  intro h
+  apply FiniteMapLaws.ext (M := M) (K := K) (V := V)
+  intro j
+  by_cases hij : i = j
+  · subst hij
+    simp [get?_delete_same, h]
+  · simp [get?_delete_ne _ _ _ hij]
+
+/-- Corresponds to Rocq's `insert_id`. -/
+theorem insert_get?' (m : M V) (i : K) (x : V) :
+    get? m i = some x → insert m i x = m := by
+  intro h
+  apply FiniteMapLaws.ext (M := M) (K := K) (V := V)
+  intro j
+  by_cases hij : i = j
+  · subst hij
+    simp [get?_insert_same, h]
+  · simp [get?_insert_ne _ _ _ _ hij]
+
+omit [DecidableEq K] [FiniteMapLaws K M] in
+/-- Corresponds to Rocq's `insert_empty`. -/
+theorem insert_empty (i : K) (x : V) :
+    insert (∅ : M V) i x = {[i := x]} := by
+  rfl
+
+/-- Corresponds to Rocq's `insert_non_empty`. -/
+theorem insert_ne_empty (m : M V) (i : K) (x : V) :
+    insert m i x ≠ ∅ := by
+  intro h
+  have := eq_empty_iff (insert m i x) |>.mp h i
+  simp [get?_insert_same] at this
+
+/-- Corresponds to Rocq's `delete_subseteq`. -/
+theorem delete_subset_self (m : M V) (i : K) : delete m i ⊆ m := by
+  intro k v h
+  by_cases hik : i = k
+  · subst hik
+    simp [get?_delete_same] at h
+  · simp [get?_delete_ne _ _ _ hik] at h
+    exact h
+
+/-- Corresponds to Rocq's `delete_subset`. -/
+theorem delete_subset_of_mem (m : M V) (i : K) (v : V) :
+    get? m i = some v → delete m i ⊆ m ∧ delete m i ≠ m := by
+  intro hi
+  constructor
+  · exact delete_subset_self m i
+  · intro heq
+    have : get? (delete m i) i = get? m i := by rw [heq]
+    simp [get?_delete_same, hi] at this
+
+/-- Corresponds to Rocq's `insert_subseteq`. -/
+theorem subset_insert (m : M V) (i : K) (x : V) :
+    get? m i = none → m ⊆ insert m i x := by
+  intro hi k v hk
+  by_cases hik : i = k
+  · subst hik
+    simp [hi] at hk
+  · simp [get?_insert_ne _ _ _ _ hik, hk]
+
+/-- Corresponds to Rocq's `insert_subset`. -/
+theorem subset_insert_of_not_mem (m : M V) (i : K) (x : V) :
+    get? m i = none → m ⊆ insert m i x ∧ m ≠ insert m i x := by
+  intro hi
+  constructor
+  · exact subset_insert m i x hi
+  · intro heq
+    have h2 : get? (insert m i x) i = some x := get?_insert_same m i x
+    rw [← heq] at h2
+    rw [hi] at h2
+    exact Option.noConfusion h2
+
+/-- Corresponds to Rocq's `delete_mono`. -/
+theorem delete_subset_delete (m₁ m₂ : M V) (i : K) :
+    m₁ ⊆ m₂ → delete m₁ i ⊆ delete m₂ i := by
+  intro hsub k v hk
+  by_cases hik : i = k
+  · subst hik
+    simp [get?_delete_same] at hk
+  · simp [get?_delete_ne _ _ _ hik] at hk ⊢
+    exact hsub k v hk
+
+/-- Corresponds to Rocq's `insert_mono`. -/
+theorem insert_subset_insert (m₁ m₂ : M V) (i : K) (x : V) :
+    m₁ ⊆ m₂ → insert m₁ i x ⊆ insert m₂ i x := by
+  intro hsub k v hk
+  by_cases hik : i = k
+  · subst hik
+    simp [get?_insert_same] at hk ⊢
+    exact hk
+  · simp [get?_insert_ne _ _ _ _ hik] at hk ⊢
+    exact hsub k v hk
+
+/-- Corresponds to Rocq's `map_non_empty_singleton`. -/
+theorem singleton_ne_empty (i : K) (x : V) :
+    {[i := x]} ≠ (∅ : M V) := by
+  exact insert_ne_empty ∅ i x
+
+/-- Corresponds to Rocq's `delete_singleton_eq`. -/
+theorem delete_singleton_same (i : K) (x : V) :
+    delete ({[i := x]} : M V) i = ∅ := by
+  apply FiniteMapLaws.ext (M := M) (K := K) (V := V)
+  intro j
+  simp [FiniteMap.singleton, get?_delete, get?_insert, get?_empty]
+
+/-- Corresponds to Rocq's `delete_singleton_ne`. -/
+theorem delete_singleton_of_ne (i j : K) (x : V) :
+    i ≠ j → delete ({[j := x]} : M V) i = {[j := x]} := by
+  intro hij
+  apply FiniteMapLaws.ext (M := M) (K := K) (V := V)
+  intro k
+  simp [FiniteMap.singleton, get?_delete, get?_insert, get?_empty]
+  intro hik
+  intro hjk
+  subst hik hjk
+  exact hij rfl
+
+/-- Corresponds to Rocq's `map_Forall_to_list`. -/
+theorem forall_iff_toList (P : K → V → Prop) (m : M V) :
+    FiniteMap.Forall P m ↔ ∀ kv ∈ toList m, P kv.1 kv.2 := by
+  constructor
+  · intro hfa kv hmem
+    have := (mem_toList m kv.1 kv.2).mp hmem
+    exact hfa kv.1 kv.2 this
+  · intro hlist k v hget
+    have := (mem_toList m k v).mpr hget
+    exact hlist (k, v) this
+
+/-- Corresponds to Rocq's `map_Forall_empty`. -/
+theorem forall_empty (P : K → V → Prop) : FiniteMap.Forall P (∅ : M V) := by
+  intro k v h
+  simp [get?_empty] at h
+
+omit [DecidableEq K] [FiniteMapLaws K M] in
+/-- Corresponds to Rocq's `map_Forall_impl`. -/
+theorem forall_mono (P Q : K → V → Prop) (m : M V) :
+    FiniteMap.Forall P m → (∀ k v, P k v → Q k v) → FiniteMap.Forall Q m := by
+  intro hp himpl k v hget
+  exact himpl k v (hp k v hget)
+
+/-- Corresponds to Rocq's `map_Forall_insert_1_1`. -/
+theorem forall_insert_of_forall (P : K → V → Prop) (m : M V) (i : K) (x : V) :
+    FiniteMap.Forall P (insert m i x) → P i x := by
+  intro hfa
+  exact hfa i x (get?_insert_same m i x)
+
+/-- Corresponds to Rocq's `map_Forall_insert_1_2`. -/
+theorem forall_of_forall_insert (P : K → V → Prop) (m : M V) (i : K) (x : V) :
+    get? m i = none → FiniteMap.Forall P (insert m i x) → FiniteMap.Forall P m := by
+  intro hi hfa k v hget
+  by_cases hik : i = k
+  · subst hik
+    simp [hi] at hget
+  · have : get? (insert m i x) k = some v := by
+      simp [get?_insert_ne _ _ _ _ hik, hget]
+    exact hfa k v this
+
+/-- Corresponds to Rocq's `map_Forall_insert_2`. -/
+theorem forall_insert (P : K → V → Prop) (m : M V) (i : K) (x : V) :
+    P i x → FiniteMap.Forall P m → FiniteMap.Forall P (insert m i x) := by
+  intro hpix hfa k v hget
+  by_cases hik : i = k
+  · subst hik
+    simp [get?_insert_same] at hget
+    rw [← hget]
+    exact hpix
+  · simp [get?_insert_ne _ _ _ _ hik] at hget
+    exact hfa k v hget
+
+/-- Corresponds to Rocq's `map_Forall_insert`. -/
+theorem forall_insert_iff (P : K → V → Prop) (m : M V) (i : K) (x : V) :
+    get? m i = none → (FiniteMap.Forall P (insert m i x) ↔ P i x ∧ FiniteMap.Forall P m) := by
+  intro hi
+  constructor
+  · intro hfa
+    exact ⟨forall_insert_of_forall P m i x hfa, forall_of_forall_insert P m i x hi hfa⟩
+  · intro ⟨hpix, hfa⟩
+    exact forall_insert P m i x hpix hfa
+
+/-- Corresponds to Rocq's `map_Forall_singleton`. -/
+theorem forall_singleton (P : K → V → Prop) (i : K) (x : V) :
+    FiniteMap.Forall P ({[i := x]} : M V) ↔ P i x := by
+  constructor
+  · intro hfa
+    exact hfa i x (get?_singleton_same i x)
+  · intro hpix k v hget
+    simp [get?_singleton] at hget
+    obtain ⟨rfl, rfl⟩ := hget
+    exact hpix
+
+/-- Corresponds to Rocq's `map_Forall_delete`. -/
+theorem forall_delete (P : K → V → Prop) (m : M V) (i : K) :
+    FiniteMap.Forall P m → FiniteMap.Forall P (delete m i) := by
+  intro hfa k v hget
+  by_cases hik : i = k
+  · subst hik
+    simp [get?_delete_same] at hget
+  · simp [get?_delete_ne _ _ _ hik] at hget
+    exact hfa k v hget
+
+omit [DecidableEq K] [FiniteMapLaws K M] in
+/-- Corresponds to Rocq's `map_disjoint_spec`. -/
+theorem disjoint_iff (m₁ m₂ : M V) :
+    m₁ ##ₘ m₂ ↔ ∀ k, get? m₁ k = none ∨ get? m₂ k = none := by
+  constructor
+  · intro hdisj k
+    by_cases h1 : (get? m₁ k).isSome
+    · by_cases h2 : (get? m₂ k).isSome
+      · exact absurd ⟨h1, h2⟩ (hdisj k)
+      · simp only [Option.not_isSome_iff_eq_none] at h2
+        exact Or.inr h2
+    · simp only [Option.not_isSome_iff_eq_none] at h1
+      exact Or.inl h1
+  · intro h k ⟨hs1, hs2⟩
+    cases h k with
+    | inl h1 => simp [h1] at hs1
+    | inr h2 => simp [h2] at hs2
+
+/-- Corresponds to Rocq's `map_disjoint_insert_l`. -/
+theorem disjoint_insert_left (m₁ m₂ : M V) (i : K) (x : V) :
+    get? m₂ i = none →
+    m₁ ##ₘ m₂ →
+    insert m₁ i x ##ₘ m₂ := by
+  intro hi hdisj k ⟨hs1, hs2⟩
+  by_cases hik : i = k
+  · subst hik
+    simp [hi] at hs2
+  · simp [get?_insert_ne _ _ _ _ hik] at hs1
+    exact hdisj k ⟨hs1, hs2⟩
+
+/-- Corresponds to Rocq's `map_disjoint_insert_r`. -/
+theorem disjoint_insert_right (m₁ m₂ : M V) (i : K) (x : V) :
+    get? m₁ i = none →
+    m₁ ##ₘ m₂ →
+    m₁ ##ₘ insert m₂ i x := by
+  intro hi hdisj k ⟨hs1, hs2⟩
+  by_cases hik : i = k
+  · subst hik
+    simp [hi] at hs1
+  · simp [get?_insert_ne _ _ _ _ hik] at hs2
+    exact hdisj k ⟨hs1, hs2⟩
+
+/-- Corresponds to Rocq's `map_disjoint_delete_l`. -/
+theorem disjoint_delete_left (m₁ m₂ : M V) (i : K) :
+    m₁ ##ₘ m₂ → delete m₁ i ##ₘ m₂ := by
+  intro hdisj k ⟨hs1, hs2⟩
+  by_cases hik : i = k
+  · subst hik
+    simp [get?_delete_same] at hs1
+  · simp [get?_delete_ne _ _ _ hik] at hs1
+    exact hdisj k ⟨hs1, hs2⟩
+
+/-- Corresponds to Rocq's `map_disjoint_delete_r`. -/
+theorem disjoint_delete_right (m₁ m₂ : M V) (i : K) :
+    m₁ ##ₘ m₂ → m₁ ##ₘ delete m₂ i := by
+  intro hdisj k ⟨hs1, hs2⟩
+  by_cases hik : i = k
+  · subst hik
+    simp [get?_delete_same] at hs2
+  · simp [get?_delete_ne _ _ _ hik] at hs2
+    exact hdisj k ⟨hs1, hs2⟩
+
+/-- Corresponds to Rocq's `map_disjoint_singleton_l`. -/
+theorem disjoint_singleton_left (m : M V) (i : K) (x : V) :
+    get? m i = none → {[i := x]} ##ₘ m := by
+  intro hi k ⟨hs1, hs2⟩
+  by_cases hik : i = k
+  · subst hik
+    simp [hi] at hs2
+  · simp [FiniteMap.singleton, get?_insert_ne _ _ _ _ hik, get?_empty] at hs1
+
+/-- Corresponds to Rocq's `map_disjoint_singleton_r`. -/
+theorem disjoint_singleton_right (m : M V) (i : K) (x : V) :
+    get? m i = none → m ##ₘ {[i := x]} := by
+  intro hi k ⟨hs1, hs2⟩
+  by_cases hik : i = k
+  · subst hik
+    simp [hi] at hs1
+  · simp [FiniteMap.singleton, get?_insert_ne _ _ _ _ hik, get?_empty] at hs2
+
+/-- toList of map (fmap) is a permutation of mapping over toList. -/
+theorem toList_map [DecidableEq V'] : ∀ (m : M V) (f : V → V'),
+  (toList (FiniteMap.map f m)).Perm
+      ((toList m).map (fun kv => (kv.1, f kv.2))) := by
+  intro m f
+  simp only [FiniteMap.map]
+  apply toList_ofList
+  simp only [List.map_map]
+  show ((toList m).map (fun x => x.1)).Nodup
+  exact nodup_toList_keys m
+
+/-- Lookup in a mapped map. -/
+theorem get?_map [DecidableEq V] {V' : Type _} [DecidableEq V'] (f : V → V') (m : M V) (k : K) :
+    get? (FiniteMap.map f m) k = (get? m k).map f := by
+  simp only [FiniteMap.map]
+  by_cases h : ∃ v, get? m k = some v
+  · obtain ⟨v, hv⟩ := h
+    have hmem : (k, v) ∈ toList m := (mem_toList m k v).mpr hv
+    have hmem' : (k, f v) ∈ (toList m).map (fun (ki, vi) => (ki, f vi)) := by
+      rw [List.mem_map]
+      exact ⟨(k, v), hmem, rfl⟩
+    have hnodup : ((toList m).map (fun (ki, vi) => (ki, f vi))).map Prod.fst |>.Nodup := by
+      simp only [List.map_map]
+      show ((toList m).map Prod.fst).Nodup
+      exact nodup_toList_keys m
+    have := (mem_ofList (M := M) _ k (f v) hnodup).mp hmem'
+    simp [hv, this]
+  · have hk : get? m k = none := by
+      cases hm : get? m k
+      · rfl
+      · exfalso; apply h; exact ⟨_, hm⟩
+    simp [hk]
+    cases h' : get? (ofList ((toList m).map (fun (ki, vi) => (ki, f vi))) : M V') k
+    · rfl
+    · rename_i v'
+      have hnodup : ((toList m).map (fun (ki, vi) => (ki, f vi))).map Prod.fst |>.Nodup := by
+        simp only [List.map_map]
+        show ((toList m).map Prod.fst).Nodup
+        exact nodup_toList_keys m
+      have hmem : (k, v') ∈ (toList m).map (fun (ki, vi) => (ki, f vi)) :=
+        (mem_ofList (M := M) (V := V') _ k v' hnodup).mpr h'
+      rw [List.mem_map] at hmem
+      obtain ⟨⟨k', v''⟩, hmem', heq⟩ := hmem
+      simp at heq
+      cases heq
+      rename_i heq_k heq_v
+      have : get? m k' = some v'' := (mem_toList m k' v'').mp hmem'
+      rw [heq_k, hk] at this
+      cases this
+
+omit [DecidableEq K] in
+/-- filterMap preserves Nodup on keys. -/
+private theorem nodup_map_fst_filterMap
+    (l : List (K × V)) (g : K → V → Option (K × V')) :
+    (l.map Prod.fst).Nodup →
+    (∀ ki vi k' v', g ki vi = some (k', v') → k' = ki) →
+    ((l.filterMap (fun (ki, vi) => g ki vi)).map Prod.fst).Nodup := by
+  intro h_nodup h_preserve_key
+  have aux : ∀ (k_target : K) (l' : List (K × V)),
+      k_target ∈ (l'.filterMap (fun (ki, vi) => g ki vi)).map Prod.fst →
+      k_target ∈ l'.map Prod.fst := by
+    intro k_target l'
+    induction l' with
+    | nil => simp
+    | cons kv' tail' ih_aux =>
+      obtain ⟨k'', v''⟩ := kv'
+      intro hmem_filter
+      simp only [List.filterMap] at hmem_filter
+      cases hg' : g k'' v'' with
+      | none =>
+        simp only [hg'] at hmem_filter
+        exact List.mem_cons_of_mem k'' (ih_aux hmem_filter)
+      | some res' =>
+        obtain ⟨k''', v'''⟩ := res'
+        have : k''' = k'' := h_preserve_key k'' v'' k''' v''' hg'
+        subst this
+        simp only [hg', List.map_cons, List.mem_cons] at hmem_filter
+        rw [List.map_cons, List.mem_cons]
+        cases hmem_filter with
+        | inl heq => left; exact heq
+        | inr hmem' => right; exact ih_aux hmem'
+  induction l with
+  | nil => simp
+  | cons kv tail ih =>
+    obtain ⟨k, v⟩ := kv
+    rw [List.map_cons, List.nodup_cons] at h_nodup
+    simp only [List.filterMap]
+    cases hg : g k v with
+    | none =>
+      exact ih h_nodup.2
+    | some res =>
+      obtain ⟨k', v'⟩ := res
+      have hk_eq : k' = k := h_preserve_key k v k' v' hg
+      rw [List.map_cons, List.nodup_cons]
+      constructor
+      · intro hmem
+        rw [hk_eq] at hmem
+        apply h_nodup.1
+        exact aux k tail hmem
+      · exact ih h_nodup.2
+
+/-- Lookup in zipWith. -/
+theorem get?_zipWith [DecidableEq V] [DecidableEq V'] [DecidableEq V'']
+    (f : V → V' → V'') (m1 : M V) (m2 : M V') (k : K) :
+    get? (FiniteMap.zipWith f m1 m2) k =
+      match get? m1 k, get? m2 k with
+      | some v1, some v2 => some (f v1 v2)
+      | _, _ => none := by
+  simp only [FiniteMap.zipWith]
+  cases h1 : get? m1 k
+  · simp
+    cases h' : get? (ofList ((toList m1).filterMap (fun (ki, vi) =>
+        match get? m2 ki with
+        | some v' => some (ki, f vi v')
+        | none => none)) : M V'') k
+    · rfl
+    · rename_i v_result
+      have hnodup : ((toList m1).filterMap (fun (ki, vi) =>
+          match get? m2 ki with
+          | some v' => some (ki, f vi v')
+          | none => none)).map Prod.fst |>.Nodup := by
+        refine nodup_map_fst_filterMap (V' := V'') (toList m1) (fun ki vi =>
+            match get? m2 ki with
+            | some v' => some (ki, f vi v')
+            | none => none) (nodup_toList_keys m1) ?_
+        intros ki vi k' v' heq
+        cases heq' : get? m2 ki <;> simp [heq'] at heq
+        obtain ⟨rfl, _⟩ := heq
+        rfl
+      have hmem : (k, v_result) ∈ (toList m1).filterMap (fun (ki, vi) =>
+          match get? m2 ki with
+          | some v' => some (ki, f vi v')
+          | none => none) :=
+        (mem_ofList (M := M) (V := V'') _ k v_result hnodup).mpr h'
+      rw [List.mem_filterMap] at hmem
+      obtain ⟨⟨k', v1'⟩, hmem1, hmatch⟩ := hmem
+      simp at hmatch
+      cases hm2 : get? m2 k' <;> simp [hm2] at hmatch
+      · obtain ⟨heq_k, _⟩ := hmatch
+        have : get? m1 k' = some v1' := (mem_toList m1 k' v1').mp hmem1
+        rw [heq_k, h1] at this
+        cases this
+  · rename_i v1
+    cases h2 : get? m2 k
+    · simp
+      cases h' : get? (ofList ((toList m1).filterMap (fun (ki, vi) =>
+          match get? m2 ki with
+          | some v' => some (ki, f vi v')
+          | none => none)) : M V'') k
+      · rfl
+      · rename_i v_result
+        have hnodup : ((toList m1).filterMap (fun (ki, vi) =>
+            match get? m2 ki with
+            | some v' => some (ki, f vi v')
+            | none => none)).map Prod.fst |>.Nodup := by
+          refine nodup_map_fst_filterMap (V' := V'') (toList m1) (fun ki vi =>
+              match get? m2 ki with
+              | some v' => some (ki, f vi v')
+              | none => none) (nodup_toList_keys m1) ?_
+          intros ki vi k' v' heq
+          cases heq' : get? m2 ki <;> simp [heq'] at heq
+          obtain ⟨rfl, _⟩ := heq
+          rfl
+        have hmem : (k, v_result) ∈ (toList m1).filterMap (fun (ki, vi) =>
+            match get? m2 ki with
+            | some v' => some (ki, f vi v')
+            | none => none) :=
+          (mem_ofList (M := M) (V := V'') _ k v_result hnodup).mpr h'
+        rw [List.mem_filterMap] at hmem
+        obtain ⟨⟨k', v1'⟩, hmem1, hmatch⟩ := hmem
+        simp at hmatch
+        cases hm2 : get? m2 k' <;> simp [hm2] at hmatch
+        · obtain ⟨heq_k, _⟩ := hmatch
+          rw [heq_k, h2] at hm2
+          cases hm2
+    · rename_i v2
+      simp
+      have hmem1 : (k, v1) ∈ toList m1 := (mem_toList m1 k v1).mpr h1
+      have hmem_filter : (k, f v1 v2) ∈ (toList m1).filterMap (fun (ki, vi) =>
+          match get? m2 ki with
+          | some v' => some (ki, f vi v')
+          | none => none) := by
+        rw [List.mem_filterMap]
+        refine ⟨(k, v1), hmem1, ?_⟩
+        simp [h2]
+      have hnodup : ((toList m1).filterMap (fun (ki, vi) =>
+          match get? m2 ki with
+          | some v' => some (ki, f vi v')
+          | none => none)).map Prod.fst |>.Nodup := by
+        refine nodup_map_fst_filterMap (V' := V'') (toList m1) (fun ki vi =>
+            match get? m2 ki with
+            | some v' => some (ki, f vi v')
+            | none => none) (nodup_toList_keys m1) ?_
+        intros ki vi k' v' heq
+        cases heq' : get? m2 ki <;> simp [heq'] at heq
+        obtain ⟨rfl, _⟩ := heq
+        rfl
+      exact (mem_ofList (M := M) _ k (f v1 v2) hnodup).mp hmem_filter
+
+/-- Corresponds to Rocq's `map_fmap_zip_with_r`. -/
+theorem map_zipWith_right [DecidableEq V] {V' V'' : Type _} [DecidableEq V'] [DecidableEq V'']
+    (f : V → V' → V'') (g1 : V'' → V) (m1 : M V) (m2 : M V')
+    (hg1 : ∀ x y, g1 (f x y) = x)
+    (hdom : ∀ k, (get? m1 k).isSome ↔ (get? m2 k).isSome) :
+    FiniteMap.map g1 (FiniteMap.zipWith f m1 m2) = m1 := by
+  apply ext
+  intro k
+  rw [get?_map, get?_zipWith]
+  cases h1 : get? m1 k with
+  | none => simp
+  | some x =>
+    have h2 : (get? m2 k).isSome = true := (hdom k).mp (by simp [h1])
+    cases h2' : get? m2 k with
+    | none => simp [h2'] at h2
+    | some y =>
+      simp [hg1]
+
+/-- Corresponds to Rocq's `map_fmap_zip_with_l`. -/
+theorem map_zipWith_left [DecidableEq V] [DecidableEq V'] {V'' : Type _} [DecidableEq V'']
+    (f : V → V' → V'') (g2 : V'' → V') (m1 : M V) (m2 : M V')
+    (hg2 : ∀ x y, g2 (f x y) = y)
+    (hdom : ∀ k, (get? m1 k).isSome ↔ (get? m2 k).isSome) :
+    FiniteMap.map g2 (FiniteMap.zipWith f m1 m2) = m2 := by
+  apply ext
+  intro k
+  rw [get?_map, get?_zipWith]
+  cases h2 : get? m2 k with
+  | none => simp
+  | some y =>
+    have h1 : (get? m1 k).isSome = true := (hdom k).mpr (by simp [h2])
+    cases h1' : get? m1 k with
+    | none => simp [h1'] at h1
+    | some x =>
+      simp [hg2]
+
+/-- Insert distributes over zipWith. -/
+theorem zipWith_insert [DecidableEq V] [DecidableEq V'] [DecidableEq V'']
+    (f : V → V' → V'') (m1 : M V) (m2 : M V') (i : K) (x : V) (y : V') :
+    FiniteMap.zipWith f (insert m1 i x) (insert m2 i y) =
+    insert (FiniteMap.zipWith f m1 m2) i (f x y) := by
+  apply ext
+  intro k
+  by_cases h : k = i
+  · subst h
+    simp only [get?_insert_same, get?_zipWith]
+  · have h' : i ≠ k := Ne.symm h
+    simp only [get?_zipWith, get?_insert_ne _ i k _ h']
+
+/-- Corresponds to Rocq's `map_delete_zip_with`. -/
+theorem zipWith_delete [DecidableEq V] [DecidableEq V'] [DecidableEq V'']
+    (f : V → V' → V'') (m1 : M V) (m2 : M V') (i : K) :
+    FiniteMap.zipWith f (delete m1 i) (delete m2 i) =
+    delete (FiniteMap.zipWith f m1 m2) i := by
+  apply ext
+  intro k
+  by_cases h : k = i
+  · subst h
+    simp only [get?_delete_same, get?_zipWith]
+  · have h' : i ≠ k := Ne.symm h
+    simp only [get?_zipWith, get?_delete_ne _ i k h']
+
+theorem zipWith_comm [DecidableEq V] [DecidableEq V'] [DecidableEq V'']
+    (f : V → V' → V'') (m1 : M V) (m2 : M V') :
+    FiniteMap.zipWith (fun x y => f y x) m2 m1 = FiniteMap.zipWith f m1 m2 := by
+  apply ext
+  intro k
+  rw [get?_zipWith, get?_zipWith]
+  cases get? m1 k <;> cases get? m2 k <;> simp
+
+/-- Corresponds to Rocq's `map_zip_with_flip`. -/
+theorem zip_comm [DecidableEq V] [DecidableEq V']
+    (m1 : M V) (m2 : M V') :
+    FiniteMap.zip m2 m1 = FiniteMap.map Prod.swap (FiniteMap.zip m1 m2) := by
+  apply ext
+  intro k
+  unfold FiniteMap.zip
+  rw [get?_map, get?_zipWith, get?_zipWith]
+  cases get? m1 k <;> cases get? m2 k <;> simp [Prod.swap]
+
+/-- Mapping with id is identity.
+    Corresponds to Rocq's `map_id`. -/
+theorem map_id [DecidableEq V] (m : M V) :
+    FiniteMap.map id m = m := by
+  apply ext
+  intro k
+  rw [get?_map]
+  cases get? m k <;> simp
+
+/-- Mapping over a zip is the same as zipping the mapped maps.
+    Corresponds to Rocq's `map_fmap_zip`. -/
+theorem zip_map [DecidableEq V] [DecidableEq V'] {V'' V''' : Type _} [DecidableEq V''] [DecidableEq V''']
+    (f : V → V'') (g : V' → V''') (m1 : M V) (m2 : M V') :
+    FiniteMap.zip (FiniteMap.map f m1) (FiniteMap.map g m2) =
+    FiniteMap.map (fun (x, y) => (f x, g y)) (FiniteMap.zip m1 m2) := by
+  apply ext
+  intro k
+  unfold FiniteMap.zip
+  rw [get?_zipWith, get?_map, get?_map, get?_map, get?_zipWith]
+  cases h1 : get? m1 k <;> cases h2 : get? m2 k <;> simp
+
+/-- Zipping fst and snd projections of a map recovers the original map.
+    Corresponds to Rocq's `map_zip_fst_snd`. -/
+theorem zip_fst_snd {V' : Type u'} [DecidableEq V] [DecidableEq V'] (m : M (V × V')) :
+    FiniteMap.zip (FiniteMap.map Prod.fst m) (FiniteMap.map Prod.snd m) = m := by
+  apply ext
+  intro k
+  unfold FiniteMap.zip
+  rw [get?_zipWith, get?_map, get?_map]
+  cases h : get? m k with
+  | none => simp
+  | some p => cases p with | mk v1 v2 => simp
+
+/-- Corresponds to part of Rocq's dom lemmas for zip. -/
+theorem isSome_zipWith [DecidableEq V] [DecidableEq V'] [DecidableEq V'']
+    (f : V → V' → V'') (m1 : M V) (m2 : M V') (k : K) :
+    (get? (FiniteMap.zipWith f m1 m2) k).isSome ↔
+    (get? m1 k).isSome ∧ (get? m2 k).isSome := by
+  rw [get?_zipWith]
+  cases get? m1 k <;> cases get? m2 k <;> simp [Option.isSome_some, Option.isSome_none]
+
+/-- Zipping two empty maps yields an empty map.
+    Corresponds to Rocq's `map_zip_empty`. -/
+theorem zip_empty [DecidableEq V] [DecidableEq V'] :
+    FiniteMap.zip (∅ : M V) (∅ : M V') = ∅ := by
+  apply ext
+  intro k
+  unfold FiniteMap.zip
+  rw [get?_zipWith, get?_empty, get?_empty, get?_empty]
+
+/-- Lookup in a zipped map.
+    Corresponds to Rocq's `lookup_zip_with` specialized to `zip`. -/
+theorem get?_zip [DecidableEq V] [DecidableEq V'] (m1 : M V) (m2 : M V') (k : K) :
+    get? (FiniteMap.zip m1 m2) k =
+      match get? m1 k, get? m2 k with
+      | some v1, some v2 => some (v1, v2)
+      | _, _ => none := by
+  unfold FiniteMap.zip
+  rw [get?_zipWith]
+
+/-- Insert distributes over zip.
+    Corresponds to Rocq's `map_zip_insert`. -/
+theorem zip_insert [DecidableEq V] [DecidableEq V']
+    (m1 : M V) (m2 : M V') (i : K) (x : V) (y : V') :
+    get? m1 i = none → get? m2 i = none →
+    FiniteMap.zip (insert m1 i x) (insert m2 i y) =
+    insert (FiniteMap.zip m1 m2) i (x, y) := by
+  intro h1 h2
+  unfold FiniteMap.zip
+  exact zipWith_insert Prod.mk m1 m2 i x y
+
+/-- Delete distributes over zip.
+    Corresponds to Rocq's `map_zip_delete`. -/
+theorem zip_delete [DecidableEq V] [DecidableEq V']
+    (m1 : M V) (m2 : M V') (i : K) :
+    FiniteMap.zip (delete m1 i) (delete m2 i) =
+    delete (FiniteMap.zip m1 m2) i := by
+  unfold FiniteMap.zip
+  exact zipWith_delete Prod.mk m1 m2 i
+
+/-- Domain of a zipped map.
+    Corresponds to part of Rocq's `elem_of_dom_2` for zip. -/
+theorem isSome_zip [DecidableEq V] [DecidableEq V'] (m1 : M V) (m2 : M V') (k : K) :
+    (get? (FiniteMap.zip m1 m2) k).isSome ↔
+    (get? m1 k).isSome ∧ (get? m2 k).isSome := by
+  unfold FiniteMap.zip
+  exact isSome_zipWith Prod.mk m1 m2 k
+
+/-- toList of a zipped map.
+    Corresponds to Rocq's `map_to_list_zip`. -/
+theorem toList_zip [DecidableEq V] [DecidableEq V'] (m1 : M V) (m2 : M V') :
+    (toList (FiniteMap.zip m1 m2)).Perm
+      ((toList m1).filterMap (fun (k, v1) =>
+        match get? m2 k with
+        | some v2 => some (k, (v1, v2))
+        | none => none)) := by
+  unfold FiniteMap.zip
+  simp only [FiniteMap.zipWith]
+  apply toList_ofList
+  refine nodup_map_fst_filterMap (V' := V × V') (toList m1)
+    (fun ki vi => match get? m2 ki with | some v' => some (ki, (vi, v')) | none => none)
+    (nodup_toList_keys m1) ?_
+  intro ki vi k' vp heq
+  cases heq' : get? m2 ki <;> simp [heq'] at heq
+  obtain ⟨rfl, _⟩ := heq
+  rfl
+
+/-- Corresponds to Rocq's `lookup_union_None`. -/
+theorem get?_union_none (m1 m2 : M V) (i : K) :
+    get? (m1 ∪ m2) i = none ↔ get? m1 i = none ∧ get? m2 i = none := by
+  rw [get?_union]
+  cases h1 : get? m1 i <;> cases h2 : get? m2 i <;> simp [Option.orElse]
+
+/-- Corresponds to Rocq's `insert_union_l`. -/
+theorem union_insert_left (m1 m2 : M V) (i : K) (x : V) :
+    get? (insert (m1 ∪ m2) i x) = get? (insert m1 i x ∪ m2) := by
+  funext k
+  by_cases hik : i = k
+  · subst hik
+    simp [get?_insert_same, get?_union]
+  · simp [get?_insert_ne _ _ _ _ hik, get?_union]
+
+end FiniteMapLaws
+
+namespace FiniteMap
+
+variable {K : Type v} {M : Type u → _}  [FiniteMap K M]
+
+/-- Submap is reflexive. -/
+theorem subset_refl (m : M V) : m ⊆ m := fun _ _ h => h
+
+/-- Submap is transitive. -/
+theorem subset_trans {m₁ m₂ m₃ : M V} (h₁ : m₁ ⊆ m₂) (h₂ : m₂ ⊆ m₃) : m₁ ⊆ m₃ :=
+  fun k v hm₁ => h₂ k v (h₁ k v hm₁)
+
+/-- Disjointness is symmetric. -/
+theorem disjoint_comm {m₁ m₂ : M V} (h : disjoint m₁ m₂) : disjoint m₂ m₁ :=
+  fun k ⟨h₂, h₁⟩ => h k ⟨h₁, h₂⟩
+
+theorem disjoint_empty_right [DecidableEq K] [FiniteMapLaws K M] (m : M V) : m ##ₘ (∅ : M V) :=
+  disjoint_comm (FiniteMapLaws.disjoint_empty_left (K:= K) m)
+
+/-- `m₂` and `m₁ \ m₂` are disjoint. -/
+theorem disjoint_difference_right [DecidableEq K] [FiniteMapLaws K M] [FiniteMapLawsSelf K M]
+    (m₁ m₂ : M V) : m₂ ##ₘ (m₁ \ m₂) := by
+  intro k ⟨h_in_m2, h_in_diff⟩
+  rw [FiniteMapLaws.get?_difference] at h_in_diff
+  simp only [h_in_m2, ↓reduceIte, Option.isSome_none, Bool.false_eq_true] at h_in_diff
+
+/-- Corresponds to Rocq's `map_difference_union`. -/
+theorem union_difference_cancel [DecidableEq K] [FiniteMapLaws K M] [FiniteMapLawsSelf K M]
+    (m₁ m₂ : M V) (hsub : m₂ ⊆ m₁) : m₂ ∪ (m₁ \ m₂) = m₁ := by
+  apply FiniteMapLaws.ext (M := M) (K := K) (V := V)
+  intro k
+  rw [FiniteMapLaws.get?_union, FiniteMapLaws.get?_difference]
+  cases hm2 : get? m₂ k with
+  | none =>
+    simp only [Option.isSome_none, Bool.false_eq_true, ↓reduceIte, Option.orElse_none]
+  | some v =>
+    simp only [Option.isSome_some, ↓reduceIte, Option.orElse_some]
+    exact (hsub k v hm2).symm
+
+end FiniteMap
+
+end Iris.Std
diff --git a/src/Iris/Std/GSet.lean b/src/Iris/Std/GSet.lean
new file mode 100644
index 00000000..aa7e96c1
--- /dev/null
+++ b/src/Iris/Std/GSet.lean
@@ -0,0 +1,159 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+
+import Iris.Std.Positive
+
+/-! # Finite Sets of Invariant Names
+
+Reference: `stdpp/theories/gset.v`, `iris/algebra/gset.v`
+
+Finite sets of invariant names, used to track which invariants are currently
+disabled in world satisfaction (`ownD` tokens). The predicate-based representation
+mirrors `CoPset` for uniformity, providing union, difference, disjointness, and
+subset operations needed by the `GSetDisj` CMRA.
+
+## Main Definitions
+
+- `GSet` — set of invariant names (`Positive`), represented as a membership predicate
+- `GSet.singleton` — singleton set `{[i]}`
+- `GSet.union`, `GSet.empty` — set operations
+- `GSet.Disjoint`, `GSet.Subset` — predicates
+-/
+
+namespace Iris
+
+/-! ## Definition -/
+
+/-- Set of invariant names, used for disabled invariant tokens. -/
+structure GSet where
+  /-- Membership predicate. -/
+  mem : Positive → Prop
+
+namespace GSet
+
+@[ext]
+theorem ext {s₁ s₂ : GSet} (h : ∀ n, s₁.mem n ↔ s₂.mem n) : s₁ = s₂ := by
+  -- extensionality for predicate-based sets
+  cases s₁; cases s₂; simp only [mk.injEq]
+  exact funext fun n => propext (h n)
+
+/-! ## Constructors and Operations -/
+
+def empty : GSet := by
+  -- empty set: always false
+  exact ⟨fun _ => False⟩
+
+def singleton (n : Positive) : GSet := by
+  -- singleton membership
+  exact ⟨fun m => m = n⟩
+
+def union (s₁ s₂ : GSet) : GSet := by
+  -- union membership via disjunction
+  exact ⟨fun n => s₁.mem n ∨ s₂.mem n⟩
+
+def diff (s₁ s₂ : GSet) : GSet := by
+  -- set difference: left membership and not right membership
+  exact ⟨fun n => s₁.mem n ∧ ¬s₂.mem n⟩
+
+instance : EmptyCollection GSet := ⟨empty⟩
+instance : Singleton Positive GSet := ⟨singleton⟩
+instance : Union GSet := ⟨union⟩
+instance : SDiff GSet := ⟨diff⟩
+
+/-! ## Predicates -/
+
+def Disjoint (s₁ s₂ : GSet) : Prop := by
+  -- disjointness means no shared element
+  exact ∀ n, ¬(s₁.mem n ∧ s₂.mem n)
+
+def Subset (s₁ s₂ : GSet) : Prop := by
+  -- subset means elementwise implication
+  exact ∀ n, s₁.mem n → s₂.mem n
+
+instance : HasSubset GSet := ⟨Subset⟩
+
+noncomputable instance (s₁ s₂ : GSet) : Decidable (Disjoint s₁ s₂) := by
+  -- classical decidability for predicates
+  exact Classical.propDecidable _
+
+/-! ## Simp Lemmas -/
+
+@[simp] theorem mem_empty (n : Positive) : (∅ : GSet).mem n ↔ False := by
+  -- unfold empty membership
+  rfl
+
+@[simp] theorem mem_singleton (n m : Positive) : ({m} : GSet).mem n ↔ n = m := by
+  -- unfold singleton membership
+  rfl
+
+@[simp] theorem mem_union (s₁ s₂ : GSet) (n : Positive) :
+    (s₁ ∪ s₂).mem n ↔ s₁.mem n ∨ s₂.mem n := by
+  -- unfold union membership
+  rfl
+
+@[simp] theorem mem_diff (s₁ s₂ : GSet) (n : Positive) :
+    (s₁ \ s₂).mem n ↔ s₁.mem n ∧ ¬s₂.mem n := by
+  -- unfold difference membership
+  rfl
+
+/-! ## Set Algebra Laws -/
+
+theorem union_assoc (s₁ s₂ s₃ : GSet) : s₁ ∪ s₂ ∪ s₃ = s₁ ∪ (s₂ ∪ s₃) := by
+  -- associativity of union via propositional associativity
+  ext n; simp [or_assoc]
+
+theorem union_comm (s₁ s₂ : GSet) : s₁ ∪ s₂ = s₂ ∪ s₁ := by
+  -- commutativity of union via propositional commutativity
+  ext n; simp [or_comm]
+
+theorem union_empty (s : GSet) : s ∪ ∅ = s := by
+  -- right identity of union
+  ext n; simp
+
+theorem empty_union (s : GSet) : ∅ ∪ s = s := by
+  -- left identity of union
+  ext n; simp
+
+theorem union_idem (s : GSet) : s ∪ s = s := by
+  -- idempotence of union
+  ext n; simp [or_self]
+
+/-! ## Disjointness and Subset -/
+
+theorem disjoint_comm {s₁ s₂ : GSet} : Disjoint s₁ s₂ ↔ Disjoint s₂ s₁ := by
+  -- symmetry by swapping conjuncts
+  refine ⟨?_, ?_⟩
+  · intro h n hn
+    exact h n ⟨hn.2, hn.1⟩
+  · intro h n hn
+    exact h n ⟨hn.2, hn.1⟩
+
+theorem disjoint_empty_right (s : GSet) : Disjoint s ∅ := by
+  -- no element can be in an empty set
+  intro _ hn; exact hn.2
+
+theorem disjoint_empty_left (s : GSet) : Disjoint ∅ s := by
+  -- no element can be in an empty set
+  intro _ hn; exact hn.1
+
+/-- Any subset can be decomposed as a disjoint union with the set difference. -/
+theorem subseteq_disjoint_union {s₁ s₂ : GSet} (h : s₁ ⊆ s₂) :
+    ∃ s₃, s₂ = s₁ ∪ s₃ ∧ Disjoint s₁ s₃ := by
+  -- choose the set difference as a disjoint complement
+  refine ⟨s₂ \ s₁, ?_, ?_⟩
+  · ext n; simp; constructor
+    · intro hn
+      by_cases h₁ : s₁.mem n
+      · exact Or.inl h₁
+      · exact Or.inr ⟨hn, h₁⟩
+    · rintro (h₁ | ⟨h₂, _⟩)
+      · exact h _ h₁
+      · exact h₂
+  · exact fun _ ⟨h₁, _, h₃⟩ => h₃ h₁
+
+end GSet
+
+end Iris
diff --git a/src/Iris/Std/List.lean b/src/Iris/Std/List.lean
new file mode 100644
index 00000000..35500711
--- /dev/null
+++ b/src/Iris/Std/List.lean
@@ -0,0 +1,101 @@
+/-
+Copyright (c) 2026 Zongyuan Liu. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Zongyuan Liu
+-/
+
+/-!
+# List Lemmas
+
+This file contains list theory lemmas that are standard properties
+not available in Lean core.
+-/
+
+namespace Iris.Std.List
+
+/-- List equivalence relation parameterized by an element equivalence relation.
+    Corresponds to Rocq's `list_equiv`. -/
+inductive Equiv {α : Type _} (R : α → α → Prop) : List α → List α → Prop where
+  | nil : Equiv R [] []
+  | cons {x y : α} {l k : List α} : R x y → Equiv R l k → Equiv R (x :: l) (y :: k)
+
+def zipIdxInt {α : Type _} (l : List α) (n : Int) : List (α × Int) :=
+  l.mapIdx (fun i v => (v, (i : Int) + n))
+
+/-- For a Nodup list, erasing an element removes it completely. -/
+theorem not_mem_erase_self_of_nodup {α : Type _} [DecidableEq α] (x : α) (l : List α)
+    (hnd : l.Nodup) : x ∉ l.erase x := by
+  induction l with
+  | nil => exact List.not_mem_nil
+  | cons y ys ih =>
+    simp only [List.erase_cons]
+    rw [List.nodup_cons] at hnd
+    split
+    · next h =>
+      have heq : y = x := eq_of_beq h
+      rw [← heq]
+      exact hnd.1
+    · next h =>
+      simp only [List.mem_cons]
+      intro hor
+      cases hor with
+      | inl heq =>
+        have : (y == x) = true := beq_iff_eq.mpr heq.symm
+        exact absurd this h
+      | inr hmem => exact ih hnd.2 hmem
+
+/-- Two Nodup lists with the same membership are permutations of each other.
+    Corresponds to Rocq's `NoDup_Permutation`. -/
+theorem perm_of_nodup_of_mem_iff {α : Type _} [DecidableEq α]
+    {l₁ l₂ : List α} (hnd₁ : l₁.Nodup) (hnd₂ : l₂.Nodup)
+    (hmem : ∀ x, x ∈ l₁ ↔ x ∈ l₂) : l₁.Perm l₂ := by
+  induction l₁ generalizing l₂ with
+  | nil =>
+    cases l₂ with
+    | nil => exact List.Perm.refl []
+    | cons y ys =>
+      have : y ∈ ([] : List α) := (hmem y).mpr List.mem_cons_self
+      exact absurd this List.not_mem_nil
+  | cons x xs ih =>
+    have hx_in_l₂ : x ∈ l₂ := (hmem x).mp List.mem_cons_self
+    have hperm₂ : l₂.Perm (x :: l₂.erase x) := List.perm_cons_erase hx_in_l₂
+    rw [List.nodup_cons] at hnd₁
+    have hx_notin_xs : x ∉ xs := hnd₁.1
+    have hnd_xs : xs.Nodup := hnd₁.2
+    have hnd_erase : (l₂.erase x).Nodup := hnd₂.erase x
+    have hmem_erase : ∀ y, y ∈ xs ↔ y ∈ l₂.erase x := by
+      intro y
+      constructor
+      · intro hy
+        have hne : y ≠ x := fun heq => hx_notin_xs (heq ▸ hy)
+        have hy_l₂ : y ∈ l₂ := (hmem y).mp (List.mem_cons_of_mem x hy)
+        exact (List.mem_erase_of_ne hne).mpr hy_l₂
+      · intro hy
+        have hne : y ≠ x := by
+          intro heq
+          rw [heq] at hy
+          exact not_mem_erase_self_of_nodup x l₂ hnd₂ hy
+        have hy_l₂ : y ∈ l₂ := List.mem_of_mem_erase hy
+        have hy_l₁ : y ∈ x :: xs := (hmem y).mpr hy_l₂
+        cases List.mem_cons.mp hy_l₁ with
+        | inl heq => exact absurd heq hne
+        | inr h => exact h
+    have hperm_xs : xs.Perm (l₂.erase x) := ih hnd_xs hnd_erase hmem_erase
+    exact (List.Perm.cons x hperm_xs).trans hperm₂.symm
+
+
+theorem nodup_of_nodup_map_fst {α β : Type _} (l : List (α × β))
+    (h : (l.map Prod.fst).Nodup) : l.Nodup := by
+  induction l with
+  | nil => exact List.nodup_nil
+  | cons x xs ih =>
+    rw [List.nodup_cons]
+    constructor
+    · intro hx
+      rw [List.map_cons, List.nodup_cons] at h
+      have : x.1 ∈ xs.map Prod.fst := List.mem_map_of_mem (f := Prod.fst) hx
+      exact h.1 this
+    · rw [List.map_cons, List.nodup_cons] at h
+      exact ih h.2
+
+end Iris.Std.List
diff --git a/src/Iris/Std/Namespace.lean b/src/Iris/Std/Namespace.lean
new file mode 100644
index 00000000..3c921e75
--- /dev/null
+++ b/src/Iris/Std/Namespace.lean
@@ -0,0 +1,201 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+
+import Iris.Std.CoPset
+import Iris.Std.DelabRule
+import Init.Data.Char.Lemmas
+
+/-! # Namespaces for Invariants
+
+Reference: `stdpp/theories/namespaces.v`
+
+Invariants are organized into a hierarchical namespace tree. Each namespace maps
+to a mask (`CoPset`) via `nclose`, which collects all invariant names that have
+the namespace as a suffix. This gives two key properties:
+
+1. **Nesting**: extending a namespace (`ndot`) yields a subset of the parent mask,
+   so opening a child namespace leaves the parent's other children accessible.
+2. **Disjointness**: sibling namespaces (same parent, different extension component)
+   produce disjoint masks, preventing conflicts when multiple invariants are open.
+
+## Main Definitions
+
+- `Namespace` — namespace type (list of encoded name components)
+- `nroot` — root namespace (covers all names)
+- `ndot` / `.@` — extend a namespace with a countable value
+- `nclose` / `↑N` — map a namespace to its invariant mask
+-/
+
+namespace Iris
+open Iris.Std
+
+/-! ## Countable Encodings -/
+
+/-- A lightweight countable encoding into name components. -/
+class Countable (A : Type _) where
+  /-- Encode a value into a name component. -/
+  encode : A → NameComponent
+  /-- Decode a name component back into a value. -/
+  decode : NameComponent → Option A
+  /-- Decoding after encoding returns the original value. -/
+  decode_encode : ∀ a, decode (encode a) = some a
+
+/-- Encode is injective thanks to the left inverse. -/
+theorem Countable.encode_inj {A : Type _} [Countable A] {x y : A}
+    (h : Countable.encode x = Countable.encode y) : x = y := by
+  -- apply decode to the equality and simplify
+  have h' := congrArg (Countable.decode (A := A)) h
+  simpa [Countable.decode_encode] using h'
+
+/-- `Nat` encodes as a singleton component. -/
+instance : Countable Nat where
+  encode n := [n]
+  decode xs :=
+    -- singleton lists decode to their element
+    match xs with
+    | [n] => some n
+    | _ => none
+  decode_encode := by
+    -- decoding the singleton yields the original number
+    intro n; rfl
+
+/-- `String` encodes as a list of character codes. -/
+instance : Countable String where
+  encode s :=
+    -- map characters to their numeric codes
+    s.toList.map Char.toNat
+  decode xs :=
+    -- rebuild the string from character codes
+    some (String.ofList (xs.map Char.ofNat))
+  decode_encode := by
+    -- mapping `Char.ofNat` after `Char.toNat` recovers the characters
+    intro s
+    -- reduce to the corresponding statement without `Option.some`
+    apply congrArg some
+    have hmap : List.map (Char.ofNat ∘ Char.toNat) s.toList = s.toList := by
+      -- map `ofNat ∘ toNat` collapses to the identity, by list induction
+      induction s.toList with
+      | nil => simp
+      | cons _ _ ih =>
+        simp [ih]
+    -- combine the map identity with `String.ofList_toList`
+    calc
+      String.ofList (List.map Char.ofNat (List.map Char.toNat s.toList))
+          = String.ofList (List.map (Char.ofNat ∘ Char.toNat) s.toList) := by
+            -- reassociate the nested map
+            simp [List.map_map]
+      _ = String.ofList s.toList := by
+            -- apply the map identity from `hmap`
+            simp [hmap]
+      _ = s := by
+            -- fold back to the original string
+            simp [String.ofList_toList]
+
+/-! ## Namespace Structure -/
+
+/-- Namespaces are lists of name components. -/
+structure Namespace where
+  /-- Namespace components, ordered from most-specific to root. -/
+  parts : List NameComponent
+
+/-- Root namespace (no components). -/
+def nroot : Namespace := by
+  -- empty namespace list
+  exact ⟨[]⟩
+
+/-- Extend a namespace with a new component. -/
+def ndot {A : Type _} [Countable A] (N : Namespace) (x : A) : Namespace := by
+  -- cons the encoded component at the front
+  exact ⟨Countable.encode x :: N.parts⟩
+
+/-- Map a namespace to its mask: all names with the namespace as a suffix. -/
+def nclose (N : Namespace) : CoPset := by
+  -- suffix predicate on lists of components
+  exact ⟨fun p => N.parts <:+ p⟩
+
+instance : Coe Namespace CoPset := ⟨nclose⟩
+
+/-! ## Notation -/
+
+syntax term " .@ " term : term
+macro_rules
+  | `($N .@ $x) => `(ndot $N $x)
+
+delab_rule nclose
+  | `($_ $N) => do
+      -- show namespace coercions as `↑N`
+      `(↑$N)
+
+/-! ## Namespace Lemmas -/
+
+/-- Helper: dropping the prefix returns the suffix. -/
+private theorem drop_append_left {α : Type _} (t s : List α) :
+    List.drop t.length (t ++ s) = s := by
+  -- prove by induction on the prefix
+  induction t with
+  | nil => simp
+  | cons _ t ih =>
+      simp [ih]
+
+/-- Helper: if `x::N` is a suffix of `p`, then `N` is also a suffix of `p`. -/
+private theorem suffix_tail {x : NameComponent} {N p : List NameComponent}
+    (h : x :: N <:+ p) : N <:+ p := by
+  -- extend the witness by one element
+  rcases h with ⟨t, rfl⟩
+  refine ⟨t ++ [x], ?_⟩
+  simp [List.append_assoc]
+
+/-- Helper: equal-length suffixes with the same tail have equal heads. -/
+private theorem suffix_cons_eq {x y : NameComponent} {N p : List NameComponent}
+    (hx : x :: N <:+ p) (hy : y :: N <:+ p) : x = y := by
+  -- unpack both suffix witnesses and compare the drop at equal lengths
+  rcases hx with ⟨t1, rfl⟩
+  rcases hy with ⟨t2, h2⟩
+  have hlen : t1.length = t2.length := by
+    -- lengths agree because the suffixes have equal length
+    have := congrArg List.length h2
+    simp [List.length_append, List.length_cons] at this
+    exact this.symm
+  have hdrop := congrArg (List.drop t1.length) h2
+  -- simplify both sides to the suffixes
+  simp [hlen] at hdrop
+  -- conclude by head equality
+  cases hdrop; rfl
+
+/-- The root namespace covers all names. -/
+theorem nclose_nroot : (↑nroot : CoPset) = (CoPset.top : CoPset) := by
+  -- suffix of the empty list is always true
+  ext p; constructor <;> intro _
+  · trivial
+  · refine ⟨p, ?_⟩
+    -- suffix witness by appending the empty list
+    simp [nroot]
+
+/-- Extending a namespace yields a subset of the original mask. -/
+theorem nclose_subseteq {A : Type _} [Countable A] (N : Namespace) (x : A) :
+    (↑(N .@ x) : CoPset) ⊆ ↑N := by
+  -- drop the added head from the suffix witness
+  intro p hp
+  exact suffix_tail hp
+
+/-- Subset transport for namespace masks. -/
+theorem nclose_subseteq' {A : Type _} [Countable A] {E : CoPset} (N : Namespace) (x : A) :
+    (↑N : CoPset) ⊆ E → (↑(N .@ x) : CoPset) ⊆ E := by
+  -- compose subset with `nclose_subseteq`
+  intro h
+  exact fun p hp => h _ (nclose_subseteq N x p hp)
+
+/-- Distinct components yield disjoint namespaces. -/
+theorem ndot_ne_disjoint {A : Type _} [Countable A]
+    (N : Namespace) {x y : A} (hxy : x ≠ y) :
+    CoPset.Disjoint (↑(N .@ x)) (↑(N .@ y)) := by
+  -- a shared suffix forces the head components to coincide
+  intro p hp
+  rcases hp with ⟨hx, hy⟩
+  have hcomp : Countable.encode x = Countable.encode y := suffix_cons_eq hx hy
+  exact hxy (Countable.encode_inj hcomp)
+
+end Iris
diff --git a/src/Iris/Std/Positive.lean b/src/Iris/Std/Positive.lean
new file mode 100644
index 00000000..e320fcfe
--- /dev/null
+++ b/src/Iris/Std/Positive.lean
@@ -0,0 +1,30 @@
+/-
+Copyright (c) 2026 Sam Hart. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam Hart
+-/
+
+/-! # Positive Names
+
+Reference: `stdpp/theories/positive.v`
+
+Invariant names need a countable supply of identifiers that support suffix-based
+namespace reasoning. Rather than using binary-encoded positive integers, we model
+names as lists of encoded components, which makes the suffix structure (needed by
+`Namespace` and `nclose`) directly available as list operations.
+
+## Main Definitions
+
+- `NameComponent` — encoded namespace components (lists of natural numbers)
+- `Positive` — invariant names, represented as lists of components
+-/
+
+namespace Iris
+
+/-- Encoded namespace components. -/
+abbrev NameComponent := List Nat
+
+/-- Positive names, represented as lists of name components. -/
+abbrev Positive := List NameComponent
+
+end Iris