Require Import List.
Require Import Arith.
Require Import monad.
Require Import Metatheory.
Require Import alist.
Require Import Values.
Require Import Memory.
Require Import Integers.
Require Import Coqlib.
Require Import Maps.
Require Import maps_ext.
Require Import Lattice.
Require Import Iteration.
Require Import ListSet.
Require Import dom_list.
Require Import util. (* for NodeSet *)

(**********************************)
(* This file defines analysis used by Vellvm. *)

Require Import syntax.
Require Import infrastructure.
Require Import infrastructure_props.
Import LLVMsyntax.
Import LLVMinfra.

(**********************************)
(* Reachability anaylysis *)

(* Instantiate the reachability solver. *)
Module ReachDS := Dataflow_Solver(LBoolean)(AtomNodeSet).

(* Compute a set of reachable blocks in function f.
   A block is reachable if the returned result maps the block to true. *)
Definition areachable_aux (f: fdef) : option (AMap.t bool) :=
  match getEntryBlock f with
  | Some (le, _) =>
     ReachDS.fixpoint (successors f) (fun pc r => r) ((le, true) :: nil)
  | None => None
  end.

Definition areachable (f: fdef) : AMap.t bool :=
  match areachable_aux f with
  | None => AMap.init true
  | Some rs => rs
  end.

(* rd is the reach analysis result. The function returns the reachable blocks
   in bd in terms of rd. *)
Fixpoint get_reachable_labels (bd:list l) (rd:AMap.t bool) (acc:list l)
  : list l :=
match bd with
| nil => acc
| l0::bd' => if (AMap.get l0 rd)
             then get_reachable_labels bd' rd (l0::acc)
             else get_reachable_labels bd' rd acc
end.

(* Compute the reachable blocks in function f. *)
Definition reachablity_analysis (f: fdef) : option (list l) :=
match getEntryBlock f with
| Some (root, _) =>
    let 'bd := bound_fdef f in
    match areachable_aux f with
    | None => None
    | Some rd => Some (get_reachable_labels bd rd nil)
    end
| None => None
end.

(* The declararive version: if b1 is reachable in f. *)
Definition isReachableFromEntry (f:fdef) (b1:block) : Prop :=
let '(l1, _) := b1 in
reachable f l1.

(* The algorithmic version: if b1 is reachable in f. *)
Definition isAReachableFromEntry (f:fdef) (b1:block) : Prop :=
let '(l1, _) := b1 in
AMap.get l1 (areachable f).

(********************************************)
Import AtomSet.

Ltac solve_set_eq :=
repeat match goal with
| |- set_eq ?a ?a => apply set_eq_refl
| H : set_eq ?bs_contents ?bs_contents0,
  H0 : set_eq ?bs_contents1 ?bs_contents2 |-
  set_eq (set_inter _ ?bs_contents ?bs_contents1)
     (set_inter _ ?bs_contents0 ?bs_contents2) =>
  apply set_eq_inter; auto
| |- set_eq (?pc :: _) (?pc :: _) => simpl_env
| |- set_eq (?pc ++ _) (?pc ++ _) => apply set_eq_app
| H : set_eq ?bs_contents ?bs_contents0 |-
      set_eq ?bs_contents ?bs_contents0 => exact H
| H0 : set_eq ?C ?D, EQ : set_eq ?A ?B, e : set_eq ?C ?A |-
  set_eq ?D ?B =>
  eauto using set_eq_trans, set_eq_sym
| H0 : set_eq ?A ?B, EQ : set_eq ?C ?D, e : set_eq ?B ?D |-
  set_eq ?A ?C =>
  eauto using set_eq_trans, set_eq_sym
end.

(********************************************)
(** * Correctness of reachable analysis *)

Lemma areachable_entrypoint:
  forall (f:fdef) l0 s0,
    getEntryBlock f = Some (l0, s0) ->
    (areachable f)!!l0 = true.
Proof.
  intros f l0 s0 Hentry. unfold areachable.
  caseEq (areachable_aux f).
    unfold areachable_aux; intros reach A.
    rewrite Hentry in A.
    assert (LBoolean.ge reach!!l0 true).
      eapply ReachDS.fixpoint_entry. eexact A. auto with coqlib.
    unfold LBoolean.ge in H. tauto.

    intros. apply AMap.gi.
Qed.

Lemma isReachableFromEntry_dec: forall f b,
  isReachableFromEntry f b \/ ~ isReachableFromEntry f b.
Proof.
  destruct f as [fh bs]. destruct b as [l0 ? ? ?]. simpl.
  apply reachable_dec; auto.
Qed.

Lemma areachable_successors:
  forall f l0 cs ps tmn l1,
  uniqFdef f ->
  blockInFdefB (l0, stmts_intro cs ps tmn) f ->
  In l1 (successors_terminator tmn) ->
  (areachable f)!!l0 = true ->
  (areachable f)!!l1 = true.
Proof.
  intros f l0 cs ps tmn l1 HuniqF HbInF Hin.
  unfold areachable.
  caseEq (areachable_aux f).
    unfold areachable_aux. intro reach; intros.
    remember (getEntryBlock f) as R.
    destruct R; inv H.
    destruct b as [le ?].
    assert (LBoolean.ge reach!!l1 reach!!l0) as J.
      change (reach!!l0) with ((fun pc r => r) l0 (reach!!l0)).
      eapply ReachDS.fixpoint_solution; eauto.
        destruct f as [[?] bs]. simpl in *.
        clear - HuniqF HbInF Hin. destruct HuniqF.
        assert ((successors_terminator tmn) = (successors_blocks bs) !!! l0)
          as EQ.
          eapply successors_terminator__successors_blocks; eauto.
        unfold l in *.
        rewrite <- EQ; auto.
    elim J; intro. congruence. auto.

  intros. apply AMap.gi.
Qed.

Require Import Dipaths.

Lemma areachable_is_correct:
  forall f l0,
  uniqFdef f ->
  reachable f l0 ->
  (areachable f)!!l0.
Proof.
  unfold reachable. autounfold with cfg.
  intros.
  remember (getEntryBlock f) as R.
  destruct R; tinv H0.
  destruct b as [l1 [p c t]]. destruct H0 as [vl [al H0]].
  remember (ACfg.vertexes (successors f)) as Vs.
  remember (ACfg.arcs (successors f)) as As.
  unfold ATree.elt, l in *.
  remember (index l0) as v0.
  remember (index l1) as v1.
  generalize dependent f.
  generalize dependent l0.
  generalize dependent l1.
  generalize dependent p.
  generalize dependent c.
  generalize dependent t.
  induction H0; intros; subst.
    inv Heqv0.
    symmetry in HeqR.
    apply areachable_entrypoint in HeqR; auto.

    destruct y as [a0].
    apply IHD_walk with (l0:=a0) in HeqR; auto.
    assert (exists ps0, exists cs0, exists tmn0,
      blockInFdefB (a0, stmts_intro ps0 cs0 tmn0) f /\
      In l0 (successors_terminator tmn0)) as J.
      eapply successors__blockInFdefB; eauto.
    destruct J as [ps0 [cs0 [tmn0 [HBinF' Hinsucc]]]].
    eapply areachable_successors; eauto.
Qed.

(** * Properties of get_reachable_labels *)
Lemma get_reachable_labels__spec_aux: forall a (t:AMap.t bool)
  (Hin : t !! a) bnd acc (Hinbnd : In a bnd \/ In a acc),
  In a (get_reachable_labels bnd t acc).
Proof.
  induction bnd; simpl; intros; try tauto.
    destruct Hinbnd as [[EQ | Hinbnd] | Hinbnd]; subst.
      rewrite Hin.
      apply IHbnd; simpl; auto.

      destruct_if; auto.
      destruct_if; auto.
        apply IHbnd; simpl; auto.
Qed.

Lemma get_reachable_labels__spec: forall a (t:AMap.t bool) bnd
  (Hin : t !! a) (Hinbnd : In a bnd),
  In a (get_reachable_labels bnd t nil).
Proof.
  intros.
  apply get_reachable_labels__spec_aux; simpl; auto.
Qed.

Ltac tinv H := try solve [inv H].

Lemma get_reachable_labels__spec_aux': forall a (t:AMap.t bool)
  bnd acc (Hinbnd : In a (get_reachable_labels bnd t acc)),
  (In a bnd /\ t !! a = true) \/ In a acc.
Proof.
  induction bnd; simpl; intros; try tauto.
    destruct_if.
      apply IHbnd in Hinbnd.
      simpl in Hinbnd.
      destruct Hinbnd as [[J1 J2]|[J |J]]; subst; try tauto.
      rewrite <- HeqR. tauto.

      apply IHbnd in Hinbnd.
      tauto.
Qed.

Lemma get_reachable_labels__spec': forall a (t:AMap.t bool) bnd
  (Hinbnd : In a (get_reachable_labels bnd t nil)),
  In a bnd.
Proof.
  intros.
  apply get_reachable_labels__spec_aux' in Hinbnd.
  tauto.
Qed.

Lemma get_reachable_labels__spec'': forall a (t:AMap.t bool) bnd
  (Hinbnd : In a (get_reachable_labels bnd t nil)),
  t !! a = true.
Proof.
  intros.
  apply get_reachable_labels__spec_aux' in Hinbnd.
  tauto.
Qed.

(** Properties of reachablity_analysis *)
Lemma reachablity_analysis__in_bound: forall f rd,
  reachablity_analysis f = Some rd ->
  incl rd (bound_fdef f).
Proof.
  unfold reachablity_analysis.
  intros. intros x Hin.
  inv_mbind.
  eapply get_reachable_labels__spec'; eauto.
Qed.

(**********************************)
(* Computing Dominators *)

(* In function f, b1 dominates b2. *)
Definition blockDominates (f: fdef) (b1 b2: block) : Prop :=
let '(l1, _) := b1 in
let '(l2, _) := b2 in
let 'els := AlgDom.sdom f l2 in
set_In l1 els \/ l1 = l2.

(* In function f, b1 strictly dominates b2. *)
Definition blockStrictDominates (f: fdef) (b1 b2: block) : Prop :=
let '(l1, _) := b1 in
let '(l2, _) := b2 in
let 'els := AlgDom.sdom f l2 in
set_In l1 els.

(* In block b, the definition id1 dominates the instruction i2. *)
Definition insnDominates (id1:id) (i2:insn) (b:block) : Prop :=
match b with
| (l5, stmts_intro ps cs tmn) =>
  match i2 with
  | insn_terminator tmn2 =>
      ((exists cs1, exists c1, exists cs2,
         cs = cs1++c1::cs2 /\ getCmdID c1 = Some id1) \/
       (exists ps1, exists p1, exists ps2,
         ps = ps1++p1::ps2 /\ getPhiNodeID p1 = id1)
       ) /\ tmn2 = tmn
  | insn_cmd c2 =>
      (exists ps1, exists p1, exists ps2,
         ps = ps1++p1::ps2 /\ getPhiNodeID p1 = id1) \/
      (exists cs1, exists c1, exists cs2, exists cs3,
         cs = cs1++c1::cs2 ++ c2 :: cs3 /\ getCmdID c1 = Some id1)
  | _ => False
  end
end.

(* Returns the commands after the definition of id0 in cs. *)
Fixpoint cmds_dominates_cmd (cs:cmds) (id0:id) : list atom :=
match cs with
| nil => nil
| c1::cs' =>
    let ctx := cmds_dominates_cmd cs' id0 in
    if eq_atom_dec (getCmdLoc c1) id0 then nil
    else
      match getCmdID c1 with
      | Some id1 => id1::ctx
      | None => ctx
      end
end.

(* id0 is defined in block b1 of function f. inscope_of_id computes all
   definitions in f that strictly dominate id0. *)
Definition inscope_of_block (f:fdef) (l1:l) (opt_ctx:option (list atom)) (lbl:l)
  :=
  match opt_ctx with
  | Some ctx =>
     match lookupBlockViaLabelFromFdef f lbl with
     | None => None
     | Some sts =>
         if eq_atom_dec lbl l1 then Some ctx
         else Some (getStmtsIDs sts ++ ctx)
     end
  | None => None
  end.

Definition init_scope (f:fdef) (ps:phinodes) (cs:cmds) (id0:id) : list atom :=
if (in_dec id_dec id0 (getPhiNodesIDs ps)) then
  getArgsIDsOfFdef f
else
  getPhiNodesIDs ps ++ cmds_dominates_cmd cs id0 ++ getArgsIDsOfFdef f.

Definition inscope_of_id (f:fdef) (b1:block) (id0:id) : option (list atom) :=
let '(l1, stmts_intro ps cs _) := b1 in
let 'els := AlgDom.sdom f l1 in
fold_left (inscope_of_block f l1) els (Some (init_scope f ps cs id0))
.

(* ids0 is a set of dominations in scope,
   if v0 is a constant, then v0 is in scope;
   if v0 is an id0, then id0 must be in ids0. *)
Definition value_in_scope (v0:value) (ids0:ids) : Prop :=
match v0 with
| value_const _ => True
| value_id vid => In vid ids0
end.

(* Check if id1 is in the scope of id2. *)
Definition idDominates (f:fdef) (id1 id2: id) : Prop :=
match lookupBlockViaIDFromFdef f id2 with
| Some b2 =>
    match inscope_of_id f b2 id2 with
    | Some ids2 => In id1 ids2
    | None => False
    end
| None => False
end.

(* id2 is defined in a reachable block of f. *)
Definition id_in_reachable_block (f:fdef) (id2:id) : Prop :=
forall b2, lookupBlockViaIDFromFdef f id2 = Some b2 ->
           isReachableFromEntry f b2.

(* v1 >> v2 == id1 >> id2 \/ v1 is constant *)
Definition valueDominates (f:fdef) (v1 v2:value) : Prop :=
match v1, v2 with
| value_id id1, value_id id2 =>
   id_in_reachable_block f id2 ->
   idDominates f id1 id2
| value_const _, _ => True
| _, _ => False
end.

(* c is defined in block b1 of function f. inscope_of_id computes all
   definitions in f that strictly dominate c. *)
Definition inscope_of_cmd (f:fdef) (b1:block) (c:cmd) : option (list atom) :=
let id0 := getCmdLoc c in inscope_of_id f b1 id0.

(* tmn is defined in block b1 of function f. inscope_of_id computes all
   definitions in f that strictly dominate tmn. *)
Definition inscope_of_tmn (f:fdef) (b1:block) (tmn:terminator)
  : option (list atom) :=
let '(l1, stmts_intro ps cs _) := b1 in
let 'els := AlgDom.sdom f l1 in
fold_left (inscope_of_block f l1) els
  (Some (getPhiNodesIDs ps ++ getCmdsIDs cs ++ getArgsIDsOfFdef f))
.

(* Properties of cmds_dominates_cmd *)
Lemma NoDup__In_cmds_dominates_cmd : forall cs1 c cs2 id1,
  NoDup (getCmdsLocs (cs1 ++ c :: cs2)) ->
  In id1 (getCmdsIDs cs1) ->
  In id1 (cmds_dominates_cmd (cs1 ++ c :: cs2) (getCmdLoc c)).
Proof.
  induction cs1; intros; simpl in *.
    inversion H0.

    inv H.
    destruct (eq_atom_dec (getCmdLoc a) (getCmdLoc c)).
      assert (False) as F.
        apply H3.
        rewrite e.
        rewrite getCmdsLocs_app. simpl.
        apply in_or_app. right. simpl. auto.
      inversion F.

      destruct (getCmdID a); auto.
      simpl in *. destruct H0 as [H0 | H0]; auto.
Qed.

Lemma getCmdsIDs__cmds_dominates_cmd : forall cs2' c',
  ~ In (getCmdLoc c') (getCmdsLocs cs2') ->
  set_eq (getCmdsIDs (cs2' ++ [c']))
  (cmds_dominates_cmd (cs2' ++ [c']) (getCmdLoc c') ++
    match getCmdID c' with
    | Some id1 => [id1]
    | None => nil
    end).
Proof.
  induction cs2'; intros c' Hnotin.
    simpl in *.
    destruct (eq_atom_dec (getCmdLoc c') (getCmdLoc c')) as [_ | n];
      try solve [contradict n; auto].
      remember (getCmdID c') as R.
      destruct R; simpl_env; apply set_eq_refl.

    simpl in *.
    assert (~ In (getCmdLoc c') (getCmdsLocs cs2')) as J.
      auto.
    apply IHcs2' in J.
    remember (getCmdID a) as R1.
    remember (getCmdID c') as R2.
    destruct (eq_atom_dec (getCmdLoc a) (getCmdLoc c'));
      try solve [contradict e; auto].
    destruct R1; auto.
      simpl_env. solve_set_eq.
Qed.

Lemma cmds_dominates_cmd__cmds_dominates_cmd : forall cs2' c' c cs',
  NoDup (getCmdsLocs (cs2'++[c']++[c]++cs')) ->
  set_eq (cmds_dominates_cmd (cs2' ++ c' :: c :: cs') (getCmdLoc c))
    (cmds_dominates_cmd (cs2' ++ c' :: c :: cs') (getCmdLoc c') ++
     match getCmdID c' with
     | Some id1 => [id1]
     | None => nil
     end).
Proof.
  induction cs2'; intros c' c cs' Hnodup.
    simpl in *.
    inv Hnodup. simpl in H1.
    remember (getCmdID c') as R.
    destruct (eq_atom_dec (getCmdLoc c') (getCmdLoc c)).
      contradict e; auto.

      destruct (eq_atom_dec (getCmdLoc c) (getCmdLoc c)) as [_|n1];
        try solve [contradict n1; auto].
      destruct (eq_atom_dec (getCmdLoc c') (getCmdLoc c')) as [_|n2];
        try solve [contradict n2; auto].
      destruct R; auto using set_eq_refl.

    simpl in *.
    inv Hnodup.
    rewrite getCmdsLocs_app in H1.
    apply NotIn_inv in H1.
    destruct H1 as [H11 H12].
    simpl in H12.
    destruct (eq_atom_dec (getCmdLoc a) (getCmdLoc c)) as [e1 | ];
      try solve [contradict e1; auto].
    destruct (eq_atom_dec (getCmdLoc a) (getCmdLoc c')) as [e1 | ];
      try solve [contradict e1; auto].
    destruct (getCmdID a); auto.
      apply IHcs2' in H2. clear IHcs2'.
      simpl_env.
       apply set_eq_app; auto using set_eq_refl.
Qed.

Lemma cmds_dominates_cmd_spec : forall id2 id0 cs,
  In id2 (cmds_dominates_cmd cs id0) -> In id2 (getCmdsIDs cs).
Proof.
  induction cs; simpl; intros; auto.
    destruct (eq_atom_dec (getCmdLoc a) id0); subst.
      inv H.

      remember (getCmdID a) as R.
      symmetry in HeqR.
      destruct R; auto.
        apply getCmdLoc_getCmdID in HeqR.
        simpl in *.
        destruct H; auto.
Qed.

Lemma cmds_dominates_cmd_spec' : forall ids1 id2 cs id0,
  In id2 (ids1 ++ cmds_dominates_cmd cs id0) ->
  In id2 (ids1 ++ getCmdsIDs cs).
Proof.
  intros.
  apply in_app_or in H.
  apply in_or_app.
  destruct H as [H | H]; auto.
  right. eapply cmds_dominates_cmd_spec; eauto.
Qed.

Lemma cmds_dominates_cmd_inv: forall id2 cs id1,
  In id1 (getCmdsLocs cs) ->
  In id2 (cmds_dominates_cmd cs id1) ->
  exists cs1, exists c, exists cs2,
    cs = cs1 ++ c :: cs2 /\
    In id2 (getCmdsLocs cs1) /\
    getCmdLoc c = id1.
Proof.
  induction cs; simpl; intros.
    inv H0.

    destruct (eq_atom_dec (getCmdLoc a) id1); subst.
      inv H0.

      destruct H as [H | H]; subst.
        congruence.

        remember (getCmdID a) as R.
        destruct R.
          symmetry in HeqR.

          simpl in H0.
          destruct H0 as [H0 | H0]; subst.
            apply in_getCmdsLocs_inv in H.
            destruct H as [cs1 [c [cs2 [J1 J2]]]]; subst.
            exists (a::cs1). exists c. exists cs2.
            simpl. erewrite getCmdLoc_getCmdID; eauto.

            apply IHcs in H0; auto.
            destruct H0 as [cs1 [c [cs2 [J1 [J2 J3]]]]]; subst.
            exists (a::cs1). exists c. exists cs2.
            simpl. eauto.

          apply IHcs in H0; auto.
          destruct H0 as [cs1 [c [cs2 [J1 [J2 J3]]]]]; subst.
          exists (a::cs1). exists c. exists cs2.
          simpl. eauto.
Qed.

Lemma cmds_dominates_cmd_spec3: forall cs1 c cs2 id1,
  NoDup (getCmdsLocs (cs1 ++ c :: cs2)) -> getCmdLoc c = id1 ->
  cmds_dominates_cmd (cs1++c::cs2) id1 = getCmdsIDs cs1.
Proof.
  induction cs1; simpl; intros; subst.
    destruct (eq_atom_dec (getCmdLoc c) (getCmdLoc c)); auto.
      congruence.

    destruct (eq_atom_dec (getCmdLoc a) (getCmdLoc c)); subst.
      inv H.
      rewrite e in H2.
      contradict H2. rewrite getCmdsLocs_app.
      apply in_or_app. simpl. auto.

      inv H.
      destruct (getCmdID a).
        eapply IHcs1 in H3; eauto.
        rewrite H3. auto.

        eapply IHcs1 in H3; eauto.
Qed.

Lemma cmds_dominates_cmd_spec5: forall cs id1,
  ~ In id1 (getCmdsLocs cs) ->
  cmds_dominates_cmd cs id1 = getCmdsIDs cs.
Proof.
  induction cs; simpl; intros; auto.
    destruct (eq_atom_dec (getCmdLoc a) id1); subst.
      contradict H. auto.

      remember (getCmdID a) as R.
      destruct R; auto.
      rewrite IHcs; auto.
Qed.

Lemma cmds_dominates_cmd_spec2: forall cs cs' id1,
  In id1 (getCmdsIDs cs) ->
  cmds_dominates_cmd (cs++cs') id1 = cmds_dominates_cmd cs id1.
Proof.
  induction cs; simpl; intros.
    inv H.

    destruct (eq_atom_dec (getCmdLoc a) id1); subst; auto.
    remember (getCmdID a) as R.
    destruct R; eauto.
      symmetry in HeqR.
      apply getCmdLoc_getCmdID in HeqR. subst.
      simpl in H.
      destruct H as [H | H]; subst; try congruence.
      rewrite IHcs; auto.
Qed.

Lemma cmds_dominates_cmd_spec'' : forall ids1 id2 cs id0 tl1
  (Hnin: ~ In id2 tl1),
  In id2 (ids1 ++ cmds_dominates_cmd cs id0 ++ tl1) ->
  In id2 (ids1 ++ getCmdsIDs cs).
Proof.
  intros.
  rewrite_env ((ids1 ++ cmds_dominates_cmd cs id0) ++ tl1) in H.
  apply in_app_or in H.
  destruct H as [H | H]; try congruence.
  apply cmds_dominates_cmd_spec' in H. auto.
Qed.

Lemma cmds_dominates_cmd_spec''' : forall ids1 id2 cs id0 ids2,
  In id2 (ids1 ++ cmds_dominates_cmd cs id0 ++ ids2) ->
  In id2 (ids1 ++ getCmdsIDs cs ++ ids2).
Proof.
  intros.
  solve_in_list.
  eapply cmds_dominates_cmd_spec; eauto.
Qed.

Lemma cmds_dominates_cmd_trans : forall id1 id2 id3 R1 R2 cs
  (G: In id1 (getCmdsLocs cs))
  (H: NoDup (R1 ++ getCmdsLocs cs))
  (H0: In id1 (R1 ++
          cmds_dominates_cmd cs id3))
  (H1: In id2 (R1 ++
          cmds_dominates_cmd cs id1 ++ R2)),
  In id2 (R1 ++
          cmds_dominates_cmd cs id3 ++ R2).
Proof.
  intros.
  solve_in_list.
  apply in_app_or in H0.
  destruct H0 as [H0 | H0].
  Case "1".
    eapply NoDup_disjoint' in H; eauto.
    apply cmds_dominates_cmd_inv in H1; auto.
    destruct H1 as [cs2 [c0 [cs3 [J1 [J2 J3]]]]]; subst.
    contradict H. apply getCmdLoc_in_getCmdsLocs. apply in_middle.
  Case "2".
    apply NoDup_split in H. destruct H as [J4 J5].
    destruct (In_dec id_dec id3 (getCmdsLocs cs)) as [Hin3 | Hnin3].
    SCase "2.1".
      apply in_getCmdsLocs_inv in Hin3.
      destruct Hin3 as [cs1 [c [cs2 [EQ1 EQ2]]]]; subst.
      rewrite cmds_dominates_cmd_spec3 in H0; auto.
      rewrite cmds_dominates_cmd_spec2 with (cs:=cs1) in H1; auto.
      rewrite cmds_dominates_cmd_spec3; auto.
      apply cmds_dominates_cmd_spec in H1; auto.
    SCase "2.2".
      rewrite cmds_dominates_cmd_spec5 in H0; auto.
      rewrite cmds_dominates_cmd_spec5; auto.
      eapply cmds_dominates_cmd_spec; eauto.
Qed.

Lemma cmds_dominates_cmd_spec0 : forall ids1 id2 cs id0,
  In id2 (ids1 ++ cmds_dominates_cmd cs id0) ->
  In id2 (ids1 ++ getCmdsLocs cs).
Proof.
  intros.
  eapply cmds_dominates_cmd_spec' in H; eauto.
  solve_in_list.
Qed.

Lemma cmds_dominates_cmd_acyclic: forall (id1 id2 : id) (cs3 : cmds)
  (Hnodup : NoDup (getCmdsLocs cs3))
  (Hin2 : In id2 (cmds_dominates_cmd cs3 id1))
  (Hin1 : In id1 (cmds_dominates_cmd cs3 id2))
  (Hin3 : In id1 (getCmdsLocs cs3)) (Hin4 : In id2 (getCmdsLocs cs3)),
  False.
Proof.
  intros.
  apply cmds_dominates_cmd_inv in Hin2; auto.
  destruct Hin2 as [cs1 [c [cs2 [J1 [J2 J3]]]]]; subst.
  apply cmds_dominates_cmd_inv in Hin1; auto.
  destruct Hin1 as [cs1' [c' [cs2' [J1' [J2' J3']]]]]; subst.
  apply in_getCmdsLocs_inv in J2.
  destruct J2 as [cs4 [c1 [cs3 [G1 G2]]]]; subst.
  apply in_getCmdsLocs_inv in J2'.
  destruct J2' as [cs4' [c1' [cs3' [G1' G2']]]]; subst.
  simpl_env in J1'. simpl_env in Hnodup. simpl in *.
  assert (G:=Hnodup).
  apply NoDup_getCmdsLocs_prop with (c1:=c1)(c2:=c') in G;
    try solve [auto | solve_in_list | rewrite J1'; solve_in_list].
  subst.
  assert (G:=Hnodup).
  apply NoDup_getCmdsLocs_prop with (c1:=c1')(c2:=c) in G;
    try solve [auto | solve_in_list | rewrite J1'; solve_in_list].
  subst.
  rewrite_env ((cs4' ++ c :: cs3') ++ c' :: cs2') in J1'.
  apply NoDup_cmds_split_middle in J1'; auto.
  destruct J1'; subst.
  clear - Hnodup.
  simpl_env in Hnodup.
  rewrite getCmdsLocs_app in Hnodup.
  apply NoDup_split in Hnodup. destruct Hnodup as [_ Hnodup].
  rewrite getCmdsLocs_app in Hnodup.
  simpl in Hnodup. inv Hnodup.
  apply H1. rewrite_env ((cs3' ++ c' :: cs3) ++ c :: cs2).
  solve_in_list.
Qed.

(* Properties of init_scope *)
Lemma init_scope_spec1: forall f ps cs id0,
  ~ In id0 (getPhiNodesIDs ps) ->
  init_scope f ps cs id0 =
    getPhiNodesIDs ps ++ cmds_dominates_cmd cs id0 ++ getArgsIDsOfFdef f.
Proof.
  intros.
  unfold init_scope.
  destruct_if; try tauto.
Qed.

Lemma init_scope_spec2: forall f ps cs id2 id1
  (J1 : In id1 (init_scope f ps cs id2))
  (Hnotin2 : ~ In id1 (getArgsIDsOfFdef f)),
  In id1 (getPhiNodesIDs ps ++ cmds_dominates_cmd cs id2 ++ getArgsIDsOfFdef f).
Proof.
  unfold init_scope.
  intros.
  destruct_if; try tauto.
Qed.

Lemma init_scope_spec3: forall f ps cs id2 id1
  (J1 : In id1 (init_scope f ps cs id2))
  (Hnotin2 : ~ In id1 (getArgsIDsOfFdef f)),
  In id1 (getPhiNodesIDs ps ++ cmds_dominates_cmd cs id2).
Proof.
  unfold init_scope.
  intros.
  destruct_if; try tauto.
     xsolve_in_list.
Qed.

Lemma init_scope_incl: forall F ps1 cs1 tmn1 id1,
  incl (init_scope F ps1 cs1 id1)
       (getStmtsIDs (stmts_intro ps1 cs1 tmn1) ++ getArgsIDsOfFdef F).
Proof.
  unfold init_scope.
  intros. intros x Hin.
  destruct_if.
    xsolve_in_list.

    simpl.
    destruct_in Hin; xsolve_in_list.
      apply cmds_dominates_cmd_spec in Hin.
      xsolve_in_list.
Qed.

(* Properties of inscope_of_block *)
Definition opt_set_eq (ops1 ops2:option (list atom)) : Prop :=
match (ops1, ops2) with
| (None, None) => True
| (Some s1, Some s2) => set_eq s1 s2
| _ => False
end.

Lemma inscope_of_block__opt_set_eq : forall f l1 l' opr1 opr2,
  opt_set_eq opr1 opr2 ->
  opt_set_eq (inscope_of_block f l1 opr1 l') (inscope_of_block f l1 opr2 l').
Proof.
  unfold inscope_of_block.
  intros.
  destruct (lookupBlockViaLabelFromFdef f l').
    destruct (eq_atom_dec l' l1); subst.
      destruct opr1.
        destruct opr2; try solve [inversion H | auto].
        destruct opr2; try solve [inversion H | auto].
      unfold opt_set_eq in *.
      destruct opr1.
        destruct opr2; try solve [inversion H ].
          apply set_eq_app; auto using set_eq_refl.
        destruct opr2; try solve [inversion H | auto ].
    unfold opt_set_eq in *.
    destruct opr1.
      destruct opr2; try solve [inversion H | auto].
      destruct opr2; try solve [inversion H | auto].
Qed.

Lemma inscope_of_block__opt_union : forall f l1 l' init1 init2 r1,
  inscope_of_block f l1 (Some init1) l' = Some r1 ->
  exists r2, inscope_of_block f l1 (Some (init1++init2)) l' = Some r2 /\
    set_eq (r1++init2) r2.
Proof.
  intros.
  unfold inscope_of_block in *.
  destruct (lookupBlockViaLabelFromFdef f l') as [sts|].
    destruct (eq_atom_dec l' l1); subst; inv H.
      exists (r1++init2). auto using set_eq_refl.
      exists (getStmtsIDs sts ++ init1 ++ init2).
        simpl_env. auto using set_eq_refl.
    inversion H.
Qed.

(* Properties of fold *)
Lemma fold_left__opt_set_eq_aux : forall ls0 opr1 opr2 f l1,
  opt_set_eq opr1 opr2 ->
  opt_set_eq (fold_left (inscope_of_block f l1) ls0 opr1)
           (fold_left (inscope_of_block f l1) ls0 opr2).
Proof.
  induction ls0; intros opr1 opr2 f l1 Heq; simpl in *; auto.
    apply IHls0.
      apply inscope_of_block__opt_set_eq; auto.
Qed.

Lemma fold_left__opt_set_eq : forall (ls0:list atom) f l1 init1 init2 r1,
  set_eq init1 init2 ->
  fold_left (inscope_of_block f l1) ls0 (Some init1) = Some r1 ->
  exists r2, fold_left (inscope_of_block f l1) ls0 (Some init2) = Some r2 /\
    set_eq r1 r2.
Proof.
  intros.
  assert (opt_set_eq (Some init1) (Some init2)) as EQ. unfold opt_set_eq. auto.
  apply fold_left__opt_set_eq_aux with (ls0:=ls0)(f:=f)(l1:=l1) in EQ.
  remember (fold_left (inscope_of_block f l1) ls0 (ret init2)) as R.
  unfold opt_set_eq in EQ.
  rewrite H0 in EQ.
  destruct R; try solve [inversion EQ].
  exists l0. auto.
Qed.

Lemma fold_left__none : forall (ls0:list atom) f l1,
  fold_left (inscope_of_block f l1) ls0 None = None.
Proof.
  induction ls0; intros f l1; simpl in *; auto.
Qed.

Lemma fold_left__opt_union : forall (ls0:list atom) f l1 init1 init2 r1,
  fold_left (inscope_of_block f l1) ls0 (Some init1) = Some r1 ->
  exists r2,
    fold_left (inscope_of_block f l1) ls0 (Some (init1++init2)) = Some r2
      /\ set_eq (r1++init2) r2.
Proof.
  induction ls0; intros f l1 init1 init2 r1 H; simpl in *; auto.
    inv H. exists (r1 ++ init2). split; auto using set_eq_refl.

    destruct (lookupBlockViaLabelFromFdef f a).
      destruct (eq_atom_dec a l1); subst; auto.
        apply IHls0 with (init2:=init2) in H; auto.
          simpl_env in H. auto.
      rewrite fold_left__none in H. inversion H.
Qed.

Lemma inc__getLabel2Block_blocks : forall a bs
  (Hinc : incl [a] (bound_blocks bs)),
  exists sts, lookupAL _ bs a = Some sts.
Proof.
  intros.
  induction bs as [|a0 bs]; simpl in *; auto.
    assert (J:=@Hinc a). simpl in J. destruct J; auto.
    destruct a0 as [l0 s0]; simpl in *.
    destruct (a==l0); subst.
      exists s0. auto.

      apply IHbs. intros x J.
      assert (x=a) as EQ.
        simpl in J. destruct J; auto. inversion H.
      subst.
      apply Hinc in J. simpl in J.
      destruct J as [J | J]; subst; auto.
      contradict n; auto.
Qed.

Lemma fold_left__bound_blocks : forall ls0 fh bs l0 init,
  incl ls0 (bound_blocks bs) ->
  exists r,
    fold_left (inscope_of_block (fdef_intro fh bs) l0) ls0 (Some init) = Some r.
Proof.
  induction ls0; intros fh bs l0 init Hinc; simpl in *.
    exists init. auto.

    assert (incl ls0 (bound_blocks bs)) as J.
      simpl_env in Hinc.
      eapply incl_app_invr; eauto.
    assert (exists sts, lookupAL _ bs a = Some sts)
      as Hlkup.
      clear - Hinc.
      simpl_env in Hinc.
      apply incl_app_invl in Hinc.
      apply inc__getLabel2Block_blocks; auto.

    destruct Hlkup as [sts Hlkup].
    rewrite Hlkup.
    destruct (eq_atom_dec a l0); subst; auto.
Qed.

Lemma fold_left__spec : forall ls0 l0 init r f,
  fold_left (inscope_of_block f l0) ls0 (Some init) = Some r ->
    incl init r /\
    (forall l1 b1,
      In l1 (ListSet.set_diff eq_atom_dec ls0 [l0]) ->
      lookupBlockViaLabelFromFdef f l1 = Some b1 ->
      incl (getStmtsIDs b1) r) /\
    (forall id1,
      In id1 r ->
      In id1 init \/
      exists sts1, exists l1, In l1 (ListSet.set_diff eq_atom_dec ls0 [l0]) /\
        lookupBlockViaLabelFromFdef f l1 = Some sts1 /\
        In id1 (getStmtsIDs sts1)
    ).
Proof.
  induction ls0; intros l0 init r f Hfold; simpl in *.
    inv Hfold.
    split. apply incl_refl.
    split; auto.
      intros ? ? Hfalse. inversion Hfalse.

    remember (lookupBlockViaLabelFromFdef f a) as R.
    destruct R as [sts|].
      destruct (eq_atom_dec a l0); subst; auto.
      apply IHls0 in Hfold.
      destruct Hfold as [J1 [J2 J3]].
      split.
        eapply incl_app_invr; eauto.
      split.
        intros l1 b1 Hin Hlkup.
        apply ListSet.set_add_elim in Hin.
        destruct Hin as [Hin | Hin]; subst; eauto.
          rewrite Hlkup in HeqR. inv HeqR.
          eapply incl_app_invl; eauto.
        intros id1 Hin.
        apply J3 in Hin.
        destruct Hin as [Hin | [b1 [l1 [H1 [H2 H3]]]]].
          apply in_app_or in Hin.
          destruct Hin as [Hin | Hin]; auto.
          right.
          exists sts. exists a.
          split; auto.
            apply ListSet.set_add_intro; auto.

          right.
          exists b1. exists l1.
          split; auto.
            apply ListSet.set_add_intro; auto.

      rewrite fold_left__none in Hfold. inversion Hfold.
Qed.

Lemma fold_left__init : forall f l1 r ls0 init,
  fold_left (inscope_of_block f l1) ls0 (Some init) = Some r ->
  incl init r.
Proof.
  induction ls0; simpl; intros.
    inv H. apply incl_refl; auto.

    destruct (lookupBlockViaLabelFromFdef f a).
      destruct (eq_atom_dec a l1); subst; auto.
        apply IHls0 in H.
        intros x J. apply H. apply in_or_app. auto.

      rewrite fold_left__none in H. inv H.
Qed.

Lemma fold_left__intro: forall f (Huniq: uniqFdef f) l1 bs_contents l2 sts2
  r init,
  In l2 (ListSet.set_diff eq_atom_dec bs_contents [l1]) ->
  lookupBlockViaLabelFromFdef f l2 = ret sts2 ->
  fold_left (inscope_of_block f l1) bs_contents (Some init) = Some r ->
  incl (getStmtsIDs sts2) r.
Proof.
  induction bs_contents; simpl; intros.
    inv H.

    destruct (eq_atom_dec a l1); subst.
      remember (lookupBlockViaLabelFromFdef f l1) as R.
      destruct R; eauto.
        rewrite fold_left__none in H1. inv H1.

      apply ListSet.set_add_elim in H.
      destruct H as [H | H]; subst.
        rewrite H0 in H1.
        apply fold_left__init in H1.
        intros x J. apply H1. apply in_or_app. auto.

        remember (lookupBlockViaLabelFromFdef f a) as R.
        destruct R.
          eapply IHbs_contents in H1; eauto.
          rewrite fold_left__none in H1. inv H1.
Qed.

Lemma cmds_dominates_cmd_inscope_of_block__inscope_of_block: forall
  (f : fdef) (t : list atom) (l1 : l) (ps1 : phinodes) (cs1 : cmds)
  id1 (id2 : id) (HwfF : uniqFdef f)
  (bs_contents : ListSet.set atom)
  (l2 : l) (p : phinodes) (c2 : cmds) (t0 : terminator)
  (HeqR1 : ret (l2, stmts_intro p c2 t0) = lookupBlockViaIDFromFdef f id2)
  (J1 : In id1 (getPhiNodesIDs p ++ cmds_dominates_cmd c2 id2))
  sts2 (l2' : atom)
  (J13 : In l2' (ListSet.set_diff eq_atom_dec bs_contents [l1]))
  (J14 : lookupBlockViaLabelFromFdef f l2' = ret sts2)
  (J15 : In id2 (getStmtsIDs sts2)) init
  (HeqR' : fold_left (inscope_of_block f l1) bs_contents (ret init) = ret t),
  In id1 t.
Proof.
  intros.
  assert ((l2, stmts_intro p c2 t0) = (l2', sts2)) as EQ.
    clear - HwfF HeqR1 J14 J15.
    apply lookupBlockViaLabelFromFdef__blockInFdefB in J14; auto.
    eapply block_eq1 with (id0:=id2); eauto.
  inv EQ.
  assert (In id1 (getStmtsIDs (stmts_intro p c2 t0))) as Hin'.
    clear - J1. simpl. eapply cmds_dominates_cmd_spec'; eauto.
  apply fold_left__intro with (l2:=l2')(sts2:=stmts_intro p c2 t0) in HeqR';
    auto.
Qed.

Lemma in_getArgsIDsOfFdef__inscope_of_blocks_with_init: forall contents' F'
  ids2 init l1
  (Hinscope : fold_left (inscope_of_block F' l1) contents'
               (ret init) = ret ids2) id1
  (Hinc: incl (getArgsIDsOfFdef F') init)
  (Hin: In id1 (getArgsIDsOfFdef F')), In id1 ids2.
Proof.
  intros.
  apply fold_left__spec in Hinscope.
  destruct Hinscope as [Hinscope _]. auto.
Qed.

(* Properties of insnDominates *)
Lemma insnDominates_spec4 : forall b i0 insn2,
  insnDominates i0 insn2 b -> In i0 (getStmtsIDs (snd b)).
Proof.
  unfold insnDominates.
  destruct b as [? []]. intros.
  destruct insn2; tinv H.
    destruct H as [[ps1 [p1 [ps2 [J1 J2]]]] |
                   [cs1 [c1 [cs2 [cs3 [J1 J2]]]]]]; subst; simpl.
      solve_in_list.

      apply in_or_app.
      right. apply InGetCmdsIDs_middle'; auto.

    destruct H as [[[cs1 [c1 [cs2 [J1 J2]]]] |
                    [ps1 [p1 [ps2 [J1 J2]]]]] Heq]; subst; simpl.
      apply in_or_app.
      right. apply InGetCmdsIDs_middle'; auto.

      solve_in_list.
Qed.

Lemma insnDominates_spec3 : forall F b i0 insn2,
  uniqFdef F ->
  blockInFdefB b F = true ->
  insnDominates i0 insn2 b ->
  lookupBlockViaIDFromFdef F i0 = ret b.
Proof.
  intros.
  eapply inGetBlockIDs__lookupBlockViaIDFromFdef; eauto.
  apply insnDominates_spec4 in H1; auto.
Qed.

Lemma insnDominates_spec1 : forall c1 block',
  NoDup (getStmtsLocs (snd block')) -> insnInBlockB (insn_cmd c1) block' ->
  ~ insnDominates (getCmdLoc c1) (insn_cmd c1) block'.
Proof.
  intros. intro J.
  unfold insnDominates in J.
  destruct block' as [? []].
  destruct J as [[ps1 [p1 [ps2 [J1 J2]]]] | [cs1 [c2 [cs2 [cs3 [J1 J2]]]]]];
    subst; simpl in *.
    apply NoDup_disjoint with (i0:=getPhiNodeID p1) in H; auto.
      apply H. apply InGetPhiNodesIDs_middle.
      rewrite J2. apply getCmdLoc_in_getCmdsLocs'; auto.

    apply getCmdLoc_getCmdID in J2.
    apply NoDup_split in H. destruct H as [_ H].
    apply NoDup_split in H. destruct H as [H _].
    rewrite_env ((cs1 ++ c2 :: cs2) ++ c1 :: cs3) in H.
    rewrite getCmdsLocs_app in H.
    apply NoDup_disjoint with (i0:=getCmdLoc c2) in H; auto.
      apply H. apply InGetCmdsLocs_middle.
      rewrite J2. simpl. auto.
Qed.

Lemma insnDominates_spec2 : forall c1 c2 block',
  NoDup (getStmtsLocs (snd block')) ->
  insnInBlockB (insn_cmd c1) block' ->
  insnInBlockB (insn_cmd c2) block' ->
  insnDominates (getCmdLoc c1) (insn_cmd c2) block' ->
  ~ insnDominates (getCmdLoc c2) (insn_cmd c1) block'.
Proof.
  unfold insnDominates. destruct block' as [? []]. intros.
  destruct H2 as [[ps1 [p1 [ps2 [J1 J2]]]] | [cs1 [c2' [cs2 [cs3 [J1 J2]]]]]];
    subst; simpl in *.
    apply NoDup_disjoint with (i0:=getPhiNodeID p1) in H; auto.
      contradict H. apply InGetPhiNodesIDs_middle.
      rewrite J2. apply getCmdLoc_in_getCmdsLocs'; auto.

    intros J.
    destruct J as [[ps3 [p4 [ps5 [J3 J4]]]] | [cs3' [c3 [cs4 [cs5 [J3 J4]]]]]];
      subst.
      apply NoDup_disjoint with (i0:=getPhiNodeID p4) in H; auto.
        contradict H. apply InGetPhiNodesIDs_middle.
        rewrite J4. apply getCmdLoc_in_getCmdsLocs'; auto.

      apply getCmdLoc_getCmdID in J2.
      apply getCmdLoc_getCmdID in J4.
      apply NoDup_split in H. destruct H as [_ H].
      apply NoDup_split in H. destruct H as [H _].
      assert (H':=H).
      apply InCmdsB_in in H0.
      apply getCmdsLocs_uniq with (c1:=c1)(c2:=c2') in H; auto using in_middle.
      rewrite J3 in H'.
      assert (H'':=H').
      apply getCmdsLocs_uniq with (c1:=c2)(c2:=c3) in H'; auto using in_middle.
        subst.
        rewrite <- J3 in H''.
        rewrite_env ((cs1 ++ c2' :: cs2) ++ c3 :: cs3) in J3.
        rewrite_env ((cs1 ++ c2' :: cs2) ++ c3 :: cs3) in H''.
        apply in_middle_inv in J3; auto.
        destruct J3 as [Heq1 Heq2]; subst.
        rewrite getCmdsLocs_app in H''.
        apply NoDup_disjoint with (i0:=getCmdLoc c2') in H''; auto.
          contradict H''. apply InGetCmdsLocs_middle.
          rewrite_env ((c3 :: cs4) ++ c2' :: cs5). apply InGetCmdsLocs_middle.

        rewrite <- J3. rewrite_env ((cs1 ++ c2' :: cs2) ++ c2 :: cs3).
        auto using in_middle.
Qed.

Lemma insnDominates_spec5: forall F1 b c instr,
  uniqFdef F1 ->
  blockInFdefB b F1 ->
  insnDominates (getCmdLoc c) instr b ->
  lookupBlockViaIDFromFdef F1 (getCmdLoc c) = Some b.
Proof.
  intros. eapply insnDominates_spec3; eauto.
Qed.

Lemma cmds_dominates_cmd__insnDominates: forall F1 c1 l0 p c0 t c
  (Huniq : uniqFdef F1)
  (H : insnInFdefBlockB (insn_cmd c1) F1 (l0, stmts_intro p c0 t) = true)
  (Hin' : In c c0) (Hsome: getCmdID c1 <> None)
  (Hin : In (getCmdLoc c1)
          (getPhiNodesIDs p ++ cmds_dominates_cmd c0 (getCmdLoc c))),
  insnDominates (getCmdLoc c1) (insn_cmd c) (l0, stmts_intro p c0 t).
Proof.
  simpl. intros.
  apply in_app_or in Hin.
  apply andb_true_iff in H.
  destruct H as [J1 J2].
  apply uniqFdef__uniqBlockLocs in J2; auto.
  simpl in J2.
  destruct Hin as [Hin | Hin].
    apply NoDup_disjoint' with (i0:=getCmdLoc c1) in J2; auto.
    contradict J2. apply in_or_app.
    apply InCmdsB_InCmdsLocs in J1; auto.
    assert (J3:=Hin').
    apply getCmdLoc_in_getCmdsLocs in Hin'.
    apply cmds_dominates_cmd_inv in Hin; auto.
    destruct Hin as [cs1 [c2 [cs2 [Heq [Hin J]]]]]; subst.

    apply NoDup_split in J2. destruct J2 as [_ J2].
    apply NoDup_split in J2. destruct J2 as [J2 _].
    apply InCmdsB_in in J1.
    assert (J2':=J2).
    apply getCmdsLocs_uniq with (c1:=c)(c2:=c2) in J2'; auto using in_middle.
    subst.
    apply nodup_getCmdsLocs_in_first with (c1:=c1) in J2; auto.
    apply in_split in J2. destruct J2 as [cs3 [c0 cs4]]; subst.
    right.
    exists cs3. exists c1. exists c0. exists cs2.
    rewrite getCmdID_getCmdLoc; auto. simpl_env. split; auto.
Qed.

Lemma insnDominates_trans: forall id1 p c t id2 l1 instr f
  (G : ~ In id1 (getArgsIDsOfFdef f))
  (H : In id1 (init_scope f p c id2))
  (H3 : NoDup (getStmtsLocs (stmts_intro p c t)))
  (H1 : insnDominates id2 instr (l1, stmts_intro p c t)),
  insnDominates id1 instr (l1, stmts_intro p c t).
Proof.
  intros.
  unfold init_scope in H.
  destruct_if; try tauto.
  apply in_app_or in H.
  destruct H as [H | H]; simpl in *.
  Case "id1 in p".
    destruct instr; auto.
      left. apply in_getPhiNodesIDs_inv; auto.

      destruct H1 as [H1 Heq]; subst.
      split; auto.
      right. apply in_getPhiNodesIDs_inv; auto.

  apply in_app_or in H.
  destruct H as [H | H]; simpl in *; try tauto.
  Case "id1 in cs".
    destruct instr; auto.
    SCase "instr=cmd".
      right.
      destruct H1 as [[ps1 [p1 [ps2 [J1 J2]]]] |
                      [cs1 [c1 [cs2 [cs3 [J1 J2]]]]]]; subst; simpl.
      SSCase "p >> cmd".
        clear HeqR. contradict n. solve_in_list.
      SSCase "cmd >> cmd".
        split_NoDup.
        rewrite cmds_dominates_cmd_spec3 in H; eauto using getCmdID__getCmdLoc.
        apply in_getCmdsIDs_inv in H.
        destruct H as [cs6 [c3 [cs7 [J6 J7]]]]; subst.
        exists cs6. exists c3. exists (cs7 ++ c1 :: cs2). exists cs3.
        simpl_env. split; auto.

    SCase "instr=tmn".
      destruct H1 as [[[cs1 [c1 [cs2 [J1 J2]]]] |
                       [ps1 [p1 [ps2 [J1 J2]]]]] Heq]; subst; simpl.
      SSCase "cmd >> tmn".
        split_NoDup.
        rewrite cmds_dominates_cmd_spec3 in H; eauto using getCmdID__getCmdLoc.
        apply in_getCmdsIDs_inv in H.
        destruct H as [cs6 [c3 [cs7 [J6 J7]]]]; subst.
        split; auto. left.
        exists cs6. exists c3. exists (cs7 ++ c1 :: cs2).
        simpl_env. split; auto.
      SSCase "p >> tmn".
        clear HeqR. contradict n. solve_in_list.
Qed.

Lemma insnDominates_spec6: forall (l1 : l) (ps1 : phinodes) (cs1 : cmds)
  (tmn1 : terminator) (id1 : id) tl
  (J' : insnDominates id1 (insn_terminator tmn1) (l1, stmts_intro ps1 cs1 tmn1)),
  In id1 (getPhiNodesIDs ps1 ++ getCmdsIDs cs1 ++ tl).
Proof.
  intros.
  destruct J' as [J' _].
  destruct J' as [[cs2 [c1' [cs3 [J1 J2]]]] | [ps2 [p1 [ps3 [J1 J2]]]]];
    subst.
    rewrite getCmdsIDs_app. simpl. rewrite J2.
    apply in_or_app. right.
    apply in_or_app. left.
    apply in_or_app. right. simpl. auto.

    rewrite getPhiNodesIDs_app. simpl.
    apply in_or_app. left.
    apply in_or_app. right. simpl. auto.
Qed.

Lemma insnDominates_spec7: forall (l3 : l) (ps1 : phinodes) (tmn1 : terminator)
  (c : cmd) (c1 : cmd) (cs1 : list cmd) (cs2 : list cmd) (cs3 : list cmd)
  (H5 : insnDominates (getCmdLoc c) (insn_cmd c1)
         (l3, stmts_intro ps1 (cs1 ++ c1 :: cs2 ++ c :: cs3) tmn1))
  (Hnodup : NoDup
             (getStmtsLocs
                (stmts_intro ps1 (cs1 ++ c1 :: cs2 ++ c :: cs3) tmn1))),
  False.
Proof.
  intros.
  assert (In (getCmdLoc c)
     (getCmdsLocs (cs1 ++ c1 :: cs2 ++ c :: cs3) ++
      getTerminatorID tmn1 :: nil)) as Hin.
    solve_in_list.
  simpl in H5.
  destruct H5 as [[ps2 [p1 [ps3 [EQ1 EQ2]]]] |
                  [cs4 [c2 [cs5 [cs6 [EQ1 EQ2]]]]]]; subst.
    simpl in Hnodup.
    apply NoDup_disjoint with (i0:=getPhiNodeID p1) in Hnodup.
      contradict Hnodup.
      solve_in_list.
      rewrite EQ2. auto.

    apply getCmdID__getCmdLoc in EQ2.
    simpl in Hnodup.
    split_NoDup.
    assert (G:=Huniq1).
    apply NoDup_getCmdsLocs_prop with (c1:=c2)(c2:=c) in G; try solve
      [auto | solve_in_list | rewrite EQ1; solve_in_list].
    subst.
    rewrite_env ((cs1 ++ c1 :: cs2) ++ c :: cs3) in EQ1.
    rewrite_env ((cs1 ++ c1 :: cs2) ++ c :: cs3) in Huniq1.
    apply NoDup_cmds_split_middle in EQ1; auto.
    destruct EQ1; subst.
    simpl_env in Huniq1.
    rewrite getCmdsLocs_app in Huniq1.
    split_NoDup.
    inv Huniq3.
    apply H1. solve_in_list.
Qed.

(* Properties of idDominates *)
Lemma idDominates__lookupBlockViaIDFromFdef : forall f id1 id2
  (Huniq: uniqFdef f) (Hnotin: ~ In id1 (getArgsIDsOfFdef f)),
  idDominates f id1 id2 ->
  exists b1, lookupBlockViaIDFromFdef f id1 = ret b1.
Proof.
  intros.
  unfold idDominates in H.
  remember (lookupBlockViaIDFromFdef f id2) as R.
  destruct R; tinv H.
  remember (inscope_of_id f b id2) as R.
  destruct R; tinv H.
  unfold inscope_of_id in HeqR0.
  destruct b as [l1 [p c t]].
  destruct f as [[fa ty fid la va] bs].
  symmetry in HeqR0.
  apply fold_left__spec in HeqR0.
  destruct HeqR0 as [J1 [J2 J3]].
  apply J3 in H.
  destruct H as [H | [b2 [l2 [H1 [H2 H3]]]]].
    unfold init_scope in H.
    simpl in H.
    destruct_if; try tauto.
    exists (l1, stmts_intro p c t).
    symmetry in HeqR.
    apply lookupBlockViaIDFromFdef__blockInFdefB in HeqR.
    apply inGetBlockIDs__lookupBlockViaIDFromFdef; auto.
    simpl. eapply cmds_dominates_cmd_spec''; eauto.

    exists (l2, b2).
    apply lookupBlockViaLabelFromFdef__blockInFdefB in H2; auto.
    apply inGetBlockIDs__lookupBlockViaIDFromFdef; auto.
Qed.

Lemma idDominates__blockDominates : forall f b1 b2 id1 id2
  (Hdom : idDominates f id1 id2) (HuniqF: uniqFdef f)
  (Hnotin: ~ In id1 (getArgsIDsOfFdef f))
  (H : lookupBlockViaIDFromFdef f id2 = ret b2)
  (J : lookupBlockViaIDFromFdef f id1 = ret b1),
  blockDominates f b1 b2.
Proof.
  unfold idDominates, blockDominates in *. intros.
  rewrite H in Hdom.
  remember (inscope_of_id f b2 id2) as R2.
  destruct R2 as [lst|]; tinv Hdom.
  unfold inscope_of_id in *.
  destruct b1 as [l1 [p c t]].
  destruct b2 as [l2 [p0 c0 t0]].
  destruct f as [[fa ty fid la va] bs].
  symmetry in HeqR2.
  apply fold_left__spec in HeqR2.
  destruct HeqR2 as [J1 [J2 J3]].
  apply J3 in Hdom.
  destruct Hdom as [Hdom | [b1 [l1' [H4 [H5 H6]]]]].
    unfold init_scope in Hdom.
    destruct_if; try tauto.
    right.
    apply lookupBlockViaIDFromFdef__blockInFdefB in H.
    apply block_eq1 with (b2:=(l2, stmts_intro p0 c0 t0)) in J; eauto 1.
      inv J; auto.
      simpl. eapply cmds_dominates_cmd_spec''; eauto.

    left.
    assert (stmts_intro p c t = b1 /\ l1 = l1') as J'.
      destruct b1. apply lookupBlockViaLabelFromFdef_inv in H5; auto.
      clear - H6 J HuniqF H5.
      eapply block_eq1 in J; eauto. inv J; auto.
    destruct J'; subst.
    apply ListSet.set_diff_elim1 in H4; auto.
Qed.

Lemma idDominates__lookupTypViaIDFromFdef : forall f id1 id2 (Huniq: uniqFdef f),
  idDominates f id1 id2 ->
  exists t, lookupTypViaIDFromFdef f id1 = ret t.
Proof.
  unfold idDominates. intros.
  remember (lookupBlockViaIDFromFdef f id2) as R.
  destruct R; tinv H.
  remember (inscope_of_id f b id2) as R.
  destruct R; tinv H.
  unfold inscope_of_id in HeqR0.
  destruct b as [l1 [ps cs tmn]].
  destruct f as [[fa ty fid la va] bs].
  remember (AlgDom.sdom (fdef_intro (fheader_intro fa ty fid la va) bs)
               l1) as R0.
  symmetry in HeqR0.
  apply fold_left__spec in HeqR0.
  destruct HeqR0 as [J1 [J2 J3]].
  apply J3 in H.
  destruct H as [H | [b2 [l2 [H1 [H2 H3]]]]].
    unfold init_scope in H.
    destruct_if.
      eapply InArgsIDs_lookupTypViaIDFromFdef; eauto.

      symmetry in HeqR.
      apply lookupBlockViaIDFromFdef__blockInFdefB in HeqR.
      rewrite_env ((getPhiNodesIDs ps ++ cmds_dominates_cmd cs id2)
                   ++ getArgsIDs la) in H.
      apply in_app_or in H.
      destruct H as [H | H].
        eapply inGetBlockLocs__lookupTypViaIDFromFdef in HeqR; eauto.
        simpl.
        apply cmds_dominates_cmd_spec' in H.
          solve_in_list.

          eapply InArgsIDs_lookupTypViaIDFromFdef; eauto.

    apply lookupBlockViaLabelFromFdef__blockInFdefB in H2; auto.
    eapply inGetBlockLocs__lookupTypViaIDFromFdef in H2; eauto.
      solve_in_list.
Qed.

Lemma idDominates_insnDominates__blockDominates : forall f id1 id2 b1 b instr
  (Hnotin: ~ In id1 (getArgsIDsOfFdef f)),
  idDominates f id1 id2 ->
  lookupBlockViaIDFromFdef f id1 = ret b1 ->
  insnDominates id2 instr b ->
  blockInFdefB b f = true ->
  uniqFdef f ->
  blockDominates f b1 b.
Proof.
  intros. eapply idDominates__blockDominates; eauto.
  destruct b. eapply insnDominates_spec3 in H1; eauto.
Qed.

Lemma idDominates_insnDominates__insnDominates : forall f id1 id2 b instr
  (Hnotin: ~ In id1 (getArgsIDsOfFdef f))
  (H: idDominates f id1 id2)
  (H0: lookupBlockViaIDFromFdef f id1 = ret b)
  (H1: insnDominates id2 instr b)
  (H2: blockInFdefB b f = true)
  (H3: uniqFdef f),
  insnDominates id1 instr b.
Proof.
  intros.
  unfold idDominates in H.
  inv_mbind. symmetry_ctx.
  unfold inscope_of_id in *.
  destruct b0 as [l1 [p c t]].
  remember (AlgDom.sdom f l1) as R0.
  apply fold_left__spec in HeqR0.
  destruct HeqR0 as [J1 [J2 J3]].
  apply J3 in H.
  destruct H as [H | [b2 [l2 [H1' [H2' H3']]]]].
    assert (b = (l1, stmts_intro p c t)) as EQ.
      eapply block_eq1 with (id0:=id1); eauto 1.
        solve_blockInFdefB.

        unfold init_scope in H.
        destruct_if.
          clear HeqR0.
          contradict H. auto.

          simpl.
          eapply cmds_dominates_cmd_spec''; eauto.
    subst.
    eapply insnDominates_trans; eauto.
      solve_NoDup.

    eapply insnDominates_spec3 in H1; eauto.
    uniq_result.
    destruct b2 as [p0 c0 t0].
    apply lookupBlockViaLabelFromFdef_inv in H2'; auto.
    apply block_eq1 with (b2:=(l2, stmts_intro p0 c0 t0)) in H0; auto.
    inv H0.
    apply ListSet.set_diff_elim2 in H1'.
    contradict H1'; simpl; auto.
Qed.

Lemma idDominates_insnDominates__insnOrBlockStrictDominates :
forall f id1 id2 b1 b instr
  (Hnotin: ~ In id1 (getArgsIDsOfFdef f)),
  idDominates f id1 id2 ->
  lookupBlockViaIDFromFdef f id1 = ret b1 ->
  insnDominates id2 instr b ->
  blockInFdefB b f = true ->
  uniqFdef f ->
  insnDominates id1 instr b \/ blockStrictDominates f b1 b.
Proof.
  intros.
  assert (H1':=H1).
  eapply idDominates_insnDominates__blockDominates in H1; eauto.
  destruct b1 as [l0 [p c t]].
  destruct b as [l1 [p0 c0 t0]].
  destruct (l_dec l0 l1); subst.
    left.
    assert ((l1, stmts_intro p c t) = (l1, stmts_intro p0 c0 t0)) as EQ.
      apply lookupBlockViaIDFromFdef__blockInFdefB in H0.
      eapply blockInFdefB_uniq in H0; eauto.
      congruence.
    inv EQ.
    eapply idDominates_insnDominates__insnDominates in H0; eauto.

    right.
    unfold blockStrictDominates.
    unfold blockDominates in H1.
    destruct H1; subst; auto.
      congruence.
Qed.

Lemma inscope_of_id__idDominates : forall l0 f b2 id2 i0
  (HeqR0 : ret l0 = inscope_of_id f b2 id2) (Hin: In i0 l0)
  (Hlk : lookupBlockViaIDFromFdef f id2 = ret b2),
  idDominates f i0 id2.
Proof.
  intros. unfold idDominates. rewrite Hlk. rewrite <- HeqR0. auto.
Qed.

Lemma inscope_of_cmd__idDominates : forall l0 f b c i0
  (HeqR0 : ret l0 = inscope_of_cmd f b c) (Hin: In i0 l0)
  (Hsome: getCmdID c <> None) (Huniq: uniqFdef f)
  (HbInF: blockInFdefB b f = true) (HcInB: cmdInBlockB c b = true),
  idDominates f i0 (getCmdLoc c).
Proof.
  unfold inscope_of_cmd.
  intros.
  eapply inscope_of_id__idDominates in HeqR0; eauto.
  apply inGetBlockIDs__lookupBlockViaIDFromFdef; auto.
    solve_in_list.
Qed.

Lemma idDominates_dec: forall f id1 id2,
  idDominates f id1 id2 \/ ~ idDominates f id1 id2.
Proof.
  unfold idDominates.
  intros.
  destruct (lookupBlockViaIDFromFdef f id2); auto.
  destruct (inscope_of_id f b id2) as [l0|]; auto.
  destruct (In_dec l_dec id1 l0); auto.
Qed.

Lemma idDominates__lookupInsnViaIDFromFdef : forall f id1 id2 (Huniq: uniqFdef f)
  (Hdom: idDominates f id1 id2),
  exists instr2,
    lookupInsnViaIDFromFdef f id2 = Some instr2 /\ getInsnID instr2 = ret id2.
Proof.
  unfold idDominates.
  intros.
  inv_mbind. symmetry_ctx.
  apply lookupBlockViaIDFromFdef__lookupInsnViaIDFromFdef in HeqR; auto.
Qed.

Lemma idDominates__inscope_of_cmd: forall l0 ps0 cs tmn0 F c2 id1
  (HBinFB : blockInFdefB (l0, stmts_intro ps0 cs tmn0) F = true)
  (Hin : In c2 cs) (HuniqF: uniqFdef F)
  (Hdom: idDominates F id1 (getCmdLoc c2)) ids2
  (Hinscope: Some ids2 = inscope_of_cmd F (l0, stmts_intro ps0 cs tmn0) c2),
  In id1 ids2.
Proof.
  unfold idDominates, inscope_of_cmd.
  intros.
  inv_mbind. symmetry_ctx.
  assert ((l0, stmts_intro ps0 cs tmn0) = b) as EQ.
    solve_block_eq.
  subst. uniq_result. auto.
Qed.

(* Properties of block_in_scope *)
Lemma cmd_in_scope__block_in_scope: forall (l' : l) (F : fdef)
  (ids0' ids1 : list atom) (HuniqF : uniqFdef F) (contents' : ListSet.set atom)
  (Heqdefs' : contents' = AlgDom.sdom F l')
  (Hinscope : fold_left (inscope_of_block F l') contents' (ret ids1) = ret ids0')
  (id1 : atom) (Hid1 : In id1 ids0') (Hnotin' : ~ In id1 ids1) insn1
  (Hlkc1 : lookupInsnViaIDFromFdef F id1 = ret insn1)
  (l0 : l) s0
  (H : insnInFdefBlockB insn1 F (l0, s0) = true),
  In l0 contents'.
Proof.
  intros.
  apply fold_left__spec in Hinscope.
  destruct Hinscope as [_ [_ Hinscope]].
  apply Hinscope in Hid1.
  destruct Hid1 as [Hid1 | [b1 [l1 [J1 [J2 J3]]]]]; try congruence.
  eapply lookupBlockViaLabelFromFdef__lookupBlockViaIDFromFdef in J2;
    eauto.
  eapply lookupInsnViaIDFromFdef_lookupBlockViaIDFromFdef__getInsnID in Hlkc1;
    eauto; simpl; auto.
  eapply insnInFdefBlockB__lookupBlockViaIDFromFdef in H;
    try solve [eauto | congruence].
  erewrite getInsnID__getInsnLoc in H; eauto.
  uniq_result.
  apply ListSet.set_diff_elim1 in J1; auto.
Qed.

Lemma domination__block_in_scope: forall (l' : l) s'
  (F : fdef) (HwfF : uniqFdef F) (c1 : cmd) (i0 : atom)
  (l0 : l) s0
  (Hreachb1 : isReachableFromEntry F (l0, s0))
  (H5 : lookupBlockViaIDFromFdef F i0 = ret (l', s'))
  (H7 : insnDominates i0 (insn_cmd c1) (l0, s0) \/
        blockStrictDominates F (l', s')
          (l0, s0))
  (Hneq : l0 <> l')
  (HbInF0 : blockInFdefB (l0, s0) F = true),
  In l' (AlgDom.sdom F l0).
Proof.
  intros.
  destruct H7 as [H7 | H7]; try congruence.
    apply insnDominates_spec3 with (F:=F) in H7; auto.
    rewrite H7 in H5. inv H5. congruence.

    clear - H7.
    unfold blockStrictDominates in H7.
    destruct (AlgDom.sdom F l0); simpl; auto.
Qed.

(* Properties of inscope_of_cmd, inscope_of_tmn *)
Lemma inscope_of_cmd_tmn : forall f l2 ps2 cs2' c' tmn' ids1
(Huniq: NoDup (getStmtsLocs (stmts_intro ps2 (cs2'++[c']) tmn'))),
Some ids1 = inscope_of_cmd f (l2, stmts_intro ps2 (cs2'++[c']) tmn') c' ->
exists ids2,
  Some ids2 = inscope_of_tmn f (l2, stmts_intro ps2 (cs2'++[c']) tmn') tmn' /\
  match getCmdID c' with
  | Some id1 => set_eq (id1::ids1) ids2
  | None => set_eq ids1 ids2
  end.
Proof.
  intros f l2 ps2 cs2' c' tmn' ids1 Huniq Hinscope.
  unfold inscope_of_cmd, inscope_of_id, init_scope in Hinscope.
  assert (~ In (getCmdLoc c') (getCmdsLocs cs2') /\
          ~ In (getCmdLoc c') (getPhiNodesIDs ps2)) as Hnotin.
    simpl in Huniq.
    split.
      split_NoDup.
      solve_NoDup_notin.

      eapply NoDup_disjoint; eauto.
      apply in_or_app. left.
      solve_in_list.
  destruct Hnotin as [Hnotin Hnotin'].
  destruct_if; try tauto.
  unfold inscope_of_tmn.
  destruct f as [[f t i0 la va] bs].
  simpl in *.
  apply getCmdsIDs__cmds_dominates_cmd in Hnotin.
  symmetry in H0.
  remember (getCmdID c') as R.
  destruct R.
    apply fold_left__opt_union with (init2:=[i1]) in H0.
    destruct H0 as [r2 [Hinscope Heq]].
    apply fold_left__opt_set_eq with (init2:=((getPhiNodesIDs ps2) ++
      ((getCmdsIDs (cs2' ++ [c'])) ++ (getArgsIDs la)))) in Hinscope.
      destruct Hinscope as [r3 [Hinscope Heq']].
      exists r3.
      split; auto.
        simpl_env.
        eapply set_eq_trans with (y:=r2); eauto.
        eapply set_eq_trans with (y:=ids1 ++ [i1]); eauto.
          apply set_eq_swap.
      simpl_env.
      apply set_eq_app; auto using set_eq_refl.
      apply set_eq_trans with (y:=(cmds_dominates_cmd (cs2' ++ [c'])
         (getCmdLoc c') ++ [i1]) ++ getArgsIDs la).
        simpl_env.
        apply set_eq_app; auto using set_eq_refl.
          apply set_eq_swap.

        apply set_eq_app; auto using set_eq_refl.
          apply set_eq_sym; auto.

    apply fold_left__opt_set_eq with (init2:=((getPhiNodesIDs ps2) ++
      ((getCmdsIDs (cs2' ++ [c'])) ++ (getArgsIDs la)))) in H0.
      destruct H0 as [r3 [Hinscope Heq']].
      exists r3.
      split; auto.
      apply set_eq_app; auto using set_eq_refl.
      apply set_eq_app; auto using set_eq_refl.
      simpl_env in Hnotin.
      apply set_eq_sym; auto.
Qed.

Lemma inscope_of_cmd_cmd : forall f l2 ps2 cs2' c' c cs' tmn' ids1
(Huniq: NoDup (getStmtsLocs (stmts_intro ps2 (cs2'++[c']++[c]++cs') tmn')))
(Hinscope: Some ids1 =
           inscope_of_cmd f (l2, stmts_intro ps2 (cs2'++[c']++[c]++cs') tmn') c'),
exists ids2,
  Some ids2 =
    inscope_of_cmd f (l2, stmts_intro ps2 (cs2'++[c']++[c]++cs') tmn') c /\
  match getCmdID c' with
  | Some id1 => set_eq (id1::ids1) ids2
  | None => set_eq ids1 ids2
  end.
Proof.
  intros f l2 ps2 cs2' c' c cs' tmn' ids1 Huniq Hinscope.
  unfold inscope_of_cmd, inscope_of_id, init_scope in Hinscope.
  unfold inscope_of_cmd, inscope_of_id, init_scope.
  assert (NoDup (getCmdsLocs (cs2'++[c']++[c]++cs'))) as Hnodup.
    simpl in Huniq. split_NoDup. auto.
  assert (~ In (getCmdLoc c) (getPhiNodesIDs ps2) /\
          ~ In (getCmdLoc c') (getPhiNodesIDs ps2)) as Hnotin.
    simpl in Huniq.
    split; eapply NoDup_disjoint; try solve
             [eauto | apply in_or_app; left; solve_in_list].
  destruct_if; try tauto.
  destruct_if; try tauto. clear Hnotin.
  destruct f as [[f t i0 la va] bs].
  apply cmds_dominates_cmd__cmds_dominates_cmd in Hnodup. simpl in *.
  symmetry in H0.
  remember (getCmdID c') as R.
  destruct R.
    apply fold_left__opt_union with (init2:=[i1]) in H0.
    destruct H0 as [r2 [Hinscope Heq]].
    apply fold_left__opt_set_eq with (init2:=((getPhiNodesIDs ps2) ++
      ((cmds_dominates_cmd (cs2' ++ c' :: c :: cs') (getCmdLoc c)) ++
      (getArgsIDs la)))) in Hinscope.
      destruct Hinscope as [r3 [Hinscope Heq']].
      exists r3.
      split; auto.
        simpl_env.
        eapply set_eq_trans with (y:=r2); eauto.
        eapply set_eq_trans with (y:=ids1 ++ [i1]); eauto.
          apply set_eq_swap.
      simpl_env.
      apply set_eq_app; auto using set_eq_refl.
      apply set_eq_trans with (y:=(cmds_dominates_cmd (cs2' ++ [c']++[c]++cs')
         (getCmdLoc c') ++ [i1]) ++ getArgsIDs la).
        simpl_env.
        apply set_eq_app; auto using set_eq_refl.
          apply set_eq_swap.

        apply set_eq_app; auto using set_eq_refl.
          apply set_eq_sym; auto.

    apply fold_left__opt_set_eq with (init2:=((getPhiNodesIDs ps2) ++
      ((cmds_dominates_cmd (cs2' ++ c' :: c :: cs') (getCmdLoc c)) ++
      (getArgsIDs la)))) in H0.
      destruct H0 as [r3 [Hinscope Heq']].
      exists r3.
      split; auto.
      apply set_eq_app; auto using set_eq_refl.
      apply set_eq_app; auto using set_eq_refl.
      simpl_env in Hnodup.
      apply set_eq_sym; auto.
Qed.

Lemma inscope_of_tmn__inscope_of_cmd_at_beginning: forall f (l3 : l)
  (ps : phinodes) (cs : cmds)
  (tmn : terminator) (ids0 : list atom) (l' : l) (ps' : phinodes)
  (HBinF : blockInFdefB (l3, stmts_intro ps cs tmn) f = true)
  (contents3 : ListSet.set atom)
  init (Heq: init = getArgsIDsOfFdef f)
  (Hinscope : ret ids0 =
             fold_left (inscope_of_block f l3) contents3
               (ret (getPhiNodesIDs ps ++ getCmdsIDs cs ++ init)))
  (Huniq : uniqFdef f)
  (contents' : ListSet.set atom)
  (Hsub : incl contents' (l3 :: contents3))
  (r : list atom)
  (J1 : fold_left (inscope_of_block f l') contents'
         (ret (getPhiNodesIDs ps' ++ init)) = ret r),
  incl (ListSet.set_diff eq_atom_dec r (getPhiNodesIDs ps')) ids0.
Proof.
  intros.
  apply fold_left__spec in J1.
  symmetry in Hinscope.
  apply fold_left__spec in Hinscope.
  destruct J1 as [J1 [J2 J3]].
  destruct Hinscope as [J4 [J5 J6]].
  intros id1 J.
  assert (J':=J).
  apply ListSet.set_diff_elim1 in J.
  apply ListSet.set_diff_elim2 in J'.
  apply J3 in J.
  destruct J as [J | J].
  SCase "id1 in init and the current block".
    simpl in J.
    apply in_app_or in J.
    destruct J as [J | J]; try solve [contradict J; auto].
    apply J4.
    apply in_or_app. right.
    apply in_or_app; auto.
  SCase "id1 in strict dominating blocks".
    destruct J as [b1 [l1 [J8 [J9 J10]]]].
    assert (In l1 contents') as J8'.
      clear - J8.
      apply ListSet.set_diff_elim1 in J8. auto.
    apply Hsub in J8'.
      destruct (eq_atom_dec l1 l3); subst.
        simpl in J9.
        assert (b1=stmts_intro ps cs tmn) as EQ.
          clear - J9 HBinF Huniq.
          eapply blockInFdefB__lookupBlockViaLabelFromFdef; eauto.
        subst.
        simpl in J10.
        apply J4.
        rewrite_env
          ((getPhiNodesIDs ps ++ getCmdsIDs cs) ++ getArgsIDsOfFdef f).
        apply in_or_app; auto.

        apply J5 in J9; auto.
          simpl in J8'.
          destruct J8' as [J8' | J8']; try solve [contradict n; auto].
          apply ListSet.set_diff_intro; auto.
            intro J. simpl in J.
            destruct J as [J | J]; auto.
Qed.

Lemma cmds_dominates_cmd_inscope_of_cmd__inscope_of_cmd: forall
  (f : fdef) (t : list atom) (l1 : l) (ps1 : phinodes) (cs1 : cmds)
  (cs : cmds) (tmn1 : terminator) id1 (c : cmd) (id2 : id)
  (HwfF : uniqFdef f) (bs_contents : ListSet.set atom)
  (HbInF : blockInFdefB (l1, stmts_intro ps1 (cs1 ++ c :: cs) tmn1) f = true)
  (l2 : l) (p : phinodes) (c2 : cmds) (t0 : terminator)
  (HeqR1 : ret (l2, stmts_intro p c2 t0) = lookupBlockViaIDFromFdef f id2)
  init (Heq: init = getArgsIDsOfFdef f)
  (J1:In id1 (init_scope f p c2 id2)) (Hnotin: ~ In id1 init)
  instr0 (HeqR0 : ret instr0 = lookupInsnViaIDFromFdef f id2)
  (J12 : In id2
          (getPhiNodesIDs ps1 ++
           cmds_dominates_cmd (cs1 ++ c :: cs) (getCmdLoc c)))
  (HeqR' : fold_left (inscope_of_block f l1) bs_contents
             (ret (getPhiNodesIDs ps1 ++
                   cmds_dominates_cmd (cs1 ++ c :: cs) (getCmdLoc c) ++ init)) =
           ret t),
  In id1 t.
Proof.
  intros.
  assert ((l2, stmts_intro p c2 t0) =
          (l1, stmts_intro ps1 (cs1 ++ c :: cs) tmn1)) as EQ.
    eapply block_eq1 with (id0:=id2); eauto.
      simpl. eapply cmds_dominates_cmd_spec' with (id0:=getCmdLoc c); eauto.
  inv EQ.
  apply fold_left__init in HeqR'.
  apply HeqR'; auto.
    unfold init_scope in J1.
    destruct_if; try tauto.
    eapply cmds_dominates_cmd_trans; eauto.
      apply cmds_dominates_cmd_spec' in J12.
      solve_in_list.

      apply uniqFdef__uniqBlockLocs in HbInF; auto.
      simpl in HbInF.
      rewrite_env ((getPhiNodesIDs ps1 ++
         getCmdsLocs (cs1 ++ c :: cs)) ++ getTerminatorID tmn1 :: nil)
      in HbInF.
      apply NoDup_split in HbInF. destruct HbInF; auto.
Qed.

Lemma inscope_of_block_cmds_dominates_cmd__inscope_of_cmd: forall
  (f : fdef) (t : list atom) (l1 : l) (ps1 : phinodes) (cs1 : cmds) (cs : cmds)
  (tmn1 : terminator) id1 (c : cmd) (id2 : id) (HwfF : uniqFdef f)
  (bs_contents : ListSet.set atom)
  (HeqR3 : bs_contents = AlgDom.sdom f l1)
  (HbInF : blockInFdefB (l1, stmts_intro ps1 (cs1 ++ c :: cs) tmn1) f = true)
  (l2 : l) s2
  (HeqR1 : ret (l2, s2) = lookupBlockViaIDFromFdef f id2)
  (bs_contents0 : ListSet.set atom)
  (HeqR4 : bs_contents0 = AlgDom.sdom f l2)
  sts1 (l1' : atom)
  (J10 : In l1' (ListSet.set_diff eq_atom_dec bs_contents0 [l2]))
  (J11 : lookupBlockViaLabelFromFdef f l1' = ret sts1)
  (J11' : In id1 (getStmtsIDs sts1)) init
  (J12 : In id2
          (getPhiNodesIDs ps1 ++
           cmds_dominates_cmd (cs1 ++ c :: cs) (getCmdLoc c)))
  (HeqR' : fold_left (inscope_of_block f l1) bs_contents
            (ret (getPhiNodesIDs ps1 ++
                  cmds_dominates_cmd (cs1 ++ c :: cs) (getCmdLoc c) ++ init)) =
           ret t),
  In id1 t.
Proof.
  intros.
  assert ((l2, s2) = (l1, stmts_intro ps1 (cs1 ++ c :: cs) tmn1)) as EQ.
    eapply block_eq1 with (id0:=id2); eauto.
      simpl. eapply cmds_dominates_cmd_spec'; eauto.
  inv EQ.
  apply fold_left__intro with (l2:=l1')(sts2:=sts1) in HeqR'; auto.
Qed.

Lemma cmds_dominates_cmd_inscope_of_tmn__inscope_of_tmn: forall
  (f : fdef) (t : list atom) (l1 : l) (ps1 : phinodes) (cs1 : cmds)
  (tmn1 : terminator) id1 (id2 : id) (HwfF : uniqFdef f)
  (bs_contents : ListSet.set atom)
  (HbInF : blockInFdefB (l1, stmts_intro ps1 cs1 tmn1) f = true)
  (l2 : l) (p : phinodes) (c0 : cmds) (t0 : terminator)
  (HeqR1 : ret (l2, stmts_intro p c0 t0) = lookupBlockViaIDFromFdef f id2)
  (J1 : In id1 (getPhiNodesIDs p ++ cmds_dominates_cmd c0 id2))
  (J12 : In id2 (getPhiNodesIDs ps1 ++ getCmdsIDs cs1)) init
  (HeqR' : fold_left (inscope_of_block f l1) bs_contents
            (ret (getPhiNodesIDs ps1 ++ getCmdsIDs cs1 ++ init)) =
           ret t),
  In id1 t.
Proof.
  intros.
  assert ((l2, stmts_intro p c0 t0) = (l1, stmts_intro ps1 cs1 tmn1)) as EQ.
    eapply block_eq1 with (id0:=id2); eauto.
  inv EQ.
  apply fold_left__init in HeqR'.
  apply HeqR'; auto.
    eapply cmds_dominates_cmd_spec' in J1; eauto.
    solve_in_list.
Qed.

Lemma inscope_of_block_cmds_dominates_cmd__inscope_of_tmn: forall
  (f : fdef) (t : list atom) (l1 : l) (ps1 : phinodes) (cs1 : cmds)
  (tmn1 : terminator) id1 (id2 : id) (HwfF : uniqFdef f)
  (bs_contents : ListSet.set atom)
  (HeqR3 : bs_contents = AlgDom.sdom f l1)
  (HbInF : blockInFdefB (l1, stmts_intro ps1 cs1 tmn1) f = true)
  (l2 : l) s2
  (HeqR1 : ret (l2, s2) = lookupBlockViaIDFromFdef f id2)
  (bs_contents0 : ListSet.set atom)
  (HeqR4 : bs_contents0 = AlgDom.sdom f l2)
  sts1 (l1' : atom)
  (J10 : In l1' (ListSet.set_diff eq_atom_dec bs_contents0 [l2]))
  (J11 : lookupBlockViaLabelFromFdef f l1' = ret sts1)
  (J11' : In id1 (getStmtsIDs sts1))
  (J12 : In id2 (getPhiNodesIDs ps1 ++ getCmdsIDs cs1)) init
  (HeqR' : fold_left (inscope_of_block f l1) bs_contents
            (ret (getPhiNodesIDs ps1 ++ getCmdsIDs cs1 ++ init)) =
           ret t),
  In id1 t.
Proof.
  intros.
  assert ((l2, s2) = (l1, stmts_intro ps1 cs1 tmn1)) as EQ.
    eapply block_eq1 with (id0:=id2); eauto.
  inv EQ.
  apply fold_left__intro with (l2:=l1')(sts2:=sts1) in HeqR'; auto.
Qed.

Lemma In_cmds_dominates_cmd_fdef__getCmdID_eq_getCmdLoc: forall
  (F1 : fdef) id0 (Huniq : uniqFdef F1)
  (c1 : cmd) (l0 : l) (p : phinodes) (c0 : cmds)
  (Hin : In (getCmdLoc c1)
          (getPhiNodesIDs p ++ cmds_dominates_cmd c0 id0))
  (t : terminator)
  (H : insnInFdefBlockB (insn_cmd c1) F1 (l0, stmts_intro p c0 t) = true),
  getCmdID c1 = Some (getCmdLoc c1).
Proof.
  intros.
  simpl in H.
  bdestruct H as G1 G2. assert (G:=G2).
  assert (NoDup (getStmtsLocs (stmts_intro p c0 t))) as Huniq'.
    eapply uniqFdef__uniqBlockLocs in G; eauto.
  apply InCmdsB_in in G1.
  apply IngetCmdsIDs__lookupCmdViaIDFromFdef with (c1:=c1) in G2; auto.
  apply lookupCmdViaIDFromFdef_spec with (id2:=getCmdLoc c1) in G;
    eauto using cmds_dominates_cmd_spec0.
  assert (In (getCmdLoc c1) (cmds_dominates_cmd c0 id0)) as Hin'.
    apply in_app_or in Hin.
    destruct Hin as [Hin | Hin]; auto.
    simpl in Huniq'.
    eapply NoDup_disjoint' in Huniq'; eauto.
    contradict Huniq'. solve_in_list.
  apply cmds_dominates_cmd_spec in Hin'.
  apply In_getCmdsIDs__getCmdID_eq_getCmdLoc in Hin'; auto.
    simpl in Huniq'.
    apply NoDup_split in Huniq'.
    destruct Huniq' as [_ Huniq'].
    apply NoDup_split in Huniq'.
    destruct Huniq'. auto.
Qed.

Lemma inscope_of_cmd_at_beginning__idDominates__phinode : forall f l' contents'
  pid ids0 i0 ps' cs' tmn'
  (Heqdefs' : contents' = AlgDom.sdom f l')
  (Hinscope : fold_left (inscope_of_block f l') contents'
               (ret (getPhiNodesIDs ps' ++ getArgsIDsOfFdef f)) =
             ret ids0) (Hin1: In i0 ids0)
  (Huniq: uniqFdef f) (Hnotin: ~ In i0 (getPhiNodesIDs ps'))
  (Hin1: In pid (getPhiNodesIDs ps'))
  (Hlkup: ret stmts_intro ps' cs' tmn' = lookupBlockViaLabelFromFdef f l'),
  idDominates f i0 pid.
Proof.
  intros.
  unfold idDominates.
  assert (lookupBlockViaIDFromFdef f pid = Some (l', stmts_intro ps' cs' tmn'))
    as Hlkup'.
    apply inGetBlockIDs__lookupBlockViaIDFromFdef; auto.
      simpl. solve_in_list.
      solve_blockInFdefB.
  fill_ctxhole.
  unfold inscope_of_id, init_scope.
  destruct_if; try solve [contradict Hin0; auto].
  assert (exists r,
    fold_left (inscope_of_block f l') (AlgDom.sdom f l') (ret getArgsIDsOfFdef f)
      = Some r) as G.
    destruct f.
    apply fold_left__bound_blocks; auto using AlgDom.sdom_in_bound.
  destruct G as [r G]. rewrite G.
  apply fold_left__opt_union with (init2:=getPhiNodesIDs ps') in G.
  destruct G as [r' [G1 G2]].
  apply fold_left__opt_set_eq with
    (init2:=getPhiNodesIDs ps' ++ getArgsIDsOfFdef f) in G1;
    auto using AtomSet.set_eq_swap.
  destruct G1 as [r'' [G3 G1]].
  uniq_result.
  apply G1 in Hin1.
  apply G2 in Hin1.
  solve_in_list.
Qed.

(* Properties of inscope_of_id *)
Lemma inscope_of_id__total: forall f b id0, inscope_of_id f b id0 <> None.
Proof.
  unfold inscope_of_id.
  destruct f as [fh bs]. destruct b as [l5 [ps5 cs5 t5]].
  intros.
  assert (J:=AlgDom.sdom_in_bound fh bs l5).
  eapply fold_left__bound_blocks
    with (fh:=fh)(l0:=l5)(init:=init_scope (fdef_intro fh bs) ps5 cs5 id0)
    in J; eauto.
  destruct J. simpl. congruence.
Qed.

Lemma inscope_of_cmd__total: forall f b c0, inscope_of_cmd f b c0 <> None.
Proof.
  intros.
  apply inscope_of_id__total.
Qed.

Lemma inscope_of_id__append_cmds: forall l0 ps0 cs1 c2 cs3 c4 cs5 tmn0 l2 l4 f
  (Huniq: NoDup
           (getStmtsLocs
             (stmts_intro ps0 (cs1 ++ c2 :: cs3 ++ c4 :: cs5) tmn0)))
  (HeqR4 : ret l4 =
         inscope_of_id f
           (l0, stmts_intro ps0 (cs1 ++ c2 :: cs3 ++ c4 :: cs5) tmn0)
           (getCmdLoc c4))
  (HeqR2 : ret l2 =
         inscope_of_id f
           (l0, stmts_intro ps0 (cs1 ++ c2 :: cs3 ++ c4 :: cs5) tmn0)
           (getCmdLoc c2)),
  AtomSet.set_eq (l2 ++ getCmdsIDs (c2::cs3)) l4.
Proof.
  unfold inscope_of_id, init_scope.
  intros.
  assert (~ In (getCmdLoc c4) (getPhiNodesIDs ps0)) as Hin4.
    simpl in Huniq.
    eapply NoDup_disjoint; eauto.
    solve_in_list.
  assert (~ In (getCmdLoc c2) (getPhiNodesIDs ps0)) as Hin2.
    simpl in Huniq.
    eapply NoDup_disjoint; eauto.
    solve_in_list.
  destruct_if; try tauto.
  destruct_if; try tauto.
  simpl in Huniq. split_NoDup.
  rewrite cmds_dominates_cmd_spec3 in H0; auto.
  rewrite_env ((cs1 ++ c2 :: cs3) ++ c4 :: cs5) in H1.
  rewrite_env ((cs1 ++ c2 :: cs3) ++ c4 :: cs5) in Huniq.
  rewrite cmds_dominates_cmd_spec3 in H1; auto.
  rewrite getCmdsIDs_app in H1.
  symmetry_ctx.
  apply fold_left__opt_union with (init2:=getCmdsIDs (c2 :: cs3)) in H0.
  destruct H0 as [r2 [J1 J2]].
  apply fold_left__opt_set_eq with
    (init2:=getPhiNodesIDs ps0 ++
               (getCmdsIDs cs1 ++ getCmdsIDs (c2 :: cs3)) ++
               getArgsIDsOfFdef f) in J1; auto.
    destruct J1 as [r3 [J3 J4]].
    uniq_result.
    eapply AtomSet.set_eq_trans; eauto.

    simpl_env.
    apply AtomSet.set_eq_app; auto using AtomSet.set_eq_refl.
    apply AtomSet.set_eq_app; auto using AtomSet.set_eq_refl.
    auto using AtomSet.set_eq_swap.
Qed.

Lemma inscope_of_id__lookupInsnViaIDFromFdef: forall f b0 id0 ids0
  (HuniqF : uniqFdef f) (H : blockInFdefB b0 f = true) id1
  (HeqR : ret ids0 = inscope_of_id f b0 id1)
  (Hnargs : ~ In id0 (getArgsIDsOfFdef f))
  (Hin : In id0 ids0),
  exists instr, lookupInsnViaIDFromFdef f id0 = Some instr /\
                getInsnID instr = Some id0.
Proof.
  intros.
  destruct b0 as [l0 [ps0 cs0 t0]].
    simpl in HeqR.
    symmetry in HeqR.
    apply fold_left__spec in HeqR.
    destruct HeqR as [_ [_ HeqR]].
    apply_clear HeqR in Hin.
    destruct Hin as [Hin | Hin].
    SCase "1.1".
      apply init_scope_spec3 in Hin; auto.
      apply in_app_or in Hin.
      destruct Hin as [Hin | Hin].
      SSCase "1.1.1".
        apply in_getPhiNodesIDs_inv' in Hin.
        destruct Hin as [p [Hin HgetID]].
        assert (insnInFdefBlockB (insn_phinode p) f
                  (l0, stmts_intro ps0 cs0 t0)) as H'.
          apply insnInFdefBlockB_intro; auto.
            simpl. solve_in_list.
        apply IngetInsnsLocs__lookupInsnViaIDFromFdef in H'; auto.
        simpl in H'.
        rewrite HgetID in H'.
        subst. eauto.
      SSCase "1.1.2".
        apply cmds_dominates_cmd_spec in Hin.
        apply in_getCmdsIDs_inv' in Hin.
        destruct Hin as [c [Hin HgetID]].
        assert (insnInFdefBlockB (insn_cmd c) f
                  (l0, stmts_intro ps0 cs0 t0)) as H'.
          apply insnInFdefBlockB_intro; auto.
            simpl. solve_in_list.
        apply IngetInsnsLocs__lookupInsnViaIDFromFdef in H'; auto.
        simpl in H'.
        assert (HgetID' := HgetID).
        apply getCmdID__getCmdLoc in HgetID.
        rewrite HgetID in H'.
        subst. eauto.
    SCase "1.2".
      destruct Hin as [sts1 [l1 [Hin [Hlk Hin']]]].
      replace sts1 with (snd (l1, sts1)) in Hin'; auto.
      apply In_getStmtsIDs__insnInBlockB in Hin'.
      destruct Hin' as [instr' [J1 J5]].
      assert (insnInFdefBlockB instr' f (l1, sts1) = true) as G.
        apply insnInFdefBlockB_intro; auto.
          solve_blockInFdefB.
      apply IngetInsnsLocs__lookupInsnViaIDFromFdef in G; auto.
      assert (J5'':=J5).
      apply getInsnID__getInsnLoc in J5.
      rewrite J5 in G.
      eauto.
Qed.

Lemma inscope_of_cmd__lookupInsnViaIDFromFdef: forall f b0 id0 ids0 c0
  (HuniqF : uniqFdef f) (H : blockInFdefB b0 f = true)
  (HeqR : ret ids0 = inscope_of_cmd f b0 c0)
  (Hnargs : ~ In id0 (getArgsIDsOfFdef f))
  (Hin : In id0 ids0),
  exists instr, lookupInsnViaIDFromFdef f id0 = Some instr /\
                getInsnID instr = Some id0.
Proof.
  intros.
  destruct b0 as [l0 [ps0 cs0 t0]].
  eapply inscope_of_id__lookupInsnViaIDFromFdef; eauto.
Qed.

Lemma cannot_use_fake_store_id: forall f st0 b0 id0 ids0 c0
  (HuniqF : uniqFdef f) (H : blockInFdefB b0 f = true)
  (HeqR : ret ids0 = inscope_of_cmd f b0 c0)
  (Hin : In id0 ids0)
  (Hist: match st0 with
         | insn_store _ _ _ _ _ => True
         | _ => False
         end)
  (HbInF0 : lookupInsnViaIDFromFdef f id0 = ret insn_cmd st0),
  False.
Proof.
  intros.
  destruct st0; tinv Hist.
  assert (~ In id0 (getArgsIDsOfFdef f)) as Hnotin.
    solve_notin_getArgsIDs.
  eapply inscope_of_cmd__lookupInsnViaIDFromFdef in H; eauto.
  destruct H as [instr [H Hget]].
  uniq_result. inv Hget.
Qed.

(* Properties of blockDominates *)
Lemma blockDominates_refl: forall f b, blockDominates f b b.
Proof.
  unfold blockDominates.
  destruct b. auto.
Qed.

Lemma blockStrictDominates__non_empty_contents: forall (f : fdef)
  (b be : block) (Hentry_dom : blockStrictDominates f be b),
  AlgDom.sdom f (getBlockLabel b) <> nil.
Proof.
  intros.
  unfold blockStrictDominates in Hentry_dom.
  destruct be, b. simpl in *.
  intro EQ. rewrite EQ in Hentry_dom. tauto.
Qed.

(* id_in_reachable_block *)
Lemma block_id_in_reachable_block: forall (f : fdef) (id1 : atom) b
  (Huniq : uniqFdef f) (Hin: In id1 (getStmtsIDs (snd b)))
  (Hreach : isReachableFromEntry f b) (Hbinf : blockInFdefB b f),
  id_in_reachable_block f id1.
Proof.
  intros.
  intros b0 Hlkb0.
  assert (b0 = b) as EQ.
    eapply block_eq2 with (id1:=id1); eauto 1.
      solve_blockInFdefB. solve_in_list. solve_in_list.
  subst. auto.
Qed.

Lemma arg_id_in_reachable_block: forall f id1 (Huniq: uniqFdef f)
  (Hin : In id1 (getArgsIDsOfFdef f)),
  id_in_reachable_block f id1.
Proof.
  unfold id_in_reachable_block.
  intros.
  contradict Hin. solve_notin_getArgsIDs.
Qed.

(* Well-formed phinodes *)
Inductive wf_phi_operands (f:fdef) (b:block) (id0:id) (t0:typ) :
    list (value * l) -> Prop :=
| wf_phi_operands_nil : wf_phi_operands f b id0 t0 nil
| wf_phi_operands_cons_vid : forall vid1 l1 vls sts1,
    lookupBlockViaLabelFromFdef f l1 = Some sts1 ->
    (((exists vb, lookupBlockViaIDFromFdef f vid1 = Some vb /\
       blockDominates f vb (l1, sts1)) \/
      not (isReachableFromEntry f (l1, sts1))) \/
     In vid1 (getArgsIDsOfFdef f)) ->
    wf_phi_operands f b id0 t0 vls ->
    wf_phi_operands f b id0 t0 ((value_id vid1, l1) :: vls)
| wf_phi_operands_cons_vc : forall c1 l1 vls,
    wf_phi_operands f b id0 t0 vls ->
    wf_phi_operands f b id0 t0 ((value_const c1, l1) :: vls).

Definition check_list_value_l (f:fdef) (b:block) (vls: list (value * l)) :=
  let '(vs1,ls1) := List.split vls in
  let ls2 := (predecessors f) !!! (getBlockLabel b) in
  (length ls2 > 0)%nat /\
  AtomSet.set_eq ls1 ls2 /\
  NoDup ls1.

Definition wf_phinode (f:fdef) (b:block) (p:phinode) :=
let '(insn_phi id0 t0 vls0) := p in
wf_phi_operands f b id0 t0 vls0 /\ check_list_value_l f b vls0.


(** * Undecidability of the subtyping problem of System FsubF *)

Require Import Undecidability.Synthetic.Undecidability.

Require Import RM_undec FsubF.
Require Import Reductions.RM_HALT_to_FsubF.

Lemma FsubF_SUBTYPE_undec : undecidable FsubF_SUBTYPE.
Proof.
  apply (undecidability_from_reducibility RM_HALT_undec).
  exact RM_HALT_to_FsubF.reduction.
Qed.


(* *********************************************************************)
(*                                                                     *)
(*              The L2C verified compiler                              *)
(*                                                                     *)
(*            L2C Group, Tsinghua University                           *)
(*                                                                     *)
(*  Copyright Tsinghua University.  All rights reserved.  This file is *)
(*  distributed under the terms of the GNU General Public License as   *)
(*  published by the Free Software Foundation, either version 2 of the *)
(*  License, or (at your option) any later version.  This file is also *)
(*  distributed under the terms of the INRIA Non-Commercial License    *)
(*  Agreement.                                                         *)
(*                                                                     *)
(* *********************************************************************)

Require Import Coqlib.
Require Import Integers.
Require Import Floats.
Require Import Cop.
Require Import Ctypes.
Require Import Clop.
Require Import Cltypes.
Require Import Lvalues.
Require Import Ltypes.

(** The following [sem_] functions compute the result of an operator
  application.  The result depends on their run-time values.
  Unlike in C, automatic conversions are not performed. For instance,
  [e1 + e2] is undefined if [e1] is a float and [e2] an integer.
  The Lustre code must explicitly convert [e2] to a float. *)

Inductive unary_operationL : Type :=
  | Obool: unary_operationL              (**r convert to bool(signed Ibool bits) ([bool]) *)
  | Ochar: unary_operationL              (**r convert to char(signed I8 bits) ([char]) *)
  | Oshort : unary_operationL            (**r convert to short(signed 16 bits) ([short]) *)
  | Oint : unary_operationL              (**r convert to int(signed 32 bits) ([int]) *)
  | Ofloat : unary_operationL            (**r convert to float(32 bits) ([float]) *)
  | Oreal : unary_operationL             (**r convert to real(64 bits) ([real]) *)
  | Onot : unary_operationL              (**r boolean negation ([not]) *)
  | Opos : unary_operationL              (**r positive (unary [+]) *)
  | Oneg : unary_operationL.             (**r opposite (unary [-]) *)

Inductive binary_operationL : Type :=
  | Oadd : binary_operationL             (**r addition (binary [+]) *)
  | Osub : binary_operationL             (**r subtraction (binary [-]) *)
  | Omul : binary_operationL             (**r multiplication (binary [*]) *)
  | Odivreal : binary_operationL         (**r division real ([/]) *)
  | Odivint : binary_operationL          (**r division integer ([div]) *)
  | Omod : binary_operationL             (**r remainder ([mod]) *)
  | Oand : binary_operationL             (**r and ([and]) *)
  | Oor : binary_operationL              (**r or ([or]) *)
  | Oxor : binary_operationL             (**r xor ([xor]) *)
  | Oeq: binary_operationL               (**r comparison ([=]) *)
  | One: binary_operationL               (**r comparison ([<>]) *)
  | Olt: binary_operationL               (**r comparison ([<]) *)
  | Ogt: binary_operationL               (**r comparison ([>]) *)
  | Ole: binary_operationL               (**r comparison ([<=]) *)
  | Oge: binary_operationL.              (**r comparison ([>=]) *)

Definition of_bool (b: bool): val := if b then Vtrue else Vfalse.

Function bool_val (v: val) (t: type) : option bool :=
  match v, t with
  | Vint n, Tint _ _ => Some (negb (Int.eq n Int.zero))
  | _, _ => None
  end.

Function sem_neg (v: val) (ty: type): option val :=
  match v, ty with
  | Vint n, Tint _ _ => Some (Vint (Int.neg n))
  | Vfloat f, Tfloat F64 => Some (Vfloat (Float.neg f))
  | Vsingle f, Tfloat F32 => Some (Vsingle (Float32.neg f))
  | _, _ => None
  end.

Function sem_notbool (v: val) (ty: type): option val :=
  match v, ty with
  | Vint n, Tint IBool _ => Some (of_bool (Int.eq n Int.zero))
  | _, _ => None
  end.

Function sem_add (v1 v2: val) (ty: type): option val :=
  match v1, v2, ty with
  | Vint n1, Vint n2, Tint _ _ => Some (Vint (Int.add n1 n2))
  | Vfloat f1, Vfloat f2, Tfloat F64 => Some (Vfloat (Float.add f1 f2))
  | Vsingle f1, Vsingle f2, Tfloat F32 => Some(Vsingle(Float32.add f1 f2))
  | _, _, _ => None
  end.

Function sem_sub (v1 v2: val) (ty: type): option val :=
  match v1, v2, ty with
  | Vint n1,  Vint n2, Tint _ _ => Some (Vint (Int.sub n1 n2))
  | Vfloat f1, Vfloat f2, Tfloat F64 => Some (Vfloat(Float.sub f1 f2))
  | Vsingle f1, Vsingle f2, Tfloat F32 => Some(Vsingle(Float32.sub f1 f2))
  | _, _, _=> None
  end.

Function sem_mul (v1 v2: val) (ty: type): option val :=
  match v1, v2, ty with
  | Vint n1, Vint n2, Tint _ _ => Some (Vint (Int.mul n1 n2))
  | Vfloat f1, Vfloat f2, Tfloat F64 => Some (Vfloat (Float.mul f1 f2))
  | Vsingle f1, Vsingle f2, Tfloat F32 => Some(Vsingle(Float32.mul f1 f2))
  | _, _, _ => None
  end.

Definition div_sign(n1 n2: int)(sz: intsize)(sg: signedness): option val :=
  match sz, sg with
  | I32, Unsigned =>
     if Int.eq n2 Int.zero
     then None else Some(Vint(Int.divu n1 n2))
  | _, _ =>
     if Int.eq n2 Int.zero
     || Int.eq n1 (Int.repr Int.min_signed) && Int.eq n2 Int.mone
     then None else Some(Vint(Int.divs n1 n2))
  end.

Function sem_div (v1 v2: val) (ty: type): option val :=
  match v1, v2, ty with
  | Vint n1, Vint n2, Tint sz sg => div_sign n1 n2 sz sg
  | Vfloat f1, Vfloat f2, Tfloat F64 => Some (Vfloat(Float.div f1 f2))
  | Vsingle f1, Vsingle f2, Tfloat F32 => Some(Vsingle(Float32.div f1 f2))
  | _, _, _ => None
  end.

Definition mod_sign(n1 n2: int)(sz: intsize)(sg: signedness): option val :=
  match sz, sg with
  | I32, Unsigned =>
     if Int.eq n2 Int.zero
     then None else Some(Vint(Int.modu n1 n2))
  | _, _ =>
     if Int.eq n2 Int.zero
     || Int.eq n1 (Int.repr Int.min_signed) && Int.eq n2 Int.mone
     then None else Some(Vint(Int.mods n1 n2))
  end.

Function sem_mod (v1 v2: val) (ty: type): option val :=
  match v1, v2, ty with
  | Vint n1, Vint n2, Tint sz sg => mod_sign n1 n2 sz sg
  | _, _, _=> None
  end.

Function sem_and (v1 v2: val) (ty: type): option val :=
  match v1, v2, ty with
  | Vint n1, Vint n2, Tint _ _ => Some (Vint (Int.and n1 n2))
  | _, _, _ => None
  end.

Function sem_or (v1 v2: val) (ty: type) : option val :=
  match v1, v2, ty with
  | Vint n1, Vint n2, Tint _ _ => Some (Vint (Int.or n1 n2))
  | _, _, _ => None
  end.

Function sem_xor (v1 v2: val) (ty: type): option val :=
  match v1, v2, ty with
  | Vint n1, Vint n2, Tint _ _ => Some (Vint (Int.xor n1 n2))
  | _, _, _ => None
  end.

Definition cmp_sign(op: comparison)(n1 n2: int)(sz: intsize)(sg: signedness): bool :=
  match sz, sg with
  | I32, Unsigned => Int.cmpu op n1 n2
  | _, _ => Int.cmp op n1 n2
  end.

Function sem_cmp (op: comparison) (v1 v2: val) (ty: type): option val :=
  match v1, v2, ty with
  | Vint n1, Vint n2, Tint sz sg => Some (of_bool (cmp_sign op n1 n2 sz sg))
  | Vfloat f1, Vfloat f2, Tfloat F64 => Some (of_bool (Float.cmp op f1 f2))
  | Vsingle f1, Vsingle f2, Tfloat F32 => Some(of_bool (Float32.cmp op f1 f2))
  | _, _, _ => None
  end.

Function classify_cast (tfrom tto: type) : classify_cast_cases :=
  match tto, tfrom with
  | Tint IBool _, Tfloat _ => cast_case_default
  | Tint sz2 si2, Tint sz1 si1 => cast_case_i2i sz2 si2
  | Tint sz2 si2, Tfloat F64 => cast_case_f2i sz2 si2
  | Tint sz2 si2, Tfloat F32 => cast_case_s2i sz2 si2
  | Tfloat F64, Tfloat F64 => cast_case_f2f
  | Tfloat F32, Tfloat F32 => cast_case_s2s
  | Tfloat F64, Tfloat F32 => cast_case_s2f
  | Tfloat F32, Tfloat F64 => cast_case_f2s
  | Tfloat F64, Tint sz1 si1 => cast_case_i2f si1
  | Tfloat F32, Tint sz1 si1 => cast_case_i2s si1
  | _, _ => cast_case_default
  end.

Definition sem_cast(v: val)(t1 t2: type): option val :=
  match classify_cast t1 t2 with
  | cast_case_i2i sz2 si2 =>
      match v with
      | Vint i => Some (Vint (cast_int_int sz2 si2 i))
      | _ => None
      end
  | cast_case_f2f =>
      match v with
      | Vfloat f => Some (Vfloat f)
      | _ => None
      end
  | cast_case_s2s =>
      match v with
      | Vsingle f => Some (Vsingle f)
      | _ => None
      end
  | cast_case_s2f =>
      match v with
      | Vsingle f => Some (Vfloat (Float.of_single f))
      | _ => None
      end
  | cast_case_f2s =>
      match v with
      | Vfloat f => Some (Vsingle (Float.to_single f))
      | _ => None
      end
  | cast_case_i2f si1 =>
      match v with
      | Vint i => Some (Vfloat (cast_int_float si1 i))
      | _ => None
      end
  | cast_case_i2s si1 =>
      match v with
      | Vint i => Some (Vsingle (cast_int_single si1 i))
      | _ => None
      end
  | cast_case_f2i sz2 si2 =>
      match v with
      | Vfloat f =>
          match cast_float_int si2 f with
          | Some i => Some (Vint (cast_int_int sz2 si2 i))
          | None => None
          end
      | _ => None
      end
  | cast_case_s2i sz2 si2 =>
      match v with
      | Vsingle f =>
          match cast_single_int si2 f with
          | Some i => Some (Vint (cast_int_int sz2 si2 i))
          | None => None
          end
      | _ => None
      end
  | _ => None
  end.

Definition sem_unary_operation (op: unary_operation) (v: val) (ty: type): option val :=
  match op with
  | Onotbool => sem_notbool v ty
  | Cop.Oneg => sem_neg v ty
  | Onotint => None
  | Oabsfloat => None
  end.

Inductive classify_binop_case: Type :=
  | binop_case_normal
  | binop_case_divint
  | binop_case_divreal.

Definition classify_binop(ty: type)(op: binary_operationL) :=
  match op with
  | Odivint =>
    match ty with
    | Tint I32 Signed => binop_case_normal
    | _ => binop_case_divint
    end
  | Odivreal =>
    match ty with
    | Tfloat _ => binop_case_normal
    | _ =>  binop_case_divreal
    end
  | _ => binop_case_normal
  end.

Definition sem_div_operation(op: binary_operationL)(v1 v2: val)(t tto: type): option val :=
  match classify_binop t op with
  | binop_case_normal => sem_div v1 v2 t
  | binop_case_divint =>
    match sem_div v1 v2 t with
    | Some v => sem_cast v t tto
    | None => None
    end
  | binop_case_divreal =>
    match (sem_cast v1 t (Tfloat F64)), (sem_cast v2 t (Tfloat F64)) with
    | Some v1', Some v2' => sem_div v1' v2' (Tfloat F64)
    | _, _ => None
    end
  end.

Definition sem_binary_operation (op: binary_operationL) (v1 v2: val)(t tto: type) : option val :=
  match op with
  | Oadd => sem_add v1 v2 t
  | Osub => sem_sub v1 v2 t
  | Omul => sem_mul v1 v2 t
  | Odivint => sem_div_operation Odivint v1 v2 t tto
  | Odivreal => sem_div_operation Odivreal v1 v2 t tto
  | Omod => sem_mod v1 v2 t
  | Oand => sem_and v1 v2 t
  | Oor => sem_or v1 v2 t
  | Oxor => sem_xor v1 v2 t
  | Oeq => sem_cmp Ceq v1 v2 t
  | One => sem_cmp Cne v1 v2 t
  | Olt => sem_cmp Clt v1 v2 t
  | Ogt => sem_cmp Cgt v1 v2 t
  | Ole => sem_cmp Cle v1 v2 t
  | Oge => sem_cmp Cge v1 v2 t
  end.

Fixpoint sem_fold_operation (op: binary_operationL)
    (ty: type) (v: val) (vl: list val): option val :=
  match vl with
  | nil => Some v
  | cons v1 vl1 =>
    match (sem_binary_operation op v v1 ty ty) with
    | Some v2 => sem_fold_operation op ty v2 vl1
    | None => None
    end
  end.

Lemma sem_unary_operation_not_mvl:
  forall op v1 t m,
  sem_unary_operation op v1 t = Some (Vmvl m) -> False.
Proof.
  destruct op; destruct v1; destruct t; intros; inv H.
  destruct i0; inv H1.
  destruct (Int.eq i Int.zero); inv H0.
  destruct f0; congruence.
  destruct f0; congruence.
Qed.

Lemma sem_div_not_mvl:
  forall v1 v2 t m,
  sem_div v1 v2 t = Some (Vmvl m) -> False.
Proof.
  intros. destruct v1,v2,t; inv H.
  destruct i1, s; intros; inv H1;
  destruct (Int.eq i0 Int.zero || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone); inv H0;
  destruct (Int.eq i0 Int.zero); inv H1.
  destruct f1; congruence.
  destruct f1; congruence.
Qed.

Lemma sem_cast_not_mvl:
  forall v1 t ty m,
  sem_cast v1 t ty = Some (Vmvl m) -> False.
Proof.
  unfold sem_cast. intros.
  destruct (classify_cast _ _); try congruence;
  destruct v1; try congruence.
  destruct (cast_float_int _ _); congruence.
  destruct (cast_single_int _ _); congruence.
Qed.

Lemma sem_div_operation_not_mvl:
  forall op v1 v2 t tto m,
  sem_div_operation op v1 v2 t tto = Some (Vmvl m) -> False.
Proof.
  unfold sem_div_operation. intros.
  destruct (classify_binop _ _); try congruence.
  +eapply sem_div_not_mvl; eauto.
  +destruct (sem_div _ _ _); try congruence.
   eapply sem_cast_not_mvl; eauto.
  +destruct (sem_cast v1 _ _); try congruence.
   destruct (sem_cast v2 _ _); try congruence.
   eapply sem_div_not_mvl; eauto.
Qed.

Lemma sem_cmp_not_mvl:
  forall op v1 v2 t m,
  sem_cmp op v1 v2 t = Some (Vmvl m) -> False.
Proof.
  destruct op, v1,v2,t; intros; inv H;
  try (destruct (cmp_sign _ _ _ _ _); inv H1; fail);
  destruct f1; try congruence;
  try destruct (Floats.Float.cmp _ _ _); inv H1;
  destruct (Floats.Float32.cmp _ _ _); inv H0.
Qed.

Lemma sem_binary_operation_not_mvl:
  forall op v1 v2 t tto m,
  sem_binary_operation op v1 v2 t tto = Some (Vmvl m) -> False.
Proof.
  destruct op; simpl; intros;
  try (destruct v1, v2, t; inv H;destruct f1; congruence; fail);
  try (eapply sem_cmp_not_mvl; eauto; fail).
  +eapply sem_div_operation_not_mvl; eauto.
  +eapply sem_div_operation_not_mvl; eauto.
  +destruct v1,v2,t; inv H.
   destruct i1; destruct s; inv H1;
    destruct (Int.eq i0 Int.zero || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone); inv H0;
    destruct (Int.eq i0 Int.zero); inv H1.
Qed.

Lemma sem_binary_operation_has_type:
  forall op v1 v2 ty tto v,
  sem_binary_operation op v1 v2 ty tto = Some v ->
  has_type v1 ty.
Proof.
  unfold has_type.
  destruct op, v1, v2, ty; simpl; intros; try inv H; auto;
  unfold sem_div_operation in *; simpl in *;
  try (destruct f1; inv H1; auto; fail);
  try (destruct i0,s; congruence; fail);
  try (destruct i,s; congruence; fail).
Qed.

Lemma sem_fold_operation_has_type:
  forall vl op ty v v1,
  sem_fold_operation op ty v vl = Some v1 ->
  has_type v1 ty ->
  has_type v ty.
Proof.
  destruct vl; simpl; intros.
  inv H. auto.
  destruct (sem_binary_operation _ _ _ _ _) eqn:?; try congruence.
  eapply sem_binary_operation_has_type; eauto.
Qed.

Lemma sem_binary_by_value:
  forall op v1 v2 v t1 t2 tto,
  sem_binary_operation op v1 v2 t1 tto = Some v ->
  has_type v t2 ->
  exists chunk, access_mode t2 = By_value chunk.
Proof.
  intros. destruct v,t2; try tauto; simpl; eauto.
  +destruct i0, s; eauto.
  +destruct f0; eauto.
  +destruct f0; eauto.
  +eapply sem_binary_operation_not_mvl in H; tauto.
  +eapply sem_binary_operation_not_mvl in H; tauto.
Qed.

Lemma sem_fold_operation_by_value:
  forall op v1 v2 v t l,
  sem_fold_operation op t v1 (v2::l)  = Some v ->
  has_type v t ->
  exists chunk, access_mode t = By_value chunk.
Proof.
  intros. inv H.
  destruct (sem_binary_operation _ _ _ _ _) eqn:?; try congruence.
  eapply sem_binary_by_value; eauto.
  eapply sem_fold_operation_has_type; eauto.
Qed.

Lemma sem_unary_by_value:
  forall op v1 v t1 t2,
  sem_unary_operation op v1 t1 = Some v ->
  has_type v t2 ->
  exists chunk, access_mode t2 = By_value chunk.
Proof.
  intros. destruct v,t2; try tauto; simpl; eauto.
  +destruct i0, s; eauto.
  +destruct f0; eauto.
  +destruct f0; eauto.
  +eapply sem_unary_operation_not_mvl in H; tauto.
  +eapply sem_unary_operation_not_mvl in H; tauto.
Qed.

Lemma sem_cast_by_value:
  forall v1 v t1 t2,
  sem_cast v1 t1 t2 = Some v ->
  exists chunk, access_mode t2 = By_value chunk.
Proof.
  unfold sem_cast, classify_cast. intros.
  destruct t1, t2; try congruence;
  try (destruct i; congruence; fail);
  try (destruct i0; congruence; fail);
  try (destruct f; congruence; fail); simpl.
  +destruct i0,s0; eauto.
  +destruct f; eauto.
  +destruct i,s; eauto.
  +destruct f0; eauto.
  +destruct f0; eauto.
Qed.