-- src/Iris/Algebra/Updates.lean

import Iris.Algebra.CMRA

namespace Iris

def UpdateP [CMRA α] (x : α) (P : α → Prop) := ∀ n mz,
  ✓{n} (x •? mz) → ∃ y, P y ∧ ✓{n} (y •? mz)

infixr:50 " ~~>: " => UpdateP

def Update [CMRA α] (x y : α) := ∀ n mz,
  ✓{n} (x •? mz) → ✓{n} (y •? mz)

infixr:50 " ~~> " => Update

section updates

variable [CMRA α] [CMRA β] (f : α → β) (g : β → α)

-- Repository definitions used:
content: scoped notation:40 x " ≡{" n "}≡ " y:41 => OFE.Dist n x y

content: notation:50 "✓{" n "} " x:51 => ValidN n x

content: class CMRA (α : Type _) extends OFE α where
  pcore : α → Option α
  op : α → α → α
  ValidN : Nat → α → Prop
  Valid : α → Prop

  op_ne : NonExpansive (op x)
  pcore_ne : x ≡{n}≡ y → pcore x = some cx →
    ∃ cy, pcore y = some cy ∧ cx ≡{n}≡ cy
  validN_ne : x ≡{n}≡ y → ValidN n x → ValidN n y

  valid_iff_validN : Valid x ↔ ∀ n, ValidN n x
  validN_succ : ValidN n.succ x → ValidN n x
  validN_op_left : ValidN n (op x y) → ValidN n x

  assoc : op x (op y z) ≡ op (op x y) z
  comm : op x y ≡ op y x

  pcore_op_left : pcore x = some cx → op cx x ≡ x
  pcore_idem : pcore x = some cx → pcore cx ≡ some cx
  pcore_op_mono : pcore x = some cx → ∀ y, ∃ cy, pcore (op x y) ≡ some (op cx cy)

  extend : ValidN n x → x ≡{n}≡ op y₁ y₂ →
    Σ' z₁ z₂, x ≡ op z₁ z₂ ∧ z₁ ≡{n}≡ y₁ ∧ z₂ ≡{n}≡ y₂

content: def pcore : DFrac F → Option (DFrac F)
  | own _        => none
  | .discard     => some discard
  | ownDiscard _ => some discard

content: inductive DFrac (F : Type _) where
 
| own (f : F) : DFrac F
 
| discard : DFrac F
 
| ownDiscard (f : F) : DFrac F

content: def op : DFrac F → DFrac F → DFrac F
  | .discard, .discard => discard
  | own f, .discard
  | ownDiscard f, .discard
  | .discard, own f
  | .discard, ownDiscard f => ownDiscard f
  | own f, own f' => own (f + f')
  | own f, ownDiscard f'
  | ownDiscard f, own f'
  | ownDiscard f, ownDiscard f' => ownDiscard (f + f')

content: class Associative (R : Relation α) (f : α → α → α) where
  assoc {x y z : α} : R (f (f x y) z) (f x (f y z))

content: instance OFE.ContractiveHom.fixpoint_ne [COFE α] [Inhabited α] :
    NonExpansive (ContractiveHom.fixpoint (α := α)) where
  ne n f1 f2 H := by admit /- proof elided -/

content: instance Option.merge_ne [OFE α] {op : α → α → α} [NonExpansive₂ op] :
    NonExpansive₂ (Option.merge op) where
  ne n x1 x2 Hx y1 y2 Hy := by admit /- proof elided -/

content: class NonExpansive₂ [OFE α] [OFE β] [OFE γ] (f : α → β → γ) where
  ne : ∀ ⦃n x₁ x₂⦄, x₁ ≡{n}≡ x₂ → ∀ ⦃y₁ y₂⦄, y₁ ≡{n}≡ y₂ → f x₁ y₁ ≡{n}≡ f x₂ y₂

content: @[ext] structure ContractiveHom (α β : Type _) [OFE α] [OFE β] extends Hom α β where
  [contractive : Contractive f]
  ne := ne_of_contractive f

content: instance OFE.Option.some.ne [OFE α] : OFE.NonExpansive (some : α → Option α) := ⟨fun _ _ _ => id⟩

content: class NonExpansive [OFE α] [OFE β] (f : α → β) where
  ne : ∀ ⦃n x₁ x₂⦄, x₁ ≡{n}≡ x₂ → f x₁ ≡{n}≡ f x₂

content: class Commutative (R : Relation α) (f : β → β → α) where
  comm {x y : β} : R (f x y) (f y x)

content: def map [OFE α] [OFE β] (f : α -n> β) (c : Chain α) : Chain β where
  chain n := f (c n)
  cauchy h := f.ne.1 (c.cauchy h)

content: structure Chain (α : Type _) [OFE α] where
  chain : Nat → α
  cauchy : n ≤ i → chain i ≡{n}≡ chain n

content: @[ext] structure Hom (α β : Type _) [OFE α] [OFE β] where
  f : α → β
  ne : NonExpansive f

content: class Reflexive (R : Relation α) where
  refl {x : α} : R x x

content: scoped infix:40 " ≡ " => OFE.Equiv

content: scoped notation:40 x " ≡{" n "}≡ " y:41 => OFE.Dist n x y

content: @[inherit_doc]
infixr:25 " -n> " => Hom

content: infixr:25 " -c> " => ContractiveHom

content: infix:60 " • " => op

content: @[inherit_doc]
infixr:25 " -C> " => Hom

-- Repository lemmas used:
content: theorem op_right_eqv (x : α) {y z : α} (e : y ≡ z) : x • y ≡ x • z

content: @[simp, refl] theorem Equiv.rfl [OFE α] {x : α} : x ≡ x

content: theorem equiv_eqv [ofe : OFE α] : Equivalence ofe.Equiv

content: @[symm] theorem Dist.symm [OFE α] {n} {x : α} : x ≡{n}≡ y → y ≡{n}≡ x

content: theorem Dist.trans [OFE α] {n} {x : α} : x ≡{n}≡ y → y ≡{n}≡ z → x ≡{n}≡ z

content: @[simp, refl] theorem Dist.rfl [OFE α] {n} {x : α} : x ≡{n}≡ x

-- Local definitions used:
content: def UpdateP [CMRA α] (x : α) (P : α → Prop) := ∀ n mz,
  ✓{n} (x •? mz) → ∃ y, P y ∧ ✓{n} (y •? mz)

content: def Update [CMRA α] (x y : α) := ∀ n mz,
  ✓{n} (x •? mz) → ✓{n} (y •? mz)

-- Local lemmas used:

-- Target theorem and proof:
theorem UpdateP.iso
    (gf : ∀ x, g (f x) ≡ x)
    (g_op : ∀ y1 y2, g (y1 • y2) ≡ g y1 • g y2)
    (g_validN : ∀ n y, ✓{n} (g y) ↔ ✓{n} y)
    (uyp : y ~~>: P)
    (pq : ∀ y', P y' → Q (g y')) :
    g y ~~>: Q
:= by
  intro n mz v
  have : ✓{n} y •? Option.map f mz :=
    match mz with
    | none => (g_validN n _).mp v
    | some z =>
      have : g y • z ≡ g (y • f z) :=
        (CMRA.op_right_eqv _ (gf z).symm).trans (g_op y (f z)).symm
      (g_validN n _).mp (CMRA.validN_ne this.dist v)
  have ⟨x, px, vx⟩ := uyp n (mz.map f) this
  have : g (x •? Option.map f mz) ≡ g x •? mz :=
    match mz with
    | none => OFE.Equiv.rfl
    | some z => (g_op x (f z)).trans (CMRA.op_right_eqv (g x) (gf z))
  exact ⟨g x, pq x px, CMRA.validN_ne this.dist ((g_validN n _).mpr vx)⟩