End Map.
Module KV_State <: StateMonad.
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.
End KV_State.
Module KV_RAM <: RAM (KV_State).
Parameter K : Type.
Parameter V : Type.
Context `{DecEq K}.
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').