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).

(* Specifications: *)
Theorem read_write : forall (k : K), equiv (ret tt) (bind (read k) (fun v => write k v)).
Theorem write_read : forall (k : K) (v : V), equiv (bind (write k v) (fun _ => ret v)) (bind (write k v) (fun _ => read k)).
Theorem read_read : forall (k : K), equiv (bind (read k) (fun v => ret v)) (bind (read k) (fun _ => read k)).
Theorem read_commute : forall (k1 k2 : K), equiv (bind (read k1) (fun v1 => bind (read k2) (fun v2 => ret (v1, v2)))) (bind (read k2) (fun v2 => bind (read k1) (fun v1 => ret (v1, v2)))).
Theorem read_write_commute : forall (k1 k2 : K) (v2 : V), k1 <> k2 -> equiv (bind (read k1) (fun v1 => bind (write k2 v2) (fun _ => ret v1))) (bind (write k2 v2) (fun _ => bind (read k1) (fun v1 => ret v1))).
Theorem write_commute : forall (k1 k2 : K) (v1 v2 : V), k1 <> k2 -> equiv (bind (write k1 v1) (fun _ => write k2 v2)) (bind (write k2 v2) (fun _ => write k1 v1)).
Theorem write_absorb : forall (k : K) (v v' : V), equiv (bind (write k v) (fun _ => write k v')) (write k v').
Theorem read_write : forall (k : K), equiv (ret tt) (bind (read k) (fun v => write k v)).
Theorem write_read : forall (k : K) (v : V), equiv (bind (write k v) (fun _ => ret v)) (bind (write k v) (fun _ => read k)).
Theorem read_read : forall (k : K), equiv (bind (read k) (fun v => ret v)) (bind (read k) (fun _ => read k)).
Theorem read_commute : forall (k1 k2 : K), equiv (bind (read k1) (fun v1 => bind (read k2) (fun v2 => ret (v1, v2)))) (bind (read k2) (fun v2 => bind (read k1) (fun v1 => ret (v1, v2)))).
Theorem read_write_commute : forall (k1 k2 : K) (v2 : V), k1 <> k2 -> equiv (bind (read k1) (fun v1 => bind (write k2 v2) (fun _ => ret v1))) (bind (write k2 v2) (fun _ => bind (read k1) (fun v1 => ret v1))).
Theorem write_commute : forall (k1 k2 : K) (v1 v2 : V), k1 <> k2 -> equiv (bind (write k1 v1) (fun _ => write k2 v2)) (bind (write k2 v2) (fun _ => write k1 v1)).
Theorem write_absorb : forall (k : K) (v v' : V), equiv (bind (write k v) (fun _ => write k v')) (write k v').