Section EquivProofs.
Context `{C : Config}.
Definition read id : Poram nat :=
monad_map snd (read_access id).
Definition write id v : Poram unit :=
monad_map (fun _ => tt) (write_access id v).
Definition triv {X} : X -> Prop :=
fun _ => True.
Definition pand {X} (P Q : X -> Prop) : X -> Prop :=
fun x => P x /\ Q x.
Definition poram_lift {X} (Pre Post : state -> Prop)
(P : X -> Prop) : Poram X -> Prop :=
state_plift
(pand well_formed Pre)
(pand well_formed Post)
P.
Definition state_plift2 {M} `{PredLift M} {S X Y}
(Pre Post : S -> S -> Prop)
(P : X -> Y -> Prop)
(m1 : StateT S M X)
(m2 : StateT S M Y) : Prop :=
forall s1 s2,
Pre s1 s2 ->
plift2 (prod_rel P Post) (m1 s1) (m2 s2).
Definition state_plift2_val {M} `{PredLift M} {S X Y}
(Pre : S -> S -> Prop)
(Post : S -> S -> X -> Y -> Prop)
(m1 : StateT S M X)
(m2 : StateT S M Y) : Prop :=
forall s1 s2,
Pre s1 s2 ->
plift2 (fun '(x, s) '(y, s') => Post s s' x y) (m1 s1) (m2 s2).
Definition poram_lift2 {X Y} (Pre Post : state -> state -> Prop)
(P : X -> Y -> Prop) : Poram X -> Poram Y -> Prop :=
state_plift2
(fun s s' => well_formed s /\ well_formed s' /\ Pre s s')
(fun s s' => well_formed s /\ well_formed s' /\ Post s s')
P.
Definition poram_lift2_val {X Y} (Pre : state -> state -> Prop)
(Post : state -> state -> X -> Y -> Prop) : Poram X -> Poram Y -> Prop :=
state_plift2_val
(fun s s' => well_formed s /\ well_formed s' /\ Pre s s')
(fun s s' x y => well_formed s /\ well_formed s' /\ Post s s' x y).

(* Specifications: *)
Lemma poram_lift2_val_to_poram_lift2 {X Y}
(Pre : state -> state -> Prop)
(Post : state -> state -> Prop)
(P : X -> Y -> Prop)
(m1 : Poram X) (m2 : Poram Y) :
poram_lift2_val Pre (fun s s' x y => Post s s' /\ P x y) m1 m2 ->
poram_lift2 Pre Post P m1 m2.
Lemma state_plift2_bind {M} `{PredLift M}
{S X Y X' Y'}
(Pre Mid Post : S -> S -> Prop)
(P : X -> Y -> Prop)
(Q : X' -> Y' -> Prop)
(m1 : StateT S M X)
(m2 : StateT S M Y)
(f1 : X -> StateT S M X')
(f2 : Y -> StateT S M Y') :
state_plift2 Pre Mid P m1 m2 ->
(forall x y, P x y ->
state_plift2 Mid Post Q (f1 x) (f2 y)) ->
state_plift2 Pre Post Q
(mbind m1 f1) (mbind m2 f2).
Lemma poram_lift2_bind {X Y X' Y'}
(Pre Mid Post : state -> state -> Prop)
(P : X -> Y -> Prop)
(Q : X' -> Y' -> Prop)
(m1 : Poram X)
(m2 : Poram Y)
(f1 : X -> Poram X')
(f2 : Y -> Poram Y') :
poram_lift2 Pre Mid P m1 m2 ->
(forall x y, P x y ->
poram_lift2 Mid Post Q (f1 x) (f2 y)) ->
poram_lift2 Pre Post Q
(mbind m1 f1) (mbind m2 f2).
Lemma poram_lift2_val_bind {X Y X' Y'}
(Pre : state -> state -> Prop)
(Mid : state -> state -> X -> Y -> Prop)
(Post : state -> state -> X' -> Y' -> Prop)
(m1 : Poram X)
(m2 : Poram Y)
(f1 : X -> Poram X')
(f2 : Y -> Poram Y') :
poram_lift2_val Pre Mid m1 m2 ->
(forall x y,
poram_lift2_val (fun s s' => Mid s s' x y) Post (f1 x) (f2 y)) ->
poram_lift2_val Pre Post
(mbind m1 f1) (mbind m2 f2).