Lvc.Liveness.LivenessAnalysisCorrect

Require Import CSet Le Var.

Require Import Plus Util AllInRel Map CSet.
Require Import Val Var Envs IL Annotation Infra.Lattice DecSolve Analysis Filter Terminating.
Require Import Analysis AnalysisBackward LivenessAnalysis TrueLiveness Subterm.
Require Import FiniteFixpointIteration.

Set Implicit Arguments.

Local Arguments proj1_sig {A} {P} e.
Local Arguments length {A} e.
Local Arguments backward {sT} {Dom} btransform ZL AL st {ST} a.

Definition liveness_analysis_correct (i:overapproximation) sT ZL LV s a (ST:subTerm s sT)
  : ann_R poEq (@backward _ _ (liveness_transform_dep i) ZL LV s ST a) a
     annotation s a
     labelsDefined s (length ZL)
     labelsDefined s (length LV)
     paramsMatch s (length ZL)
     true_live_sound i ZL (proj1_sig LV) s
                      (mapAnn proj1_sig a).
Proof.
  intros EQ Ann DefZL DefLV PM.
  general induction Ann; simpl in *; inv DefZL; inv DefLV; inv PM; destruct a;
    clear_trivial_eqs.
  - pose proof (ann_R_get ); simpl in ×.
    econstructor.
    + eapply IHAnn; eauto.
    + intros.
      rewrite getAnn_mapAnn in .
      rewrite H in .
      cases in .
      eapply live_exp_sound_incl; [eapply Exp.live_freeVars|].
      rewrite . eapply incl_right.
    + intros.
      rewrite .
      simpl. rewrite getAnn_mapAnn.
      eapply incl_union_left.
      rewrite H. reflexivity.
  - econstructor; intros.
    + eapply ; eauto.
    + eapply ; eauto.
    + repeat cases in ; try congruence.
      eapply live_op_sound_incl; [eapply Ops.live_freeVars|].
      simpl. rewrite . eauto with cset.
    + rewrite getAnn_mapAnn. simpl.
      rewrite .
      eapply ann_R_get in . rewrite .
      eauto with cset.
    + rewrite getAnn_mapAnn. simpl.
      rewrite .
      eapply ann_R_get in . rewrite .
      eauto with cset.
  - edestruct (get_in_range _ ) as [Z ?]; eauto.
    edestruct (get_in_range _ ) as [[Lv ?] ?]; eauto.
    econstructor; eauto.
    + simpl. cases; eauto. rewrite .
      repeat erewrite get_nth; eauto.
      eapply incl_left.
    + simpl in ×.
      erewrite get_nth in ; eauto using map_get_1.
      erewrite get_nth in ; eauto. simpl in ×.
      eapply filter_by_incl_argsLive; eauto.
      inv_get; eauto.
      rewrite ; eauto with cset.
    + inv_get; eauto.
  - econstructor.
    simpl in ×. rewrite . eapply Ops.live_freeVars.
  - simpl in ×.
    econstructor.
    + rewrite map_map.
      erewrite map_ext with (l:=sa);[| intros; rewrite getAnn_mapAnn; reflexivity].
      rewrite map_map with (l:=sa). rewrite List.map_app.
      eapply (IHAnn i (fst s ZL) (getAnn sa LV)
             (subTerm_EQ_Fun1 eq_refl ST)); eauto.
      etransitivity; eauto.
      refine (@backward_ext sT (fun s{ x : var | x occurVars s}) _
                            (liveness_transform_dep i)
                            (@liveness_transform_dep_ext i sT) _ _ _ _ _ _ _ _ _ _); eauto.
      eapply PIR2_app; eauto.
      eapply PIR2_get.
      × intros; inv_get.
        exploit ; eauto.
      × len_simpl; eauto.
    + rewrite map_length. eauto.
    + intros. inv_get.
      rewrite map_map.
      erewrite map_ext with (l:=sa);[| intros; rewrite getAnn_mapAnn; reflexivity].
      rewrite map_map with (l:=sa). rewrite List.map_app.
      edestruct (@get_backwardF sT _ (@backward _ (fun : stmt{ : var | occurVars })
                                                (liveness_transform_dep i))); eauto.
      eapply ( _ _ _ i (fst s ZL) (getAnn sa LV) ); eauto.
    + intros. inv_get. cases; eauto.
      rewrite . eapply incl_union_left.
      edestruct (@get_backwardF sT _ (@backward _ (fun : stmt{ : var | occurVars })
                                                (liveness_transform_dep i))); eauto.
      exploit ; eauto.
      eapply incl_list_union. eapply zip_get. eapply Take.get_take; eauto using get_range.
      eapply map_get_1. eapply get_app_lt; eauto with len.
      eapply Take.get_take; eauto using get_range. eapply get_app_lt; eauto with len.
      rewrite getAnn_mapAnn.
      eapply ann_R_get in .
      eapply SigR.sig_R_proj1_sig in .
      rewrite . eauto.
    + rewrite getAnn_mapAnn.
      eapply ann_R_get in .
      rewrite .
      rewrite . cases; eauto with cset.
Qed.


Definition correct i s
  : paramsMatch s nil
     true_live_sound i nil nil s (livenessAnalysis i s).
Proof.
  intros.
  unfold livenessAnalysis.
  destr_sig. destr_sig. dcr.
  eapply (@liveness_analysis_correct i s nil nil s); eauto.
  eapply .
Qed.


(* For now, settle for occur vars;
   TODO: Show that the fixpoint is contained in freeVars (and union of Lv) *)

Lemma livenessAnalysis_getAnn i s
  : getAnn (livenessAnalysis i s) occurVars s.
Proof.
  unfold livenessAnalysis. repeat destr_sig.
  rewrite getAnn_mapAnn. destr_sig; eauto.
Qed.


Require Import RenamedApart.

Lemma extend_incl sT ZL LV D Dt s ans sa
      (IFC:Indexwise.indexwise_R (funConstr D Dt) s ans)
      (Len: s = sa) ( : s = ans)
      (LE: (n : ) (a : ann var) (b : ann (var × var)),
          get (mapAnn proj1_sig sa) n a
          get ans n b ann_R (fun (x : var) (y : var × var) ⇒ x fst y) a b)
      (BND : (n : ) (lv : {X : var | X occurVars sT}) (Z : params),
          get ZL n Z get LV n lv proj1_sig lv \ of_list Z D)
  : n , get sa n get ans n ( : ) (lv : {X : var | X occurVars sT}) (Z : params),
                   get (fst s ZL) Z get (getAnn sa LV) lv
                    proj1_sig lv \ of_list Z fst (getAnn ).
  intros ? ? ? ? ? ? .
  eapply get_app_cases in ; len_simpl; destruct ; dcr; inv_get.
  - edestruct IFC; eauto; dcr. rewrite .
    exploit LE as GET; eauto.
    eapply ann_R_get in GET. rewrite getAnn_mapAnn in GET.
    rewrite GET.
    edestruct IFC; try eapply ; eauto; dcr.
    rewrite .
    clear; cset_tac.
  - rewrite get_app_ge in ; len_simpl; try rewrite Len in *; eauto with len.
    exploit BND; eauto.
    rewrite .
    edestruct IFC; eauto; dcr.
    rewrite . eauto with cset.
Qed.

Lemma extend_incl' i sT s t (ST:subTerm (stmtFun s t) sT) ZL LV D Dt ans sa
      (IFC:Indexwise.indexwise_R (funConstr D Dt) s ans)
      (Len: s = sa) ( : s = ans)
      (LE: (n : ) (a : ann var) (b : ann (var × var)),
          get (mapAnn proj1_sig sa) n a
          get ans n b ann_R (fun (x : var) (y : var × var) ⇒ x fst y) a b)
      (BND : (n : ) (lv : {X : var | X occurVars sT}) (Z : params),
          get ZL n Z get LV n lv proj1_sig lv \ of_list Z D)
      (RA: (n : ) (Zs : params × stmt) (a : ann (var × var)),
          get s n Zs get ans n a renamedApart (snd Zs) a)
      (IH: (n : ) (s' : params × stmt) (sa' : ann {X : var | X occurVars sT}),
          get sa n sa'
          get s n s'
           (i : overapproximation) (ZL : params) (LV : {X : var | X occurVars sT})
            (ST : subTerm (snd s') sT) (ra : ann (var × var)),
            renamedApart (snd s') ra
            labelsDefined (snd s') ZL
            labelsDefined (snd s') LV
            ( ( : ) (lv : {X : var | X occurVars sT}) (Z : params),
                get ZL Z get LV lv proj1_sig lv \ of_list Z fst (getAnn ra))
            ann_R (fun (x : var) (y : var × var) ⇒ x fst y) (mapAnn proj1_sig sa') ra
            ann_R (fun (x : var) (y : var × var) ⇒ x fst y)
                  (mapAnn proj1_sig (@backward _ _ (liveness_transform_dep i) ZL LV (snd s') ST sa')) ra)
      (LDef: (n : ) (Zs : params × stmt), get s n Zs labelsDefined (snd Zs) (s + ZL))
      (LDef': (n : ) (Zs : params × stmt), get s n Zs labelsDefined (snd Zs) (s + LV))
  : (n : ) (lv : {X : var | X occurVars sT}) (Z : params),
    get (fst s ZL) n Z
    get
      (getAnn
          backwardF (backward (liveness_transform_dep i)) (fst s ZL) (getAnn sa LV) s sa
         (subTerm_EQ_Fun2 eq_refl ST) LV) n lv proj1_sig lv \ of_list Z D.
Proof.
  intros ? ? ? .
  eapply get_app_cases in ; destruct ; dcr; inv_get.
  - rewrite get_app_lt in ; eauto with len. inv_get.
    edestruct (@backwardF_get sT _ (@backward _ (fun : stmt{ : var | occurVars })
                                              (liveness_transform_dep i))); eauto; dcr; subst.
    exploit RA; eauto.
    exploit IH; try eapply . Focus 7.
    eapply ann_R_get in . rewrite getAnn_mapAnn in .
    rewrite . edestruct IFC; eauto; dcr.
    rewrite . repeat get_functional. clear; cset_tac.
    eauto. eauto. eauto. len_simpl.
    rewrite Len. eauto. eauto using extend_incl. eauto.
  - rewrite get_app_ge in ; eauto with len.
Qed.


Lemma live_ann_incl_ra (i:overapproximation) sT ZL LV s a (ST:subTerm s sT) ra
      (RA:renamedApart s ra)
      (Ann:annotation s a)
      (DefZL:labelsDefined s (length ZL))
      (DefLV:labelsDefined s (length LV))
      (BND: n lv Z, get ZL n Z get LV n lv proj1_sig lv \ of_list Z fst (getAnn ra))
      (LE:ann_R (fun (x : var) (y : var × var) ⇒ x fst y) (mapAnn proj1_sig a) ra)
  : ann_R (fun (x : var) (y : var × var) ⇒ x fst y) (mapAnn proj1_sig (@backward _ _ (liveness_transform_dep i) ZL LV s ST a)) ra.
Proof.
  general induction Ann; invt renamedApart;
    invt @ann_R; inv DefZL; inv DefLV; simpl; econstructor; simpl; eauto;
    simpl in ×.
  - exploit (IHAnn i ZL LV) as IH; eauto.
    + intros; pe_rewrite. rewrite BND; eauto with cset.
    + eapply ann_R_get in IH. rewrite getAnn_mapAnn in IH.
      cases; erewrite IH; pe_rewrite; try rewrite ;
        revert ; clear; cset_tac.
  - eapply IHAnn; eauto.
    + intros. pe_rewrite. rewrite BND; eauto with cset.
  - exploit ( i ZL LV) as ; eauto.
    + intros. pe_rewrite. rewrite BND; eauto with cset.
    + eapply ann_R_get in . rewrite getAnn_mapAnn in .
      exploit ( i ZL LV) as ; eauto.
      × intros. pe_rewrite. rewrite BND; eauto with cset.
      × eapply ann_R_get in . rewrite getAnn_mapAnn in .
        rewrite , , . pe_rewrite.
        clear_all. cset_tac.
  - eapply ; eauto.
    + intros. pe_rewrite. rewrite BND; eauto with cset.
  - eapply ; eauto.
    + intros. pe_rewrite. rewrite BND; eauto with cset.
  - edestruct (get_in_range _ ) as [Z ?]; eauto.
    edestruct (get_in_range _ ) as [[Lv ?] ?]; eauto.
    repeat erewrite get_nth; eauto.
    rewrite list_union_incl with (s':=D); only 3: eauto with cset.
    + cases; eauto with cset.
    + intros; inv_get. rewrite .
      eapply incl_list_union; eauto using get.
  - exploit (IHAnn i) as IH; try eapply ; try assumption. eauto.
    Focus 3.
    eapply ann_R_get in IH. rewrite getAnn_mapAnn in IH.
    rewrite IH.
    pe_rewrite. cases; [| eauto with cset].
    eapply union_incl_split; eauto.
    eapply list_union_incl; only 2: eauto with cset; intros; inv_get.

    rewrite get_app_lt in ; [| eauto with len].
    inv_get.

    edestruct (@backwardF_get sT _ (@backward _ (fun : stmt{ : var | occurVars })
                                              (liveness_transform_dep i))); eauto; dcr; subst.
    exploit ; eauto.
    exploit as IH'; try eapply .
    Focus 7.
    eapply ann_R_get in IH'. rewrite getAnn_mapAnn in IH'.
    rewrite IH'.
    edestruct ; eauto; dcr.
    rewrite . repeat get_functional. clear; cset_tac.
    eauto. eauto. eauto. eauto. eauto using extend_incl.
    eapply ; eauto. eauto. eauto with len.
    pe_rewrite. eapply extend_incl'; eauto.
  - eauto with len.
  - intros; inv_get.
    edestruct (@backwardF_get sT _ (@backward _ (fun : stmt{ : var | occurVars })
                                              (liveness_transform_dep i))); eauto; dcr; subst.
    eapply ; eauto using extend_incl.
  - eapply IHAnn; eauto with len.
    pe_rewrite. eapply extend_incl'; eauto.
Qed.


Lemma renamedApart_annotation s ang
: renamedApart s ang
   annotation s ang.
Proof.
  intros. general induction H; eauto 20 using @annotation.
Qed.


Lemma livenessAnalysis_renamedApart_incl i s ra
      (RA:renamedApart s ra) (LD:labelsDefined s 0)
  : ann_R (fun (x : var) (y : var × var) ⇒ x fst y) (livenessAnalysis i s) ra.
Proof.
  unfold livenessAnalysis.
  eapply safeFixpoint_induction; intros.
  - clear LD.
    unfold initial_value. simpl.
    generalize (occurVars s).
    general induction RA; simpl; econstructor; simpl; set_simpl; eauto with cset len.
    intros; inv_get. eapply ; eauto.
  - intros. simpl. destruct a; simpl.
    eapply live_ann_incl_ra; eauto.
    isabsurd.
Qed.