(* seplog (c) AIST 2005-2013. R. Affeldt, N. Marti, et al. GNU GPLv3. *)
(* seplog (c) AIST 2014-2018. R. Affeldt et al. GNU GPLv3. *)
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq.
Require Import ssrZ ZArith_ext seq_ext machine_int multi_int uniq_tac.
Import MachineInt.
Require Import mips_seplog mips_frame mips_tactics mips_contrib mapstos.
Require Import mont_mul_strict_prg.
Require Import mont_square_triple multi_lt_triple multi_sub_u_u_L_triple.
Import expr_m.
Import assert_m.

Local Open Scope machine_int_scope.
Local Open Scope eqmod_scope.
Local Open Scope heap_scope.
Local Open Scope uniq_scope.
Local Open Scope mips_expr_scope.
Local Open Scope mips_assert_scope.
Local Open Scope mips_cmd_scope.
Local Open Scope mips_hoare_scope.
Local Open Scope multi_int_scope.
Local Open Scope zarith_ext_scope.

Section mont_square_strict.

Variables k alpha x z m one ext int_ X_ Y_ M_ Z_ quot C t s_ : reg.

Lemma mont_square_strict_verif :
  uniq(k, alpha, x, z, m, one, ext, int_, X_, Y_, M_, Z_, quot, C, t, s_, r0) ->
  forall nk valpha vx vm vz X M,
  u2Z (M `32_ 0) * u2Z valpha =m -1 {{ \B^1 }} ->
  size X = nk -> size M = nk -> u2Z vz + 4 * Z_of_nat nk.+1 < \B^1 ->
  \S_{ nk } X < \S_{ nk } M ->
  {{ fun s h => [x]_s = vx /\ [z]_s = vz /\ [m]_s = vm /\
    u2Z [k]_s = Z_of_nat nk /\ [alpha]_s = valpha /\
    (var_e x |--> X ** var_e z |--> nseq nk zero32 ++ zero32 :: nil ** var_e m |--> M ++ zero32 :: nil) s h /\ store.multi_null s}}
  mont_mul_strict k alpha x x z m one ext int_ X_ Y_ M_ Z_ quot C t s_
  {{ fun s h => exists Z, size Z = nk /\ [x]_s = vx /\ [z]_s = vz /\ [m]_s = vm /\
    u2Z [k]_s = Z_of_nat nk /\ [alpha]_s = valpha /\
    (var_e x |--> X ** var_e z |--> Z ++ zero32 :: nil ** var_e m |--> M ++ zero32 :: nil) s h /\
    \B^nk * \S_{ nk } Z =m \S_{ nk } X * \S_{ nk } X {{ \S_{ nk } M }} /\ \S_{ nk } Z < \S_{ nk } M}}.
Proof.
move=> Hset nk valpha vx vm vz X M Halpha HlenX HlenM Hnz HXM.
rewrite /mont_mul_strict.

(**  montgomery k alpha x y z m_ one ext int_ X_ Y_ M_ Z_ quot C t s_ ; *)

apply while.hoare_seq with ((fun s h => exists Z, size Z = nk /\
  [x]_s = vx /\ [z]_s = vz /\ [m]_s = vm /\
  u2Z [k]_s = Z_of_nat nk /\ [alpha]_s = valpha /\
  (var_e x |--> X ** var_e z |--> Z ** var_e m |--> M) s h /\
  \B^nk * \S_{nk.+1} (Z ++ [C]_s :: nil) =m \S_{ nk } X * \S_{ nk } X {{ \S_{ nk } M }} /\
  \S_{nk.+1} (Z ++ [C]_s :: nil) < 2 * \S_{ nk } M /\
  u2Z [t]_s = u2Z vz + 4 * Z_of_nat nk.-1) **
(var_e z \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32
  ** var_e m \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32)).

apply (hoare_prop_m.hoare_stren ((fun s h => [x]_s = vx /\ [z]_s = vz /\ [m]_s = vm /\
  u2Z [k]_s = Z_of_nat nk /\ [alpha]_s = valpha /\
  (var_e x |--> X ** var_e z |--> nseq nk zero32 ** var_e m |--> M) s h /\ store.multi_null s) **
(var_e z \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32
  ** var_e m \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32))).

move=> s h [r_x [r_z [r_m_ [r_k [r_alpha [Hmem Hmultiplier]]]]]].

rewrite assert_m.conCE !assert_m.conAE
  decompose_last_equiv size_nseq !assert_m.conAE assert_m.conCE !assert_m.conAE in Hmem.

rewrite assert_m.conCE !assert_m.conAE.
move: Hmem; apply monotony=> // h' Hmem.
rewrite decompose_last_equiv HlenM in Hmem.
rewrite !assert_m.conAE assert_m.conCE !assert_m.conAE in Hmem.
by move: Hmem; apply monotony => // h'' Hmem.

apply frame_rule_R => //.
- eapply mont_square_triple; eauto.
  apply: (ltZ_trans _ Hnz).
  rewrite Z_S mulZDr !addZA -{1}[_ + _]addZ0; exact/ltZ_add2l.
- by Inde_frame.

apply pull_out_exists_con => Z.

apply (hoare_prop_m.hoare_stren (!(fun s => size Z = nk ) **
  (fun s h => [x]_s = vx /\ [z]_s = vz /\ [m]_s = vm /\
    u2Z [k]_s = Z_of_nat nk /\ [alpha]_s = valpha /\
    \B^nk * \S_{nk.+1} (Z ++ [C]_s :: nil) =m \S_{ nk } X * \S_{ nk } X {{ \S_{ nk } M }} /\
    \S_{nk.+1} (Z ++ [C]_s :: nil) < 2 * \S_{ nk } M /\ u2Z [t]_s = u2Z vz + 4 * Z_of_nat nk.-1 /\
    ((var_e x |--> X ** var_e z |--> Z ** var_e m |--> M
      ** var_e z \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32
        ** var_e m \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32) s h)))).

move=> s h [h1 [h2 [Hdisj [Hunion [[len_Z [r_x [r_z [r_m [r_k [r_alpha [Hmem [Sum_Z1 [Sum_Z2 r_t]]]]]]]]] Hmem2]]]]].
exists heap.emp, (h1 \U h2); repeat (split; trivial).
by map_tac_m.Disj.
by map_tac_m.Equal.
rewrite -2!assert_m.conAE; Compose_sepcon h1 h2 => //.
by rewrite conAE.

apply pull_out_bang => len_Z.

(**  ifte_beq C, r0 thendo *)

apply while.hoare_ifte.

(**    (multi_lt_prg k z m_ X_ Y_ int_ ext Z_ M_; *)

apply (hoare_prop_m.hoare_stren (fun s h =>
  (([x]_s = vx /\ [z]_s = vz /\ [m]_s = vm /\
    u2Z [k]_s = Z_of_nat nk /\ [alpha]_s = valpha /\
    \B^nk * \S_{nk.+1} (Z ++ zero32 :: nil) =m \S_{ nk } X * \S_{ nk } X {{\S_{ nk } M}}) /\
  \S_{nk.+1} (Z ++ zero32 :: nil) < 2 * \S_{ nk } M /\
  u2Z [t]_s = u2Z vz + 4 * Z_of_nat nk.-1 /\
  (var_e x |--> X ** var_e z |--> Z ** var_e m |--> M **
    var_e z \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32 **
      var_e m \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32) s h))).

move=> s h [ [r_x [r_z [r_m [r_k [r_alpha [Sum_Z1 [Sum_Z2 [r_t Hmem]]]]]]]] HbeqC0].

rewrite /= store.get_r0 in HbeqC0; move/eqP/u2Z_inj in HbeqC0.
by rewrite HbeqC0 in Sum_Z1 Sum_Z2.

apply (hoare_prop_m.hoare_stren ((fun s h => (u2Z [k]_s = Z_of_nat nk /\
  [z]_s = vz /\ [m]_s = vm /\ (var_e z |--> Z ** var_e m |--> M) s h)) **
((fun s h => [x]_s = vx /\ [alpha]_s = valpha /\
  \B^nk * \S_{nk.+1} (Z ++ zero32 :: nil) =m \S_{ nk } X * \S_{ nk } X {{\S_{ nk } M}} /\
  \S_{nk.+1} (Z ++ zero32 :: nil) < 2 * \S_{ nk } M /\
  u2Z [t]_s = u2Z vz + 4 * Z_of_nat nk.-1) //\\
(var_e x |--> X ** var_e z \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32 **
  var_e m \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32)))).

move=> s h [[r_x [r_z [r_m [r_k [r_alpha Sum_Z1]]]]] [Sum_Z2 [r_t Hmem]]].

have {}Hmem : ((var_e z |--> Z ** var_e m |--> M) **
  (var_e x |--> X ** var_e z \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32 **
    var_e m \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32)) s h.
  by assoc_comm Hmem.
case: Hmem => h1 [h2 [Hdisj [Hunion [H1 H2]]]].
by exists h1, h2.

apply while.hoare_seq with ((fun s h => u2Z [k]_s = Z_of_nat nk /\
  [z]_s = vz /\ [m]_s = vm /\
  ((\S_{ nk } Z < \S_{ nk } M /\ [int_]_s = one32 /\ [ext]_s = zero32) \/
    (\S_{ nk } Z > \S_{ nk } M /\ [int_]_s = zero32 /\ [ext]_s = one32) \/
    (\S_{ nk } Z = \S_{ nk } M /\ [int_]_s = zero32 /\ [ext]_s = zero32)) /\
  (var_e z |--> Z ** var_e m |--> M) s h) **
((fun s h => [x]_s = vx /\ [alpha]_s = valpha /\
  (\B^nk * \S_{ nk.+1 } (Z ++ zero32 :: nil) =m \S_{ nk } X * \S_{ nk } X {{\S_{ nk } M}}) /\
  \S_{ nk.+1 } (Z ++ zero32 :: nil) < 2 * \S_{ nk } M /\
  u2Z [t]_s = u2Z vz + 4 * Z_of_nat nk.-1) //\\
(var_e x |--> X ** var_e z \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32 **
  var_e m \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32))).

apply frame_rule_R.
- eapply multi_lt_triple; eauto.
  by Uniq_uniq r0.
- by Inde_frame.
- move=> ?; by Inde_mult.

(**    ifte_beq int_, r0 thendo *)

apply while.hoare_ifte.

(**      multisub k one z m_ z ext int_ quot C Z_ X_ Y_ X_
    elsedo
      nop)
  elsedo *)

apply (hoare_prop_m.hoare_stren (!(fun s => \S_{ nk } M <= \S_{ nk } Z) **
  (fun s h => [z]_s = vz /\ [m]_s = vm /\ u2Z [k]_s = Z_of_nat nk /\
    [x]_s = vx /\ [alpha]_s = valpha /\
    (\B^nk * \S_{ nk.+1 } (Z ++ zero32 :: nil) =m \S_{ nk } X * \S_{ nk } X {{\S_{ nk } M}}) /\
    \S_{ nk.+1 } (Z ++ zero32 :: nil) < 2 * \S_{ nk } M /\
    u2Z [t]_s = u2Z vz + 4 * Z_of_nat nk.-1 /\
    ((var_e z |--> Z ** var_e m |--> M) **
      (var_e x |--> X ** var_e z \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32 **
        var_e m \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32)) s h))).

move=> s h [[h1 [h2 [Hdisj [Hunion [[r_k [r_z [r_m [Hor Hmem]]]] [[r_x [r_alpha [Sum_Z1 [Sum_Z2 r_t]]]] Hmem2]]]]]] Hbeqint0].

rewrite /= store.get_r0 in Hbeqint0; move/eqP in Hbeqint0.

exists heap.emp, (h1 \U h2); repeat (split; trivial).
by map_tac_m.Disj.
by map_tac_m.Equal.
case : Hor.
- case => _ [Hor _]; by rewrite Hor /one32 /zero32 2?Z2uK in Hbeqint0.
- case; [case=> H _; exact/ltZW/Z.gt_lt | case=> -> _; exact/leZZ].
- by exists h1, h2.

apply pull_out_bang => HZM.

apply (hoare_prop_m.hoare_stren ((fun s h => ([z]_s = vz /\ [m]_s = vm /\
  u2Z [k]_s = Z_of_nat nk /\ (var_e z |--> Z ** var_e m |--> M) s h)) **
(fun s h => [x]_s = vx /\ [alpha]_s = valpha /\
  (\B^nk * \S_{ nk.+1 } (Z ++ zero32 :: nil) =m \S_{ nk } X * \S_{ nk } X {{\S_{ nk } M}}) /\
  \S_{ nk.+1 } (Z ++ zero32 :: nil) < 2 * \S_{ nk } M /\
  u2Z [t]_s = u2Z vz + 4 * Z_of_nat nk.-1 /\
  (var_e x |--> X ** var_e z \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32 **
      var_e m \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32) s h))).

move=> s h [r_z [r_m [r_k [r_x [r_alpha [Sum_Z1 [Sum_Z2 [Hgpt Hmem]]]]]]]].

case: Hmem => h1 [h2 [Hdisj [Hunion [H1 H2]]]].
by exists h1, h2.

apply (hoare_prop_m.hoare_weak ((fun s h => exists Z', size Z' = nk /\ [z]_s = vz /\
  [m]_s = vm /\ u2Z [k]_s = Z_of_nat nk /\ [C]_s = zero32 /\ (var_e z |--> Z' ** var_e m |--> M) s h /\
  \S_{ nk } Z' = \S_{ nk } Z - \S_{ nk } M) **
(fun s h => [x]_s = vx /\ [alpha]_s = valpha /\
  (\B^nk * \S_{ nk.+1 } (Z ++ zero32 :: nil) =m \S_{ nk } X * \S_{ nk } X {{ \S_{ nk } M }}) /\
  \S_{ nk.+1 } (Z ++ zero32 :: nil) < 2 * \S_{ nk } M /\
  u2Z [t]_s = u2Z vz + 4 * Z_of_nat nk.-1 /\
  (var_e x |--> X ** var_e z \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32 **
    var_e m \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32) s h))).

move=> s h [h1 [h2 [Hdisj [Hunion [[Z' [len_Z' [r_z [r_m [r_k [HC [Hmem1 HSumSub]]]]]]] [r_x [r_alpha [Sum_Z1 [Sum_Z2 [r_t Hmem2]]]]]]]]]].
exists Z'; repeat (split; trivial).

move: (assert_m.con_cons _ _ _ _ _ Hdisj Hmem1 Hmem2).
rewrite -Hunion => Htmp.
rewrite 2!decompose_last_equiv len_Z' HlenM; by assoc_comm Htmp.

rewrite HSumSub.
rewrite (lSum_cut_last _ Z) // in Sum_Z1; last by rewrite size_cat /= len_Z addnC.
rewrite subn1 [_.+1.-1]/= /= /zero32 Z2uK // mulZ0 // addZ0 in Sum_Z1.
rewrite mulZBr; exact/eqmod_minmod.

rewrite (lSum_cut_last _ Z) // in Sum_Z2; last by rewrite size_cat /= len_Z addnC.
rewrite subn1 [_.+1.-1]/= /zero32 Z2uK // mulZ0 // in Sum_Z2.
rewrite HSumSub; lia.

apply frame_rule_R.
- eapply multi_sub_u_u_L_triple_B_le_A; eauto.
  + by Uniq_uniq r0.
  + apply: (ltZ_trans _ Hnz).
    rewrite Z_S mulZDr !addZA -{1}[_ + _]addZ0; exact/ltZ_add2l.
- by Inde_frame.
- move=> ?; by Inde_mult.

apply hoare_nop'.

move=> s h [ [h1 [h2 [Hdisj [Hunion [[r_k [r_z [r_m [Hor Hmem1]]]] [[r_x [r_alpha [Sum_Z1 [Sum_Z2 r_t]]]] Hmem2]]]]]] Hbneint0].
exists Z; repeat (split; trivial).

move: (assert_m.con_cons _ _ _ _ _ Hdisj Hmem1 Hmem2).
rewrite -Hunion => Htmp.
rewrite 2!decompose_last_equiv len_Z HlenM; by assoc_comm Htmp.

rewrite (lSum_cut_last _ Z) // in Sum_Z1; last by rewrite size_cat /= len_Z addnC.
by rewrite subn1 /zero32 Z2uK // mulZ0 addZ0 in Sum_Z1.
case: Hor.
- by case.
- rewrite /= store.get_r0 in Hbneint0; move/eqP in Hbneint0.
  case.
  + case=> _ [Hor _]; by rewrite Hor in Hbneint0.
  + move=> [_ [Hor _]]; by rewrite Hor in Hbneint0.

(** addiu t t four16 *)

apply hoare_addiu with (fun s h => ([x]_s = vx /\ [z]_s = vz /\ [m]_s = vm /\
  u2Z [k]_s = Z_of_nat nk /\ [alpha]_s = valpha /\
  (\B^nk * \S_{ nk.+1 } (Z ++ [C]_s :: nil) =m \S_{ nk } X * \S_{ nk } X {{\S_{ nk } M}}) /\
  \S_{ nk.+1 } (Z ++ [C]_s :: nil) < 2 * \S_{ nk } M /\
  u2Z [t]_s = u2Z vz + 4 * Z_of_nat nk /\ u2Z [C]_s <> u2Z (zero32) /\
  (var_e x |--> X ** var_e z |--> Z ** var_e m |--> M **
    var_e z \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32 **
      var_e m \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32) s h)).

move=> s h [[r_x [r_z [r_m [r_k [r_alpha [Sum_Z1 [Sum_Z2 [r_t Hmem]]]]]]]] HbneC0].
rewrite /wp_addiu; repeat Reg_upd; repeat (split; trivial).
- rewrite sext_Z2u // u2Z_add_Z2u //.
  + rewrite r_t -subn1 inj_minus1 //; last by destruct nk => //; exact/le_n_S/le_O_n.
    ring.
  + rewrite r_t -subn1 inj_minus1; last by destruct nk => //; exact/le_n_S/le_O_n.
    rewrite -Zbeta1E; rewrite Z_S in Hnz; lia.
- rewrite /= store.get_r0 // in HbneC0; by move/eqP : HbneC0.
- by Assert_upd.

(** sw C zero16 t *)

apply hoare_sw_back'' with (fun s h => ([x]_s = vx /\ [z]_s = vz /\ [m]_s = vm /\
  u2Z [k]_s = Z_of_nat nk /\ [alpha]_s = valpha /\
  \B^nk * \S_{ nk.+1 } (Z ++ [C]_s :: nil) =m \S_{ nk } X * \S_{ nk } X {{\S_{ nk } M}} /\
  \S_{ nk.+1 } (Z ++ [C]_s :: nil) < 2 * \S_{ nk } M /\
  u2Z [t]_s = u2Z vz + 4 * Z_of_nat nk /\ u2Z [C]_s <> u2Z (zero32) /\
  (var_e x |--> X ** var_e z |--> Z ** var_e m |--> M **
    var_e z \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e [C]_s **
      var_e m \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32) s h)).

move=> s h [r_x [r_z [r_m [r_k [r_alpha [Sum_Z1 [Sum_Z2 [r_t [r_C Hmem]]]]]]]]].

have Htmp : [t]_s `+ sext 16 zero16 = [z]_s `+ Z2u 32 (Z_of_nat (4 * nk)).
  rewrite sext_0 addi0; apply u2Z_inj.
  rewrite r_t u2Z_add_Z2u //.
  rewrite r_z inj_mult; ring.
  exact: Zle_0_nat.
  rewrite r_z -Zbeta1E inj_mult [Z_of_nat 4]/=.
  move: (min_u2Z vz) => ?; omegaz.

exists (int_e zero32).
rewrite assert_m.conCE !assert_m.conAE assert_m.conCE !assert_m.conAE assert_m.conCE !assert_m.conAE in Hmem.
move: Hmem; apply monotony => // h'.
exact: mapsto_ext.

apply currying => h0 H0.

repeat (split; trivial).
assoc_comm H0.
exact: mapsto_ext H0.

(*:    addiu ext k one16 ; *)

apply hoare_addiu with (fun s h => ([x]_s = vx /\ [z]_s = vz /\ [m]_s = vm /\
  u2Z [k]_s = Z_of_nat nk /\ [alpha]_s = valpha /\
  \B^nk * \S_{ nk.+1 } (Z ++ [C]_s :: nil) =m \S_{ nk } X * \S_{ nk } X {{\S_{ nk } M}} /\
  \S_{ nk.+1 } (Z ++ [C]_s :: nil) < 2 * \S_{ nk } M /\
  u2Z [t]_s = u2Z vz + 4 * Z_of_nat nk /\ u2Z [C]_s <> u2Z (zero32) /\
  u2Z [ext]_s = Z_of_nat nk.+1 /\
  (var_e x |--> X ** var_e z |--> Z ** var_e m |--> M **
    var_e z \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e [C]_s **
      var_e m \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32) s h)).

move=> s h [r_x [r_z [r_m [r_k [r_alpha [Sum_Z1 [Sum_Z2 [r_t [r_C Hmem]]]]]]]]].
rewrite /wp_addiu; repeat Reg_upd; repeat (split; trivial).
- rewrite sext_Z2u // u2Z_add_Z2u //.
  + rewrite r_k Z_S; ring.
  + rewrite r_k -Zbeta1E.
    move: (min_u2Z vz) => ?; omegaz.
- by Assert_upd.

(**   multisub ext one z m_ z M_ int_ quot C Z_ X_ Y_ X_). *)

apply (hoare_prop_m.hoare_stren ((fun s h => exists Cint32,
  (\S_{ nk.+1 } (M ++ zero32 :: nil) <= \S_{ nk.+1 } (Z ++ Cint32 :: nil) /\ [C]_s = Cint32) /\ h = heap.emp) **
(fun s h => ([x]_s = vx /\ [z]_s = vz /\ [m]_s = vm /\
  u2Z [k]_s = Z_of_nat nk /\ [alpha]_s = valpha /\
  (\B^nk * \S_{ nk.+1 } (Z ++ [C]_s :: nil) =m \S_{ nk } X * \S_{ nk } X {{\S_{ nk } M}}) /\
  \S_{ nk.+1 } (Z ++ [C]_s :: nil) < 2 * \S_{ nk } M /\
  u2Z [t]_s = u2Z vz + 4 * Z_of_nat nk /\ u2Z [ext]_s = Z_of_nat nk.+1 /\
  ((var_e x |--> X ** var_e z |--> Z ** var_e m |--> M **
    var_e z \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e [C]_s **
      var_e m \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32) s h))))).

move=> s h [r_x [r_z [r_m [r_k [r_alpha [Sum_Z1 [Sum_Z2 [r_t [r_C [r_ext Hmem]]]]]]]]]].
exists heap.emp, h; repeat (split; trivial).
by map_tac_m.Disj.
by map_tac_m.Equal.
exists ([C]_s); repeat (split; trivial).
rewrite lSum_cut_last; last by rewrite size_cat /= HlenM addnC.
rewrite lSum_cut_last; last by rewrite size_cat /= len_Z addnC.
rewrite /= subn1 /zero32 Z2uK // mulZ0 addZ0.
move: (max_lSum nk M); rewrite -ZbetaE => ?.
move: (min_lSum nk Z) (min_lSum nk M) => ? ?.
have ? : 0 < u2Z [C]_s.
  rewrite /zero32 Z2uK // in r_C.
  rewrite ltZ_neqAle; split; by [apply min_u2Z | contradict r_C].
simpl.
apply (@leZ_trans (\S_{ nk } Z + \B^nk * 1)); first by lia.
apply leZ_add2l, leZ_pmul2l; by [lia | ].

apply pull_out_exists_con => Cint32.

apply (hoare_prop_m.hoare_stren (
  !(fun s => \S_{ nk.+1 } (M ++ zero32 :: nil) <= \S_{ nk.+1 } (Z ++ Cint32 :: nil)) **
  (fun s h => [ x ]_s = vx /\ [ z ]_s = vz /\ [ m ]_s = vm /\
    u2Z [ k ]_s = Z_of_nat nk /\ [ alpha ]_s = valpha /\ [ C ]_s = Cint32 /\
    (\B^nk * \S_{ nk.+1 } (Z ++ [ C ]_s :: nil) =m \S_{ nk } X * \S_{ nk } X {{\S_{ nk } M}}) /\
    \S_{ nk.+1 } (Z ++ [ C ]_s :: nil) < 2 * \S_{ nk } M /\
    u2Z [t]_s = u2Z vz + 4 * Z_of_nat nk /\ u2Z [ext]_s = Z_of_nat nk.+1 /\
    (var_e x |--> X ** var_e z |--> Z ** var_e m |--> M **
      var_e z \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e [ C ]_s **
        var_e m \+ int_e (Z2u 32 (Z_of_nat (4 * nk))) |~> int_e zero32) s h))).

move=> s h [h1 [h2 [Hdisj [Hunion [[[Sum_Z1 r_C] Hh1] [r_x [r_z [r_m [r_k [r_alpha [Sum_Z2 [Sum_Z3 [r_t [r_ext Hmem]]]]]]]]]]]]]].
by exists h1, h2.

apply pull_out_bang => HZM.

apply (hoare_prop_m.hoare_stren ((fun s h => [z]_s = vz /\
  [m]_s = vm /\ u2Z [ext]_s = Z_of_nat nk.+1 /\
  (var_e z |--> (Z ++ Cint32 :: nil) ** var_e m |--> M ++ zero32 :: nil) s h) **
(fun s h => [x]_s = vx /\
  u2Z [k]_s = Z_of_nat nk /\ [alpha]_s = valpha /\
  (\B^nk * \S_{ nk.+1 } (Z ++ Cint32 :: nil) =m \S_{ nk } X * \S_{ nk } X {{\S_{ nk } M}}) /\
  \S_{ nk.+1 } (Z ++ Cint32 :: nil) < 2 * \S_{ nk } M /\
  u2Z [t]_s = u2Z vz + 4 * Z_of_nat nk /\ (var_e x |--> X) s h))).

move=> s h [r_x [r_z [r_m [r_k [r_alpha [r_C [Sum_Z1 [Sum_Z2 [r_t [r_ext Hmem]]]]]]]]]].

have {}Hmem : ((var_e z |--> Z ++ Cint32 :: nil ** var_e m |--> M ++ zero32 :: nil) ** (var_e x |--> X)) s h.
  rewrite 2!decompose_last_equiv len_Z HlenM.
  assoc_comm Hmem.
  by rewrite -r_C.
case: Hmem => h1 [h2 [Hdisj [Hunion [H1 H2]]]].
exists h1, h2; repeat (split; trivial).
by rewrite -r_C.
by rewrite -r_C.

apply (hoare_prop_m.hoare_weak ((fun s h => exists Z', size Z' = nk.+1 /\ [z]_s = vz /\
  [m]_s = vm /\ u2Z [ext]_s = Z_of_nat nk.+1 /\ [C]_s = zero32 /\
  (var_e z |--> Z' ** var_e m |--> M ++ zero32 :: nil) s h /\
  \S_{ nk.+1 } Z' = \S_{ nk.+1 } (Z ++ Cint32 :: nil) - \S_{ nk.+1 } (M ++ zero32 :: nil)) **
(fun s h => [x]_s = vx /\ u2Z [k]_s = Z_of_nat nk /\ [alpha]_s = valpha /\
    (\B^nk * \S_{ nk.+1 } (Z ++ Cint32 :: nil) =m \S_{ nk } X * \S_{ nk } X {{ \S_{ nk } M }}) /\
    \S_{ nk.+1 } (Z ++ Cint32 :: nil) < 2 * \S_{ nk } M /\
    u2Z [t]_s = u2Z vz + 4 * Z_of_nat nk /\ (var_e x |--> X) s h))).

move=> s h [h1 [h2 [Hdisj [Hunion [[Z' [len_Z' [r_z [r_m_ [r_ext [HC [Hmem1 Sum_Z']]]]]]] [r_x [r_k [r_alpha [HsumZC2 [HsumZC3 [r_t Hmem2]]]]]]]]]]].

have [Z'' [HlenZ'' HZ'Z'']] :
  exists Z'', size Z'' = nk /\ Z' = Z'' ++ zero32 :: nil.
  have Htmp :  \S_{ nk.+1 } Z' < \S_{ nk.+1 } (M ++ zero32 :: nil).
    rewrite Sum_Z' (lSum_cut_last nk.+1 M); last by rewrite size_cat /= HlenM addnC.
    rewrite !subn1 /zero32 Z2uK // mulZ0 addZ0.
    rewrite (lSum_cut_last nk.+1 M) in HZM; last by rewrite size_cat /= HlenM addnC.
    rewrite subn1 /zero32 Z2uK // mulZ0 addZ0 in HZM.
    rewrite /=.
    apply (@ltZ_leZ_trans (2 * \S_{ nk } M - \S_{ nk } M)); [exact/ltZ_sub2r | lia].
  have Htmp' : \S_{ nk.+1 } Z' < \B^nk.
    rewrite (lSum_cut_last _ M) // in Htmp; last by rewrite size_cat /= HlenM addnC.
    rewrite subn1 [_.+1.-1]/= /zero32 Z2uK // mulZ0 addZ0 in Htmp.
    move: (max_lSum nk M); rewrite -ZbetaE => ?; lia.
  rewrite (lSum_beyond_inv 32 nk.+1 _ nk len_Z').
  exists (take nk Z'); split => //.
  by rewrite size_takel // len_Z'.
  by rewrite subSn // subnn.
  by [].
  by rewrite -ZbetaE.

exists Z''; repeat (split; trivial).

rewrite -HZ'Z'' assert_m.conCE.

exists h1, h2; repeat (split => //).

rewrite HZ'Z'' (lSum_cut_last _ Z'') // in Sum_Z'; last by rewrite size_cat /= HlenZ'' addnC.
rewrite subn1 [_.+1.-1]/= (lSum_cut_last _ M) // in Sum_Z'; last by rewrite size_cat /= HlenM addnC.
rewrite subn1 [_.+1.-1]/= /zero32 Z2uK // mulZ0 2!addZ0 in Sum_Z'.
rewrite Sum_Z' mulZBr; exact: eqmod_minmod.

rewrite HZ'Z'' (lSum_cut_last _ Z'') // in Sum_Z'; last by rewrite size_cat /= HlenZ'' addnC.
rewrite subn1 [_.+1.-1]/= (lSum_cut_last _ M) // in Sum_Z'; last by rewrite size_cat /= HlenM addnC.
rewrite subn1 [_.+1.-1]/= /zero32 Z2uK // mulZ0 2!addZ0 in Sum_Z'.
rewrite Sum_Z'.
apply (@ltZ_leZ_trans (2 * \S_{ nk } M - \S_{ nk } M)); [exact: ltZ_sub2r | lia].

apply frame_rule_R.
- eapply multi_sub_u_u_L_triple_B_le_A; eauto.
  by Uniq_uniq r0.
  by rewrite size_cat /= len_Z addnC.
  by rewrite size_cat /= HlenM addnC.
- by Inde_frame.
- move=> ?; by Inde_mult.
Qed.

End mont_square_strict.


Require Import Omega.
Require Import Bool.
Require Import RelationClasses.
Require Import Program.

From sflib Require Import sflib.
From Paco Require Import paco.

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import DataStructure.
From PromisingLib Require Import DenseOrder.
From PromisingLib Require Import Loc.
From PromisingLib Require Import Language.

Require Import Event.
Require Import Time.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import TView.
Require Import Local.
Require Import Thread.
Require Import Configuration.
Require Import Behavior.

Require Import Single.
Require Import JoinedView.

Require Import LocalDRFPFView.

Require Import OrdStep.
Require Import Stable.
Require Import RAStep.
Require Import PFtoRASimThread.
Require Import PFtoRA.

Set Implicit Arguments.

Module RARace.
Section RARACE.
  Variable L: Loc.t -> bool.

  Definition race (c1: Configuration.t): Prop :=
    exists c2 c3
           tid_w e_w loc from to val released ordw
           tid_r lang st3 lc3 e4 e5
           pf e_r released' ordr,
      (<<WRITE_STEP: OrdConfiguration.step L Ordering.acqrel e_w tid_w c1 c2>>) /\
      (<<WRITE_EVENT: ThreadEvent.is_writing e_w = Some (loc, from, to, val, released, ordw)>>) /\
      (<<STEPS2: rtc (@OrdConfiguration.all_step L Ordering.acqrel) c2 c3>>) /\
      (<<FIND: IdentMap.find tid_r (Configuration.threads c3) = Some (existT _ lang st3, lc3)>>) /\
      (<<THREAD_STEPS: rtc (@OrdThread.all_step _ L Ordering.acqrel)
                           (Thread.mk _ st3 lc3 (Configuration.sc c3) (Configuration.memory c3))
                           e4>>) /\
      (<<CONS: Local.promise_consistent (Thread.local e4)>>) /\
      (<<READ_STEP: OrdThread.step L Ordering.acqrel pf e_r e4 e5>>) /\
      (<<READ_EVENT: ThreadEvent.is_reading e_r = Some (loc, to, val, released', ordr)>>) /\
      (<<LOC: L loc>>) /\
      (<<HIGHER: Time.lt ((Local.tview (Thread.local e4)).(TView.cur).(View.rlx) loc) to>>) /\
      (<<ORDERING: __guard__(Ordering.le ordw Ordering.strong_relaxed \/
                             Ordering.le ordr Ordering.strong_relaxed)>>).

  Definition racefree (c: Configuration.t): Prop :=
    forall c1
           (STEPS1: rtc (@OrdConfiguration.all_step L Ordering.acqrel) c c1),
      ~ race c1.

  Definition racefree_syn (s: Threads.syntax): Prop :=
    racefree (Configuration.init s).

End RARACE.
End RARace.


(* GENERIC *)

Require Export MinBFTg.
Require Export ComponentAxiom.

Section MinBFTkn0.

  Local Open Scope eo.
  Local Open Scope proc.

  Context { dtc                 : DTimeContext        }.
  Context { minbft_context      : MinBFT_context      }.
  Context { m_initial_keys      : MinBFT_initial_keys }.
  Context { u_initial_keys      : USIG_initial_keys   }.
  Context { usig_hash           : USIG_hash           }.
  Context { minbft_auth         : MinBFT_auth         }.

  (* ===============================================================
     Some useful lemmas/definitions
     =============================================================== *)

  Definition ui_in_log_entry (ui : UI) (e : LOG_state_entry) : bool :=
    if UI_dec ui (request_data2ui (log_entry_request_data e))
    then true
    else if in_dec UI_dec ui (log_entry_commits e) then true else false.

  Definition ui_in_log ui l : bool :=
    existsb (ui_in_log_entry ui) l.

  Definition RequestData2HashData (r : RequestData) : HashData :=
    Build_HashData
      (request_data2view r)
      (request_data2request r)
      (ui_pre (request_data2ui r)).

  Lemma HashData_Deq : Deq HashData.
  Proof.
    repeat introv.
    destruct x as [v1 m1 ui1], y as [v2 m2 ui2].
    destruct (ViewDeq v1 v2); subst; prove_dec.
    destruct (Request_Deq m1 m2); subst; prove_dec.

    destruct ui1 as [i1 j1 c1], ui2 as [i2 j2 c2].

    destruct (rep_deq i1 i2); subst; prove_dec.
    destruct (deq_nat j1 j2); subst; prove_dec.
    destruct (deq_nat c1 c2); subst; prove_dec.
  Defined.

  Definition RequestDataAndUI2HashData (r : RequestData) (ui : UI) : HashData :=
    Build_HashData
      (request_data2view r)
      (request_data2request r)
      (ui_pre ui).

  Fixpoint hash_data_in_log_commits (hd : HashData) (rd : RequestData) (l : list UI) : bool :=
    match l with
    | [] => false
    | ui :: uis =>
      if HashData_Deq hd (RequestDataAndUI2HashData rd ui) then true
      else hash_data_in_log_commits hd rd uis
    end.

  Definition hash_data_in_log_entry (hd : HashData) (e : LOG_state_entry) : bool :=
    if HashData_Deq hd (RequestData2HashData (log_entry_request_data e))
    then true
    else hash_data_in_log_commits hd (log_entry_request_data e) (log_entry_commits e).

  Definition hash_data_in_log (hd : HashData) (l : LOG_state) : bool :=
    existsb (hash_data_in_log_entry hd) l.

  Inductive MinBFT_data :=
(*  | minbft_data_prepare (p  : Prepare)
  | minbft_data_commit  (c  : Commit)
  | minbft_data_hdata   (hd : HashData)*)
  | minbft_data_rdata   (rd : RequestData)
  | minbft_data_ui      (ui : UI).

  Definition MinBFT_auth2data (a : AuthenticatedData) : list MinBFT_data :=
    match a with
    | MkAuthData (MinBFT_msg_bare_prepare bp pui) [d] =>
      let ui := Build_UI pui d in
      [minbft_data_rdata (prepare2request_data (prepare bp ui)),
       minbft_data_ui ui]

    | MkAuthData (MinBFT_msg_bare_commit bc pui) [d] =>
      let uj  := Build_UI pui d in
      let com := commit bc uj in
      [minbft_data_rdata (commit2request_data_i com),
       (*minbft_data_rdata (commit2request_data_j com),*)
       minbft_data_ui (bare_commit_ui bc),
       minbft_data_ui uj]

    | _ => []
    end.

  Definition request_data_in_log (rd : RequestData) (l : LOG_state) : bool :=
    match find_entry rd l with
    | Some _ => true
    | None => false
    end.

  Lemma equal_hash_data_implies_equal_request_data :
    forall r1 r2,
      request_data2ui r1 = request_data2ui r2
      -> RequestData2HashData r1 = RequestData2HashData r2
      -> minbft_data_rdata r1 = minbft_data_rdata r2.
  Proof.
    introv h q.
    destruct r1 as [v1 r1 ui1], r2 as [v2 r2 ui2]; simpl in *; subst.
    unfold RequestData2HashData in *; ginv; auto.
  Qed.

  (* === INSTANTIATION OF ComponentTrust === *)

  Definition auth_data2ui (a : AuthenticatedData) : list UI :=
    match a with
    | MkAuthData (MinBFT_msg_bare_prepare _ pui) [d] => [Build_UI pui d]
    | MkAuthData (MinBFT_msg_bare_commit  c pui) [d] => [bare_commit_ui c, Build_UI pui d]
    | _ => []
    end.

  Definition USIG_output_interface2ui (cn : PreCompName) (o : USIG_output_interface) : option UI :=
    match o with
    | create_ui_out ui => ui
    | verify_ui_out b => None
    | verify_ui_out_def => None
    end.

  Global Instance MinBFT_I_ComponentTrust : ComponentTrust :=
    MkComponentTrust
      UI
      auth_data2ui
      USIG_output_interface2ui
      (fun n => Some (ui2rep n)).

  (* === ======================== === *)

End MinBFTkn0.


(* seplog (c) AIST 2005-2013. R. Affeldt, N. Marti, et al. GNU GPLv3. *)
(* seplog (c) AIST 2014-2018. R. Affeldt et al. GNU GPLv3. *)
From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat eqtype seq.
Require Import ssrZ ZArith_ext seq_ext ssrnat_ext machine_int uniq_tac multi_int.
Import MachineInt.
Require Import mips_seplog mips_contrib mips_tactics mips_frame.
Import expr_m.
Import assert_m.
Require Import multi_sub_s_s_s_prg pick_sign_triple multi_add_s_s_u_triple.
Require Import multi_sub_s_s_u_triple pick_sign_triple copy_s_s_triple.

Local Open Scope zarith_ext_scope.
Local Open Scope uniq_scope.
Local Open Scope mips_hoare_scope.
Local Open Scope mips_expr_scope.
Local Open Scope mips_assert_scope.
Local Open Scope machine_int_scope.
Local Open Scope multi_int_scope.

Lemma multi_sub_s_s_s_triple rk rz rx ry a0 a1 a2 a3 a4 a5 rX rY rZ :
  uniq(rk, rz, rx, ry, a0, a1, a2, a3, a4, a5, rX, rY, rZ, r0) ->
  forall nk vx vy vz ptrx ptry ptrz, 0 < Z_of_nat nk < 2 ^^ 31 ->
    u2Z ptrx + 4 * Z_of_nat nk < \B^1 ->
    u2Z ptry + 4 * Z_of_nat nk < \B^1 ->
    u2Z ptrz + 4 * Z_of_nat nk < \B^1 ->
  forall X Y Z, size X = nk -> size Y = nk -> size Z = nk ->
    forall slenx sleny slenz,
    s2Z slenx = sgZ (s2Z slenx) * Z_of_nat nk ->
    s2Z sleny = sgZ (s2Z sleny) * Z_of_nat nk ->
    s2Z slenz = sgZ (s2Z slenz) * Z_of_nat nk ->
    sgZ (s2Z slenx) = sgZ (sgZ (s2Z slenx) * \S_{ nk } X) ->
    sgZ (s2Z sleny) = sgZ (sgZ (s2Z sleny) * \S_{ nk } Y) ->
    sgZ (s2Z slenz) = sgZ (sgZ (s2Z slenz) * \S_{ nk } Z) ->
{{ fun s h => [rx]_s = vx /\ [ry]_s = vy /\ [rz]_s = vz /\ u2Z [rk]_s = Z_of_nat nk /\
    ((var_e rz |--> slenz :: ptrz :: nil ** int_e ptrz |--> Z) **
     (var_e rx |--> slenx :: ptrx :: nil ** int_e ptrx |--> X) **
     (var_e ry |--> sleny :: ptry :: nil ** int_e ptry |--> Y)) s h }}
 multi_sub_s_s_s rk rz rx ry a0 a1 a2 a3 a4 a5 rX rY rZ
 {{ fun s h => exists Z' slenz', size Z' = nk /\
   s2Z slenz' = sgZ (s2Z slenz') * Z_of_nat nk /\
   sgZ (s2Z slenz') = sgZ (sgZ (s2Z slenx) * \S_{ nk } X - sgZ (s2Z sleny) * \S_{ nk } Y) /\
   ((var_e rz |--> slenz' :: ptrz :: nil ** int_e ptrz |--> Z') **
    (var_e rx |--> slenx :: ptrx :: nil ** int_e ptrx |--> X) **
    (var_e ry |--> sleny :: ptry :: nil ** int_e ptry |--> Y)) s h /\
   u2Z ([a3]_ s) <= 1 /\
   sgZ (s2Z slenz') * (\S_{ nk } Z' + u2Z ([a3]_ s) * \B^nk) =
   sgZ (s2Z slenx) * \S_{ nk } X - sgZ (s2Z sleny) * \S_{ nk } Y }}.
Proof.
move=> Hregs nk vx vy vz ptrx ptry ptrz Hnk ptrx_fit ptry_fit ptrz_fit X Y Z lenX lenY lenZ
  slenx sleny slenz Hslenx Hsleny Hslenz sgn_slenx sgn_sleny sgn_slenz.
rewrite /multi_sub_s_s_s.
apply hoare_lw_back_alt'' with (fun s h =>
  [rx ]_ s = vx /\ [ry ]_ s = vy /\ [rz ]_ s = vz /\
  u2Z [rk ]_ s = Z_of_nat nk /\
  ((var_e rz |--> slenz :: ptrz :: nil ** int_e ptrz |--> Z) **
    (var_e rx |--> slenx :: ptrx :: nil ** int_e ptrx |--> X) **
    var_e ry |--> sleny :: ptry :: nil ** int_e ptry |--> Y) s h /\
  [rY]_s = ptry).
move=> s h [Hrx [Hry [hrz [Hrk H]]]].
exists ptry; split.
  rewrite -conAE conCE conAE -mapsto2_mapstos conAE -conCE conAE in H.
  move: H; apply monotony => // h'; apply mapsto_ext => //=; by rewrite sext_Z2u.
rewrite /update_store_lw.
repeat Reg_upd.
repeat (split=> //).
by Assert_upd.
apply while.hoare_seq with (fun s h =>
  [rx ]_ s = vx /\ [ry ]_ s = vy /\ [ rz ]_s = vz /\
  u2Z [rk ]_ s = Z_of_nat nk /\
  ((var_e rz |--> slenz :: ptrz :: nil ** int_e ptrz |--> Z) **
    (var_e rx |--> slenx :: ptrx :: nil ** int_e ptrx |--> X) **
    var_e ry |--> sleny :: ptry :: nil ** int_e ptry |--> Y) s h /\
  [rY]_s = ptry /\
  [a0 ]_ s = sleny /\
  sgZ (s2Z [a1 ]_ s) = sgZ (s2Z sleny) /\
  (s2Z [ a1 ]_ s = 0 \/ s2Z [ a1 ]_ s = 1 \/ s2Z [ a1 ]_s = - 1)).
eapply while.hoare_conseq; last first.
  apply (pick_sign_triple
    (fun s h => [rx ]_ s = vx /\ [ rz ]_s = vz /\ [rY ]_ s = ptry /\ u2Z [rk ]_ s = Z_of_nat nk)
    ((var_e rz |--> slenz :: ptrz :: nil ** int_e ptrz |--> Z) **
      (var_e rx |--> slenx :: ptrx :: nil ** int_e ptrx |--> X) **
      var_e ry \+ int_e four32 |--> ptry :: nil ** int_e ptry |--> Y) vy sleny).
  by Uniq_uniq r0.
  by Inde.
  by Inde.
move=> s h [Hrx [Hry [Hrz [Hrk [H HrY]]]]].
repeat (split => //).
rewrite -conAE conCE -mapsto2_mapstos in H.
assoc_comm H.
by rewrite -mapsto1_mapstos.
move=> s h [Hry [Ha0 [sgn_a1 [Ha1 [H [Hrx [Hrz [HrY Hrk]]]]]]]].
repeat (split => //).
rewrite -conAE conCE -mapsto2_mapstos.
assoc_comm H.
by rewrite mapsto1_mapstos.
apply while.hoare_ifte.

apply while.hoare_ifte.

apply while.hoare_seq with (fun s h => s2Z sleny = 0 /\
  [rx ]_ s = vx /\ [ry ]_ s = vy /\ [rz ]_ s = vz /\
  u2Z [rk ]_ s = Z_of_nat nk /\
  ((var_e rz |--> slenx :: ptrz :: nil ** int_e ptrz |--> (if slenx == zero32 then Z else X)) **
    (var_e rx |--> slenx :: ptrx :: nil ** int_e ptrx |--> X) **
    var_e ry |--> sleny :: ptry :: nil ** int_e ptry |--> Y) s h /\
  [rY ]_ s = ptry).
have : uniq(rk, rz, rx, a0, a1, a2, a3, a4, r0) by Uniq_uniq r0.
move/copy_s_s_triple.
move/(_ Z X nk lenZ lenX slenz ptrz ptrz_fit slenx ptrx ptrx_fit vx Hslenx sgn_slenx) =>
  hoare_triple.
eapply (before_frame (fun s h =>
  s2Z sleny = 0 /\
  [ry ]_ s = vy /\
  [rz ]_ s = vz /\
  (var_e ry |--> sleny :: ptry :: nil ** int_e ptry |--> Y) s h /\
  [rY ]_ s = ptry)).
apply frame_rule_R.
by apply hoare_triple.
rewrite [modified_regs _]/=; by Inde.
by [].
move=> s h [[[Hrx [Hry [Hrz [Hrk [H [HrY [Ha0 [sgn_a1 Ha1']]]]]]]] _] Ha1].
rewrite -conAE in H; case: H => h1 [h2 [h1dh2 [h1Uh2 [Hh1 Hh2]]]].
rewrite /= store.get_r0 in Ha1.
move/eqP/u2Z_inj in Ha1.
exists h1, h2; repeat (split => //).
rewrite Ha1 s2Z_u2Z_pos' // Z2uK //= in sgn_a1.
by apply/Zsgn_null/esym.
move=> s h [h1 [h2 [h1dh2 [h1Uh2 [Hh1 Hh2]]]]].
case: Hh1 => Hrx [Hrk Hh1].
case: Hh2 => sleny_0 [Hry [Hrz [Hh2 HrY]]].
repeat (split => //).
rewrite -conAE.
by exists h1, h2.

apply (hoare_prop_m.pull_out_conjunction' hoare0_false) => sleny0.

apply hoare_addiu'.
move=> s h [Hrx [Hry [Hrz [Hrk [H HrY]]]]].
rewrite /wp_addiu.
exists (if slenx == zero32 then Z else X), slenx.
split; first by case: ifP.
split; first by [].
split; first by rewrite sleny0 /= subZ0.
split; first by Assert_upd.
repeat Reg_upd.
rewrite add0i sext_Z2u // Z2uK //.
split; first by [].
rewrite mul0Z addZ0 sleny0 /= subZ0.
case: ifP => // /eqP ->.
by rewrite s2Z_u2Z_pos' // Z2uK.

have : uniq(rk, rz, rx, rY, a0, a1, a2, a3, a4, a5, rX, rZ, r0) by Uniq_uniq r0.
move/multi_sub_s_s_u_triple/(_ nk vz vx ptry Hnk ptrz ptrx ptrz_fit ptrx_fit ptry_fit Z X Y lenZ lenX lenY slenx slenz Hslenx Hslenz sgn_slenx) => hoare_triple.
eapply (before_frame (fun s h => 0 < s2Z sleny /\ [ry ]_ s = vy /\
  (var_e ry |--> sleny :: ptry :: nil) s h )).
apply frame_rule_R.
  exact/hoare_triple.
  rewrite [modified_regs _]/=; by Inde.
by [].
move=> s h [[[Hrx [hry [Hrz [Hrk [H [hrY [Ha0 [sgn_a1 Ha1'']]]]]]]] Ha1'] Ha1].
rewrite -conAE conCE 2!conAE in H.
case: H => h1 [h2 [h1dh2 [h1Uh2 [Hh1 Hh2]]]].
rewrite conCE.
exists h1, h2; repeat (split => //).
have Ha1''' : s2Z [a1]_s = 1.
  case: Ha1'' => Ha1''.
    rewrite /= in Ha1.
    exfalso.
    move/eqP in Ha1; apply Ha1.
    by rewrite store.get_r0 Z2uK // -s2Z_u2Z_pos // Ha1''.
  case: Ha1'' => // Ha1''.
  rewrite /= in Ha1'.
  exfalso.
  move/leZP : Ha1'.
  by rewrite Ha1'' => /leZP.
rewrite Ha1''' /= in sgn_a1.
by apply Zsgn_pos.
rewrite -conAE conCE.
move: Hh2; apply monotony => // h2'.
by apply mapstos_ext.
move=> Hh2'; by assoc_comm Hh2'.

move=> s h [h1 [h2 [h1dh2 [h1Uh2 [Hh1 Hh2]]]]].
case: Hh1 => Z' [slenz' [lenZ' [HrY [Hslenz' [sgn_slenz' [Hh1 [Ha3 HSum]]]]]]].
case: Hh2 => sleny0 [Hry Hh2].
exists Z', slenz'; repeat (split => //).
apply Zsgn_pos in sleny0; by rewrite sgn_slenz' sleny0 mul1Z.
rewrite -2!conAE conCE -conAE.
exists h1, h2; repeat (split => //).
assoc_comm Hh1.
move: Hh1; apply mapstos_ext => /=.
by [].
apply Zsgn_pos in sleny0; by rewrite sleny0 mul1Z.

have : uniq(rk, rz, rx, rY, a0, a1, a2, a3, a4, a5, rX, rZ, r0) by Uniq_uniq r0.
move/multi_add_s_s_u_triple/(_ nk vz vx ptry Hnk ptrz ptrx
ptrz_fit ptrx_fit ptry_fit Z X Y lenZ lenX lenY _ _ Hslenx Hslenz sgn_slenx) => hoare_triple.
eapply (before_frame (fun s h => s2Z sleny < 0 /\ (var_e ry |--> sleny :: ptry :: nil) s h)).
apply frame_rule_R.
  by apply hoare_triple.
  rewrite [modified_regs _]/=; by Inde.
by [].
move=> s h [ [Hrx [Hry [Hrz [Hrk [H [HrY [Ha0 [Ha1' Ha1'']]]]]]]] Ha1 ].
rewrite /= in Ha1.
move/leZP in Ha1.
rewrite -conAE conCE -mapsto2_mapstos conAE in H.
rewrite conCE.
case: H => h1 [h2 [h1dh2 [h1Uh2 [Hh1 Hh2]]]].
exists h1, h2; repeat (split => //).
suff : s2Z [a1 ]_ s = -1.
  move=> abs; rewrite abs /= in Ha1'.
  by apply Zsgn_neg.
case: Ha1'' => // Ha1''.
  exfalso.
  by move: Ha1; rewrite Ha1'' => /leZP.
case: Ha1'' => // Ha1''.
exfalso.
by move: Ha1; rewrite Ha1'' => /leZP.
by rewrite -mapsto2_mapstos.
rewrite -conAE conCE.
assoc_comm Hh2.
move: Hh2; by apply mapstos_ext.

move=> s h [h1 [h2 [h1dh2 [h1Uh2 [Hh1 Hh2]]]]].
case: Hh1 => Z' [slenz' [lenZ' [HrY [H_ [sgn_slenz' [Hh1 [Ha3 HSum]]]]]]].
case: Hh2 => sleny0 Hh2.
have Htmp : sgZ (s2Z sleny) = -1 by apply Zsgn_neg.
exists Z', slenz'; repeat (split => //).
rewrite sgn_slenz' Htmp.
by rewrite Z.sub_opp_r.
rewrite -conAE conCE conAE conCE.
exists h1, h2; repeat (split => //).
assoc_comm Hh1.
move: Hh1; by apply mapstos_ext => /=.
rewrite HSum Htmp; ring.
Qed.