-- Loom/MonadAlgebras/WP/Basic.lean

import Loom.MonadAlgebras.Defs

import Loom.MonadAlgebras.Instances.Basic

import Loom.MonadAlgebras.Instances.ExceptT

import Loom.MonadAlgebras.Instances.StateT

import Loom.MonadAlgebras.Instances.ReaderT

import Loom.MonadAlgebras.Instances.Gen

variable {m : Type u -> Type v} [Monad m] [LawfulMonad m] {α : Type u} {l : Type u}

section

variable [CompleteLattice l]

section

variable [mprop : MAlgOrdered m l]

def wp (c : m α) (post : α -> l) : l := liftM (n := Cont l) c post

end

variable [MAlgOrdered m l]

end

section

variable [CompleteLattice l] [MAlgOrdered m l]

noncomputable

end

section Determinism

variable [inst: CompleteLattice l] [MAlgOrdered m l]

end Determinism

section Loops

open Lean.Order

variable [inst: _root_.CompleteLattice l] [MAlgOrdered m l]

namespace PartialCorrectness

variable [∀ α, CCPO (m α)] [MonoBind m] [MAlgPartial m]

end PartialCorrectness

namespace TotalCorrectness

variable [∀ α, CCPO (m α)] [MonoBind m]

variable [MAlgTotal m]

end TotalCorrectness

end Loops

section Lift

variable [inst: CompleteLattice l] [MAlgOrdered m l]

open ExceptionAsSuccess in

open ExceptionAsFailure in

open TotalCorrectness in

-- Repository definitions used:
content: abbrev MAlg.lift {m : Type u -> Type v} {l : Type u} [Monad m] [MAlg m l] :
  {α : Type u} -> m α -> Cont l α := fun x f => μ $ f <$> x

content: class MAlg [Monad m] (l : outParam (Type v)) where
  μ : m l -> l
  pure : ∀ l, μ (pure l) = l
  bind : ∀ {α : Type v} (x : m α) (f g : α -> m l),
    μ ∘ f = μ ∘ g ->
    μ (x >>= f) = μ (x >>= g)

content: class LogicLift (l : outParam (Type u)) ( k : Type u) [CompleteLattice l] [CompleteLattice k] where
  [lift : MonadLift (Cont l) (Cont k)]
  lift_top {α : Type u} :
    monadLift (m := Cont l) (n := Cont k) (fun (_ : α -> l) => ⊤) = ⊤
  lift_bot {α : Type u} :
    monadLift (m := Cont l) (n := Cont k) (fun (_ : α -> l) => ⊥) = ⊥

content: class MAlgOrdered (l : outParam (Type v)) [Monad m] [CompleteLattice l] where
  μ : m l -> l
  μ_ord_pure : ∀ l, μ (pure l) = l
  μ_ord_bind {α : Type v} :
    ∀ (f g : α -> m l), μ ∘ f ≤ μ ∘ g ->
      ∀ x : m α, μ (x >>= f) ≤ μ (x >>= g)

-- Repository lemmas used:
content: lemma MAlg.lift_StateT [Monad m] [LawfulMonad m] [CompleteLattice l] [inst: MAlgOrdered m l] (x : StateT σ m α) :
  MAlg.lift x post = fun s => MAlg.lift (x s) (fun xs => post xs.1 xs.2)

-- Local definitions used:
content: def wp (c : m α) (post : α -> l) : l := liftM (n := Cont l) c post

-- Local lemmas used:
content: lemma wp_pure (x : α) (post : α -> l) : wp (m := m) (pure x) post = post x

content: lemma wp_bind {β} (x : m α) (f : α -> m β) (post : β -> l) :
    wp (x >>= f) post = wp x (fun x => wp (f x) post)

-- Target theorem and proof:
lemma StateT.wp_lift (c : m α) (post : α -> σ -> l) :
  wp (liftM (n := StateT σ m) c) post = fun s => wp (m := m) c (post · s)
:= by
  simp [wp, liftM, monadLift, MAlg.lift_StateT, MonadLift.monadLift, StateT.lift];
  have liftE : ∀ α, MAlg.lift (m := m) (α := α) = wp := by intros; ext; simp [wp, liftM, monadLift]
  ext s; rw [map_eq_pure_bind, liftE, liftE, wp_bind]; simp [wp_pure]