Definition state (S X : Type) := option (prod X S).Definition State (S X : Type) := S -> option (prod X S).Definition ret {S} := @ret S.Definition bind {S} := @bind S.Definition get {S} := @get S.Definition put {S} := @put S.Parameter K : Type.Parameter V : Type.Definition S : Type := Map K V.Definition well_formed := @well_formed K V.Definition bind {X Y} := @bind S X Y.Definition ret {X} := @ret S X.Definition get := @get S.Definition put := @put S.Definition lift {X} (o : option X) : OptState S X :=
    fun s =>
      match o with
      | Some x => Some (x, s)
      | None => None
      end.Definition read (k : K) : State S V :=
    bind get (fun s =>
    lift (lookup k s)).Definition write (k : K) (v : V) : State S unit :=
    bind get (fun s =>
    bind (put (insert k v s)) (fun _ =>
    ret tt)).Definition prod_rel {X X' Y Y'} (P : X -> X' -> Prop) (Q : Y -> Y' -> Prop) :
  X * Y -> X' * Y' -> Prop :=
  fun p1 p2 =>
    P (fst p1) (fst p2) /\
    Q (snd p1) (snd p2).Definition state_equiv (s1 s2 : S) : Prop :=
    forall (k : K), lookup k s1 = lookup k s2.Definition equiv {X : Type} (m1 m2 : State S X) : Prop :=
    forall s1 s2, well_formed s1 -> well_formed s2 -> state_equiv s1 s2 ->
    opt_lift2 (prod_rel eq state_equiv) (m1 s1) (m2 s2).

Theorem write_absorb : forall (k : K) (v v' : V), equiv (bind (write k v) (fun _ => write k v')) (write k v').