Require Import Coq.Strings.Ascii.
Require Import Fiat.Common.Enumerable.
Require Import Fiat.Common.Enumerable.BoolProp.
Require Import Fiat.Common.List.Operations.
Require Import Fiat.Common.List.FlattenList.
Require Import Fiat.Common.List.ListFacts.
Require Import Fiat.Common.Equality.
Require Import Fiat.Common.StringOperations.
Require Import Fiat.Common.StringFacts.
Require Import Fiat.Parsers.ContextFreeGrammar.Core.
Require Import Fiat.Parsers.ContextFreeGrammar.PreNotations.
Require Import Fiat.Common.Gensym.

Local Open Scope type_scope.

Definition default_nonterminal_carrierT : Type := nat.
(** (nonterminal, production_index, drop_count) *)
Definition default_production_carrierT : Type
  := default_nonterminal_carrierT * (nat * nat).

Global Instance dnc_BoolDecR : BoolDecR default_nonterminal_carrierT := _.
Global Instance dnc_BoolDec_bl : BoolDec_bl (@eq default_nonterminal_carrierT)
  := _.
Global Instance dnc_BoolDec_lb : BoolDec_lb (@eq default_nonterminal_carrierT)
  := _.

Local Ltac eassumption' :=
  idtac;
  match goal with
    | [ H : _ |- _ ] => solve [ refine H ]
  end.

Definition default_production_carrierT_beq : default_production_carrierT -> default_production_carrierT -> bool
  := Equality.beq.
Definition default_production_carrierT_bl
: forall {x y}, default_production_carrierT_beq x y = true -> x = y
  := Equality.bl.
Definition default_production_carrierT_lb
: forall {x y}, x = y -> default_production_carrierT_beq x y = true
  := Equality.lb.

Section grammar.
  Context {Char} {G : pregrammar' Char}.

  Local Notation valid_nonterminals := (List.map fst (pregrammar_productions G)).

  Definition some_invalid_nonterminal
    := gensym valid_nonterminals.

  Lemma some_invalid_nonterminal_invalid'
  : ~List.In some_invalid_nonterminal valid_nonterminals.
  Proof.
    apply gensym_fresh.
  Qed.
  Lemma some_invalid_nonterminal_invalid
  : ~List.In some_invalid_nonterminal (Valid_nonterminals G).
  Proof.
    intro H; apply some_invalid_nonterminal_invalid'.
    assumption.
  Qed.

  Definition default_to_nonterminal
  : default_nonterminal_carrierT -> String.string
    := fun nt => List.nth nt valid_nonterminals some_invalid_nonterminal.

  Lemma default_find_to_nonterminal idx
  : List.first_index_error
      (string_beq (default_to_nonterminal idx))
      valid_nonterminals
    = bool_rect
        (fun _ => option _)
        (Some idx)
        (None)
        (Compare_dec.leb (S idx) (List.length valid_nonterminals)).
  Proof.
    pose proof (nonterminals_unique G) as HNoDup.
    hnf in HNoDup.
    unfold pregrammar_nonterminals in *.
    destruct (Compare_dec.leb (S idx) (List.length valid_nonterminals)) eqn:H0; simpl;
      [ apply Compare_dec.leb_complete in H0
      | apply Compare_dec.leb_complete_conv in H0 ].
      { generalize dependent idx.
        unfold default_to_nonterminal, default_to_nonterminal, Valid_nonterminals, grammar_of_pregrammar, pregrammar_nonterminals.
        replace valid_nonterminals with (uniquize string_beq valid_nonterminals) by (rewrite HNoDup; reflexivity).
        induction valid_nonterminals as [|x xs IHxs].
        { simpl; intros; omega. }
        { simpl.
          simpl in *.
          destruct (list_bin string_beq x (uniquize string_beq xs)) eqn:H''; try assumption.
          { apply (f_equal (@List.length _)) in HNoDup.
            simpl in *.
            pose proof (uniquize_shorter xs string_beq) as H'.
            rewrite HNoDup in H'.
            exfalso; clear -H'.
            omega. }
          apply (f_equal (@List.tl _)) in HNoDup; simpl in *.
          specialize (IHxs HNoDup).
          intros [|idx].
          { simpl.
            rewrite (string_lb eq_refl); trivial. }
          { simpl; intros H'.
            specialize (IHxs idx (Le.le_S_n _ _ H')).
            rewrite first_index_helper_first_index_error, IHxs by omega.
            apply first_index_error_Some_correct in IHxs.
            repeat match goal with
                     | _ => exact (@string_lb)
                     | _ => progress simpl in *
                     | [ H : and _ _ |- _ ] => destruct H
                     | [ H : ex _ |- _ ] => destruct H
                     | [ |- context[if ?E then _ else _] ] => destruct E eqn:?
                     | _ => reflexivity
                     | [ |- Some _ = Some _ ] => apply f_equal
                     | [ |- 0 = S _ ] => exfalso
                     | [ H : string_beq _ _ = true |- _ ] => apply string_bl in H
                     | _ => progress subst
                     | [ H : _ = ?x |- _ ] => is_var x; subst x
                     | [ H : S _ = S _ |- _ ] => apply (f_equal pred) in H
                     | [ H : List.length (uniquize _ _) = List.length _ |- _ ]
                       => apply uniquize_length in H
                     | [ H : uniquize ?beq ?ls = ?ls, H' : context[uniquize ?beq ?ls] |- _ ]
                       => rewrite H in H'
                     | [ H : list_bin _ _ _ = false |- False ]
                       => rewrite list_in_lb in H; [ discriminate | | ]
                     | [ |- List.In (List.nth _ _ _) _ ] => apply List.nth_In; omega
                     | [ |- context[List.nth_error ?n ?ls] ] => destruct (List.nth_error n ls) eqn:?
                     | _ => congruence
                     | _ => progress unfold BoolFacts.Bool.bool_rect_nodep in *
                   end. } } }
      { unfold default_to_nonterminal, default_to_nonterminal.
        simpl.
        rewrite List.nth_overflow by omega.
        apply first_index_error_None_correct; intros elem H''.
        destruct (string_beq some_invalid_nonterminal elem) eqn:H'''; trivial.
        apply string_bl in H'''.
        subst.
        apply some_invalid_nonterminal_invalid' in H''; destruct H''. }
  Qed.

  Lemma list_to_productions_to_nonterminal nt
  : Lookup_string G (default_to_nonterminal nt)
    = Lookup_idx G nt.
  Proof.
    unfold Lookup_string, Lookup_idx.
    unfold list_to_productions at 1; simpl.
    unfold productions, production in *.
    rewrite <- find_first_index_error by exact bl.
    rewrite default_find_to_nonterminal.
    set (ls' := pregrammar_productions G); clearbody ls'.
    revert nt; induction ls' as [|x xs IHxs]; simpl; intro nt;
    destruct nt; simpl; trivial;
    rewrite <- IHxs; clear IHxs.
    edestruct @Compare_dec.leb; simpl; reflexivity.
  Qed.

  Section index.
    Context (idx : default_production_carrierT).

    Let nt_idx := fst idx.
    Let nts := (Lookup_idx G nt_idx).
    Let ps_idx := List.length nts - S (fst (snd idx)).
    Let drop_count := snd (snd idx).
    Let ps := (List.nth ps_idx nts nil).

    Definition default_to_production : production Char
    := List.drop drop_count ps.

    Definition default_production_tl : default_production_carrierT
      := (nt_idx,
          (fst (snd idx),
           if Compare_dec.leb (S drop_count) (List.length ps)
           then S drop_count
           else drop_count)).

    Definition default_production_carrier_valid : bool
      := ((Compare_dec.leb (S nt_idx) (List.length (pregrammar_productions G)))
            && ((Compare_dec.leb (S (fst (snd idx))) (List.length nts))
                  && (Compare_dec.leb drop_count (List.length ps))))%bool.
  End index.

  Global Instance default_production_carrier_valid_enumerable
  : Enumerable { idx : default_production_carrierT | is_true (default_production_carrier_valid idx) }.
  Proof.
    exact _.
  Defined.
End grammar.


From Coqprime Require Import PocklingtonRefl.
Local Open Scope positive_scope.
Require Import  p11_0.
Require Import  p11_1.
Require Import  p11_2.
Require Import  p11_3.
Require Import  p11_4.
Require Import  p11_5.
Require Import  p11_6.
Require Import  p11_7.
Require Import  p11_8.
Require Import  p11_9.
Require Import  p11_10.
Require Import  p11_11.
Require Import  p11_12.
Require Import  p11_13.
Require Import  p11_14.
Require Import  p11_15.
Require Import  p11_16.
Require Import  p11_17.
Require Import  p11_18.
Require Import  p11_19.
Require Import  p11_20.
Require Import  p11_21.
Require Import  p11_22.
Require Import  p11_23.
Require Import  p11_24.
Require Import  p11_25.
Require Import  p11_26.
Require Import  p11_27.
Require Import  p11_28.
Require Import  p11_29.
Require Import  p11_30.
Require Import  p11_31.
Require Import  p11_32.
Require Import  p11_33.
Require Import  p11_34.
Require Import  p11_35.
Require Import  p11_36.
Require Import  p11_37.
Require Import  p11_38.
Require Import  p11_39.
Require Import  p11_40.
Require Import  p11_41.
Require Import  p11_42.
Require Import  p11_43.
Require Import  p11_44.
Require Import  p11_45.
Require Import  p11_46.
Require Import  p11_47.
Require Import  p11_48.
Require Import  p11_49.
Require Import  p11_50.
Require Import  p11_51.
Require Import  p11_52.
Require Import  p11_53.
Require Import  p11_54.
Require Import  p11_55.
Require Import  p11_56.
Require Import  p11_57.
Require Import  p11_58.
Require Import  p11_59.
Require Import  p11_60.
Require Import  p11_61.
Require Import  p11_62.
Require Import  p11_63.
Require Import  p11_64.
Require Import  p11_65.
Require Import  p11_66.
Require Import  p11_67.
Require Import  p11_68.
Require Import  p11_69.
Require Import  p11_70.
Require Import  p11_71.
Require Import  p11_72.
Require Import  p11_73.
Require Import  p11_74.
Require Import  p11_75.
Require Import  p11_76.
Require Import  p11_77.
Require Import  p11_78.
Require Import  p11_79.
Require Import  p11_80.
Require Import  p11_81.
Require Import  p11_82.
Require Import  p11_83.
Require Import  p11_84.
Require Import  p11_85.
Require Import  p11_86.
Require Import  p11_87.
Require Import  p11_88.
Require Import  p11_89.
Require Import  p11_90.
Require Import  p11_91.
Require Import  p11_92.
Require Import  p11_93.
Require Import  p11_94.
Require Import  p11_95.
Require Import  p11_96.
Require Import  p11_97.
Require Import  p11_98.
Require Import  p11_99.
Require Import  p11_100.
Require Import  p11_101.
Require Import  p11_102.
Require Import  p11_103.
Require Import  p11_104.
Require Import  p11_105.
Require Import  p11_106.
Require Import  p11_107.
Require Import  p11_108.
Require Import  p11_109.
Require Import  p11_110.
Require Import  p11_111.
Require Import  p11_112.
Require Import  p11_113.
Require Import  p11_114.
Require Import  p11_115.
Require Import  p11_116.
Require Import  p11_117.
Require Import  p11_118.
Require Import  p11_119.
Require Import  p11_120.
Require Import  p11_121.
Require Import  p11_122.

Lemma  primo: prime 3563460728101118298229371115865970481044819223675200285275488632043525832262132249539830178755274741587837088015967729069590355645254412149985554902590736107673878699603023839312818401354719067107751421298039868676536138879187429498361351047753425236506091250888523693233395165252850631412794910629424929608098207781383646407138888952240245227717506820102107998986149323111996203607988470169649137242461140780302116452239343784545884848055714409006993475687995140188893391435363343214421654991280601382598565844648511024684919160392624395401288646923527005429511313993248781257994597340472567957348232037403808167633263995759576462321510959968224378012092370943925101232418885996274881788074601638717665313611181497934117962479902901702277391997459499382130878521678662811797039134302560667298323527656111492988711007388606096914990586514343033859123027480915922660863474758445608891045651988847977972184220169617081550670659.
Proof.
exact
(primo0 (primo1 (primo2 (primo3 (primo4 (primo5 (primo6 (primo7 (primo8 (primo9 (primo10 (primo11 (primo12 (primo13 (primo14 (primo15 (primo16 (primo17 (primo18 (primo19 (primo20 (primo21 (primo22 (primo23 (primo24 (primo25 (primo26 (primo27 (primo28 (primo29 (primo30 (primo31 (primo32 (primo33 (primo34 (primo35 (primo36 (primo37 (primo38 (primo39 (primo40 (primo41 (primo42 (primo43 (primo44 (primo45 (primo46 (primo47 (primo48 (primo49 (primo50 (primo51 (primo52 (primo53 (primo54 (primo55 (primo56 (primo57 (primo58 (primo59 (primo60 (primo61 (primo62 (primo63 (primo64 (primo65 (primo66 (primo67 (primo68 (primo69 (primo70 (primo71 (primo72 (primo73 (primo74 (primo75 (primo76 (primo77 (primo78 (primo79 (primo80 (primo81 (primo82 (primo83 (primo84 (primo85 (primo86 (primo87 (primo88 (primo89 (primo90 (primo91 (primo92 (primo93 (primo94 (primo95 (primo96 (primo97 (primo98 (primo99 (primo100 (primo101 (primo102 (primo103 (primo104 (primo105 (primo106 (primo107 (primo108 (primo109 (primo110 (primo111 (primo112 (primo113 (primo114 (primo115 (primo116 (primo117 (primo118 (primo119 (primo120 (primo121 primo122)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))).
Qed.


Require Export Db.Spec.
Require Import Coq.Logic.FunctionalExtensionality.
Require Export Coq.Program.Equality.
Require Export Coq.Program.Tactics.

Module Type Kit.

  Parameter TM: Type.
  Declare Instance inst_vr: Vr TM.
  Declare Instance inst_ap: ∀ Y {vrY: Vr Y} {wkY: Wk Y} {liftY: Lift Y TM}, Ap TM Y.

  Declare Instance inst_ap_inj: LemApInj (apXY := inst_ap Ix) TM Ix.
  Declare Instance inst_ap_vr:
    ∀ Y {vrY: Vr Y} {wkY: Wk Y} {liftY: Lift Y TM}, LemApVr TM Y.
  Parameter inst_ap_comp:
    ∀ Y Z {vrY: Vr Y} {wkY: Wk Y} {liftY: Lift Y TM} {vrZ: Vr Z} {wkZ: Wk Z}
      {liftZ: Lift Z TM} {apYZ: Ap Y Z} {compUpYZ: LemCompUp Y Z}
      {apLiftYZTM: LemApLift Y Z TM}, LemApComp TM Y Z.
  Parameter inst_ap_liftSub:
    ∀ Y {vrY: Vr Y} {wkY: Wk Y} {liftY: Lift Y TM}, LemApLiftSub TM Y.
  Parameter inst_ap_ixComp:
    ∀ (t: TM) (ξ: Sub Ix) (ζ: Sub TM), t[ξ][ζ] = t[⌈ξ⌉ >=> ζ].

End Kit.

Module Inst (kit: Kit).

  Local Ltac crush :=
    intros; cbn in * |-;
    repeat
      (cbn;
       repeat crushDbSyntaxMatchH;
       rewrite ?ap_vr, ?ap_comp);
    auto.

  Import kit.
  Existing Instance inst_ap.
  Existing Instance inst_ap_vr.
  Existing Instance inst_ap_inj.
  Existing Instance inst_ap_comp.
  Existing Instance inst_ap_liftSub.

  Instance inst_apTMZTM {Z} {vrZ: Vr Z} {apTMZ: Ap TM Z} :
    LemApLift TM Z TM := λ _ _, eq_refl.
  Instance inst_apLiftIxIx: LemApLift Ix Ix TM := ap_vr.

  #[refine] Instance compUpTMIx: LemCompUp TM Ix := {}.
  Proof. intros; extensionality i; destruct i; crush. Qed.

  Instance inst_wkApIx: LemApWk TM Ix := λ _, eq_refl.

  #[refine] Instance compUpTM: LemCompUp TM TM := {}.
  Proof.
    intros; extensionality i; destruct i; crush.
    rewrite inst_ap_ixComp; f_equal.
    extensionality j; destruct j; crush.
  Qed.

  #[refine] Instance wkApTM: LemApWk TM TM := {}.
  Proof.
    crush.
    rewrite  <- ap_liftSub.
    f_equal.
    extensionality i; crush.
  Qed.

  (* Instance sbTM: Subst TM := {}. *)

  (* Automatically populate the infrastructure database for type TM with lemmas
     for which the rewrite direction is certain. *)
  (* Hint Rewrite (apply_wkm_comm TM Ix) : infrastructure. *)
  (* Hint Rewrite (apply_wkm_beta1_cancel TM TM) : infrastructure. *)
  (* Hint Rewrite (apply_beta1_comm TM TM) : infrastructure. *)

  (* Hint Rewrite (apply_wkm_up_comm TM Ix) : infrastructure. *)
  (* Hint Rewrite (apply_wkm_beta1_up_cancel TM TM) : infrastructure. *)
  (* Hint Rewrite (apply_beta1_up_comm TM TM) : infrastructure. *)

  (* Hint Rewrite (apply_wkm_up2_comm TM Ix) : infrastructure. *)
  (* Hint Rewrite (apply_wkm_beta1_up2_cancel TM TM) : infrastructure. *)
  (* Hint Rewrite (apply_beta1_up2_comm TM TM) : infrastructure. *)

  (* Hint Rewrite (apply_wkm_ups_comm TM Ix) : infrastructure. *)
  (* Hint Rewrite (apply_wkm_beta1_ups_cancel TM TM) : infrastructure. *)
  (* Hint Rewrite (apply_beta1_ups_comm TM TM) : infrastructure. *)

  (* Hint Rewrite (ap_liftSub' TM TM) : infrastructure. *)
  (* Hint Rewrite (up_liftSub TM) : infrastructure. *)
  (* Hint Rewrite (liftSub_wkm TM) : infrastructure. *)
  (* Hint Rewrite (liftSub_wkms TM) : infrastructure. *)

  (* Hint Rewrite (up_wk TM) : infrastructure. *)
  (* Hint Rewrite (wk_ap TM) : infrastructure. *)

  (* Set Printing  Implicit. *)
  (* Unset Printing Notations. *)
  (* Print Rewrite HintDb infrastructure. *)

End Inst.


Require Import Lia List.
Import ListNotations.
From Minirust.def Require Import ty encoding le.
From Minirust.proof.lemma Require Import le wrap_abstract.

Section unique_prov.

Context {memory: Memory}.

Lemma unique_prov_cons2 {a} {b} {l} {p} (H: unique_prov (a :: b :: l) = Some p) :
  unique_prov (b :: l) = Some p.
Proof.

destruct a.
{ discriminate H. }

destruct o; cycle 1.
{ discriminate H. }

destruct b.
{ unfold unique_prov in H. simpl in H. destruct (P_EQ_REFLECT p0 p0); auto. }

destruct o; cycle 1.
{ unfold unique_prov in H. simpl in H. destruct (P_EQ_REFLECT p0 p0); auto. }

destruct (P_EQ_REFLECT p0 p1).
- unfold unique_prov in H.
  simpl in H.
  destruct (P_EQ_REFLECT p0 p0); cycle 1.
  { exfalso. apply n. auto. }

  destruct (P_EQ_REFLECT p1 p0); cycle 1.
  { simpl in H. discriminate H. }

  simpl in H.
  unfold unique_prov.
  rewrite <- H.
  simpl.
  f_equal; try auto.

  destruct (P_EQ_REFLECT p1 p1); cycle 1.
  { exfalso. apply n. auto. }

  simpl.
  rewrite <- e.
  auto.
- unfold unique_prov in H.
  simpl in H.

  destruct (P_EQ_REFLECT p0 p0); cycle 1.
  { exfalso. apply n0. auto. }

  destruct (P_EQ_REFLECT p1 p0); cycle 1.
  { simpl in H. discriminate H. }

  simpl in H.
  exfalso.
  apply n.
  auto.
Qed.

Lemma unique_le {l1 l2: list AbstractByte} (Hle: le l1 l2) p (H: unique_prov l1 = Some p) :
  unique_prov l2 = Some p.
Proof.
assert (l1 = l2); cycle 1.
{ rewrite <- H0. auto. }

induction (mk_le_list _ _ Hle) as [| ab1 ab2 l1 l2 HLe IH HLeAB _].
{ auto. }

assert (le l1 l2) as Hle'.
{ simpl in Hle. inversion Hle. assumption. }

assert (ab1 = ab2). {
  destruct ab1.
  { unfold unique_prov in H. simpl in H. discriminate H. }

  destruct HLeAB.
  - unfold unique_prov in H. discriminate H.
  - unfold unique_prov in H. discriminate H.
  - simpl in Hle. inversion Hle. inversion H0; auto.
}
rewrite <- H0. rewrite <- H0 in Hle,HLeAB. clear H0 ab2.
f_equal.

destruct l1.
- destruct l2.
-- auto.
-- contradiction Hle'.
- apply IH.
-- assumption.
-- apply (unique_prov_cons2 H).
Qed.

Lemma unique_prov_dev {b} {p} {b0} {l} : unique_prov (Init b p :: Init b0 p :: l) = unique_prov (Init b0 p :: l).
Proof.
unfold unique_prov.
simpl.
destruct p.
- simpl.
  destruct (P_EQ_REFLECT p p); auto.
- simpl. auto.
Qed.

Lemma unique_wrap {l} {p} (H: length l > 0): unique_prov (wrap_abstract l p) = p.
Proof.
induction l as [|b l IH].
- simpl in H.
  assert (~(0 > 0)). { lia. }
  exfalso.
  apply H0.
  assumption.
- destruct l.
-- unfold unique_prov.
   simpl.
   destruct p.
--- simpl.
    destruct (P_EQ_REFLECT p p); auto.
    contradict n.
    auto.
--- simpl. auto.
-- simpl.
   simpl in IH.
   rewrite unique_prov_dev.
   apply IH.
   lia.
Qed.

Lemma wrap_unique_le {bl l} (H: unwrap_abstract l = Some bl) : le (wrap_abstract bl (unique_prov l)) l.
Proof.
destruct (unique_prov l) eqn:Huniq; cycle 1.
{ apply unwrap_le; assumption. }

assert (wrap_abstract bl (Some p) = l); cycle 1.
{ rewrite H0. apply (le_list_abstract_byte_refl l). }

generalize dependent bl.
induction l as [|ab l IH].
{ unfold unique_prov in Huniq. simpl in Huniq. discriminate Huniq. }

intros bl H.
destruct bl. {
  destruct ab.
  - simpl in H. discriminate H.
  - simpl in H. destruct (unwrap_abstract l); simpl in H; discriminate H.
}

simpl.
assert (Init b (Some p) = ab) as Hab. {
  destruct ab.
  { simpl in H. discriminate H. }

  assert (b = b0). {
    simpl in H.
    destruct (unwrap_abstract l).
    - simpl in H. inversion H. auto.
    - simpl in H. discriminate H.
  }

  rewrite H0.
  f_equal.

  unfold unique_prov in Huniq.
  destruct o; cycle 1.
  { simpl in Huniq. discriminate Huniq. }

  simpl in Huniq.
  destruct ((P_EQ p0 p0 &&
           forallb
             (fun x : AbstractByte =>
              match x with
              | Init _ (Some a) =>
                  P_EQ a p0
              | _ => false
              end) l))%bool eqn:E.
  - simpl in Huniq. inversion Huniq. auto.
  - simpl in Huniq. discriminate Huniq.
}

rewrite Hab.
f_equal.

destruct l eqn:E. {
  destruct ab.
  { simpl in Hab. discriminate Hab. }

  simpl in H. inversion H.
  simpl. auto.
}

apply IH.
- apply (unique_prov_cons2 Huniq).
- simpl in H.
  destruct ab. { discriminate H. }
-- destruct a.
   { simpl in H. discriminate H. }

   simpl in H. inversion H.
   simpl.
   destruct (unwrap_abstract l0).
--- simpl. simpl in H. inversion H. auto.
--- simpl in H. discriminate H.
Qed.

End unique_prov.


Load GradVer18LemmaHI.
Import Semantics.

Lemma dynSemStarNotModifiesHx : forall ss H1 H2 r1 r2 A1 A2 A,
  ~ In A A1 ->
  H1 (fst A) <> None ->
  dynSemStar
    (H1, [(r1, A1, ss)])
    (H2, [(r2, A2, [])]) ->
  evalA'_d H1 A = evalA'_d H2 A.
Proof.
  induction ss; intros; simpl in *.
  - inversionx H4; try tauto.
    inversionx H5.
  - inversionx H4.
    rename H5 into ds.
    rename H6 into dss.
    destruct A.
    inversionx ds.
    * eapply IHss in dss; eauto.
      + unfold evalA'_d in *. simpl in *.
        unfold HSubst in dss.
        dec (o_dec o0 o1); try tauto.
        destruct (H1 o1); try tauto.
        destruct p0. simpl in *.
        destruct o2; cut.
        dec (string_dec f0 f1); cut.
      + unfold HSubst. simpl in *.
        dec (o_dec o0 o1); try tauto.
        destruct (H1 o1); try tauto.
        destruct p0.
        discriminate.
    * eapply IHss in dss; eauto.
    * eapply IHss in dss; eauto.
      + rewriteRev dss. clear dss.
        unfold evalA'_d in *. simpl in *.
        unfold Halloc.
        rewrite H13.
        dec (o_dec o1 o0); tauto.
      + simpl in *. unfold not in *.
        intros. contradict H0.
        apply in_app_iff in H4.
        intuition.
        apply in_map_iff in H0. unf. inversionx H0.
        tauto.
      + unfold Halloc.
        rewrite H13. simpl in *.
        dec (o_dec o1 o0); tauto.
    * eapply IHss in dss; eauto.
    * admit.
    * eapply IHss in dss; eauto.
    * eapply IHss in dss; eauto.
      unfold not in *. intros. contradict H0.
      apply InAexcept in H4.
      assumption.
    * eapply IHss in dss; eauto.
    * admit.
Admitted.

Lemma evalphiComposeDisjointFP : forall H r A1 A2 p1 p2,
    disjoint A1 A2 ->
    evalphi H r A1 p1 ->
    evalphi H r A2 p2 ->
    evalphi H r (A1 ++ A2) (p1 ++ p2).
Proof.
  intros.
  eapp evalphiAppRev.
  - eapp evalphiIncl.
    intuition.
  - eapp evalphiIncl.
    rewrite AexceptAppFirst.
    rewrite (AexceptDisjoint A2).
    * intuition.
    * apply evalphiImpliesAccess in H2.
      unfold disjoint, incl in *.
      intros.
      specialize (H1 x0).
      specialize (H2 x0).
      intuition.
Qed.

Lemma evalphiComposeDisjointFPx : forall H r A p1 p2,
    disjoint (footprint H r p1) (footprint H r p2) ->
    evalphi H r A p1 ->
    evalphi H r A p2 ->
    evalphi H r A (p1 ++ p2).
Proof.
  intros.
  eapp evalphiAppRev.
  assert (incl (footprint H0 r p2) A).
    eapp evalphiImpliesAccess.
  eappIn evalphiNarrowAccess H3.
  eapp evalphiIncl.
  unfold incl, disjoint in *.
  intro AA.
  specialize (H1 AA).
  specialize (H4 AA).
  intuition.
  eapp InAexceptConstr.
Qed.

Lemma dynSemStarNoAccessInventing : forall ss H1 H2 r1 r2 A1 A2 A,
  dynSemStar
    (H1, [(r1, A1, ss)])
    (H2, [(r2, A2, [])]) ->
  In A A2 ->
  In A A1 \/ H1 (fst A) = None.
Proof.
  induction ss; intros; simpl in *.
  - inversionx H0; try tauto.
    inversionx H4.
  - inversionx H0.
    rename H4 into ds.
    rename H5 into dss.
    inversionx ds.
    * eapply IHss in dss; eauto.
      intuition.
      unfold HSubst in H0. destruct A. simpl in *.
      dec (o_dec o1 o0); try auto.
      destruct (H1 o0); try auto.
      destruct p0.
      discriminate.
    * eapply IHss in dss; eauto.
    * eapply IHss in dss; eauto.
      destruct A. simpl in *.
      inversionx dss.
      + apply in_app_iff in H0.
        intuition.
        apply in_map_iff in H4.
        unf. inversionx H4.
        auto.
      + unfold Halloc in H0.
        rewrite H12 in *.
        dec (o_dec o0 o1); tauto.
    * eapply IHss in dss; eauto.
    * admit.
    * eapply IHss in dss; eauto.
    * eapply IHss in dss; eauto.
      intuition.
      apply InAexcept in H0.
      auto.
    * eapply IHss in dss; eauto.
    * admit.
Admitted.

Lemma dynSemStarNotModifies : forall x ss H1 H2 r1 r2 A1 A2,
  (∀ s', In s' ss → ¬ writesTo x s') ->
  dynSemStar
    (H1, [(r1, A1, ss)])
    (H2, [(r2, A2, [])]) ->
  r1 x = r2 x.
Proof.
  induction ss; intros; simpl in *.
  - inversionx H3; try tauto.
    inversionx H4.
  - inversionx H3.
    rename H4 into ds.
    rename H5 into dss.
    assert (¬ writesTo x0 a) as wt1. apply H0. tauto.
    assert (∀ s' : s, In s' ss → ¬ writesTo x0 s') as wt2. intros. apply H0. tauto.
    inversionx ds; simpl in wt1.
    * apply IHss in dss; auto.
    * apply IHss in dss; auto.
      unfold rhoSubst in dss.
      dec (x_dec x0 x1); try tauto.
      contradict wt1.
      constructor.
    * apply IHss in dss; auto.
      unfold rhoSubst in dss.
      dec (x_dec x0 x1); try tauto.
      contradict wt1.
      constructor.
    * apply IHss in dss; auto.
      unfold rhoSubst in dss.
      dec (x_dec x0 xresult); try tauto.
      contradict wt1.
      constructor.
    * admit.
    * apply IHss in dss; auto.
    * apply IHss in dss; auto.
    * apply IHss in dss; auto.
      unfold rhoSubst in dss.
      dec (x_dec x0 x1); try tauto.
      contradict wt1.
      constructor.
    * admit.
Admitted.

Lemma dynSemStarNotModifiesH : forall ss H1 H2 r1 r2 A1 A2 A v,
  ~ In A A1 ->
  dynSemStar
    (H1, [(r1, A1, ss)])
    (H2, [(r2, A2, [])]) ->
  evalA'_d H1 A = Some v ->
  evalA'_d H2 A = Some v.
Proof.
  induction ss; intros; simpl in *.
  - inversionx H3; try tauto.
    inversionx H5.
  - inversionx H3.
    rename H5 into ds.
    rename H6 into dss.
    inversionx ds.
    * eapply IHss in dss; eauto.
      destruct A. unfold evalA'_d in *. simpl in *.
      unfold HSubst.
      dec (o_dec o1 o0); try tauto.
      destruct (H1 o0); try discriminate.
      destruct p0. simpl in *.
      rewrite H4.
      dec (string_dec f1 f0); try tauto.
    * eapply IHss in dss; eauto.
    * eapply IHss in dss; eauto.
      + unfold not. intros.
        apply in_app_iff in H3.
        intuition.
        apply in_map_iff in H5.
        unf. subst.
        unfold evalA'_d, HeapNotSetAt in *.
        simpl in *.
        rewrite H12 in *.
        discriminate.
      + unfold Halloc.
        rewrite H13.
        destruct A. unfold evalA'_d in *. simpl in *.
        dec (o_dec o0 o1); try tauto.
        unfold HeapNotSetAt in H12. rewrite H12 in *.
        discriminate.
    * eapply IHss in dss; eauto.
    * admit.
    * eapply IHss in dss; eauto.
    * eapply IHss in dss; eauto.
      unfold not in *. intros. contradict H0.
      apply InAexcept in H3.
      assumption.
    * eapply IHss in dss; eauto.
    * admit.
Admitted.
(*
Lemma dynSemStarNotModifiesHX' : forall ss H1 H2 r1 r2 r A1 A2 A p,
  disjoint (footprint H1 r1 p) A1 ->
  dynSemStar
    (H1, [(r1, A1, ss)])
    (H2, [(r2, A2, [])]) ->
  sfrmphi [] p ->
  evalphi' H1 r A p ->
  evalphi' H2 r A p.
Proof.
   *)

Lemma evale'ChangeHeap : forall H1 H2 r e,
  (forall A', In A' (staticFootprintXe e) ->
    evalA'_s H1 r A' = evalA'_s H2 r A') ->
  evale' H1 r e = evale' H2 r e.
Proof.
  induction e0; intros; unfold evale in *; simpl in *; try tauto.
  assert (evalA'_s H1 r (e0, f0) = evalA'_s H2 r (e0, f0))
  as tracker.
    eapp H0.
  unfold evalA'_s, evalA'_d, A'_s2A'_d in tracker.
  simpl in *.
  destruct (evale' H1 r e0);
  try destruct v0;
  destruct (evale' H2 r e0);
  try destruct v0;
  try discriminate;
  try tauto;
  destruct v1;
  try tauto.
Qed.

Lemma footprint'ChangeHeap : forall H1 H2 r p,
  (forall A', In A' (staticFootprintX' p) ->
    evalA'_s H1 r A' = evalA'_s H2 r A') ->
  footprint' H1 r p = footprint' H2 r p.
Proof.
  intros.
  destruct p0; try tauto.
  simpl in *.
  erewrite evale'ChangeHeap; eauto.
Qed.

Lemma footprintChangeHeap : forall H1 H2 r p,
  (forall A', In A' (staticFootprintX p) ->
    evalA'_s H1 r A' = evalA'_s H2 r A') ->
  footprint H1 r p = footprint H2 r p.
Proof.
  induction p0; intros; simpl in *; try tauto.
  erewrite IHp0, footprint'ChangeHeap; eauto;
  intuition.
Qed.

Lemma evalphi'ChangeHeap : forall H1 H2 S1 S2 r A p,
  dynSemStar (H1, S1) (H2, S2) ->
  (forall A', In A' (staticFootprintX' p) ->
    evalA'_s H1 r A' = evalA'_s H2 r A') ->
  evalphi' H1 r A p ->
  evalphi' H2 r A p.
Proof.
  intros;
  inversionx H4;
  simpl in *.
  - eca.
  - eca;
    unfold evale in *;
    rewriteRev (evale'ChangeHeap H1 H2); eauto; intros; eapp H3; intuition.
  - eca;
    unfold evale in *;
    rewriteRev (evale'ChangeHeap H1 H2); eauto; intros; eapp H3; intuition.
  - assert (evale' H2 r e0 = Some (vo o0)) as ee.
      rewriteRev (evale'ChangeHeap H1 H2); eauto; intros; eapp H3; intuition.
    unfold evale in *.
    simpl in *.
    rewrite H6 in *.
    destruct H1 eqn: eeH1; cut.
    destruct p0.
    eapply HeapGetsMoreSpecific in eeH1; eauto.
    unf.
    eca.
    unfold evale. simpl. rewrite ee.
    rewrite H4.
    simpl.
(*     HeapFieldsGetMoreSpecific. *)
    admit.
Admitted.

Lemma evalphiChangeHeap : forall H1 H2 S1 S2 r p A,
  dynSemStar (H1, S1) (H2, S2) ->
  (forall A', In A' (staticFootprintX p) ->
    evalA'_s H1 r A' = evalA'_s H2 r A') ->
  evalphi H1 r A p ->
  evalphi H2 r A p.
Proof.
  induction p0; intros; simpl in *; try constructor.
  inversionx H4.
  rewrite (footprint'ChangeHeap H1 H2) in *; intuition.
  eappIn IHp0 H15; intuition.
  eappIn (evalphi'ChangeHeap H1 H2) H14; intuition.
  eca.
Qed.

Lemma evale'ChangeRho : forall r1 r2 H e,
  (forall x, In x (FVe e) -> r1 x = r2 x) ->
  evale' H r1 e = evale' H r2 e.
Proof.
  induction e0; intros; simpl in *.
  - tauto.
  - apply H1.
    tauto.
  - rewrite IHe0;
    tauto.
Qed.

Lemma footprint'ChangeRho : forall r1 r2 H p,
  (forall x, In x (FV' p) -> r1 x = r2 x) ->
  footprint' H r1 p = footprint' H r2 p.
Proof.
  intros.
  destruct p0; try tauto.
  simpl in *.
  erewrite evale'ChangeRho; tauto.
Qed.

Lemma footprintChangeRho : forall r1 r2 H p,
  (forall x, In x (FV p) -> r1 x = r2 x) ->
  footprint H r1 p = footprint H r2 p.
Proof.
  induction p0; intros; simpl in *; try tauto.
  erewrite IHp0, footprint'ChangeRho; eauto;
  intuition.
Qed.

Lemma evalphi'ChangeRho : forall r1 r2 H p A,
  (forall x, In x (FV' p) -> r1 x = r2 x) ->
  evalphi' H r1 A p ->
  evalphi' H r2 A p.
Proof.
  intros; simpl in *.
  inversionx H2.
  - constructor.
  - simpl in *.
    eca; unfold evale in *;
    erewrite evale'ChangeRho in H4, H5; eauto;
    intros; intuition.
  - simpl in *.
    eca; unfold evale in *;
    erewrite evale'ChangeRho in H4, H5; eauto;
    intros; intuition.
  - simpl in *.
    unfold evale in *. simpl in *.
    rewrite H4 in H5.
    eca; unfold evale in *;
    erewrite evale'ChangeRho in H4; eauto;
    intros; intuition.
    simpl. rewrite H4.
    eauto.
Qed.

Lemma evalphiChangeRho : forall r1 r2 H p A,
  (forall x, In x (FV p) -> r1 x = r2 x) ->
  evalphi H r1 A p ->
  evalphi H r2 A p.
Proof.
  induction p0; intros; simpl in *; try constructor.
  inversionx H2.
  eca.
  - rewrite (footprint'ChangeRho r1 r2) in H7; auto.
    intros.
    intuition.
  - rewrite (footprint'ChangeRho r1 r2) in H12; auto.
    * eapp (evalphi'ChangeRho r1 r2).
      intros. intuition.
    * intros. intuition.
  - rewrite (footprint'ChangeRho r1 r2) in H13; auto.
    * eapp IHp0.
      intros. intuition.
    * intros. intuition.
Qed.

Lemma evale'RemoveHSubst : forall o f v H r e,
  ~ In (o, f) (footprintXe H r e) ->
  evale' H r e = evale' (HSubst o f v H) r e.
Proof.
  induction e0; intros; simpl in *; try tauto.
  unfold footprintXe in *. simpl in *.
  rewrite in_app_iff in H1.
  apply not_or_and in H1. unf.
  rewriteRev IHe0; auto.
  unfold A'_s2A'_d in *. simpl in *.
  destruct (evale' H0 r e0); try tauto.
  destruct v1; try tauto.
  simpl in *.
  unfold HSubst.
  dec (o_dec o1 o0); cut.
  destruct (H0 o0); cut. destruct p0. simpl.
  destruct o2; cut.
  dec (string_dec f1 f0); cut.
  contradict H2.
  auto.
Qed.

Lemma footprint'RemoveHSubst : forall o f v H r p,
  ~ In (o, f) (footprintX' H r p) ->
  footprint' H r p = footprint' (HSubst o f v H) r p.
Proof.
  intros.
  destruct p0; try tauto.
  unfold footprintX' in *.
  simpl in *.
  eappIn evale'RemoveHSubst H1.
  rewriteRev H1.
  tauto.
Qed.

Lemma evalphi'RemoveHSubst : forall o f v H r p A,
  ~ In (o, f) (footprintX' H r p) ->
  evalphi' H r A p <->
  evalphi' (HSubst o f v H) r A p.
Proof.
  intros.
  unfold footprintX' in H1.
  destruct p0; simpl in *;
  try rewrite map_app in H1;
  try rewrite oflattenApp in H1;
  try rewrite in_app_iff in H1;
  try apply not_or_and in H1;
  unf.
  - split; constructor.
  - split; intros;
    inversionx H1; eca; unfold evale in *;
    try rewriteRev evale'RemoveHSubst; eauto;
    try erewrite evale'RemoveHSubst; eauto.
  - split; intros;
    inversionx H1; eca; unfold evale in *;
    try rewriteRev evale'RemoveHSubst; eauto;
    try erewrite evale'RemoveHSubst; eauto.
  - split; intros; inv H2; unfold evale in *;
    simpl in *; rewrite H6 in *.
    * erewrite evale'RemoveHSubst in H6; eauto.
      eca.
      unfold evale. simpl.
      rewrite H6.
      instantiate (1 := if o_decb o1 o0 && f_decb f1 f0 then v0 else v1).
      unfold HSubst.
      dec (o_dec o1 o0); eauto.
      destruct H0; cut.
      destruct p0.
      simpl in *.
      rewrite H10.
      auto.
    * rewriteRevIn evale'RemoveHSubst H6; eauto.
      unfold HSubst in *.
      dec (o_dec o1 o0).
        Focus 2. eca. unfold evale. simpl. rewrite H6. eauto.
      destruct H0 eqn: eeH0; cut.
      destruct p0.
      simpl in *.
      destruct o2 eqn: eeo2; cut.
      eca.
      unfold evale. simpl. rewrite H6.
      rewrite eeH0.
      simpl.
      eauto.
Qed.

Lemma evalphiRemoveHSubst : forall o f v H r p A,
  ~ In (o, f) (footprintX H r p) ->
  evalphi H r A p <->
  evalphi (HSubst o f v H) r A p.
Proof.
  induction p0; intros; simpl in *; split; try constructor; intros.
  - inversionx H2.
    unfold footprintX in H1.
    simpl in H1.
    rewrite map_app in H1.
    rewrite oflattenApp in H1.
    rewrite in_app_iff in H1.
    apply not_or_and in H1.
    eca.
    * rewriteRev footprint'RemoveHSubst; eauto; try apply H1.
    * rewriteRev footprint'RemoveHSubst; eauto; try apply H1.
      rewriteRev evalphi'RemoveHSubst; try apply H1.
      eauto.
    * rewriteRev footprint'RemoveHSubst; eauto; try apply H1.
      eapp IHp0.
      tauto.
  - inversionx H2.
    unfold footprintX in H1.
    simpl in H1.
    rewrite map_app in H1.
    rewrite oflattenApp in H1.
    rewrite in_app_iff in H1.
    apply not_or_and in H1.
    eca.
    * erewrite footprint'RemoveHSubst; eauto; try apply H1.
    * erewrite footprint'RemoveHSubst; eauto; try apply H1.
      erewrite evalphi'RemoveHSubst; try apply H1.
      eauto.
    * erewrite footprint'RemoveHSubst; eauto; try apply H1.
      eapp IHp0.
      tauto.
Qed.

Theorem framedOff : forall ss H1 H2 r1 r2 A1 A2 r A p,
  dynSemStar (H1, [(r1, A1, ss)]) (H2, [(r2, A2, [])]) ->
  (forall A', In A' A -> exists v, H1 (fst A') = Some v) ->
  disjoint A A1 ->
  sfrmphi [] p ->
  evalphi H1 r A p ->
  evalphi H2 r (A ++ A2) p.
Proof.
  induction ss; intros; simpl in *.
  - inversionx H0; try inversionx H7.
    eapp evalphiIncl.
    intuition.
  - inversionx H0.
    inversionx H7.
    * eappIn IHss H8.
        intros.
        apply H3 in H0. unf.
        destruct A'. simpl in *.
        unfold HSubst.
        dec (o_dec o1 o0); try (eex; fail).
        rewrite H7. destruct x1. eex.
      apply evalphiRemoveHSubst; auto.
      specialize (H4 (o0, f0)).
      intuition.
      eapply sfrmphiVSdfpX in H5. apply H5 in H0.
      apply evalphiImpliesAccess in H6. apply H6 in H0.
      tauto.
    * eappIn IHss H8.
    * assert (evalphi (Halloc o0 C0 H1) r A p0).
        eapp evalphiRemoveHalloc.
      eappIn IHss H8.
        intros.
        apply H3 in H7. unf.
        destruct A'. simpl in *.
        unfold Halloc.
        rewrite H17.
        dec (o_dec o0 o1); eex.
      assert (disjoint A (map (λ cf' : T * f, (o0, snd cf')) Tfs)).
        unfold disjoint. intros.
        apply imply_to_or. intro.
        unfold not. intro.
        apply in_map_iff in H9. unf. subst.
        apply H3 in H7. unf. simpl in *.
        rewrite H16 in H9. discriminate.
      unfold disjoint. intros.
      specialize (H4 x1).
      specialize (H7 x1).
      rewrite in_app_iff. intuition.
    * eappIn IHss H8.
    * admit.
    * eappIn IHss H8.
    * eappIn IHss H8.
      unfold disjoint. intros.
      specialize (H4 x0).
      intuition.
      apply or_intror.
      intro. contradict H0.
      eapp InAexcept.
    * eappIn IHss H8.
    * admit.
Admitted.

(*
Lemma dynSemStarSustainsHelper : forall ss H1 H2 r1 r2 A1 A2 r A,
  ~ In (A'_s2A'_d H1 r1 A) (map Some A1) ->
  dynSemStar
    (H1, [(r1, A1, ss)])
    (H2, [(r2, A2, [])]) ->
  evalA'_s H1 r A = evalA'_s H2 r A.
Proof.
  unfold evalA'_s, A'_s2A'_d.
  induction ss; intros; simpl in *.
  - inversionx H3; try tauto.
    inversionx H4.
  - inversionx H3.
    inversionx H4.
    * eapply IHss in H5; eauto.
      + rewriteRev H5. clear H5.

      rewrite H0.
      eauto.
      destruct A. simpl in *.
      destruct (evale' H1 r1 e0) eqn: ee.

  intros.

  Check dynSemStarNotModifiesH.
  eapp (evalphiChangeHeap H1 H2).

Lemma dynSemStarSustains : forall ss H1 H2 r1 r2 A1 A2 r p A,
  disjoint A A1 ->
  dynSemStar
    (H1, [(r1, A1, ss)])
    (H2, [(r2, A2, [])]) ->
  evalphi H1 r A p ->
  evalphi H2 r A p.
Proof.
  intros.
  eapp (evalphiChangeHeap H1 H2).

 *)


Require Import Coqlib.
Require Import Maps.
Require Import LibTactics.

Require Import Integers.
Open Scope Z_scope.
Import ListNotations.

Set Asymmetric Patterns.

Require Import state.
Require Import language.

Set Implicit Arguments.
Unset Strict Implicit.

Require Import logic.

Require Import lemmas.
Require Import lemmas_ins.

Require Import Coq.Logic.FunctionalExtensionality.

Require Import sep_lemma.

Open Scope nat.
Open Scope code_scope.
Open Scope mem_scope.

(*+ Auxiliary Definition +*)
Definition update_frame (fm : Frame) (n : nat) (v : Val) :=
  match fm with
  | consfm w0 w1 w2 w3 w4 w5 w6 w7 =>
    match n with
    | 0 => consfm v w1 w2 w3 w4 w5 w6 w7
    | 1 => consfm w0 v w2 w3 w4 w5 w6 w7
    | 2 => consfm w0 w1 v w3 w4 w5 w6 w7
    | 3 => consfm w0 w1 w2 v w4 w5 w6 w7
    | 4 => consfm w0 w1 w2 w3 v w5 w6 w7
    | 5 => consfm w0 w1 w2 w3 w4 v w6 w7
    | 6 => consfm w0 w1 w2 w3 w4 w5 v w7
    | 7 => consfm w0 w1 w2 w3 w4 w5 w6 v
    | _ => consfm w0 w1 w2 w3 w4 w5 w6 w7
    end
  end.

Definition get_frame_nth (fm : Frame) (n : nat) :=
  match fm with
  | consfm w0 w1 w2 w3 w4 w5 w6 w7 =>
    match n with
    | 0 => Some w0
    | 1 => Some w1
    | 2 => Some w2
    | 3 => Some w3
    | 4 => Some w4
    | 5 => Some w5
    | 6 => Some w6
    | 7 => Some w7
    | _ => None
    end
  end.

Definition get_frame_nth' (fm : Frame) (n : nat) :=
  match fm with
  | consfm w0 w1 w2 w3 w4 w5 w6 w7 =>
    match n with
    | 0 => w0
    | 1 => w1
    | 2 => w2
    | 3 => w3
    | 4 => w4
    | 5 => w5
    | 6 => w6
    | 7 => w7
    | _ => W ($ 0)
    end
  end.

Definition GenRegState : Type := Frame * Frame * Frame * Frame.

Fixpoint upd_genreg (greg_st : GenRegState) (rr : GenReg) (w : Val) : GenRegState :=
  match greg_st with
  | (fmg, fmo, fml, fmi) =>
    match rr with
    | r0 => (update_frame fmg 0 w, fmo, fml, fmi)
    | r1 => (update_frame fmg 1 w, fmo, fml, fmi)
    | r2 => (update_frame fmg 2 w, fmo, fml, fmi)
    | r3 => (update_frame fmg 3 w, fmo, fml, fmi)
    | r4 => (update_frame fmg 4 w, fmo, fml, fmi)
    | r5 => (update_frame fmg 5 w, fmo, fml, fmi)
    | r6 => (update_frame fmg 6 w, fmo, fml, fmi)
    | r7 => (update_frame fmg 7 w, fmo, fml, fmi)
    | r8 => (fmg, update_frame fmo 0 w, fml, fmi)
    | r9 => (fmg, update_frame fmo 1 w, fml, fmi)
    | r10 => (fmg, update_frame fmo 2 w, fml, fmi)
    | r11 => (fmg, update_frame fmo 3 w, fml, fmi)
    | r12 => (fmg, update_frame fmo 4 w, fml, fmi)
    | r13 => (fmg, update_frame fmo 5 w, fml, fmi)
    | r14 => (fmg, update_frame fmo 6 w, fml, fmi)
    | r15 => (fmg, update_frame fmo 7 w, fml, fmi)
    | r16 => (fmg, fmo, update_frame fml 0 w, fmi)
    | r17 => (fmg, fmo, update_frame fml 1 w, fmi)
    | r18 => (fmg, fmo, update_frame fml 2 w, fmi)
    | r19 => (fmg, fmo, update_frame fml 3 w, fmi)
    | r20 => (fmg, fmo, update_frame fml 4 w, fmi)
    | r21 => (fmg, fmo, update_frame fml 5 w, fmi)
    | r22 => (fmg, fmo, update_frame fml 6 w, fmi)
    | r23 => (fmg, fmo, update_frame fml 7 w, fmi)
    | r24 => (fmg, fmo, fml, update_frame fmi 0 w)
    | r25 => (fmg, fmo, fml, update_frame fmi 1 w)
    | r26 => (fmg, fmo, fml, update_frame fmi 2 w)
    | r27 => (fmg, fmo, fml, update_frame fmi 3 w)
    | r28 => (fmg, fmo, fml, update_frame fmi 4 w)
    | r29 => (fmg, fmo, fml, update_frame fmi 5 w)
    | r30 => (fmg, fmo, fml, update_frame fmi 6 w)
    | r31 => (fmg, fmo, fml, update_frame fmi 7 w)
    end
  end.

Definition get_global_frame (fm : Frame) (rr : GenReg) :=
  match rr with
  | r0 => Some (W $ 0)
  | r1 => get_frame_nth fm 1
  | r2 => get_frame_nth fm 2
  | r3 => get_frame_nth fm 3
  | r4 => get_frame_nth fm 4
  | r5 => get_frame_nth fm 5
  | r6 => get_frame_nth fm 6
  | r7 => get_frame_nth fm 7
  | _ => None
  end.

Definition get_out_frame (fm : Frame) (rr : GenReg) :=
  match rr with
  | r8 => get_frame_nth fm 0
  | r9 => get_frame_nth fm 1
  | r10 => get_frame_nth fm 2
  | r11 => get_frame_nth fm 3
  | r12 => get_frame_nth fm 4
  | r13 => get_frame_nth fm 5
  | r14 => get_frame_nth fm 6
  | r15 => get_frame_nth fm 7
  | _ => None
  end.

Definition get_local_frame (fm : Frame) (rr : GenReg) :=
  match rr with
  | r16 => get_frame_nth fm 0
  | r17 => get_frame_nth fm 1
  | r18 => get_frame_nth fm 2
  | r19 => get_frame_nth fm 3
  | r20 => get_frame_nth fm 4
  | r21 => get_frame_nth fm 5
  | r22 => get_frame_nth fm 6
  | r23 => get_frame_nth fm 7
  | _ => None
  end.

Definition get_in_frame (fm : Frame) (rr : GenReg) :=
  match rr with
  | r24 => get_frame_nth fm 0
  | r25 => get_frame_nth fm 1
  | r26 => get_frame_nth fm 2
  | r27 => get_frame_nth fm 3
  | r28 => get_frame_nth fm 4
  | r29 => get_frame_nth fm 5
  | r30 => get_frame_nth fm 6
  | r31 => get_frame_nth fm 7
  | _ => None
  end.

Fixpoint get_genreg_val (greg_st : GenRegState) (rr : GenReg) : Val :=
  match greg_st with
  | (fmg, fmo, fml, fmi) =>
    match rr with
    | r0 => (W $ 0)
    | r1 => get_frame_nth' fmg 1
    | r2 => get_frame_nth' fmg 2
    | r3 => get_frame_nth' fmg 3
    | r4 => get_frame_nth' fmg 4
    | r5 => get_frame_nth' fmg 5
    | r6 => get_frame_nth' fmg 6
    | r7 => get_frame_nth' fmg 7
    | r8 => get_frame_nth' fmo 0
    | r9 => get_frame_nth' fmo 1
    | r10 => get_frame_nth' fmo 2
    | r11 => get_frame_nth' fmo 3
    | r12 => get_frame_nth' fmo 4
    | r13 => get_frame_nth' fmo 5
    | r14 => get_frame_nth' fmo 6
    | r15 => get_frame_nth' fmo 7
    | r16 => get_frame_nth' fml 0
    | r17 => get_frame_nth' fml 1
    | r18 => get_frame_nth' fml 2
    | r19 => get_frame_nth' fml 3
    | r20 => get_frame_nth' fml 4
    | r21 => get_frame_nth' fml 5
    | r22 => get_frame_nth' fml 6
    | r23 => get_frame_nth' fml 7
    | r24 => get_frame_nth' fmi 0
    | r25 => get_frame_nth' fmi 1
    | r26 => get_frame_nth' fmi 2
    | r27 => get_frame_nth' fmi 3
    | r28 => get_frame_nth' fmi 4
    | r29 => get_frame_nth' fmi 5
    | r30 => get_frame_nth' fmi 6
    | r31 => get_frame_nth' fmi 7
    end
  end.

Fixpoint get_genreg_val' (greg_st : GenRegState) (rr : GenReg) : Val :=
  match greg_st with
  | (fmg, fmo, fml, fmi) =>
    match rr with
    | r0 => get_frame_nth' fmg 0
    | r1 => get_frame_nth' fmg 1
    | r2 => get_frame_nth' fmg 2
    | r3 => get_frame_nth' fmg 3
    | r4 => get_frame_nth' fmg 4
    | r5 => get_frame_nth' fmg 5
    | r6 => get_frame_nth' fmg 6
    | r7 => get_frame_nth' fmg 7
    | r8 => get_frame_nth' fmo 0
    | r9 => get_frame_nth' fmo 1
    | r10 => get_frame_nth' fmo 2
    | r11 => get_frame_nth' fmo 3
    | r12 => get_frame_nth' fmo 4
    | r13 => get_frame_nth' fmo 5
    | r14 => get_frame_nth' fmo 6
    | r15 => get_frame_nth' fmo 7
    | r16 => get_frame_nth' fml 0
    | r17 => get_frame_nth' fml 1
    | r18 => get_frame_nth' fml 2
    | r19 => get_frame_nth' fml 3
    | r20 => get_frame_nth' fml 4
    | r21 => get_frame_nth' fml 5
    | r22 => get_frame_nth' fml 6
    | r23 => get_frame_nth' fml 7
    | r24 => get_frame_nth' fmi 0
    | r25 => get_frame_nth' fmi 1
    | r26 => get_frame_nth' fmi 2
    | r27 => get_frame_nth' fmi 3
    | r28 => get_frame_nth' fmi 4
    | r29 => get_frame_nth' fmi 5
    | r30 => get_frame_nth' fmi 6
    | r31 => get_frame_nth' fmi 7
    end
  end.

Definition GlobalRegs (fm : Frame) :=
  match fm with
  | consfm w0 w1 w2 w3 w4 w5 w6 w7 =>
    r0 |=> w0 ** r1 |=> w1 ** r2 |=> w2 ** r3 |=> w3 ** r4 |=> w4 **
       r5 |=> w5 ** r6 |=> w6 ** r7 |=> w7
  end.

Definition GenRegs (grst : GenRegState) : asrt :=
  match grst with
  | (fmg, fmo, fml, fmi) =>
    GlobalRegs fmg ** OutRegs fmo ** LocalRegs fml ** InRegs fmi
  end.

Definition eval_opexp_reg (grst : GenRegState) (a : OpExp) :=
  match a with
  | Or r => Some (get_genreg_val grst r)
  | Ow w => if ($ (-4096)) <=ᵢ w && w <=ᵢ ($ 4095) then Some (W w) else None
  end.

Definition eval_addrexp_reg (grst : GenRegState) (b : AddrExp) :=
  match b with
  | Ao a => eval_opexp_reg grst a
  | Aro r a =>
    match eval_opexp_reg grst a with
    | Some v2 => val_add (get_genreg_val grst r) v2
    | None => None
    end
  end.

Lemma get_global_frame_get_R :
  forall fm p M R F D v (rr : GenReg),
    (M, (R, F), D) |= GlobalRegs fm ** p ->
    get_global_frame fm rr = Some v ->
    get_R R rr = Some v.
Proof.
  intros.
  sep_star_split_tac.
  simpl in H4.
  simpljoin1.
  unfolds GlobalRegs.
  destruct fm.
  destruct rr; simpl in H0; tryfalse;
    try inversion H0; subst; try eapply get_R_merge_still; unfold get_R.

  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 2.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 3.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 4.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 5.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 6.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 7.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 8.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.
Qed.

Lemma get_out_frame_get_R :
  forall fm p M R F D v (rr : GenReg),
    (M, (R, F), D) |= OutRegs fm ** p ->
    get_out_frame fm rr = Some v ->
    get_R R rr = Some v.
Proof.
  intros.
  sep_star_split_tac.
  simpl in H4.
  simpljoin1.
  unfolds OutRegs.
  destruct fm.
  destruct rr; simpl in H0; tryfalse;
    try inversion H0; subst; try eapply get_R_merge_still; unfold get_R.

  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 2.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 3.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 4.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 5.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 6.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 7.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 8.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.
Qed.

Lemma get_local_frame_get_R :
  forall fm p M R F D v (rr : GenReg),
    (M, (R, F), D) |= LocalRegs fm ** p ->
    get_local_frame fm rr = Some v ->
    get_R R rr = Some v.
Proof.
  intros.
  sep_star_split_tac.
  simpl in H4.
  simpljoin1.
  unfolds LocalRegs.
  destruct fm.
  destruct rr; simpl in H0; tryfalse;
    try inversion H0; subst; try eapply get_R_merge_still; unfold get_R.

  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 2.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 3.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 4.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 5.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 6.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 7.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 8.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.
Qed.

Lemma get_in_frame_get_R :
  forall fm p M R F D v (rr : GenReg),
    (M, (R, F), D) |= InRegs fm ** p ->
    get_in_frame fm rr = Some v ->
    get_R R rr = Some v.
Proof.
  intros.
  sep_star_split_tac.
  simpl in H4.
  simpljoin1.
  unfolds OutRegs.
  destruct fm.
  destruct rr; simpl in H0; tryfalse;
    try inversion H0; subst; try eapply get_R_merge_still; unfold get_R.

  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 2.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 3.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 4.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 5.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 6.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 7.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.

  simpl_sep_liftn_in H 8.
  eapply rn_st_v_eval_reg_v in H.
  rewrite H; eauto.
Qed.

Lemma getR_eq_get_genreg_val :
  forall M R F D grst (rr : GenReg),
    (M, (R, F), D) |= GenRegs grst ->
    get_R R rr = Some (get_genreg_val grst rr).
Proof.
  intros.
  unfolds GenRegs.
  destruct grst.
  destruct p.
  destruct p.
  destruct f1, f2, f0, f.
  destruct rr; simpl;
    try solve [eapply get_global_frame_get_R; [eauto | simpl; eauto] ];
    try solve [simpl_sep_liftn_in H 2;
               eapply get_out_frame_get_R; [eauto | simpl; eauto] ];
    try solve [simpl_sep_liftn_in H 3;
               eapply get_local_frame_get_R; [eauto | simpl; eauto] ];
    try solve [sliftn_in H 4;
               eapply get_in_frame_get_R; [eauto | simpl; eauto] ].
Qed.

Lemma eval_opexp_reg_eq_eval_opexp :
  forall M R F D grst oexp v,
    (M, (R, F), D) |= GenRegs grst ->
    eval_opexp_reg grst oexp = Some v ->
    eval_opexp R oexp = Some v.
Proof.
  intros.
  unfolds GenRegs.
  destruct grst.
  destruct p.
  destruct p.
  destruct f1, f2, f0, f.
  destruct oexp; simpl in H0.
  destruct g; inversion H0; subst; simpl;
    try solve [eapply get_global_frame_get_R; [eauto | simpl; eauto] ];
    try solve [simpl_sep_liftn_in H 2;
               eapply get_out_frame_get_R; [eauto | simpl; eauto] ];
    try solve [simpl_sep_liftn_in H 3;
               eapply get_local_frame_get_R; [eauto | simpl; eauto] ];
    try solve [sliftn_in H 4;
               eapply get_in_frame_get_R; [eauto | simpl; eauto] ].
  destruct (($ (-4096)) <=ᵢ w && w <=ᵢ ($ 4095)) eqn:Heqe; eauto;
    inversion H0; subst; eauto.
  simpl; eauto.
  rewrite Heqe; eauto.
Qed.

Lemma eval_aexp_reg_eq_eval_aexp :
  forall M R F D grst aexp v,
    (M, (R, F), D) |= GenRegs grst ->
    eval_addrexp_reg grst aexp = Some v ->
    eval_addrexp R aexp = Some v.
Proof.
  intros.
  destruct grst.
  destruct p.
  destruct p.
  destruct f1, f2, f0, f.
  destruct aexp.
  simpl in H0.
  eapply eval_opexp_reg_eq_eval_opexp; eauto.
  lets Ht : H.

  Ltac destruct_eval_opexp_reg :=
    let Heqe := fresh in
    match goal with
    | H : context [eval_opexp_reg ?grst ?o] |- _ =>
      destruct (eval_opexp_reg grst o) eqn:Heqe
    | _ => idtac
    end.

  Ltac eval_opexp_reg_to_eval_opexp :=
    match goal with
    | H : eval_opexp_reg ?grst ?o = Some ?w |- _ =>
      eapply eval_opexp_reg_eq_eval_opexp in H; [rewrite H; eauto | eauto]
    | _ => idtac
    end.

  destruct g; simpl in H0; simpl;
  try solve [
        eapply get_global_frame_get_R in H;
        [
          erewrite H; eauto; destruct_eval_opexp_reg; tryfalse;
          eval_opexp_reg_to_eval_opexp
        | simpl; eauto
        ]
      ];
  try solve [
        unfold GenRegs in H; simpl_sep_liftn_in H 2;
        eapply get_out_frame_get_R in H;
        [
          erewrite H; eauto; destruct_eval_opexp_reg; tryfalse;
          eval_opexp_reg_to_eval_opexp
        | simpl; eauto
        ]
      ];
  try solve [
        unfold GenRegs in H; simpl_sep_liftn_in H 3;
        eapply get_local_frame_get_R in H;
        [
          erewrite H; eauto; destruct_eval_opexp_reg; tryfalse;
          eval_opexp_reg_to_eval_opexp
        | simpl; eauto
        ]
      ];
  try solve [
        unfold GenRegs in H; sliftn_in H 4;
        eapply get_in_frame_get_R in H;
        [
          erewrite H; eauto; destruct_eval_opexp_reg; tryfalse;
          eval_opexp_reg_to_eval_opexp
        | simpl; eauto
        ]
      ].
  eapply get_global_frame_get_R in H;
    [
      erewrite H; eauto; destruct_eval_opexp_reg; tryfalse;
      eval_opexp_reg_to_eval_opexp
    | simpl; eauto
    ].
  destruct v32; simpl in H0; tryfalse; eauto.
Qed.

Ltac asrt_to_line_in H t :=
  match type of H with
  | _ |= ?p1 ** ?p2 =>
    eapply asrt_combine_to_line_stable with (n := t) in H;
    unfold asrt_combine_to_line in H; fold asrt_combine_to_line in H
  | _ => idtac
  end.

Ltac asrt_to_line t :=
  match goal with
  | |- _ |= ?p1 ** ?p2 =>
    eapply asrt_combine_to_line_stable_rev with (n := t);
    unfold asrt_combine_to_line; fold asrt_combine_to_line
  | _ => idtac
  end.

Definition globalRegs_rm_one (fm : Frame) (rr : GenReg) :=
  match fm with
  | consfm w0 w1 w2 w3 w4 w5 w6 w7 =>
    match rr with
    | r0 =>
      r1 |=> w1 ** r2 |=> w2 ** r3 |=> w3 **
         r4 |=> w4 ** r5 |=> w5 ** r6 |=> w6 ** r7 |=> w7
    | r1 =>
      r0 |=> w0 ** r2 |=> w2 ** r3 |=> w3 **
         r4 |=> w4 ** r5 |=> w5 ** r6 |=> w6 ** r7 |=> w7
    | r2 =>
      r0 |=> w0 ** r1 |=> w1 ** r3 |=> w3 **
         r4 |=> w4 ** r5 |=> w5 ** r6 |=> w6 ** r7 |=> w7
    | r3 =>
      r0 |=> w0 ** r1 |=> w1 ** r2 |=> w2 **
         r4 |=> w4 ** r5 |=> w5 ** r6 |=> w6 ** r7 |=> w7
    | r4 =>
      r0 |=> w0 ** r1 |=> w1 ** r2 |=> w2 **
         r3 |=> w3 ** r5 |=> w5 ** r6 |=> w6 ** r7 |=> w7
    | r5 =>
      r0 |=> w0 ** r1 |=> w1 ** r2 |=> w2 **
         r3 |=> w3 ** r4 |=> w4 ** r6 |=> w6 ** r7 |=> w7
    | r6 =>
      r0 |=> w0 ** r1 |=> w1 ** r2 |=> w2 **
         r3 |=> w3 ** r4 |=> w4 ** r5 |=> w5 ** r7 |=> w7
    | r7 =>
      r0 |=> w0 ** r1 |=> w1 ** r2 |=> w2 **
         r3 |=> w3 ** r4 |=> w4 ** r5 |=> w5 ** r6 |=> w6
    | _ =>
      r0 |=> w0 ** r1 |=> w1 ** r2 |=> w2 **
         r3 |=> w3 ** r4 |=> w4 ** r5 |=> w5 ** r6 |=> w6 ** r7 |=> w7
    end
  end.

Definition outRegs_rm_one (fm : Frame) (rr : GenReg) :=
  match fm with
  | consfm w0 w1 w2 w3 w4 w5 w6 w7 =>
    match rr with
    | r8 =>
      r9 |=> w1 ** r10 |=> w2 ** r11 |=> w3 **
         r12 |=> w4 ** r13 |=> w5 ** r14 |=> w6 ** r15 |=> w7
    | r9 =>
      r8 |=> w0 ** r10 |=> w2 ** r11 |=> w3 **
         r12 |=> w4 ** r13 |=> w5 ** r14 |=> w6 ** r15 |=> w7
    | r10 =>
      r8 |=> w0 ** r9 |=> w1 ** r11 |=> w3 **
         r12 |=> w4 ** r13 |=> w5 ** r14 |=> w6 ** r15 |=> w7
    | r11 =>
      r8 |=> w0 ** r9 |=> w1 ** r10 |=> w2 **
         r12 |=> w4 ** r13 |=> w5 ** r14 |=> w6 ** r15 |=> w7
    | r12 =>
      r8 |=> w0 ** r9 |=> w1 ** r10 |=> w2 **
         r11 |=> w3 ** r13 |=> w5 ** r14 |=> w6 ** r15 |=> w7
    | r13 =>
      r8 |=> w0 ** r9 |=> w1 ** r10 |=> w2 **
         r11 |=> w3 ** r12 |=> w4 ** r14 |=> w6 ** r15 |=> w7
    | r14 =>
      r8 |=> w0 ** r9 |=> w1 ** r10 |=> w2 **
         r11 |=> w3 ** r12 |=> w4 ** r13 |=> w5 ** r15 |=> w7
    | r15 =>
      r8 |=> w0 ** r9 |=> w1 ** r10 |=> w2 **
         r11 |=> w3 ** r12 |=> w4 ** r13 |=> w5 ** r14 |=> w6
    | _ =>
      r8 |=> w0 ** r9 |=> w1 ** r10 |=> w2 **
         r11 |=> w3 ** r12 |=> w4 ** r13 |=> w5 ** r14 |=> w6 ** r15 |=> w7
    end
  end.

Definition localRegs_rm_one (fm : Frame) (rr : GenReg) :=
  match fm with
  | consfm w0 w1 w2 w3 w4 w5 w6 w7 =>
    match rr with
    | r16 =>
      r17 |=> w1 ** r18 |=> w2 ** r19 |=> w3 **
         r20 |=> w4 ** r21 |=> w5 ** r22 |=> w6 ** r23 |=> w7
    | r17 =>
      r16 |=> w0 ** r18 |=> w2 ** r19 |=> w3 **
         r20 |=> w4 ** r21 |=> w5 ** r22 |=> w6 ** r23 |=> w7
    | r18 =>
      r16 |=> w0 ** r17 |=> w1 ** r19 |=> w3 **
         r20 |=> w4 ** r21 |=> w5 ** r22 |=> w6 ** r23 |=> w7
    | r19 =>
      r16 |=> w0 ** r17 |=> w1 ** r18 |=> w2 **
         r20 |=> w4 ** r21 |=> w5 ** r22 |=> w6 ** r23 |=> w7
    | r20 =>
      r16 |=> w0 ** r17 |=> w1 ** r18 |=> w2 **
         r19 |=> w3 ** r21 |=> w5 ** r22 |=> w6 ** r23 |=> w7
    | r21 =>
      r16 |=> w0 ** r17 |=> w1 ** r18 |=> w2 **
         r19 |=> w3 ** r20 |=> w4 ** r22 |=> w6 ** r23 |=> w7
    | r22 =>
      r16 |=> w0 ** r17 |=> w1 ** r18 |=> w2 **
          r19 |=> w3 ** r20 |=> w4 ** r21 |=> w5 ** r23 |=> w7
    | r23 =>
      r16 |=> w0 ** r17 |=> w1 ** r18 |=> w2 **
          r19 |=> w3 ** r20 |=> w4 ** r21 |=> w5 ** r22 |=> w6
    | _ =>
      r16 |=> w0 ** r17 |=> w1 ** r18 |=> w2 ** r19 |=> w3 **
         r20 |=> w4 ** r21 |=> w5 ** r22 |=> w6 ** r23 |=> w7
    end
  end.

Definition inRegs_rm_one (fm : Frame) (rr : GenReg) :=
  match fm with
  | consfm w0 w1 w2 w3 w4 w5 w6 w7 =>
    match rr with
    | r24 =>
      r25 |=> w1 ** r26 |=> w2 ** r27 |=> w3 **
         r28 |=> w4 ** r29 |=> w5 ** r30 |=> w6 ** r31 |=> w7
    | r25 =>
      r24 |=> w0 ** r26 |=> w2 ** r27 |=> w3 **
         r28 |=> w4 ** r29 |=> w5 ** r30 |=> w6 ** r31 |=> w7
    | r26 =>
      r24 |=> w0 ** r25 |=> w1 ** r27 |=> w3 **
         r28 |=> w4 ** r29 |=> w5 ** r30 |=> w6 ** r31 |=> w7
    | r27 =>
      r24 |=> w0 ** r25 |=> w1 ** r26 |=> w2 **
         r28 |=> w4 ** r29 |=> w5 ** r30 |=> w6 ** r31 |=> w7
    | r28 =>
      r24 |=> w0 ** r25 |=> w1 ** r26 |=> w2 **
          r27 |=> w3 ** r29 |=> w5 ** r30 |=> w6 ** r31 |=> w7
    | r29 =>
      r24 |=> w0 ** r25 |=> w1 ** r26 |=> w2 **
          r27 |=> w3 ** r28 |=> w4 ** r30 |=> w6 ** r31 |=> w7
    | r30 =>
      r24 |=> w0 ** r25 |=> w1 ** r26 |=> w2 **
          r27 |=> w3 ** r28 |=> w4 ** r29 |=> w5 ** r31 |=> w7
    | r31 =>
      r24 |=> w0 ** r25 |=> w1 ** r26 |=> w2 **
          r27 |=> w3 ** r28 |=> w4 ** r29 |=> w5 ** r30 |=> w6
    | _ =>
      r24 |=> w0 ** r25 |=> w1 ** r26 |=> w2 ** r27 |=> w3 **
         r28 |=> w4 ** r29 |=> w5 ** r30 |=> w6 ** r31 |=> w7
    end
  end.

Definition GenRegs_rm_one (greg_st : GenRegState) (rr : GenReg) :=
  match greg_st with
  | (fmg, fmo, fml, fmi) =>
    globalRegs_rm_one fmg rr ** outRegs_rm_one fmo rr **
                      localRegs_rm_one fml rr ** inRegs_rm_one fmi rr
  end.

Lemma GenRegs_split_one :
  forall s grst p (rr : GenReg),
    s |= GenRegs grst ** p ->
    s |= rr |=> get_genreg_val' grst rr ** GenRegs_rm_one grst rr ** p.
Proof.
  intros.
  eapply astar_assoc_elim; eauto.
  eapply astar_subst1; eauto.
  clear H.
  intros.
  unfolds GenRegs.
  destruct grst.
  destruct p0.
  destruct p0.
  destruct f1, f2, f0, f.

  Ltac simpl_reg_elim m :=
    match goal with
    | H : ?s |= _ |- ?s |= _ =>
      asrt_to_ls; asrt_to_ls_in H;
      simpl_sep_liftn_in H m; eauto
    | _ => idtac
    end.

  destruct rr;
    simpl get_genreg_val';
    simpl GenRegs_rm_one;
    unfold GlobalRegs, OutRegs, LocalRegs, InRegs in H.
  simpl_reg_elim 1.
  simpl_reg_elim 2.
  simpl_reg_elim 3.
  simpl_reg_elim 4.
  simpl_reg_elim 5.
  simpl_reg_elim 6.
  simpl_reg_elim 7.
  simpl_reg_elim 8.
  simpl_reg_elim 9.
  simpl_reg_elim 10.
  simpl_reg_elim 11.
  simpl_reg_elim 12.
  simpl_reg_elim 13.
  simpl_reg_elim 14.
  simpl_reg_elim 15.
  simpl_reg_elim 16.
  simpl_reg_elim 17.
  simpl_reg_elim 18.
  simpl_reg_elim 19.
  simpl_reg_elim 20.
  simpl_reg_elim 21.
  simpl_reg_elim 22.
  simpl_reg_elim 23.
  simpl_reg_elim 24.
  simpl_reg_elim 25.
  simpl_reg_elim 26.
  simpl_reg_elim 27.
  simpl_reg_elim 28.
  simpl_reg_elim 29.
  simpl_reg_elim 30.
  simpl_reg_elim 31.
  simpl_reg_elim 32.
Qed.

Lemma GenRegs_upd_combine_one :
  forall s grst p (rr : GenReg) v,
    s |= rr |=> v ** GenRegs_rm_one grst rr ** p ->
    s |= GenRegs (upd_genreg grst rr v) ** p.
Proof.
  intros.
  eapply astar_assoc_intro in H; eauto.
  eapply astar_subst1; eauto.
  clear H.
  intros.
  destruct grst.
  destruct p0.
  destruct p0.
  destruct f1, f2, f0, f.

  Ltac simpl_reg_elim1 m :=
    match goal with
    | H : ?s |= _ |- ?s |= _ =>
      asrt_to_ls; asrt_to_ls_in H;
      simpl_sep_liftn m; eauto
    | _ => idtac
    end.

  destruct rr;
    simpl upd_genreg; simpls GenRegs_rm_one;
    unfolds GenRegs,  GlobalRegs, OutRegs, LocalRegs, InRegs.
  simpl_reg_elim1 1.
  simpl_reg_elim1 2.
  simpl_reg_elim1 3.
  simpl_reg_elim1 4.
  simpl_reg_elim1 5.
  simpl_reg_elim1 6.
  simpl_reg_elim1 7.
  simpl_reg_elim1 8.
  simpl_reg_elim1 9.
  simpl_reg_elim1 10.
  simpl_reg_elim1 11.
  simpl_reg_elim1 12.
  simpl_reg_elim1 13.
  simpl_reg_elim1 14.
  simpl_reg_elim1 15.
  simpl_reg_elim1 16.
  simpl_reg_elim1 17.
  simpl_reg_elim1 18.
  simpl_reg_elim1 19.
  simpl_reg_elim1 20.
  simpl_reg_elim1 21.
  simpl_reg_elim1 22.
  simpl_reg_elim1 23.
  simpl_reg_elim1 24.
  simpl_reg_elim1 25.
  simpl_reg_elim1 26.
  simpl_reg_elim1 27.
  simpl_reg_elim1 28.
  simpl_reg_elim1 29.
  simpl_reg_elim1 30.
  simpl_reg_elim1 31.
  simpl_reg_elim1 32.
Qed.

Lemma Regs_Global_combine_GenRegs :
  forall fmg fmo fml fmi p s,
    s |= Regs fmo fml fmi ** GlobalRegs fmg ** p ->
    s |= GenRegs (fmg, fmo, fml, fmi) ** p.
Proof.
  intros.
  unfold Regs in H.
  unfold GenRegs.
  sliftn_in H 5.
  sliftn 5.
  sep_cancel1 1 1.
  sliftn_in H0 1.
  sep_cancel1 1 2.
  sliftn_in H 3.
  sep_cancel1 1 1.
  eauto.
Qed.

Lemma GenRegs_split_Regs_Global :
  forall fmg fmo fml fmi p s,
    s |= GenRegs (fmg, fmo, fml, fmi) ** p ->
    s |= Regs fmo fml fmi ** GlobalRegs fmg ** p.
Proof.
  intros.
  unfold GenRegs in H.
  eapply astar_assoc_elim in H.
  sep_cancel1 1 2.
  unfold Regs.
  eauto.
Qed.

Theorem add_rule_reg :
  forall grst rs rd p oexp v1 v2 v,
    Some v = val_add v1 v2 ->
    get_genreg_val grst rs = v1 -> eval_opexp_reg grst oexp = Some v2 ->
    |- {{ GenRegs grst ** p }} add rs oexp rd
                              {{ GenRegs (upd_genreg grst rd v) ** p }}.
Proof.
  introv Hres; intros.
  eapply ins_conseq_rule.
  eauto.
  eapply add_rule; eauto.
  {
    intros.
    simpl.
    split.
    {
      sep_star_split_tac.
      simpl in H5.
      simpljoin1.
      simpl.
      eapply getR_eq_get_genreg_val in H1; eauto.
      eapply get_R_merge_still; eauto.
    }
    {
      sep_star_split_tac.
      simpl in H5.
      simpljoin1.
      simpl.
      eapply eval_opexp_merge_still; eauto.
      eapply eval_opexp_reg_eq_eval_opexp; eauto.
    }
  }
  {
    intros.
    instantiate (2 := (get_genreg_val' grst rd)).
    instantiate (1 := (GenRegs_rm_one grst rd ** p)).
    eapply GenRegs_split_one; eauto.
  }

  intros.
  eapply GenRegs_upd_combine_one; eauto.
Qed.

Theorem sub_rule_reg :
  forall grst rs rd p oexp v1 v2 v,
    Some v = val_sub v1 v2 ->
    get_genreg_val grst rs = v1 -> eval_opexp_reg grst oexp = Some v2 ->
    |- {{ GenRegs grst ** p }} sub rs oexp rd
                              {{ GenRegs (upd_genreg grst rd v) ** p }}.
Proof.
  introv Hres; intros.
  eapply ins_conseq_rule.
  eauto.
  eapply sub_rule; eauto.
  {
    intros.
    simpl.
    split.
    {
      sep_star_split_tac.
      simpl in H5.
      simpljoin1.
      simpl.
      eapply getR_eq_get_genreg_val in H1; eauto.
      eapply get_R_merge_still; eauto.
    }
    {
      sep_star_split_tac.
      simpl in H5.
      simpljoin1.
      simpl.
      eapply eval_opexp_merge_still; eauto.
      eapply eval_opexp_reg_eq_eval_opexp; eauto.
    }
  }
  {
    intros.
    instantiate (2 := (get_genreg_val' grst rd)).
    instantiate (1 := (GenRegs_rm_one grst rd ** p)).
    eapply GenRegs_split_one; eauto.
  }

  intros.
  eapply GenRegs_upd_combine_one; eauto.
Qed.

Theorem and_rule_reg :
  forall grst rs rd p oexp v1 v2,
    get_genreg_val grst rs = W v1 -> eval_opexp_reg grst oexp = Some (W v2) ->
    |- {{ GenRegs grst ** p }} and rs oexp rd
                              {{ GenRegs (upd_genreg grst rd (W v1 &ᵢ v2)) ** p }}.
Proof.
  intros.
  eapply ins_conseq_rule.
  eauto.
  eapply and_rule; eauto.
  {
    intros.
    simpl.
    split.
    {
      instantiate (1 := v1).
      sep_star_split_tac.
      simpl in H5.
      simpljoin1.
      simpl.
      eapply getR_eq_get_genreg_val in H1; eauto.
      eapply get_R_merge_still; eauto.
      rewrite H in H1; eauto.
    }
    {
      instantiate (1 := v2).
      sep_star_split_tac.
      simpl in H5.
      simpljoin1.
      simpl.
      eapply eval_opexp_merge_still; eauto.
      eapply eval_opexp_reg_eq_eval_opexp; eauto.
    }
  }
  {
    intros.
    instantiate (2 := (get_genreg_val' grst rd)).
    instantiate (1 := (GenRegs_rm_one grst rd ** p)).
    eapply GenRegs_split_one; eauto.
  }

  intros.
  eapply GenRegs_upd_combine_one; eauto.
Qed.

Theorem or_rule_reg :
  forall grst rs rd p oexp v1 v2,
    get_genreg_val grst rs = W v1 -> eval_opexp_reg grst oexp = Some (W v2) ->
    |- {{ GenRegs grst ** p }} or rs oexp rd
                              {{ GenRegs (upd_genreg grst rd (W v1 |ᵢ v2)) ** p }}.
Proof.
  intros.
  eapply ins_conseq_rule.
  eauto.
  eapply or_rule; eauto.
  {
    intros.
    simpl.
    split.
    {
      instantiate (1 := v1).
      sep_star_split_tac.
      simpl in H5.
      simpljoin1.
      simpl.
      eapply getR_eq_get_genreg_val in H1; eauto.
      eapply get_R_merge_still; eauto.
      rewrite H in H1; eauto.
    }
    {
      instantiate (1 := v2).
      sep_star_split_tac.
      simpl in H5.
      simpljoin1.
      simpl.
      eapply eval_opexp_merge_still; eauto.
      eapply eval_opexp_reg_eq_eval_opexp; eauto.
    }
  }
  {
    intros.
    instantiate (2 := (get_genreg_val' grst rd)).
    instantiate (1 := (GenRegs_rm_one grst rd ** p)).
    eapply GenRegs_split_one; eauto.
  }

  intros.
  eapply GenRegs_upd_combine_one; eauto.
Qed.

Theorem sll_rule_reg :
  forall grst rs rd p oexp v1 v2,
    get_genreg_val grst rs = W v1 -> eval_opexp_reg grst oexp = Some (W v2) ->
    |- {{ GenRegs grst ** p }} sll rs oexp rd
                              {{ GenRegs (upd_genreg grst rd (W v1 <<ᵢ (get_range 0 4 v2))) ** p }}.
Proof.
  intros.
  eapply ins_conseq_rule.
  eauto.
  eapply sll_rule; eauto.
  {
    intros.
    simpl.
    split.
    {
      instantiate (1 := v1).
      sep_star_split_tac.
      simpl in H5.
      simpljoin1.
      simpl.
      eapply getR_eq_get_genreg_val in H1; eauto.
      eapply get_R_merge_still; eauto.
      rewrite H in H1; eauto.
    }
    {
      instantiate (1 := v2).
      sep_star_split_tac.
      simpl in H5.
      simpljoin1.
      simpl.
      eapply eval_opexp_merge_still; eauto.
      eapply eval_opexp_reg_eq_eval_opexp; eauto.
    }
  }
  {
    intros.
    instantiate (2 := (get_genreg_val' grst rd)).
    instantiate (1 := (GenRegs_rm_one grst rd ** p)).
    eapply GenRegs_split_one; eauto.
  }

  intros.
  eapply GenRegs_upd_combine_one; eauto.
Qed.

Theorem srl_rule_reg :
  forall grst rs rd p oexp v1 v2,
    get_genreg_val grst rs = W v1 -> eval_opexp_reg grst oexp = Some (W v2) ->
    |- {{ GenRegs grst ** p }} srl rs oexp rd
                              {{ GenRegs (upd_genreg grst rd (W v1 >>ᵢ (get_range 0 4 v2))) ** p }}.
Proof.
  intros.
  eapply ins_conseq_rule.
  eauto.
  eapply srl_rule; eauto.
  {
    intros.
    simpl.
    split.
    {
      instantiate (1 := v1).
      sep_star_split_tac.
      simpl in H5.
      simpljoin1.
      simpl.
      eapply getR_eq_get_genreg_val in H1; eauto.
      eapply get_R_merge_still; eauto.
      rewrite H in H1; eauto.
    }
    {
      instantiate (1 := v2).
      sep_star_split_tac.
      simpl in H5.
      simpljoin1.
      simpl.
      eapply eval_opexp_merge_still; eauto.
      eapply eval_opexp_reg_eq_eval_opexp; eauto.
    }
  }
  {
    intros.
    instantiate (2 := (get_genreg_val' grst rd)).
    instantiate (1 := (GenRegs_rm_one grst rd ** p)).
    eapply GenRegs_split_one; eauto.
  }

  intros.
  eapply GenRegs_upd_combine_one; eauto.
Qed.

Theorem set_rule_reg :
  forall grst rd p w,
    |- {{ GenRegs grst ** p }} sett w rd
                              {{ GenRegs (upd_genreg grst rd w) ** p }}.
Proof.
  intros.
  eapply ins_conseq_rule.
  eauto.
  eapply set_rule; eauto.
  {
    instantiate (2 := (get_genreg_val' grst rd)).
    instantiate (1 := (GenRegs_rm_one grst rd ** p)).
    intros.
    eapply GenRegs_split_one; eauto.
  }
  {
    intros.
    eapply GenRegs_upd_combine_one; eauto.
  }
Qed.

Theorem getcwp_rule_reg :
  forall grst rd p id F,
    |- {{ GenRegs grst ** {| id, F|} ** p }}
        getcwp rd
        {{ GenRegs (upd_genreg grst rd (W id)) ** {| id, F|} ** p }}.
Proof.
  intros.
  eapply ins_conseq_rule.
  eauto.
  eapply getcwp_rule; eauto.
  {
    intros.
    simpl_sep_liftn 2.
    instantiate (4 := (get_genreg_val' grst rd)).
    instantiate (3 := id).
    instantiate (2 := F).
    instantiate (1 := (GenRegs_rm_one grst rd ** p)).
    sep_cancel1 2 2.
    eapply GenRegs_split_one; eauto.
  }
  {
    intros.
    sep_cancel1 1 2.
    eapply GenRegs_upd_combine_one; eauto.
  }
Qed.

Theorem ld_rule_reg :
  forall p aexp rd grst v l,
    eval_addrexp_reg grst aexp = Some (Ptr l) ->
    |- {{ GenRegs grst ** l |-> v ** p }}
        ld aexp rd
       {{ GenRegs (upd_genreg grst rd v) ** l |-> v ** p }}.
Proof.
  intros.
  eapply ins_conseq_rule.
  eauto.
  eapply ld_rule; eauto.
  {
    intros.
    instantiate (1 := l).
    simpl.
    split; eauto.
    sep_star_split_tac.
    simpl in H3, H4.
    simpljoin1.
    simpl.
    eapply eval_addrexp_merge_still; eauto.
    eapply eval_aexp_reg_eq_eval_aexp; eauto.
    sep_star_split_tac.
    simpl in H3, H4.
    simpljoin1.
    simpl in H1.
    simpljoin1; eauto.
  }
  {
    intros.
    instantiate (1 := GenRegs_rm_one grst rd ** p).
    instantiate (1 := get_genreg_val' grst rd).
    instantiate (1 := v).
    sep_cancel1 2 1.
    eapply GenRegs_split_one; eauto.
  }
  {
    intros.
    sep_cancel1 1 2.
    eapply GenRegs_upd_combine_one; eauto.
  }
Qed.

Theorem st_rule_reg :
  forall p aexp rs grst v v' l,
    eval_addrexp_reg grst aexp = Some (Ptr l) -> get_genreg_val grst rs = v' ->
    |- {{ GenRegs grst ** l |-> v ** p }}
        st rs aexp
        {{ GenRegs grst ** l |-> v' ** p }}.
Proof.
  intros.
  eapply ins_conseq_rule.
  Focus 2.
  instantiate (2 := l |-> v ** GenRegs grst ** p).
  instantiate (1 := l |-> v' ** GenRegs grst ** p).
  eapply st_rule; eauto.
  intros.
  simpl.
  split.
  simpl_sep_liftn_in H1 2.
  sep_star_split_tac.
  simpl in H4, H5.
  simpljoin1.
  simpl.
  eapply get_R_merge_still; eauto.
  eapply getR_eq_get_genreg_val; eauto.
  split.
  simpl_sep_liftn_in H1 2.
  sep_star_split_tac.
  simpl in H4, H5.
  simpljoin1.
  simpl.
  eapply eval_addrexp_merge_still; eauto.
  eapply eval_aexp_reg_eq_eval_aexp; eauto.
  sep_star_split_tac.
  simpl in H4.
  simpl in H5.
  simpljoin1.
  simpl in H1.
  simpljoin1; eauto.
  intros.
  sep_cancel1 1 2.
  eauto.
  intros.
  sep_cancel1 2 1.
  eauto.
Qed.

Theorem save_rule_reg :
  forall p (rs rd : GenReg) (id id' : Word) (F : FrameList)
         (fm1 fm2 fmg fmo fml fmi : Frame) (v : Word) v1 v2 res (oexp : OpExp),
    Some res = val_add v1 v2 ->
    get_genreg_val (fmg, fmo, fml, fmi) rs = v1 ->
    eval_opexp_reg (fmg, fmo, fml, fmi) oexp = Some v2 ->
    id' = pre_cwp id -> win_masked id' v = false ->
    |- {{ GenRegs (fmg, fmo, fml, fmi) ** Rwim |=> W v ** {| id, F ++ [fm1; fm2] |} ** p }}
        save rs oexp rd
      {{ GenRegs (upd_genreg (fmg, fm1, fm2, fmo) rd res) ** Rwim |=> W v **
                 {| id', fml :: fmi :: F |} ** p }}.
Proof.
  introv Hres; intros.
  eapply ins_conseq_rule.
  instantiate (1 := Rwim |=> W v ** GenRegs (fmg, fmo, fml, fmi) **
                         {|id, F ++ [fm1; fm2]|} ** p).
  intros.
  sep_cancel1 2 1.
  eauto.
  eapply save_rule; eauto.
  {
    intros.
    sep_star_split_tac.
    simpl in H6, H7.
    simpljoin1.
    simpl sat.
    split.
    {
      eapply getR_eq_get_genreg_val with (rr := rs) in H3; eauto.
      clear - H3.
      eapply get_R_merge_still; eauto.
    }
    {
      eapply eval_opexp_merge_still; eauto.
      eapply eval_opexp_reg_eq_eval_opexp; eauto.
    }
  }
  {
    intros.
    instantiate (1 := GlobalRegs fmg ** p).
    instantiate (3 := fmo).
    instantiate (2 := fml).
    instantiate (1 := fmi).
    sep_cancel1 2 1.
    eapply astar_comm in H4.
    sliftn 3.
    sep_cancel1 1 1.
    unfold GenRegs in H3.
    unfold Regs.
    eapply astar_comm.
    sep_cancel1 1 1.
    eauto.
  }
  {
    intros.
    instantiate (1 := {|id', fml :: fmi :: F|} ** GenRegs_rm_one (fmg, fm1, fm2, fmo) rd ** p).
    instantiate (1 := (get_genreg_val' (fmg, fm1, fm2, fmo) rd)).
    sep_cancel1 1 2.
    eapply GenRegs_split_one; eauto.
    eapply Regs_Global_combine_GenRegs; eauto.
  }
  {
    intros.
    sep_cancel1 1 2.
    sep_cancel1 2 2.
    eapply GenRegs_upd_combine_one; eauto.
  }
Qed.

Theorem restore_rule_reg :
  forall p (rs rd : GenReg) (id id' : Word) (F : FrameList)
         (fm1 fm2 fmg fmo fml fmi : Frame) v1 v2 v (res : Val) (oexp : OpExp),
    Some res = val_add v1 v2 ->
    get_genreg_val (fmg, fmo, fml, fmi) rs = v1 ->
    eval_opexp_reg (fmg, fmo, fml, fmi) oexp = Some v2 ->
    id' = post_cwp id -> win_masked id' v = false ->
    |- {{ GenRegs (fmg, fmo, fml, fmi) ** Rwim |=> W v ** {| id, fm1 :: fm2 :: F |} ** p }}
        restore rs oexp rd
      {{ GenRegs (upd_genreg (fmg, fmi, fm1, fm2) rd res) ** Rwim |=> W v **
                 {| id', F ++ [fmo; fml] |} ** p }}.
Proof.
  introv Hres; intros.
  eapply ins_conseq_rule.
  instantiate (1 := Rwim |=> W v ** GenRegs (fmg, fmo, fml, fmi) **
                         {|id, fm1 :: fm2 :: F|} ** p).
  intros.
  sep_cancel1 1 2.
  eauto.
  eapply restore_rule; eauto.
  {
    intros.
    simpl.
    sep_star_split_tac.
    simpl in H6, H7.
    simpljoin1.
    simpl getregs.
    split.
    eapply get_R_merge_still; eauto.
    eapply getR_eq_get_genreg_val; eauto.
    eapply eval_opexp_merge_still; eauto.
    eapply eval_opexp_reg_eq_eval_opexp; eauto.
  }
  {
    intros.
    sep_cancel1 2 1.
    instantiate (1 := GlobalRegs fmg ** p).
    sliftn_in H4 2.
    sliftn 3.
    sep_cancel1 1 1.
    unfold GenRegs in H3.
    sliftn 2.
    sep_cancel1 1 1.
    unfold Regs.
    eauto.
  }
  {
    intros.
    instantiate (1 := {|id', F ++ [fmo; fml]|} ** GenRegs_rm_one (fmg, fmi, fm1, fm2) rd ** p).
    instantiate (1 := (get_genreg_val' (fmg, fmi, fm1, fm2) rd)).
    sep_cancel1 1 2.
    eapply Regs_Global_combine_GenRegs in H4.
    eapply GenRegs_split_one; eauto.
  }
  {
    intros.
    sep_cancel1 1 2.
    sep_cancel1 2 2.
    eapply GenRegs_upd_combine_one; eauto.
  }
Qed.

Theorem subcc_rule_reg :
  forall oexp (rs rd : GenReg) v1 v2 v grst vn vz p,
    get_genreg_val grst rs = W v1 ->
    eval_opexp_reg grst oexp = Some (W v2) -> v = v1 -ᵢ v2 ->
    |- {{ GenRegs grst ** n |=> vn ** z |=> vz ** p  }}
        subcc rs oexp rd
      {{ GenRegs (upd_genreg grst rd (W v)) ** n |=> W (get_range 31 31 v) ** z |=> W (iszero v) ** p }}.
Proof.
  intros.
  eapply ins_conseq_rule.
  eauto.
  eapply subcc_rule.
  {
    introv Hs.
    instantiate (2 := v1).
    instantiate (1 := v2).
    simpl.
    split.
    sep_star_split_tac.
    simpl in H3, H5, H6.
    simpljoin1.
    simpl.
    eapply get_R_merge_still; eauto.
    eapply getR_eq_get_genreg_val in H4; rewrite H4, H; eauto.
    sep_star_split_tac.
    simpl in H3, H5, H6.
    simpljoin1.
    simpl.
    eapply eval_opexp_merge_still; eauto.
    eapply eval_opexp_reg_eq_eval_opexp; eauto.
  }
  {
    eauto.
  }
  {
    introv Hs.
    instantiate (4 := (get_genreg_val' grst rd)).
    instantiate (1 := (GenRegs_rm_one grst rd ** p)).
    instantiate (1 := vz).
    instantiate (1 := vn).
    sep_cancel1 2 2.
    sep_cancel1 2 2.
    eapply GenRegs_split_one; eauto.
  }
  {
    introv Hs.
    sep_cancel1 2 2.
    sep_cancel1 2 2.
    eapply GenRegs_upd_combine_one; eauto.
  }
Qed.

Theorem andcc_rule_reg :
  forall oexp (rs rd : GenReg) v1 v2 v grst vn vz p,
    get_genreg_val grst rs = W v1 ->
    eval_opexp_reg grst oexp = Some (W v2) -> v = v1 &ᵢ v2 ->
    |- {{ GenRegs grst ** n |=> vn ** z |=> vz ** p  }}
        andcc rs oexp rd
      {{ GenRegs (upd_genreg grst rd (W v)) ** n |=> W (get_range 31 31 v) ** z |=> W (iszero v) ** p }}.
Proof.
  intros.
  eapply ins_conseq_rule.
  eauto.
  eapply andcc_rule; eauto.
  {
    introv Hs.
    simpl.
    split.
    sep_star_split_tac.
    simpl in H3, H5, H6.
    simpljoin1.
    simpl.
    eapply get_R_merge_still; eauto.
    eapply getR_eq_get_genreg_val in H4; eauto; rewrite H4, H; eauto.
    sep_star_split_tac.
    simpl in H3, H5, H6.
    simpljoin1.
    simpl.
    eapply eval_opexp_merge_still; eauto.
    eapply eval_opexp_reg_eq_eval_opexp; eauto.
  }
  {
    introv Hs.
    instantiate (4 := (get_genreg_val' grst rd)).
    instantiate (1 := (GenRegs_rm_one grst rd ** p)).
    instantiate (1 := vz).
    instantiate (1 := vn).
    sep_cancel1 2 2.
    sep_cancel1 2 2.
    eapply GenRegs_split_one; eauto.
  }
  {
    introv Hs.
    sep_cancel1 2 2.
    sep_cancel1 2 2.
    eapply GenRegs_upd_combine_one; eauto.
  }
Qed.

Theorem rd_rule_reg :
  forall (rsp : SpReg) v (rr : GenReg) p grst,
    |- {{ GenRegs grst ** rsp |=> W v ** p }}
        rd rsp rr
      {{ GenRegs (upd_genreg grst rr (W v)) ** rsp |=> W v ** p }}.
Proof.
  intros.
  eapply ins_conseq_rule with
  (p1 := rsp |=> W v ** rr |=> get_genreg_val' grst rr ** GenRegs_rm_one grst rr ** p).
  Focus 2.
  eapply rd_rule; eauto.
  introv Hs.
  sep_cancel1 2 1.
  eapply GenRegs_split_one; eauto.
  introv Hs.
  sep_cancel1 1 2.
  eapply GenRegs_upd_combine_one; eauto.
Qed.

Theorem wr_rule_reg :
  forall oexp (rs : GenReg) v1 v2 v grst (rsp : SpReg) p,
    get_genreg_val grst rs = W v1 ->
    eval_opexp_reg grst oexp = Some (W v2) ->
    |- {{ GenRegs grst ** rsp |=> v ** p }}
        wr rs oexp rsp
      {{ GenRegs grst ** 3 @ rsp |==> set_spec_reg rsp (v1 xor v2) ** p }}.
Proof.
  intros.
  eapply ins_conseq_rule with (p1 := rsp |=> v ** GenRegs grst ** p).
  Focus 2.
  eapply wr_rule; eauto.
  instantiate (2 := v1).
  instantiate (1 := v2).
  introv Hs.
  simpl_sep_liftn_in Hs 2.
  simpl.
  split.

    subst.
    sep_star_split_tac.
    simpl in H4, H5.
    simpljoin1.
    simpl.
    eapply get_R_merge_still; eauto.
    eapply getR_eq_get_genreg_val in H3; eauto; rewrite H3, H; eauto.

    sep_star_split_tac.
    simpl in H4, H5.
    simpljoin1.
    simpl.
    eapply eval_opexp_merge_still; eauto.
    eapply eval_opexp_reg_eq_eval_opexp; eauto.

  introv Hs.
  sep_cancel1 1 2.
  eauto.
  introv Hs.
  sep_cancel1 2 1.
  eauto.
Qed.


(** * Simulation environment for the H-VHDL semantics. *)

(** Module defining the components of the simulation environment.  *)

Require Import Setoid.
Require Import common.CoqLib.
Require Import common.NatMap.
Require Import common.NatSet.
Require Import common.ListPlus.
Require Import common.GlobalTypes.

Require Import hvhdl.AbstractSyntax.
Require Import hvhdl.SemanticalDomains.
Require Import hvhdl.HVhdlTypes.

Open Scope natset_scope.

(** ** Miscellaneous Environment Definitions *)

(** *** Equal Domains *)

(** Defines the design environment describing H-VHDL design instances
    in the semantical world. The design environment maps identifiers
    of a certain category of constructs (e.g, constant identifiers) to
    their declaration information (e.g, type and value for
    constants). *)

(** Definition of the [dom] function that yields a list of identifiers
    corresponding to the definition domain of an IdMap. *)

Definition EqualDom {A} (m m' : NatMap.t A) : Prop := forall (k : nat), NatMap.In k m <-> NatMap.In k m'.
Definition dom {A : Type} (f : IdMap A) : list ident := fs (NatMap.elements f).

Definition EqualDom_refl : forall {A} (m : IdMap A), EqualDom m m. firstorder. Defined.
Definition EqualDom_trans : forall {A} (m m' m'' : IdMap A), EqualDom m m' -> EqualDom m' m'' -> EqualDom m m''.
  unfold EqualDom; intros; transitivity (NatMap.In k m'); auto.
Defined.
Definition EqualDom_sym : forall {A} (m m' : IdMap A), EqualDom m m' -> EqualDom m' m.
  unfold EqualDom; symmetry; auto.
Defined.

Add Parametric Relation {A : Type} : (IdMap A) (EqualDom)
    reflexivity proved by EqualDom_refl
    symmetry proved by EqualDom_sym
    transitivity proved by EqualDom_trans
      as EqualDom_rel.

#[export] Hint Resolve EqualDom_refl : hvhdl.
#[export] Hint Resolve EqualDom_trans : hvhdl.
#[export] Hint Resolve EqualDom_sym : hvhdl.

(** Defines the relation stating that a set [idset] is the
    differentiated intersection of two maps [m] and [m'] mapping
    identifier to value.

    The differentiated intersection of two maps [m] and [m'] is the
    set { x ∈ dom(m) ∩ dom(m') | m(x) ≠ m'(x) }.
 *)

Definition IsDiffInter (m m' : IdMap value) (idset : IdSet) :=
  (forall id v v', NatSet.In id idset -> MapsTo id v m -> MapsTo id v' m' -> ~VEq v v') /\
  (forall id v v', MapsTo id v m -> MapsTo id v' m' -> ~VEq v v' -> NatSet.In id idset).

(** Defines the relation stating that a map [ovunion] results of the
    overriding union of two maps [ovridden] and [ovriding].

    A map [m''] results of the overriding union of maps [m] and [m']
    if m'' = λx. m'(x) if x ∈ dom(m') ∧ m(x) otherwise.

    We add in the relation definition that the overridden map
    [ovridden] and the resulting map [ovunion] must have the same
    definition domains.  *)

Definition IsOverrUnion (ovridden ovriding ovunion : IdMap value) :=
  EqualDom ovridden ovunion /\
  (forall id v, MapsTo id v ovriding -> MapsTo id v ovunion) /\
  (forall id v, ~NatMap.In id ovriding -> MapsTo id v ovridden -> MapsTo id v ovunion).

(** ** Local Environment *)

(** Defines a process local variable environment as a map from local
    variable identifiers to couples (type * value).  *)

Definition LEnv := IdMap (type * value).

(** Defines an empty process local variable environment. *)

Definition EmptyLEnv := NatMap.empty (type * value).

(** ** Elaborated Design *)

(** Elaborated design attributes *)

(* Needed because the inductive definition of the [DesignAttribute]
   type does not respect the strict positivity requirement.

   However, I am almost sure that it is not dangerous to do so. *)

Local Unset Positivity Checking.

(** Defines an elaborated design as a mapping from identifiers to
    [DesignAttribute]. *)

Inductive ElDesign : Type :=
| MkElDesign :> NatMap.t DesignAttribute -> ElDesign
with DesignAttribute  :=
| Generic (t : type) (v : value)
| Input (t : type)
| Output (t : type)
| Internal (t : type)
| Process (lenv : LEnv)
| Component (Δ__c : ElDesign).

Coercion ElDesign_to_IdMap (Δ : ElDesign) : NatMap.t DesignAttribute :=
  match Δ with MkElDesign m => m end.

(** Defines a bare elaborated design. *)

Definition EmptyElDesign := MkElDesign (NatMap.empty DesignAttribute).

(** *** Identifiers qualification *)

Definition GenericOf (Δ : ElDesign) id :=
  exists t v, MapsTo id (Generic t v) Δ.

Definition InputOf (Δ : ElDesign) id :=
  exists t, MapsTo id (Input t) Δ.

Definition OutputOf (Δ : ElDesign) id :=
  exists t, MapsTo id (Output t) Δ.

Definition InternalOf (Δ : ElDesign) id :=
  exists t, MapsTo id (Internal t) Δ.

Definition ProcessOf (Δ : ElDesign) id :=
  exists Λ, MapsTo id (Process Λ) Δ.

Definition CompOf (Δ : ElDesign) id :=
  exists Δ__c, MapsTo id (Component Δ__c) Δ.

(** ** Design State *)

(** Defines the structure of design state composed of a signal store
    [sstore], and a design instance store [cstore]. *)

Inductive DState : Type :=
  MkDState {
      sstore  : IdMap value;
      cstore : IdMap DState;
    }.

(** Defines an empty design state. *)

Definition EmptyDState := MkDState (NatMap.empty value)
                                   (NatMap.empty DState).

Definition EmptySStore := (NatMap.empty value).

(** Macro to add, or to override, a mapping [id ⇒ value] in the
    [sstore] of the design state [σ].  *)

Definition sstore_add (id : ident) (v : value) (σ : DState) : DState :=
  MkDState (NatMap.add id v (sstore σ)) (cstore σ).

(** Macro to add, or to override, a mapping [id__c ⇒ σ__c] in the [cstore]
    of the design state [σ].  *)

Definition cstore_add (id__c : ident) (σ__c : DState) (σ : DState) : DState :=
  MkDState (sstore σ) (NatMap.add id__c σ__c (cstore σ)).

(** Defines the [InSStore] predicate that states that [id] is mapped
    to a value in the [sstore] of design state [σ].

    Wrapper around the [In] predicate.  *)

Definition InSStore (id : ident) (σ : DState) :=
  NatMap.In id (sstore σ).

(** Design state equality relation *)

Inductive DStateEq (σ1 σ2 : DState) : Prop :=
  DSEq {
      sstore_eq :
      forall id v1 v2,
        NatMap.MapsTo id v1 (sstore σ1) ->
        NatMap.MapsTo id v2 (sstore σ2) ->
        VEq v1 v2;

      cstore_eq :
      forall id σ__c1 σ__c2,
        NatMap.MapsTo id σ__c1 (cstore σ1) ->
        NatMap.MapsTo id σ__c2 (cstore σ2) ->
        DStateEq σ__c1 σ__c2
    }.

(** DStateEq is decidable *)

Lemma DStateEq_dec : forall x y, {DStateEq x y} + {~DStateEq x y}. Admitted.

(** Predicate stating that a DState [σ__m] results from the
    interleaving of an origin DState [σ__o], and two DState
    [σ'] and [σ''].

    To understand the predicate, one can consider that the states
    [σ'] and [σ''] result from the parallel execution of two
    concurrent statements in the context of [σ__o].

*)

Record IsMergedDState (σ__o σ' σ'' σ__m : DState) : Prop :=
  IMDS {

      (* Describes the content of [(sstore σ__m)] *)
      sstore1 :
      forall id v1 v2,
        NatMap.MapsTo id v1 (sstore σ') ->
        NatMap.MapsTo id v2 (sstore σ__o) ->
        VNEq v1 v2 ->
        NatMap.MapsTo id v1 (sstore σ__m);

      sstore2 :
      forall id v1 v2,
        NatMap.MapsTo id v1 (sstore σ'') ->
        NatMap.MapsTo id v2 (sstore σ__o) ->
        VNEq v1 v2 ->
        NatMap.MapsTo id v1 (sstore σ__m);

      sstore__o :
      forall id v__o v1 v2,
        NatMap.MapsTo id v__o (sstore σ__o) ->
        NatMap.MapsTo id v1 (sstore σ') ->
        NatMap.MapsTo id v2 (sstore σ'') ->
        VEq v__o v1 ->
        VEq v__o v2 ->
        NatMap.MapsTo id v__o (sstore σ__m);

      (* Describes the content of [(cstore σ__m)] *)
      cstore1 :
      forall id σ__c1 σ__c2,
        NatMap.MapsTo id σ__c1 (cstore σ') ->
        NatMap.MapsTo id σ__c2 (cstore σ__o) ->
        ~DStateEq σ__c1 σ__c2 ->
        NatMap.MapsTo id σ__c1 (cstore σ__m);

      cstore2 :
      forall id σ__c1 σ__c2,
        NatMap.MapsTo id σ__c1 (cstore σ'') ->
        NatMap.MapsTo id σ__c2 (cstore σ__o) ->
        ~DStateEq σ__c1 σ__c2 ->
        NatMap.MapsTo id σ__c1 (cstore σ__m);

      cstore__o :
      forall id σ__co σ__c1 σ__c2,
        NatMap.MapsTo id σ__co (cstore σ__o) ->
        NatMap.MapsTo id σ__c1 (cstore σ') ->
        NatMap.MapsTo id σ__c2 (cstore σ'') ->
        DStateEq σ__co σ__c1 ->
        DStateEq σ__co σ__c2 ->
        NatMap.MapsTo id σ__co (cstore σ__m)

    }.

(** Looks up the value associated to [id] in map [m1] and [m2] and
    compares it to [v0]. If values are equal then the [v0] is
    returned, otherwise the looked-up value is returned.

    Note that if [id] is not bound in [m1] or [m2], [v0] is
    returned instead of raising an error, in order to have a total
    function.  *)

Definition get_freshest_value {A : Type}
  {Aeq : A -> A -> Prop}
  (Aeq_dec : forall x y, {Aeq x y} + {~Aeq x y})
  (m1 m2 : IdMap A) (id : ident) (v0 : A) : A :=
  match find id m1 with
  | Some v1 =>
      if Aeq_dec v0 v1 then
        match find id m2 with
        | Some v2 => if Aeq_dec v0 v2 then v0 else v2
        (* Case [id] is not bound in [m1] *)
        | None => v0
        end
      else v1
  (* Case [id] is not bound in [m1] *)
  | None => v0
  end.

(** Returns a new identifier map where the identifiers bound in [m0]
    are associated with the freshest value either coming from [m1] or
    [m2], or from [m0] if an identifier is associated with the same
    value in the three maps. *)

Definition merge_idmap {A : Type}
           {Aeq : A -> A -> Prop}
           (Aeq_dec : forall x y, {Aeq x y} + {~Aeq x y})
           (m0 m1 m2 : IdMap A) : IdMap A :=
  NatMap.mapi (get_freshest_value Aeq_dec m1 m2) m0.

(** Returns a new design state resulting from the merging of the
    origin state [σ0] with the two states [σ1] and [σ2]. *)

Definition merge (σ0 σ1 σ2 : DState) : DState :=
  MkDState
    (merge_idmap value_eq_dec (sstore σ0) (sstore σ1) (sstore σ2))
    (merge_idmap DStateEq_dec (cstore σ0) (cstore σ1) (cstore σ2)).

(** Defines the relation stating that a design state [σ__i] is the
    result of the "injection" of the values of map [m] in the
    [sstore] of design state [σ__o]. *)

Definition IsInjectedDState (σ__o : DState) (m : IdMap value) (σ__i : DState) : Prop :=
  IsOverrUnion (sstore σ__o) m (sstore σ__i).

(** Overrides map [m0] with the values defined in map [m1] for all
    identifiers mapped in [m0] and [m1]. *)

Definition inj_in_map {A : Type} (m0 m1 : IdMap A) :=
  let overr_value id v := match find id m1 with
                          | Some v1 => v1
                          | None => v
                          end in
  NatMap.mapi overr_value m0.

(** Overrides the signal store of state [σ] with the values of map
    [m]. *)

Definition inj (σ : DState) (m : IdMap value) : DState :=
  MkDState (inj_in_map (sstore σ) m) (cstore σ).