Require Import Events. (*is needed for some definitions (loc_unmapped etc*)
Require Import Memory.
Require Import Coqlib.
Require Import Integers.
Require Import compcert.common.Values.
Require Import Maps.
Require Import Axioms.

Require Import FiniteMaps.
Require Import sepcomp.mem_lemmas.
Require Import sepcomp.mem_interpolation_defs.

Definition AccessMap_EI_Property (j:meminj) (m1 m1' m2 : mem)
           (AM:ZMap.t (Z -> perm_kind -> option permission)):Prop :=
  forall b2,
    (Mem.valid_block m2 b2 -> forall k ofs2,
       match j b2 with
         None => PMap.get b2 AM ofs2 k  =
                        PMap.get b2 m2.(Mem.mem_access) ofs2 k
       | Some (b3,d3) =>
          (Mem.perm m1 b2 ofs2 Max Nonempty ->
           PMap.get b2 AM ofs2 k = PMap.get b2 m1'.(Mem.mem_access) ofs2 k)
       /\ (~Mem.perm m1 b2 ofs2 Max Nonempty ->
           PMap.get b2 AM ofs2 k  = PMap.get b2 m2.(Mem.mem_access) ofs2 k)
     end)
  /\ (~ Mem.valid_block m2 b2 -> forall k ofs2,
         (Mem.perm m1' b2 ofs2 Max Nonempty ->
           PMap.get b2 AM ofs2 k = PMap.get b2 m1'.(Mem.mem_access) ofs2 k)
       /\ (~Mem.perm m1' b2 ofs2 Max Nonempty -> PMap.get b2 AM ofs2 k = None)).

Definition Content_EI_Property (j:meminj) (m1 m1' m2:Mem.mem)
                               (CM:ZMap.t (ZMap.t memval)):=
  forall b2,
      (Mem.valid_block m2 b2 -> forall ofs2,
             match j b2 with
               None =>  ZMap.get ofs2 (PMap.get b2 CM) =
                           ZMap.get ofs2 (PMap.get b2 m2.(Mem.mem_contents))
             | Some (b3,delta3) =>
                     (Mem.perm m1 b2 ofs2 Max Nonempty ->
                            ZMap.get ofs2 (PMap.get b2 CM) =
                           ZMap.get ofs2 (PMap.get b2 m1'.(Mem.mem_contents)))
                 /\ (~Mem.perm m1 b2 ofs2 Max Nonempty ->
                          ZMap.get ofs2 (PMap.get b2 CM) =
                         ZMap.get ofs2 (PMap.get b2 m2.(Mem.mem_contents)))
            end)
    /\ (~ Mem.valid_block m2 b2 -> forall (HM1': Mem.valid_block m1' b2) ofs2,
           (Mem.perm m1' b2 ofs2 Cur Readable ->
                ZMap.get ofs2 (PMap.get b2 CM) =
                ZMap.get ofs2 (PMap.get b2 m1'.(Mem.mem_contents)))
        /\ (~Mem.perm m1' b2 ofs2 Cur Readable ->
                ZMap.get ofs2 (PMap.get b2 CM) =Undef))
    /\ fst CM !! b2 = Undef.

Lemma EI_ok: forall (m1 m2 m1':mem)
               (Ext12: Mem.extends m1 m2)
               (Fwd1: mem_forward m1 m1') m3 j
               (Inj23: Mem.inject j m2 m3)
               m3' (Fwd3: mem_forward m3 m3') j'
               (Inj13': Mem.inject j' m1' m3')
               (UnchOn3: Mem.unchanged_on (loc_out_of_reach j m1) m3 m3')
               (InjInc: inject_incr j j') (injSep: inject_separated j j' m1 m3)
               (UnchOn1: Mem.unchanged_on (loc_unmapped j) m1 m1') m2'
               (NB: m2'.(Mem.nextblock)=m1'.(Mem.nextblock))
               (CONT: Content_EI_Property j m1 m1' m2 (m2'.(Mem.mem_contents)))
               (ACCESS: AccessMap_EI_Property j m1 m1' m2 (m2'.(Mem.mem_access))),
        mem_forward m2 m2' /\
               Mem.extends m1' m2' /\
               Mem.inject j' m2' m3' /\
               Mem.unchanged_on (loc_out_of_bounds m1) m2 m2' /\
               Mem.unchanged_on (loc_unmapped j) m2 m2'.
Proof. intros.
assert (VB' : forall b : block, Mem.valid_block m1' b = Mem.valid_block m2' b).
  intros; unfold Mem.valid_block. rewrite NB. trivial.
assert (Inj13:= Mem.extends_inject_compose _ _ _ _ Ext12 Inj23).
assert (MMU_LU: Mem.unchanged_on (loc_unmapped j) m2 m2' ).
   split. intros.
       destruct (ACCESS b) as [Val _].
        specialize (Val H0 k ofs). rewrite H in Val.
        rewrite (perm_subst _ _ _ _ _ _ _ Val). split; auto.
    intros. assert (Val2:= Mem.perm_valid_block _ _ _ _ _ H0).
        destruct (CONT b) as [ContVal _]. rewrite H in ContVal.
        apply (ContVal Val2 ofs).
assert (Fwd2: mem_forward m2 m2').
    split; intros.
     (*valid_block*) apply (Mem.valid_block_extends _ _ b Ext12) in H.
        apply Fwd1 in H. destruct H as[H _]. rewrite <- VB'. apply H.
      (*max*)
      apply (valid_split _ _ _ _  (ACCESS b)); clear ACCESS; intros.
           specialize (H2 Max ofs).
           remember (j b) as jb.
           destruct jb; apply eq_sym in Heqjb.
                destruct p0.
                apply (perm_split _ _ _ _ _ _ _ H2); clear H2; intros.
                    rewrite (perm_subst _ _ _ _ _ _ _ H3) in *. clear H3.
                    unfold Mem.perm. rewrite po_oo in *.
                       eapply po_trans. apply (extends_permorder _ _ Ext12).
                       destruct (Fwd1 b). apply (Mem.perm_valid_block _ _ _ _ _ H2).
                       apply (H4 ofs _ H0).
                   rewrite (perm_subst _ _ _ _ _ _ _ H3) in *. apply H0.
            rewrite (perm_subst _ _ _ _ _ _ _ H2) in *. apply H0.
      exfalso. apply (H1 H).
assert (MMU_LOOB: Mem.unchanged_on (loc_out_of_bounds m1) m2 m2').
   split; intros.
      apply (valid_split _ _ _ _  (ACCESS b)); clear ACCESS; intros.
         specialize (H2 k ofs).
         remember (j b) as jb.
         destruct jb; apply eq_sym in Heqjb.
              destruct p0.
              destruct H2 as [_ NoMax].
              rewrite (perm_subst _ _ _ _ _ _ _ (NoMax H)).
              split; auto.
         rewrite (perm_subst _ _ _ _ _ _ _ H2) in *.
           split; auto.
      contradiction.
  destruct (CONT b) as [ValC _].
       destruct (ACCESS b) as [ValA _].
       specialize (ValC (Mem.perm_valid_block _ _ _ _ _ H0) ofs).
       specialize (ValA (Mem.perm_valid_block _ _ _ _ _ H0) Cur ofs).
       unfold loc_out_of_bounds in H.
       remember (j b) as jb.
       destruct jb; apply eq_sym in Heqjb.
          destruct p.
          eapply (perm_split _ _ _ _ _ _ _ ValC); clear ValC; intros.
             exfalso. apply H. apply H1.
         apply H2.
      apply ValC.
split; trivial.
assert (Ext12':  Mem.extends m1' m2').
    split.
    (*nextblock*)
        rewrite NB. trivial.
    (*mem_inj*)
         assert (Perm12': forall b ofs k p, Mem.perm m1' b ofs k p ->
                                            Mem.perm m2' b ofs k p).
              intros.
              apply (valid_split _ _ _ _  (ACCESS b)); clear ACCESS; intros.
                  assert (Val1: Mem.valid_block m1 b).
                     apply (Mem.valid_block_extends _ _ _ Ext12). apply H0.
                  assert (Perm1: Mem.perm m1 b ofs Max Nonempty).
                        apply Fwd1. apply Val1.
                        eapply Mem.perm_max. eapply Mem.perm_implies.
                        apply H. constructor.
                  specialize (H1 k ofs).
                  remember (j b) as jb.
                  destruct jb; apply eq_sym in Heqjb.
                     destruct p0.
                     apply (perm_split _ _ _ _ _ _ _ H1); clear H1; intros.
                        rewrite (perm_subst _ _ _ _ _ _ _ H2). assumption.
                      exfalso. apply (H1 Perm1). (*rewrite (perm_subst _ _ _ _ _ _ _ H2). assumption.*)
            rewrite (perm_subst _ _ _ _ _ _ _ H1) in *. clear H1.
                 destruct UnchOn1 as [UP _].
                 eapply (extends_perm _ _ Ext12).
                 rewrite (UP _ _ _ p Heqjb Val1). apply H.
             destruct (H1 k ofs) as [Val _]; clear H1.
                  assert (Perm1: Mem.perm m1' b ofs Max Nonempty).
                          eapply Mem.perm_max. eapply Mem.perm_implies.
                          apply H. constructor.
                  rewrite (perm_subst _ _ _ _ _ _ _ (Val Perm1)). assumption.
         split.
         (*mi_perm*) intros. inv H. rewrite Zplus_0_r.
                     apply (Perm12' _ _ _ _ H0).
         (*mi_align*) intros. inv H. apply Z.divide_0_r.
         (*mi_memval *) intros. inv H. rewrite Zplus_0_r.
            destruct (CONT b2) as [ContVal [ContInval Default]]; clear CONT.
            apply (valid_split _ _ _ _  (ACCESS b2)); clear ACCESS; intros.
                clear ContInval.
                assert (Perm: Mem.perm m1 b2 ofs Max Nonempty).
                    clear H1 ContVal. apply Fwd1.
                     apply (Mem.valid_block_extends _ _ _ Ext12). apply H.
                    eapply Mem.perm_max. eapply Mem.perm_implies.
                       apply H0. constructor.
               specialize (ContVal H ofs). specialize (H1 Cur ofs).
                  remember (j b2) as jb2.
                  destruct jb2; apply eq_sym in Heqjb2.
                          destruct p.
                          destruct ContVal as [Cont _]. rewrite (Cont Perm). clear Cont.
                          apply memval_inject_id_refl.
                  rewrite ContVal. clear ContVal.
                         destruct UnchOn1 as [UP UV].
                         apply (Mem.valid_block_extends _ _ _ Ext12) in H.
                         rewrite <- (UP _ _ _ _ Heqjb2 H) in H0.
                         rewrite (UV _ _ Heqjb2 H0).
                         specialize (Mem.mi_memval _ _ _ (Mem.mext_inj _ _
                                      Ext12) b2 ofs _ _ (eq_refl _) H0).
                         rewrite Zplus_0_r; trivial.
                assert (VB1':= Mem.perm_valid_block _ _ _ _ _ H0).
                destruct (ContInval H VB1' ofs) as [Cont _].
                  clear ContVal ContInval.
                  rewrite (Cont H0); clear Cont.
                  apply memval_inject_id_refl.
split; trivial.
assert (Inj23': Mem.inject j' m2' m3').
    assert (MI: Mem.mem_inj j' m2' m3').
        assert (MiPerm: forall b1 b2 delta ofs k p,  j' b1 = Some (b2, delta) ->
                       Mem.perm m2' b1 ofs k p ->
                       Mem.perm m3' b2 (ofs + delta) k p).
          intros.
          assert (NP: Mem.perm m2' b1 ofs Max Nonempty).
            eapply Mem.perm_max. eapply Mem.perm_implies. apply H0. constructor.
          apply (valid_split _ _ _ _  (ACCESS b1)); clear ACCESS; intros.
              assert (Val1: Mem.valid_block m1 b1).
                 apply (Mem.valid_block_extends _ _ _ Ext12). apply H1.
              assert (J: j b1 = Some (b2, delta)).
                  remember (j b1) as d. destruct d; apply eq_sym in Heqd.
                    destruct p0. rewrite (InjInc _ _ _ Heqd) in H.  apply H.
                  destruct (injSep _ _ _ Heqd H). exfalso. apply (H3 Val1).
              rewrite J in H2.
              destruct (H2 Max ofs) as [Perm2'MaxP Perm2'MaxNop].
              specialize (H2 k ofs).
              apply (perm_split _ _ _ _ _ _ _ H2); clear H2; intros.
                  clear Perm2'MaxNop.
                  rewrite (perm_subst _ _ _ _ _ _ _ H3) in *; clear H3.
                  eapply Inj13'. apply H. apply H0.
              clear Perm2'MaxP.
                  rewrite (perm_subst _ _ _ _ _ _ _ H3) in *; clear H3.
                  rewrite (perm_subst _ _ _ _ _ _ _ (Perm2'MaxNop H2)) in *;
                          clear Perm2'MaxNop.
                  destruct UnchOn3 as [U3Perm _].
                  assert (loc_out_of_reach j m1 b2 (ofs + delta)).
                        unfold loc_out_of_reach; intros. intros N.
                           destruct (eq_block b0 b1); subst.
                               rewrite H3 in J; inv J.
                               assert (ofs + delta - delta = ofs). omega.
                               rewrite H4 in N. apply (H2 N).
                           assert (N2: Mem.perm m2 b0 (ofs + delta - delta0)
                                       Max Nonempty).
                               specialize (Mem.mi_perm _ _ _ (Mem.mext_inj _ _  Ext12) b0 b0 Z0
                                                      (ofs + delta - delta0)). rewrite Zplus_0_r. intros.
                               apply (H4 _ _ (eq_refl _) N).
                           destruct (Mem.mi_no_overlap _ _ _ Inj23 _ _
                                                 _ _ _ _ _ _ n H3 J N2 NP).
                              apply H4; trivial.
                              apply H4. omega.
                  assert (Val3:=Mem.valid_block_inject_2 _ _ _ _ _ _ J Inj23).
              rewrite <- (U3Perm _ _ _ p H3 Val3).
                eapply Inj23. apply J. apply H0.
          assert (NVal1: ~Mem.valid_block m1 b1). intros N. apply H1.
                 apply (Mem.valid_block_extends _ _ _ Ext12). apply N.
          assert (J: j b1 = None).
              remember (j b1) as d. destruct d; apply eq_sym in Heqd; trivial.
                  destruct p0. exfalso. apply H1.
                     apply (Mem.valid_block_inject_1 _ _ _ _ _ _ Heqd Inj23).
          destruct (H2 Max ofs) as [Perm2'MaxP Perm2'MaxNop].
          specialize (H2 k ofs).
          apply (perm_split _ _ _ _ _ _ _ H2); clear H2; intros.
              clear Perm2'MaxNop.
              rewrite (perm_subst _ _ _ _ _ _ _ H3) in *; clear H3.
              rewrite (perm_subst _ _ _ _ _ _ _ (Perm2'MaxP H2)) in NP;
                      clear Perm2'MaxP.
              eapply Inj13'. apply H. apply H0.
          clear Perm2'MaxP.
              unfold Mem.perm in NP.
              rewrite (Perm2'MaxNop H2) in NP. inv NP.
         (*end of proof of MiPerm*)
    split.
    (*mi_perm*) apply MiPerm.
    (*mi_align*)
       intros.
       apply (valid_split _ _ _ _  (ACCESS b1)); clear ACCESS; intros.
         specialize (H2 Max).
         remember (j b1) as q.
         destruct q; apply eq_sym in Heqq.
           destruct p0.
           assert (J':= InjInc _ _ _ Heqq). rewrite J' in H. inv H.
           assert (RNG: Mem.range_perm m2 b1 ofs (ofs + size_chunk chunk) Max p).
             intros z; intros.
             destruct (H2 z) as [Perm NoPerm].
             specialize (H0 _ H). clear H2.
             destruct (Mem.perm_dec m1 b1 z Max Nonempty).
               rewrite (perm_subst _ _ _ _ _ _ _ (Perm p0)) in *; clear Perm NoPerm.
                 eapply (extends_perm _ _ Ext12).
                 eapply Fwd1. eapply Mem.valid_block_inject_1. apply Heqq. eassumption.
                      assumption.
             rewrite (perm_subst _ _ _ _ _ _ _ (NoPerm n)) in *; clear Perm NoPerm.
               assumption.
           eapply Inj23. apply Heqq. eassumption.
         destruct (injSep _ _ _ Heqq H).
            exfalso. apply H3.
            eapply (Mem.valid_block_extends _ _ b1 Ext12). assumption.
       assert (RNG: Mem.range_perm m1' b1 ofs (ofs + size_chunk chunk) Max p).
             intros z; intros.
             destruct (H2 Max z) as [Perm NoPerm]. clear H2.
             specialize (H0 _ H3).
             destruct (Mem.perm_dec m1' b1 z Max Nonempty).
               rewrite (perm_subst _ _ _ _ _ _ _ (Perm p0)) in *; clear Perm NoPerm. assumption.
             unfold Mem.perm in H0. rewrite (NoPerm n) in H0. simpl in H0. intuition.
        eapply Inj13'. apply H. apply RNG.
       (*mi_memval *) intros.
           destruct (CONT b1) as [ContVal [ContInval Default]]; clear CONT.
           assert (NP: Mem.perm m2' b1 ofs Max Nonempty).
                   eapply Mem.perm_max. eapply Mem.perm_implies.
                   apply H0. constructor.
           apply (valid_split _ _ _ _  (ACCESS b1)); clear ACCESS; intros.
              clear ContInval.
              specialize (ContVal H1 ofs).
              apply (Mem.valid_block_extends _ _ _ Ext12) in H1.
              assert (J: j b1 = Some (b2, delta)).
                  remember (j b1) as d. destruct d; apply eq_sym in Heqd.
                    destruct p. rewrite (InjInc _ _ _ Heqd) in H.  apply H.
                  destruct (injSep _ _ _ Heqd H). exfalso. apply (H3 H1).
              rewrite J in ContVal. destruct ContVal as [ContPerm ContNoperm].
              rewrite J in H2.
              destruct (H2 Max ofs) as [Perm2'MaxP Perm2'MaxNop].
              specialize (H2 Cur ofs).
              apply (perm_split _ _ _ _ _ _ _ H2); clear H2; intros.
                  clear Perm2'MaxNop ContNoperm.
                  rewrite (perm_subst _ _ _ _ _ _ _ H3) in *; clear H3.
                  rewrite (ContPerm H2). clear ContPerm.
                  rewrite (perm_subst _ _ _ _ _ _ _ (Perm2'MaxP H2)) in *;
                          clear Perm2'MaxP.
                  eapply Inj13'. apply H. apply H0.
              clear Perm2'MaxP ContPerm.
                  rewrite (perm_subst _ _ _ _ _ _ _ H3) in *; clear H3.
                  rewrite (perm_subst _ _ _ _ _ _ _ (Perm2'MaxNop H2)) in *;
                          clear Perm2'MaxNop.
                  rewrite (ContNoperm H2). clear ContNoperm.
                  destruct UnchOn3 as [U3Perm U3Val].
                  assert (loc_out_of_reach j m1 b2 (ofs + delta)).
                    unfold loc_out_of_reach; intros. intros N.
                       destruct (eq_block b0 b1); subst.
                           rewrite H3 in J; inv J.
                           assert (ofs + delta - delta = ofs). omega.
                           rewrite H4 in N. apply (H2 N).
                       assert (N2: Mem.perm m2 b0 (ofs + delta - delta0)
                                   Max Nonempty).
                          (*rewrite EP12. apply N. apply N.*)
                               specialize (Mem.mi_perm _ _ _ (Mem.mext_inj _ _  Ext12) b0 b0 Z0
                                                      (ofs + delta - delta0)). rewrite Zplus_0_r. intros.
                               apply (H4 _ _ (eq_refl _) N).
                       destruct (Mem.mi_no_overlap _ _ _ Inj23 _ _ _
                                                   _ _ _ _ _ n H3 J N2 NP).
                              apply H4; trivial.
                              apply H4. omega.
              assert (Val3:=Mem.valid_block_inject_2 _ _ _ _ _ _ J Inj23).
              assert (Perm3:  Mem.perm m3 b2 (ofs+delta) Cur Readable).
                  eapply Inj23. apply J. apply H0.
            rewrite (U3Val _ _ H3 Perm3).
              eapply memval_inject_incr.
                 apply (Mem.mi_memval _ _ _ (Mem.mi_inj _ _ _ Inj23)
                                      _ _ _ _ J H0).
                   assumption.
           clear ContVal.
              assert (NVal1: ~Mem.valid_block m1 b1). intros N. apply H1.
                   apply (Mem.valid_block_extends _ _ _ Ext12). apply N.
              assert (J: j b1 = None).
                remember (j b1) as d.
                destruct d; apply eq_sym in Heqd; trivial.
                    destruct p. exfalso. apply H1.
                    apply (Mem.valid_block_inject_1 _ _ _ _ _ _ Heqd Inj23).
              destruct (H2 Max ofs) as [Perm2'MaxP Perm2'MaxNop].
              assert (VB1': Mem.valid_block m1' b1).
                 rewrite VB'. apply (Mem.perm_valid_block _ _ _ _ _ H0).
              destruct (ContInval H1 VB1' ofs) as [ContPerm ContNoPerm];
                       clear ContInval.
              specialize (H2 Cur ofs).
              apply (perm_split _ _ _ _ _ _ _ H2); clear H2; intros.
                  clear Perm2'MaxNop ContNoPerm.
                  rewrite (perm_subst _ _ _ _ _ _ _ H3) in *; clear H3.
                  rewrite (perm_subst _ _ _ _ _ _ _ (Perm2'MaxP H2)) in NP;
                          clear Perm2'MaxP.
                  rewrite (ContPerm H0); clear ContPerm.
                  eapply Inj13'. apply H. apply H0.
              clear Perm2'MaxP ContPerm.
                  unfold Mem.perm in NP.
                  rewrite (Perm2'MaxNop H2) in NP. inv NP.
    (*end of proof of MI: Mem.mem_inj j' m2' m3'*)
    split; intros.
        (*mi_inj*)
           apply MI.
        (*mi_freeblocks*)
           eapply Inj13'. rewrite VB'. apply H.
        (* mi_mappedblocks*)
           eapply Inj13'. apply H.
        (* mi_no_overlap*)
           intros b1 b1' delta1 b2 b2'; intros.
           remember (j b1) as jb1.
           destruct jb1; apply eq_sym in Heqjb1.
           (*j b = Some p*)
              destruct p. rewrite (InjInc _ _ _ Heqjb1) in H0. inv H0.
              assert (ValB1:=Mem.valid_block_inject_1 _ _ _ _ _ _ Heqjb1 Inj23).
              assert (Perm1: Mem.perm m2 b1 ofs1 Max Nonempty).
                     eapply Fwd2. apply ValB1. apply H2.
              remember (j b2) as jb2.
              destruct jb2; apply eq_sym in Heqjb2.
              (*j b2 = Some p*)
                 destruct p. rewrite (InjInc _ _ _ Heqjb2) in H1. inv H1.
                 assert (ValB2:= Mem.valid_block_inject_1 _ _ _ _ _ _
                                 Heqjb2 Inj23).
                 assert (Perm2: Mem.perm m2 b2 ofs2 Max Nonempty).
                    eapply Fwd2. apply ValB2. apply H3.
                 eapply (Mem.mi_no_overlap _ _ _ Inj23 _ _ _ _ _ _
                                    _ _ H Heqjb1 Heqjb2 Perm1 Perm2).
              (*j b2 = None*)
                 destruct (injSep _ _ _ Heqjb2 H1).
                 left. intros N; subst.
                 apply H4.
                 apply (Mem.valid_block_inject_2 _ _ _ _ _ _ Heqjb1 Inj13).
           (*j b = None*)
              destruct (injSep _ _ _ Heqjb1 H0).
              remember (j b2) as jb2.
              destruct jb2; apply eq_sym in Heqjb2.
              (*j b2 = Some p*)
                 destruct p. rewrite (InjInc _ _ _ Heqjb2) in H1. inv H1.
                 left. intros N; subst.
                 apply H5.
                 apply (Mem.valid_block_inject_2 _ _ _ _ _ _ Heqjb2 Inj13).
              (*j b2 = None*)
                 destruct (injSep _ _ _ Heqjb2 H1).
                 apply (valid_split _ _ _ _  (ACCESS b1)); intros.
                     exfalso. apply H4.
                        apply (Mem.valid_block_extends _ _ _ Ext12). apply H8.
                 specialize (H9 Max ofs1).
                 apply (valid_split _ _ _ _  (ACCESS b2)); intros.
                     exfalso. apply H6.
                        apply (Mem.valid_block_extends _ _ _ Ext12). apply H10.
                 specialize (H11 Max ofs2).
                 apply (perm_split _ _ _ _ _ _ _ H9); clear H9; intros.
                    rewrite (perm_subst _ _ _ _ _ _ _ H12) in *; clear H12.
                    apply (perm_split _ _ _ _ _ _ _ H11); clear H11; intros.
                       rewrite (perm_subst _ _ _ _ _ _ _ H12) in *; clear H12.
                       eapply (Mem.mi_no_overlap _ _ _ Inj13' _ _ _
                                 _ _ _  _ _ H H0 H1 H2 H3).
                    unfold Mem.perm in H3. rewrite H12 in H3. inv H3.
                 unfold Mem.perm in H2. rewrite H12 in H2. inv H2.
        (*mi_representable*)
           apply (valid_split _ _ _ _  (ACCESS b)); intros.
           (*case valid*)
             assert (J: j b = Some (b', delta)).
               remember (j b) as d. destruct d; apply eq_sym in Heqd.
                 destruct p. rewrite (InjInc _ _ _ Heqd) in H.  apply H.
                 destruct (injSep _ _ _ Heqd H). exfalso.
                 apply (Mem.valid_block_extends _ _ _ Ext12) in H1. apply (H3 H1).
             (* weak_valid_pointer*)
             rewrite J in H2.
             destruct H0.
             (*location ofs*)
               specialize (H2 Max (Int.unsigned ofs)).
               apply (perm_split _ _ _ _ _ _ _ H2); clear H2; intros.
                 rewrite (perm_subst _ _ _ _ _ _ _ H3) in *. clear H3.
                 eapply Inj13'. apply H. left. apply H0.
               rewrite (perm_subst _ _ _ _ _ _ _ H3) in *. clear H3.
                 eapply Inj23. apply J. left. apply H0.
             (*location ofs -1*)
               specialize (H2 Max (Int.unsigned ofs -1)).
               apply (perm_split _ _ _ _ _ _ _ H2); clear H2; intros.
                 rewrite (perm_subst _ _ _ _ _ _ _ H3) in *. clear H3.
                 eapply Inj13'. apply H. right. apply H0.
               rewrite (perm_subst _ _ _ _ _ _ _ H3) in *. clear H3.
                 eapply Inj23. apply J. right. apply H0.
           (*case invalid*)
             assert (J: j b = None).
               remember (j b) as d. destruct d; apply eq_sym in Heqd; trivial.
                  destruct p. exfalso. apply H1.
                  apply (Mem.valid_block_inject_1 _ _ _ _ _ _ Heqd Inj23).
             (* weak_valid_pointer*)
             destruct H0.
             (*location ofs*)
               specialize (H2 Max (Int.unsigned ofs)).
               apply (perm_split _ _ _ _ _ _ _ H2); clear H2; intros.
                 rewrite (perm_subst _ _ _ _ _ _ _ H3) in *. clear H3.
                 eapply Inj13'. apply H. left. apply H0.
               unfold Mem.perm in H0. rewrite H3 in H0. contradiction.
             (*location ofs -1*)
               specialize (H2 Max (Int.unsigned ofs -1)).
               apply (perm_split _ _ _ _ _ _ _ H2); clear H2; intros.
                 rewrite (perm_subst _ _ _ _ _ _ _ H3) in *. clear H3.
                 eapply Inj13'. apply H. right. apply H0.
               unfold Mem.perm in H0. rewrite H3 in H0. contradiction.
split; trivial.
split; trivial.
Qed.

Definition AccessMap_EI_FUN (j:meminj) (m1 m1' m2 : mem) (b2:block):
           Z -> perm_kind -> option permission :=
  if plt b2 (Mem.nextblock m2)
  then (fun ofs2 k =>
       match j b2 with
         None => PMap.get b2 m2.(Mem.mem_access) ofs2 k
       | Some (b3,d3) =>
          if Mem.perm_dec m1 b2 ofs2 Max Nonempty
          then PMap.get b2 m1'.(Mem.mem_access) ofs2 k
          else PMap.get b2 m2.(Mem.mem_access) ofs2 k
        end)
  else (fun ofs2 k =>
         if Mem.perm_dec m1' b2 ofs2 Max Nonempty
         then PMap.get b2 m1'.(Mem.mem_access) ofs2 k
         else None).

Lemma mkAccessMap_EI_existsT: forall j (m1 m1' m2:Mem.mem)
       (VB : (Mem.nextblock m2 <= Mem.nextblock m1')%positive),
      { M : PMap.t (Z -> perm_kind -> option permission) |
          fst M = (fun k ofs => None) /\
          forall b, PMap.get b M = AccessMap_EI_FUN j m1 m1' m2 b}.
Proof. intros.
  apply (pmap_construct_c _ (AccessMap_EI_FUN j m1 m1' m2)
              (Mem.nextblock m1') (fun ofs k => None)).
    intros. unfold AccessMap_EI_FUN.
    remember (plt n (Mem.nextblock m2)) as d.
    destruct d; clear Heqd; trivial.
       exfalso. xomega.
    extensionality ofs. extensionality k.
      destruct (Mem.perm_dec m1' n ofs Max Nonempty); trivial.
      apply Mem.perm_valid_block in p.
      exfalso. unfold Mem.valid_block in p. xomega.
Qed.

Definition ContentMap_EI_ValidBlock_FUN (j:meminj) m1 m1' m2 b2 ofs2: memval :=
             match j b2 with
               None => ZMap.get ofs2 (PMap.get b2 m2.(Mem.mem_contents))
             | Some (b3,delta3) =>
                  if Mem.perm_dec m1 b2 ofs2 Max Nonempty
                  then ZMap.get ofs2 (PMap.get b2 m1'.(Mem.mem_contents))
                  else ZMap.get ofs2 (PMap.get b2 m2.(Mem.mem_contents))
             end.

Definition ContentMap_EI_InvalidBlock_FUN m1' b2 ofs2: memval :=
    if Mem.perm_dec m1' b2 ofs2 Cur Readable
    then ZMap.get ofs2 (PMap.get b2 m1'.(Mem.mem_contents))
    else Undef.

Definition ContentMap_EI_Block_FUN j m1 m1' m2 b ofs : memval:=
  if plt b (Mem.nextblock m2)
  then ContentMap_EI_ValidBlock_FUN j m1 m1' m2 b ofs
  else ContentMap_EI_InvalidBlock_FUN m1' b ofs.

Lemma CM_block_EI_existsT: forall j (m1 m1' m2:Mem.mem) b,
      { M : ZMap.t memval |
          fst M = Undef /\
          forall ofs, ZMap.get ofs M =
                      ContentMap_EI_Block_FUN j m1 m1' m2 b ofs}.
Proof. intros.
  remember (zmap_finite_c _ (PMap.get b m1'.(Mem.mem_contents))) as LH1.
  apply eq_sym in HeqLH1. destruct LH1 as [lo1 hi1].
  specialize (zmap_finite_sound_c _ _ _ _ HeqLH1).
  intros Bounds1; clear HeqLH1.
  remember (zmap_finite_c _ (PMap.get b m2.(Mem.mem_contents))) as LH2.
  apply eq_sym in HeqLH2. destruct LH2 as [lo2 hi2].
  specialize (zmap_finite_sound_c _ _ _ _ HeqLH2).
  intros Bounds2; clear HeqLH2.
   assert (Undef2: fst (Mem.mem_contents m2) !! b = Undef). apply m2.
   assert (Undef1: fst (Mem.mem_contents m1') !! b = Undef). apply m1'.
   rewrite Undef2 in *. rewrite Undef1 in *. clear Undef1 Undef2.

  destruct (zmap_construct_c _ (ContentMap_EI_Block_FUN j m1 m1' m2 b)
             (Z.min lo1 lo2) (Z.max hi1 hi2) Undef) as [M PM].
    intros. unfold ContentMap_EI_Block_FUN; simpl.
        unfold ContentMap_EI_ValidBlock_FUN.
        unfold ContentMap_EI_InvalidBlock_FUN.
   rewrite Bounds1.
   rewrite Bounds2.
     destruct (plt b (Mem.nextblock m2)); trivial.
       destruct (j b); trivial.
         destruct p0.
         destruct (Mem.perm_dec m1 b n Max Nonempty); trivial.
     destruct (Mem.perm_dec m1' b n Cur Readable); trivial.

     destruct H.  apply Z.min_glb_lt_iff in H. left. apply H.
     assert (Z.max hi1 hi2 < n) by omega.
     apply Z.max_lub_lt_iff in H0. right; omega.
     destruct H.  apply Z.min_glb_lt_iff in H. left. apply H.
     assert (Z.max hi1 hi2 < n) by omega.
     apply Z.max_lub_lt_iff in H0. right; omega.
  exists M. apply PM.
Qed.

Definition ContentsMap_EI_FUN (j:meminj) (m1 m1' m2:Mem.mem) (b:block):
            ZMap.t memval.
destruct (plt b (Mem.nextblock m1')).
  apply(CM_block_EI_existsT j m1 m1' m2 b).
  apply (ZMap.init Undef).
Defined.

Lemma ContentsMap_EI_existsT: forall (j:meminj) (m1 m1' m2:Mem.mem),
      { M : PMap.t (ZMap.t memval) |
        fst M = ZMap.init Undef /\
        forall b, PMap.get b M = ContentsMap_EI_FUN j m1 m1' m2 b}.
Proof. intros.
  apply (pmap_construct_c _ (ContentsMap_EI_FUN j m1 m1' m2)
              (Mem.nextblock m1') (ZMap.init Undef)).
    intros. unfold ContentsMap_EI_FUN. simpl.
    remember (plt n (Mem.nextblock m1')) as d.
    destruct d; clear Heqd; trivial.
      exfalso. xomega.
Qed.

Definition mkEI (j j': meminj) (m1 m2 m1':mem)
                (Ext12: Mem.extends m1 m2)
                (Fwd1: mem_forward m1 m1') m3
                (Inj23: Mem.inject j m2 m3)
                m3' (Fwd3: mem_forward m3 m3')
                (Inj13': Mem.inject j' m1' m3')
                (UnchOn3: Mem.unchanged_on (loc_out_of_reach j m1) m3 m3')
                (InjInc: inject_incr j j') (injSep: inject_separated j j' m1 m3)
                (UnchOn1: Mem.unchanged_on (loc_unmapped j) m1 m1')
             : Mem.mem'.
assert (VB: (Mem.nextblock m2 <= Mem.nextblock m1')%positive).
   destruct Ext12. rewrite <- mext_next.
   apply (forward_nextblock _ _ Fwd1).
destruct (mkAccessMap_EI_existsT j m1 m1' m2) as [AM [ADefault PAM]].
   assumption.
destruct (ContentsMap_EI_existsT j m1 m1' m2) as [CM [CDefault PCM]].
eapply Mem.mkmem with (nextblock:=m1'.(Mem.nextblock))
                      (mem_access:=AM)
                      (mem_contents:=CM).
  (*apply (mkContentsMap_EI_exists j m1 m1' m2).*)
(*  apply m1'.*)
  (*access_max*)
     intros. rewrite PAM. unfold AccessMap_EI_FUN.
     destruct (plt b (Mem.nextblock m2)).
     (*valid_block m2 b*)
        destruct (j b).
          destruct p0.
          destruct (Mem.perm_dec m1 b ofs Max Nonempty).
             apply m1'.
             apply m2.
        apply m2.
     (*~ valid_block m2 b*)
        destruct (Mem.perm_dec m1' b ofs Max Nonempty).
           apply m1'.
           reflexivity.
  (*nextblock_noaccess*)
    intros. rewrite PAM.
    unfold AccessMap_EI_FUN.
    destruct (plt b (Mem.nextblock m2)).
      exfalso. apply H; clear - VB p. xomega.
    destruct (Mem.perm_dec m1' b ofs Max Nonempty); trivial.
      exfalso. apply H. apply (Mem.perm_valid_block _ _ _ _ _ p).
  (*contents_default*)
    intros. rewrite PCM.
    unfold ContentsMap_EI_FUN.
    destruct (plt b (Mem.nextblock m1')).
     remember (CM_block_EI_existsT j m1 m1' m2 b).
     destruct s. apply a.
    reflexivity.
Defined.

Lemma interpolate_EI: forall (m1 m2 m1':mem)
                   (Ext12: Mem.extends m1 m2) (Fwd1: mem_forward m1 m1')
                   m3 j (Inj23: Mem.inject j m2 m3) m3'
                   (Fwd3: mem_forward m3 m3') j'
                   (Inj13': Mem.inject j' m1' m3')
                   (UnchOn3: Mem.unchanged_on (loc_out_of_reach j m1) m3 m3')
                   (InjInc: inject_incr j j')
                   (injSep: inject_separated j j' m1 m3)
                   (UnchOn1:  Mem.unchanged_on (loc_unmapped j) m1 m1'),
       exists m2', mem_forward m2 m2' /\ Mem.extends m1' m2' /\
                   Mem.inject j' m2' m3' /\
                   Mem.unchanged_on (loc_out_of_bounds m1) m2 m2' /\
                   Mem.unchanged_on (loc_unmapped j) m2 m2'.
Proof. intros.
  assert (VB: Mem.nextblock
    (mkEI j j' m1 m2 m1' Ext12 Fwd1 m3 Inj23 m3' Fwd3 Inj13' UnchOn3 InjInc
       injSep UnchOn1) = Mem.nextblock m1').
    unfold mkEI.
   destruct (mkAccessMap_EI_existsT j m1 m1' m2) as [AM [ADefault PAM]].
   simpl.
   destruct (ContentsMap_EI_existsT j m1 m1' m2) as [CM [CDefault PCM]].
   simpl. reflexivity.
  exists (mkEI j j' m1 m2 m1' Ext12 Fwd1 _ Inj23 _ Fwd3 Inj13'
              UnchOn3 InjInc injSep UnchOn1).
  apply (EI_ok m1 m2 m1' Ext12 Fwd1 _ _ Inj23 _ Fwd3 _ Inj13'
            UnchOn3 InjInc injSep UnchOn1
            (mkEI j j' m1 m2 m1' Ext12 Fwd1 m3 Inj23 m3' Fwd3
                  Inj13' UnchOn3 InjInc injSep UnchOn1)
            VB).
(*ContentMapOK*)
   unfold Content_EI_Property, mkEI.
   destruct (mkAccessMap_EI_existsT j m1 m1' m2) as [AM [ADef AP]]; simpl.
        destruct (ContentsMap_EI_existsT j m1 m1' m2) as [CM [CDef CP]]. simpl.
   intros.
   split; intros.
   (*valid_block m2 b*)
     rewrite CP. unfold ContentsMap_EI_FUN.
     destruct (CM_block_EI_existsT j m1 m1' m2 b2) as [CMb [CMbDef CMbP]]; simpl.
     destruct (plt b2 (Mem.nextblock m1')).
       remember (j b2).
       destruct o.
         destruct p0.
         rewrite CMbP.
         unfold ContentMap_EI_Block_FUN.
         destruct (plt b2 (Mem.nextblock m2)).
           unfold ContentMap_EI_ValidBlock_FUN.
           rewrite <- Heqo.
           destruct (Mem.perm_dec m1 b2 ofs2 Max Nonempty).
           split; intros; trivial. contradiction.
           split; intros; trivial. contradiction.
         contradiction.
       rewrite CMbP.
         unfold ContentMap_EI_Block_FUN.
         destruct (plt b2 (Mem.nextblock m2)); try contradiction.
         unfold ContentMap_EI_ValidBlock_FUN.
         rewrite <- Heqo. trivial.
    exfalso. apply n. apply Fwd1.
      rewrite Mem.valid_block_extends. apply H. assumption.
  split; intros.
     rewrite CP. unfold ContentsMap_EI_FUN.
     destruct (CM_block_EI_existsT j m1 m1' m2 b2) as [CMb [CMbDef CMbP]]; simpl.
     destruct (plt b2 (Mem.nextblock m1')); try contradiction.
     split; intros.
       rewrite CMbP. unfold ContentMap_EI_Block_FUN.
         destruct (plt b2 (Mem.nextblock m2)); try contradiction.
         unfold ContentMap_EI_InvalidBlock_FUN.
         destruct (Mem.perm_dec m1' b2 ofs2 Cur Readable); try contradiction.
         trivial.
       rewrite CMbP. unfold ContentMap_EI_Block_FUN.
         destruct (plt b2 (Mem.nextblock m2)); try contradiction.
         unfold ContentMap_EI_InvalidBlock_FUN.
         destruct (Mem.perm_dec m1' b2 ofs2 Cur Readable); try contradiction.
         trivial.
  (*default*)
     rewrite CP.
     unfold ContentsMap_EI_FUN.
     destruct ( plt b2 (Mem.nextblock m1')).
       destruct (CM_block_EI_existsT j m1 m1' m2 b2) as [CMb [CMbDef CMbP]]; simpl.
       assumption.
       reflexivity.
(*AccessMapOK*)
   unfold AccessMap_EI_Property, mkEI.
   destruct (mkAccessMap_EI_existsT j m1 m1' m2) as [AM [ADef AP]]; simpl.
        destruct (ContentsMap_EI_existsT j m1 m1' m2) as [CM [CDef CP]]. simpl.
   intros.
   split; intros.
   (*valid_block m2 b*)
     rewrite AP. unfold AccessMap_EI_FUN.
     destruct (plt b2 (Mem.nextblock m2)); try contradiction.
     destruct (Mem.perm_dec m1 b2 ofs2 Max Nonempty).
       remember (j b2).
       destruct o; trivial.
       destruct p1.
          split; intros; try contradiction. trivial.
     remember (j b2).
       destruct o; trivial.
       destruct p0.
          split; intros; try contradiction. trivial.

  (*invalid_block m2 b*)
   rewrite AP. unfold AccessMap_EI_FUN.
   destruct (plt b2 (Mem.nextblock m2)); try contradiction.
   destruct (Mem.perm_dec m1' b2 ofs2 Max Nonempty).
     split; intros; try contradiction. trivial.
     split; intros; try contradiction. trivial.
Qed.


(* PREAMBLE *)

From compcert.common    Require AST.
From compcert.cfrontend Require Csyntax Csem.
From compcert.lib       Require Coqlib.
From trancert.lib       Require Tac Decidability Option.
From trancert.analysis  Require StatementQuant ExprQuant.

Import Coqlib BinNums common.AST Algebraic Csyntax Csem Decidability Option Tac ExprQuant StatementQuant.

Section Appears.

  Variable v: ident.

  Definition appears_expr e : Prop := exists_var_in_expr (Logic.eq v) e.
  Definition appears_exprlist e : Prop := exists_var_in_exprlist (Logic.eq v) e.

  Definition appears_ctx (C: expr->expr): Prop := forall k1 k2 e, context k1 k2 C -> appears_expr (C e).
  Definition appears_ctxlist (C: expr->exprlist): Prop := forall k e, contextlist k C -> appears_exprlist (C e).

  Definition appears_stmt : statement -> Prop := exists_var_in_stmt (Logic.eq v).

  Definition appears_expr_dec : forall e, dec (appears_expr e) :=
    exists_var_in_expr_dec (eq v) (peq v).

  Definition appears_stmt_dec : forall s, dec (appears_stmt s).
    apply exists_var_in_stmt_dec.
    apply Coqlib.peq.
  Defined.

End Appears.


Require Import Ssreflect.ssreflect Ssreflect.ssrfun Ssreflect.ssrbool Ssreflect.finfun Ssreflect.fintype Ssreflect.ssrnat Ssreflect.eqtype Ssreflect.seq Ssreflect.tuple.
Require Import x86proved.bitsrep x86proved.bitsops x86proved.bitsprops x86proved.bitsopsprops.
Require Import x86proved.spred x86proved.septac x86proved.spec x86proved.safe x86proved.x86.basic x86proved.x86.program x86proved.x86.macros x86proved.x86.call.
Require Import x86proved.x86.instr x86proved.monad x86proved.reader x86proved.writer x86proved.x86.procstate x86proved.x86.procstatemonad x86proved.x86.mem x86proved.x86.exn x86proved.x86.eval
               x86proved.monadinst x86proved.x86.ioaction x86proved.bitsrep x86proved.bitsops x86proved.x86.eval x86proved.x86.step x86proved.x86.instrcodec x86proved.pointsto x86proved.cursor.
Require Import x86proved.x86.program x86proved.x86.programassem x86proved.x86.reg x86proved.x86.instrsyntax x86proved.x86.instrrules.
Require Import x86proved.spectac x86proved.charge.iltac x86proved.triple.

(* ATBR *)
Require Import ATBR.DecideKleeneAlgebra.
Require Import ATBR.DKA_Definitions.

Require Import interfaceATBR.
Require Import regexpsyntax.

Local Open Scope regex_scope.
Open Scope char_scope.

(**********************************)
(* Floating point regexp          *)
(**********************************)

Definition alphabet: seq DWORD :=
cat [seq (# c) | c <- iota (Ascii.nat_of_ascii "0") 10 ]
    [:: #(Ascii.nat_of_ascii "-")
      ; #(Ascii.nat_of_ascii "+")
      ; #(Ascii.nat_of_ascii "e")
      ; #(Ascii.nat_of_ascii ".")].

(* ^[-+]?[0-9]*\.?[0-9]+([e][-+]?[0-9]+)?$ *)
(*=FP *)
Definition FP: regex :=
  [[ "-" , "+"]]? '
  [{ "0" , "9" }]* ' $"." ? '
  [{ "0" , "9" }]+ '
  ($"e" ' [[ "-" , "+"]]? ' [{ "0" , "9" }]+)?.
(*=End *)

(**********************************)
(* Examples:                      *)
(**********************************)

(*=FP_code*)
Definition FP_x86 (acc rej: DWORD): program :=
    X_to_x86 FP alphabet acc rej.
(*=End*)

(*
Definition code_zero: program := code rO [:: #1 ; #2 ; #3 ] #42 #24.
Definition bytes_zero := assemble #x"C0000000" code_zero.
(* Compute (bytesToHex bytes_zero). *)

Definition code_var1: program := code $"1" [:: #1 ; #2 ; #3 ] #42 #24.
Definition bytes_var1 := assemble #x"C0000000" code_var1.
(* Compute (bytesToHex bytes_var1). *)
*)

Local Close Scope regex_scope.


Require Import Platform.AutoSep Platform.Malloc Platform.tests.Abort Platform.Bootstrap.

Module Type S.
  Variable heapSize : nat.
End S.

Module Make(M : S).
Import M.

Section boot.
  Hypothesis heapSizeLowerBound : (3 <= heapSize)%nat.

  Definition size := heapSize + 50 + 0.

  Hypothesis mem_size : goodSize (size * 4)%nat.

  Let heapSizeUpperBound : goodSize (heapSize * 4).
    goodSize.
  Qed.

  Definition bootS := bootS heapSize 0.

  Definition boot := bimport [[ "malloc"!"init" @ [Malloc.initS], "test"!"main" @ [Abort.mainS] ]]
    bmodule "main" {{
      bfunctionNoRet "main"() [bootS]
        Sp <- (heapSize * 4)%nat;;

        Assert [PREonly[_] 0 =?> heapSize];;

        Call "malloc"!"init"(0, heapSize)
        [PREonly[_] mallocHeap 0];;

        Goto "test"!"main"
      end
    }}.

  Theorem ok : moduleOk boot.
    vcgen; abstract genesis.
  Qed.

  Definition m0 := link Malloc.m boot.
  Definition m1 := link Abort.m m0.

  Lemma ok0 : moduleOk m0.
    link Malloc.ok ok.
  Qed.

  Lemma ok1 : moduleOk m1.
    link Abort.ok ok0.
  Qed.

  Variable stn : settings.
  Variable prog : program.

  Hypothesis inj : forall l1 l2 w, Labels stn l1 = Some w
    -> Labels stn l2 = Some w
    -> l1 = l2.

  Hypothesis agree : forall l pre bl,
    LabelMap.MapsTo l (pre, bl) (XCAP.Blocks m1)
    -> exists w, Labels stn l = Some w
      /\ prog w = Some bl.

  Hypothesis agreeImp : forall l pre, LabelMap.MapsTo l pre (XCAP.Imports m1)
    -> exists w, Labels stn l = Some w
      /\ prog w = None.

  Hypothesis omitImp : forall l w,
    Labels stn ("sys", l) = Some w
    -> prog w = None.

  Variable w : W.
  Hypothesis at_start : Labels stn ("main", Global "main") = Some w.

  Variable st : state.

  Hypothesis mem_low : forall n, (n < size * 4)%nat -> st.(Mem) n <> None.
  Hypothesis mem_high : forall w, $ (size * 4) <= w -> st.(Mem) w = None.

  Theorem safe : sys_safe stn prog (w, st).
    safety ok1.
  Qed.
End boot.

End Make.


Require Import Coq.ZArith.ZArith.
Require Import coqutil.Z.Lia.
Require Import coqutil.Macros.unique.
Require Import compiler.util.Common.
Require Import bedrock2.Semantics.
Require Import riscv.Utility.Monads.
Require Import compiler.FlatImp.
Require Import riscv.Spec.Decode.
Require Import coqutil.sanity.
Require Import riscv.Utility.MkMachineWidth.
Require Import riscv.Spec.PseudoInstructions.
Require Import riscv.Utility.InstructionCoercions.
Require Import riscv.Spec.Machine.
Require Import compiler.FlatToRiscvDef.
Require Import compiler.FlatToRiscvFunctions.
Require Import riscv.Platform.RiscvMachine.
Require Import riscv.Platform.MinimalMMIO.
Require Import riscv.Platform.MetricMinimalMMIO.
Require Import riscv.Spec.Primitives.
Require Import riscv.Spec.MetricPrimitives.
Require Import compiler.MetricsToRiscv.
Require Import compiler.FlatToRiscvDef.
Require Import riscv.Utility.runsToNonDet.
Require Import compiler.GoFlatToRiscv.
Require Import compiler.SeparationLogic.
Require Import coqutil.Datatypes.Option.
Require Import coqutil.Tactics.Simp.
Require Import compiler.util.Learning.
Require Export coqutil.Word.SimplWordExpr.
Require Import compiler.RiscvWordProperties.
Require Import riscv.Platform.FE310ExtSpec.
Require Import coqutil.Z.div_mod_to_equations.
Require Import coqutil.Datatypes.ListSet.
Require bedrock2.FE310CSemantics.
Import ListNotations.

Open Scope ilist_scope.

Definition compile_interact(results: list Z) a (args: list Z):
  list Instruction :=
  if String.eqb "MMIOWRITE" a then
    match results, args with
    | [], [addr; val] => [[ Sw addr val 0 ]]
    | _, _ => [[]] (* invalid, excluded by ext_spec *)
    end
  else
    match results, args with
    | [res], [addr] => [[ Lw res addr 0 ]]
    | _, _ => [[]] (* invalid, excluded by ext_spec *)
    end.

Lemma compile_interact_length: forall binds f args,
    Z.of_nat (List.length (compile_interact binds f args)) <= 1.
Proof.
  intros. unfold compile_interact.
  destruct (String.eqb _ _); destruct binds; try destruct binds;
  try destruct args; try destruct args; try destruct args;
  cbv; intros; discriminate.
Qed.

Lemma compile_interact_length': forall binds f args,
    Z.of_nat (List.length (compile_interact binds f args)) <= 7.
Proof. intros. rewrite compile_interact_length. blia. Qed.

Lemma compile_interact_emits_valid: forall iset binds a args,
    Forall valid_FlatImp_var binds ->
    Forall valid_FlatImp_var args ->
    valid_instructions iset (compile_interact binds a args).
Proof.
  intros.
  unfold compile_interact.
  destruct (String.eqb _ _); destruct args; try destruct args; try destruct args;
    destruct binds; try destruct binds;
    intros instr HIn; cbn -[String.eqb] in *; intuition idtac; try contradiction.
  - rewrite <- H1.
    simp_step.
    simp_step.
    (* try simp_step. (* TODO this should not fail fatally *) *)
    split; [|cbv;auto].
    unfold Encode.respects_bounds. simpl.
    unfold Encode.verify_S, valid_FlatImp_var, opcode_STORE, funct3_SW in *.
    repeat split; (blia || assumption).
  - rewrite <- H1.
    simp_step.
    simp_step.
    simp_step.
    simp_step.
    (* try simp_step. (* TODO this should not fail fatally *) *)
    split; [|cbv;auto].
    unfold Encode.respects_bounds. simpl.
    unfold Encode.verify_I, valid_FlatImp_var, opcode_LOAD, funct3_LW in *.
    repeat split; (blia || assumption).
Qed.

Local Arguments Z.mul: simpl never.
Local Arguments Z.add: simpl never.
Local Arguments Z.of_nat: simpl never.
Local Arguments Z.modulo : simpl never.
Local Arguments Z.pow: simpl never.
Local Arguments Z.sub: simpl never.
Local Arguments Registers.reg_class.all: simpl never.

Section MMIO1.
  Context {iset : InstructionSet} {bitwidth_iset : FlatToRiscvCommon.bitwidth_iset 32 iset}.
  Context {word: Word.Interface.word 32}.
  Context {word_ok: word.ok word}.
  Context {word_riscv_ok: word.riscv_ok word}.
  Context {mem: map.map word byte}.
  Context {mem_ok: map.ok mem}.
  Context {locals: map.map Z word}.
  Context {locals_ok: map.ok locals}.
  Context {funname_env: forall T, map.map String.string T}.
  Context {funname_env_ok: forall T, map.ok (funname_env T)}.

  Add Ring wring : (word.ring_theory (word := word))
      (preprocess [autorewrite with rew_word_morphism],
       morphism (word.ring_morph (word := word)),
       constants [word_cst]).

  Definition compile_ext_call(_: funname_env Z)(_ _: Z)(s: stmt Z) :=
      match s with
      | SInteract resvars action argvars => compile_interact resvars action argvars
      | _ => []
      end.

  Section CompilationTest.
    Definition magicMMIOAddrLit: Z := 0x10024000.
    Variable addr: Z.
    Variable i: Z.
    Variable s: Z.

    (*
    addr = magicMMIOAddr;
    loop {
      i = input addr;
      stay in loop only if i is non-zero;
      s = i _ i;
      output addr s;
    }
    *)
    Definition doubler: stmt Z :=
      (SSeq (SLit addr magicMMIOAddrLit)
            (SLoop (SLoad Syntax.access_size.four i addr 0)
                   (CondNez i)
                   (SSeq (SOp s Syntax.bopname.add i (Var i))
                         (SStore Syntax.access_size.four addr s 0)))).

    Definition compiled: list Instruction :=
      Eval cbv in compile_stmt RV32I compile_ext_call map.empty 0 0 doubler.
    Goal True.
      let c := eval cbv in compiled in pose c.
    Abort.
  End CompilationTest.

  Lemma load4bytes_in_MMIO_is_None: forall (m: mem) (addr: word),
      map.undef_on m isMMIOAddr ->
      isMMIOAddr addr ->
      Memory.load_bytes 4 m addr = None.
  Proof.
    intros. unfold Memory.load_bytes, map.undef_on, map.agree_on, map.getmany_of_tuple in *.
    simpl.
    rewrite H by assumption.
    rewrite map.get_empty.
    reflexivity.
  Qed.

  Lemma loadWord_in_MMIO_is_None: forall (m: mem) (addr: word),
      map.undef_on m isMMIOAddr ->
      isMMIOAddr addr ->
      Memory.loadWord m addr = None.
  Proof.
    intros. unfold Memory.loadWord.
    apply load4bytes_in_MMIO_is_None; assumption.
  Qed.

  Lemma storeWord_in_MMIO_is_None: forall (m: mem) (addr: word) v,
      map.undef_on m isMMIOAddr ->
      isMMIOAddr addr ->
      Memory.storeWord m addr v = None.
  Proof.
    unfold Memory.storeWord. intros. unfold Memory.store_bytes.
    rewrite load4bytes_in_MMIO_is_None; auto.
  Qed.

  Ltac contrad := contradiction || discriminate || congruence.

  (* TODO: why are these here? *)
  Arguments LittleEndian.combine: simpl never. (* TODO can we put this next to its definition? *)
  Arguments mcomp_sat: simpl never.
  Arguments LittleEndian.split: simpl never.
  Local Arguments String.eqb: simpl never.

  Ltac fwd :=
    match goal with
    |- free.interp interp_action ?p ?s ?post =>
      let p' := eval hnf in p in
      change (free.interp interp_action p' s post);
      rewrite free.interp_act;
      cbn [interp_action MinimalMMIO.interpret_action snd fst];
        simpl_MetricRiscvMachine_get_set
    | |- load ?n ?ctx ?a ?s ?k =>
        let g' := eval cbv beta delta [load] in (load n ctx a s k) in
        change g';
        simpl_MetricRiscvMachine_get_set
    | _ => progress cbn [free.bind]
    | |- store ?n ?ctx ?a ?v ?s ?k =>
        let g' := eval cbv beta delta [store] in (store n ctx a v s k) in
        change g';
        simpl_MetricRiscvMachine_get_set
    | _ => progress cbn [free.bind]
    | _ => rewrite free.interp_ret
    end.

  Lemma disjoint_MMIO_goal: forall (x y: word),
      isMMIOAddr x ->
      ~ isMMIOAddr y ->
      word.unsigned x mod 4 = 0 ->
      word.add (word.add (word.add x (word.of_Z 1)) (word.of_Z 1)) (word.of_Z 1) <> y /\
      word.add (word.add x (word.of_Z 1)) (word.of_Z 1) <> y /\
      word.add x (word.of_Z 1) <> y /\
      x <> y.
  Proof.
    intros.
    unfold isMMIOAddr, FE310_mmio, isOTP,isPRCI, isGPIO0, isUART0, isSPI1 in *.
    simpl in *.
    ssplit.
    all: intro C.
    1: replace x with (word.sub y (word.of_Z 3)) in * by (subst y; solve_word_eq word_ok).
    2: replace x with (word.sub y (word.of_Z 2)) in * by (subst y; solve_word_eq word_ok).
    3: replace x with (word.sub y (word.of_Z 1)) in * by (subst y; solve_word_eq word_ok).
    4: replace x with y in * by assumption.
    all: clear C;
      rewrite ?word.unsigned_sub, ?word.unsigned_of_Z in H, H1;
      unfold word.wrap in *;
      pose proof (word.unsigned_range y);
      forget (word.unsigned y) as Y; clear x y;
      let r := eval cbv in (2 ^ 32) in change (2 ^ 32) with r in *;
      Z.div_mod_to_equations;
      (* COQBUG (performance) https://github.com/coq/coq/issues/10743,
         workaround by @thery *)
      repeat match goal with
             | [ H : ?x -> _, H' : ?x -> _ |- _ ] =>
               pose proof (fun u : x => conj (H u) (H' u)); clear H H'
             end.
    all: time blia.
  Time Qed.

  Lemma compile_ext_call_correct: forall resvars extcall argvars,
      FlatToRiscvCommon.compiles_FlatToRiscv_correctly compile_ext_call compile_ext_call
        (FlatImp.SInteract resvars extcall argvars).
  Proof.
    unfold FlatToRiscvCommon.compiles_FlatToRiscv_correctly. simpl. intros.
    destruct H5 as (? & ? & V_resvars & V_argvars).
    rename extcall into action.
    pose proof (compile_interact_emits_valid RV32I _ action _ V_resvars V_argvars).
    simp.
    destruct_RiscvMachine initialL.
    unfold FlatToRiscvCommon.goodMachine in *.
    match goal with
    | H: forall _ _, outcome _ _ -> _ |- _ => specialize H with (mReceive := map.empty)
    end.
    destruct (String.eqb "MMIOWRITE" action) eqn: E;
      cbn [getRegs getPc getNextPc getMem getLog getMachine getMetrics getXAddrs] in *.
    + (* MMOutput *)
      progress simpl in *|-.
      match goal with
      | H: FE310CSemantics.ext_spec _ _ _ _ _ |- _ => rename H into Ex
      end.
      unfold compile_interact in *.
      cbv [FE310CSemantics.ext_spec] in Ex.
      rewrite E in *.
      destruct Ex as (?&?&?&(?&?&?)&?). subst mGive argvals.
      repeat match goal with
             | H: _ /\ _ |- _ => destruct H
             | H: exists x, _ |- _ => let x' := fresh x in destruct H as [x' H]
             end.
      destruct argvars. {
        exfalso.
        match goal with
        | A: map.getmany_of_list _ ?L1 = Some ?L2 |- _ =>
          clear -A; cbn in *; congruence
        end.
      }
      destruct argvars. {
        exfalso.
        match goal with
        | A: map.getmany_of_list _ ?L1 = Some ?L2 |- _ =>
          clear -A; cbn in *; destruct_one_match_hyp; congruence
        end.
      }
      destruct argvars; cycle 1. {
        exfalso.
        match goal with
        | A: map.getmany_of_list _ ?L1 = Some ?L2 |- _ =>
          clear -A; cbn in *; simp; destruct_one_match_hyp; congruence
        end.
      }
      cbn in *|-.
      match goal with
      | H: map.split _ _ map.empty |- _ => rewrite map.split_empty_r in H; subst
      end.
      match goal with
      | HO: outcome _ _, H: _ |- _ => specialize (H _ HO); rename H into HP
      end.
      destruct g. FlatToRiscvCommon.simpl_g_get.
      simp.
      subst.
      cbn in *.
      simp.
      eapply runsToNonDet.runsToStep_cps.
      match goal with
      | H: iff1 allx _ |- _ => apply iff1ToEq in H; subst allx
      end.

      split; simpl_MetricRiscvMachine_get_set. {
        intros _.
        eapply ptsto_instr_subset_to_isXAddr4.
        eapply shrink_footpr_subset. 1: eassumption.
        cbn in *. wwcancel.
      }

      erewrite ptsto_bytes.load_bytes_of_sep; cycle 1.
      { cbv [program ptsto_instr Scalars.truncated_scalar Scalars.littleendian] in *.
        cbn [array bytes_per] in *.
        simpl_MetricRiscvMachine_get_set.
        wcancel_assumption. }
      change (@Bind _ _) with (@free.bind MetricMinimalMMIO.action result) in *.
      unfold free.bind at 1.

      rewrite <-LittleEndian.split_eq, LittleEndian.combine_split.
      rewrite Z.mod_small by eapply EncodeBound.encode_range.
      rewrite DecodeEncode.decode_encode; cycle 1. {
        epose proof Registers.arg_range_Forall as HH.
        rewrite E3 in HH.
        repeat match goal with HH : Forall _ (_::_)|-_ => inversion HH; subst; clear HH end.
        split; cbn; unfold Encode.verify_S, funct3_SW, opcode_STORE; ssplit; try Lia.lia.
      }
      repeat fwd.

      unfold getReg.
      destr ((0 <? z1) && (z1 <? 32))%bool; cbv [valid_FlatImp_var] in *; [|exfalso; blia].
      destr ((0 <? z2) && (z2 <? 32))%bool; cbv [valid_FlatImp_var] in *; [|exfalso; blia].
      replace (map.get initialL_regs z1) with (Some x) by (symmetry; unfold map.extends in *; eauto).
      replace (map.get initialL_regs z2) with (Some x0) by (symmetry; unfold map.extends in *; eauto).

      cbv [Utility.add Utility.ZToReg MachineWidth_XLEN]; rewrite word.add_0_r.
      unshelve erewrite (_ : _ = None); [eapply storeWord_in_MMIO_is_None; eauto|].

      cbv [MinimalMMIO.nonmem_store FE310_mmio].
      split; [trivial|].
      split; [red; auto|].

      repeat fwd.

      eapply runsToNonDet.runsToDone.
      simpl_MetricRiscvMachine_get_set.
      simpl_word_exprs word_ok.
      unfold mmioStoreEvent, signedByteTupleToReg in *.
      unfold regToInt32.
      rewrite LittleEndian.combine_split.
      rewrite sextend_width_nop by reflexivity.
      rewrite Z.mod_small by apply word.unsigned_range.
      rewrite word.of_Z_unsigned.
      apply eqb_eq in E. subst action.
      cbn -[invalidateWrittenXAddrs] in *.
      specialize (HPp1 mKeep). rewrite map.split_empty_r in HPp1. specialize (HPp1 eq_refl).
      do 4 eexists.
      split; eauto.
      split; eauto.
      split; [unfold map.only_differ; eauto|].
      split. {
        unfold id. MetricsToRiscv.solve_MetricLog.
      }
      split; eauto.
      split; eauto.
      split; eauto.
      split; eauto.
      split; eauto.
      split. {
        lazymatch goal with
        | H: map.undef_on initialL_mem ?A |- _ =>
          rename H into U; change (map.undef_on initialL_mem isMMIOAddr) in U; move U at bottom
        end.
        lazymatch goal with
        | H: disjoint (of_list initialL_xaddrs) ?A |- _ =>
          rename H into D; change (disjoint (of_list initialL_xaddrs) isMMIOAddr) in D;
            move D at bottom
        end.
        lazymatch goal with
        | H: FE310CSemantics.isMMIOAddr x |- _ =>
          rename H into M0; change (isMMIOAddr x) in M0; move M0 at bottom
        end.
        lazymatch goal with
        | H: word.unsigned x mod 4 = 0 |- _ => rename H into D4; move D4 at bottom
        end.
        assert (forall {T: Type} (a b c: set T), subset a b -> subset b c -> subset a c)
          as subset_trans. {
          clear. unfold subset, PropSet.elem_of. intros. firstorder idtac.
        }
        eapply subset_trans. 1: eassumption.
        clear -D4 M0 D word_ok.
        unfold invalidateWrittenXAddrs.
        change removeXAddr with (@List.removeb word word.eqb).
        rewrite ?ListSet.of_list_removeb.
        unfold map.undef_on, map.agree_on, disjoint in *.
        unfold subset, diff, singleton_set, of_list, PropSet.elem_of in *.
        intros y HIn.
        specialize (D y). destruct D; [contradiction|].
        rewrite ?and_assoc.
        split; [exact HIn|clear HIn].
        eapply disjoint_MMIO_goal; assumption.
      }
      ssplit; eauto.
      unfold invalidateWrittenXAddrs.
      change removeXAddr with (@List.removeb word word.eqb).
      rewrite ?ListSet.of_list_removeb.
      repeat apply disjoint_diff_l.
      assumption.

    + (* MMInput *)
      simpl in *|-.
      match goal with
      | H: FE310CSemantics.ext_spec _ _ _ _ _ |- _ => rename H into Ex
      end.
      unfold compile_interact in *.
      cbv [FE310CSemantics.ext_spec] in Ex.
      simpl in *|-.

      rewrite E in *.
      destruct ("MMIOREAD" =? action)%string eqn:EE in Ex; try contradiction.
      destruct Ex as (?&?&(?&?&?)&?). subst mGive argvals.
      repeat match goal with
             | l: list _ |- _ => destruct l;
                                   try (exfalso; (contrad || (cheap_saturate; contrad))); []
             end.
      destruct argvars; cycle 1. {
        exfalso.
        match goal with
        | A: map.getmany_of_list _ ?L1 = Some ?L2 |- _ =>
          clear -A; cbn in *; simp; destruct_one_match_hyp; congruence
        end.
      }
      cbn in *|-.
      match goal with
      | H: map.split _ _ map.empty |- _ => rewrite map.split_empty_r in H; subst
      end.
      destruct g. FlatToRiscvCommon.simpl_g_get.
      simp.
      subst.
      cbn in *.
      eapply runsToNonDet.runsToStep_cps.
      match goal with
      | H: iff1 allx _ |- _ => apply iff1ToEq in H; subst allx
      end.

      split; simpl_MetricRiscvMachine_get_set. {
        intros _.
        eapply ptsto_instr_subset_to_isXAddr4.
        eapply shrink_footpr_subset. 1: eassumption.
        unfold program.
        cbn in *. wwcancel.
      }
      erewrite ptsto_bytes.load_bytes_of_sep; cycle 1.
      { cbv [program ptsto_instr Scalars.truncated_scalar Scalars.littleendian] in *.
        cbn [array bytes_per] in *.
        simpl_MetricRiscvMachine_get_set.
        wcancel_assumption. }

      change (@Bind _ _) with (@free.bind MetricMinimalMMIO.action result) in *.
      unfold free.bind at 1.

      rewrite <-LittleEndian.split_eq, LittleEndian.combine_split.
      rewrite Z.mod_small by (eapply EncodeBound.encode_range).
      rewrite DecodeEncode.decode_encode; cycle 1. {
        epose proof Registers.arg_range_Forall as HH.
        rewrite E1 in HH.
        repeat match goal with HH : Forall _ (_::_)|-_ => inversion HH; subst; clear HH end.
        split; cbn; unfold Encode.verify_I, opcode_LOAD, funct3_LW; ssplit; try Lia.lia.
      }

      repeat fwd.

      unfold getReg.
      destr ((0 <? z1) && (z1 <? 32))%bool; cbv [valid_FlatImp_var] in *; [|exfalso; blia].
      replace (map.get initialL_regs z1) with (Some x) by (symmetry; unfold map.extends in *; eauto).

      split; try discriminate.
      cbv [Utility.add Utility.ZToReg MachineWidth_XLEN]; rewrite word.add_0_r.
      unshelve erewrite (_ : _ = None); [eapply loadWord_in_MMIO_is_None|]; eauto.

      cbv [MinimalMMIO.nonmem_load FE310_mmio].
      split; [trivial|].
      split; [red; auto|].
      split; [ cbv [MMIOReadOK];
               exists (LittleEndian.split 4 0); trivial |].
      intros.

      repeat fwd.

      eapply runsToNonDet.runsToDone.
      simpl_MetricRiscvMachine_get_set.
      simpl_word_exprs word_ok.

      unfold mmioLoadEvent, signedByteTupleToReg.
      match goal with
      | A: forall _, outcome _ _ -> _, OC: forall _, outcome _ _ |- _ =>
         epose proof (A (cons _ nil) (OC _)) as P; clear A
      end.
      cbn in P.
      simp.
      apply eqb_eq in EE. subst action.
      cbn in *.
      specialize (Pp1 mKeep). rewrite map.split_empty_r in Pp1. specialize (Pp1 eq_refl).
      unfold setReg.
      destr ((0 <? z1) && (z1 <? 32))%bool; [|exfalso;blia].
      do 4 eexists.
      split; eauto.
      split; eauto.
      split. {
        unfold map.only_differ. intros. unfold union, of_list, elem_of, singleton_set. simpl.
        rewrite map.get_put_dec.
        destruct_one_match; auto.
      }
      split. {
        unfold id. MetricsToRiscv.solve_MetricLog.
      }
      split. {
        eapply map.put_extends. eassumption.
      }
      split. {
        unfold map.forall_keys in *.
        intros.
        lazymatch goal with
        | H : context [map.get _ ?x] |- _ <= ?x < _ =>
          rewrite map.get_put_dec in H
        end.
        destruct_one_match_hyp. 1: blia. eauto.
      }
      split. {
        rewrite map.get_put_diff; eauto. unfold RegisterNames.sp. blia.
      }
      split. {
        eapply @regs_initialized.preserve_regs_initialized_after_put.
        2: eassumption.
        typeclasses eauto.
      }
      eauto 10.
  Time Qed. (* takes ~70s *)

End MMIO1.


Require Import Util LengthEq IL RenamedApart LabelsDefined OptionR.
Require Import Keep Drop Take Restrict SetOperations OUnion.
Require Import Annotation Liveness.Liveness Coherence Delocation.
Require Import AddParam AddAdd MoreListSet DelocationAlgo DelocationAlgoIsCalled.
Require Import PartialOrder.

Set Implicit Arguments.

Opaque to_list.

Lemma additionalParameters_live_monotone ZL Lv LV' s an' LV lv
: live_sound Imperative ZL Lv s lv
  -> additionalParameters_live LV s lv an'
  -> PIR2 Subset LV' (Lv \\ ZL)
  -> additionalParameters_live LV' s lv an'.
Proof.
  intros LS APLS LE.
  general induction APLS; invt live_sound;
    eauto using additionalParameters_live.
  - inv_get. simpl in *.
    edestruct PIR2_nth_2 as [? [A B]]; eauto using zip_get.
    econstructor; eauto using map_get_1; simpl; eauto with cset.
  - lnorm.
    econstructor; eauto.
    + intros. exploit H1; eauto.
      rewrite zip_app; eauto with len. eapply PIR2_app; eauto.
      eapply PIR2_get. intros. inv_get.
      exploit H; eauto using @ifFstR.
      eauto 30 with len.
    + exploit IHAPLS; eauto.
      rewrite zip_app; eauto with len. eapply PIR2_app; eauto.
      eapply PIR2_get. intros. inv_get.
      exploit H; eauto using @ifFstR.
      eauto 30 with len.
Qed.

Lemma computeParameters_live b ZL Lv AP s lv
: live_sound Imperative ZL Lv s lv
  -> poLe AP (Lv \\ ZL)
  -> length Lv = length ZL
  -> length ZL = length AP
  -> noUnreachableCode (isCalled b) s
  -> additionalParameters_live (oget ⊝ (snd (computeParameters (Lv \\ ZL) AP s lv)))
                              s lv (fst (computeParameters (Lv \\ ZL) AP s lv)).
Proof.
  intros LS SUB LEN1 LEN2 REACH.
  general induction LS; inv REACH; simpl in *; repeat let_pair_case_eq; repeat let_case_eq;
    subst; simpl in *.
  - econstructor; eauto 20 using addParam_Subset with len.
  - econstructor; eauto with len.
    + eapply additionalParameters_live_monotone; eauto.
      * eapply PIR2_ifFstR_Subset_oget, ifFstR_zip_ounion;
          eauto using computeParameters_LV_DL with len.
    + eapply additionalParameters_live_monotone; eauto.
      * eapply PIR2_ifFstR_Subset_oget, ifFstR_zip_ounion;
          eauto using computeParameters_LV_DL with len.
  - inv_get. hnf in SUB. PIR2_inv. inv_get.
    econstructor; eauto using map_get_eq, keep_Some; simpl; eauto with cset.
    etransitivity; eauto. eapply SUB0.
  - econstructor.
  - exploit computeParameters_length as Len1; eauto with len.
    lnorm.
    econstructor.
    + eauto with len.
    + intros. inv_get.
      pose proof (H8 _ H10).
      edestruct computeParameters_isCalledFrom_get_Some; try eapply H9;
        eauto using map_get_1, get_app with len; dcr; subst.
      intros; edestruct H2; eauto.
      simpl. rewrite of_list_3.
      exploit (@computeParameters_LV_DL (fst ⊝ F ++ ZL) (getAnn ⊝ als ++ Lv) (tab {}  ‖F‖ ++ AP));
        eauto using PIR2_Subset_tab_extend with len.
      len_simpl.
      exploit computeParametersF_LV_DL; eauto; eauto with len.
      eapply PIR2_nth in H13; eauto. dcr; inv_get.
      split.
      rewrite H15. clear_all; cset_tac.
      edestruct H2; eauto.
      eapply NoDupA_app; eauto.
      eapply nodup_to_list_eq.
      intros.
      rewrite InA_In_eq in H18. rewrite InA_in in H18.
      rewrite InA_In_eq in H17. rewrite InA_in in H17.
      rewrite of_list_3 in H18.
      revert H15 H17 H18. clear_all. cset_tac.
    + intros. inv_get. len_simpl.
      exploit H1; eauto using pair_eta, PIR2_Subset_tab_extend with len.
      eapply additionalParameters_live_monotone; try eapply H9; eauto.
      rewrite map_map.
      rewrite of_list_oto_list_oget.
      rewrite <- List.map_app. rewrite <- take_eta.
      eapply PIR2_ifFstR_Subset_oget.
      eapply ifFstR_addAdds2. rewrite zip_app; eauto with len.
      eapply computeParametersF_LV_DL; eauto with len.
      eapply computeParameters_LV_DL; eauto using PIR2_Subset_tab_extend with len.
    + eapply additionalParameters_live_monotone; try eapply IHLS;
        eauto using PIR2_Subset_tab_extend with len.
      rewrite map_map.
      rewrite of_list_oto_list_oget.
      rewrite <- List.map_app. rewrite <- take_eta.
      eapply PIR2_ifFstR_Subset_oget.
      eapply ifFstR_addAdds2. rewrite zip_app; eauto with len.
      eapply computeParametersF_LV_DL; eauto with len.
      eapply computeParameters_LV_DL; eauto using PIR2_Subset_tab_extend with len.
    + rewrite map_length. rewrite take_length_le; eauto.
      rewrite zip_length2.
      * eauto 20 with len.
      * rewrite fold_zip_ounion_length; eauto.
        -- eauto 20 with len.
        -- eapply computeParametersF_length; eauto.
           rewrite computeParameters_length; eauto with len.
           eauto with len.
Qed.

Lemma is_live b s lv
: live_sound Imperative nil nil s lv
  -> noUnreachableCode (isCalled b) s
  -> additionalParameters_live nil s lv (fst (computeParameters nil nil s lv)).
Proof.
  intros.
  assert (snd (computeParameters nil nil s lv) = nil). {
    exploit computeParameters_AP_LV; eauto.
    inv H1; eauto.
  }
  exploit computeParameters_live; eauto; try reflexivity.
  simpl in *. rewrite H1 in H2. eauto.
Qed.