Add LoadPath "vst".
Require Import msl.Coqlib2.
Require Import msl.log_normalize.
Require Import msl.eq_dec.
Require Import Coq.Unicode.Utf8.
Require Import Coq.Program.Equality.

Require Import Types.
Require Import Judge.
Require Import Subst.
Require Import ProgramLogic.
Require Import Translation.
Require Import Language.
Require Import WFLemmas.
Require Import SubstLemmas.
Require Import EvalLemmas.
Require Import Tactics.
Require Import List.
Import ListNotations.

Lemma forall_p_combine :
  forall (X Y : Type) (P : Y -> Prop) (xs : list X) (ys : list Y),
    length xs = length ys ->
    Forall P ys ->
    Forall (fun xy => P (snd xy)) (combine xs ys).
Proof.
  intros.
  rewrite Forall_forall in *.
  intros.
  destruct x as [x y].
  simpl in *.
  pose (combine_split xs ys H).
  specialize (H0 y).
  apply in_combine_r in H1.
  apply H0.
  assumption.
Qed.

Lemma sub_eq_expr :
  forall (e : expr) x x',
    subst (subst_one x (var_e x')) e
    = subst (fun i => if eq_dec i x then x' else i) e.
Proof.
  induction e.
  * reflexivity.
  * intros. unfold subst. simpl. unfold subst_one. foo.
  * intros.
    unfold subst at 1.
    unfold Subst_var_expr.
    unfold Language.subst_expr.
    rewrite IHe1.
    rewrite IHe2.
    reflexivity.
Qed.

Lemma sub_eq :
  forall (p : reft_prop) x x',
    subst (subst_one x (var_e x')) p
    = subst (fun i => if eq_dec i x then x' else i) p.
Proof.
  intros.
  induction p.
  constructor.
  unfold subst.
  unfold Subst_prop, Subst_prop_var, subst_prop, subst_prop_var.
  rewrite sub_eq_expr.
  rewrite sub_eq_expr.
  reflexivity.
  unfold subst in *.
  simpl.
  rewrite IHp.
  reflexivity.
  unfold subst in *.
  simpl.
  rewrite IHp1.
  rewrite IHp2.
  reflexivity.
  unfold subst in *.
  simpl.
  rewrite IHp1.
  rewrite IHp2.
  reflexivity.
Qed.

Lemma subst_vv_ty:
  forall x x' T,
    x <> ν ->
    sep_ty (var_e x) T
    |-- subst (subst_one ν x') (sep_ty (var_e x) T).
Proof.
  intros.
  unfold subst.
  unfold sep_ty.
  destruct T as [b p].
  rewrite subst_distr_andp.
  apply andp_derives.
  rewrite subst_distr_andp.
  apply andp_derives.
  unfold sep_base.
  unfold subst, Subst_pred, subst_pred.
  simpl in *.
  intro w.
  apply exp_left.
  intro vv.
  rewrite <- exp_andp1.
  apply andp_derives.
  normalize.
  apply (exp_right vv).
  apply prop_right.
  unfold subst_one.
  destruct (eq_dec x ν).
    congruence.
    rewrite <- H0. reflexivity.
  apply derives_refl.
  intro w.
  unfold subst at 2, Subst_pred, subst_pred.
  repeat rewrite <- subst_ty_prop.
  unfold subst, Subst_pred, subst_pred.
  assert
     ((λ i : var, eval w (subst_one ν (var_e x) i))
      = (λ i : var,
               eval (fun i0 => eval w (subst_one ν x' i0), hp w)
                    (subst_one ν (var_e x) i))).
  extensionality i.
  unfold subst_one.
  destruct (eq_dec i ν).
  simpl.
  destruct (eq_dec x ν). intuition. reflexivity.
  destruct (eq_dec i ν). intuition. simpl.
  destruct (eq_dec i ν). intuition. reflexivity.
  rewrite <- H0.
  simpl.
  apply derives_refl.
  normalize.
Qed.

Lemma vv_sub_env :
  forall G,
    var_not_in ν G ->
      (forall x,
         sep_env G |-- subst (subst_one ν x) (sep_env G)).
Proof.
  intro G.
  induction G.
  + simpl. trivial.
  + destruct a as [b p].
    unfold sep_env in *.
    fold sep_env in *.
    intro H.
    intro e.
    repeat rewrite subst_distr_andp.
    apply andp_derives.
    apply andp_derives.
    apply subst_vv_ty.
    unfold var_not_in in H.
    rewrite Forall_forall in H.
    apply H with (x := (b, p)).
    left. reflexivity.
    apply IHG.
    inversion H.
    assumption.
    trivial.
Qed.

Lemma vv_sub_guards :
  forall G Grds,
    wf_guards G Grds ->
      forall (x : expr),
      sep_guards Grds |-- subst (subst_one ν x) (sep_guards Grds).
Proof.
  intros G Grds.
  induction Grds as [| p].
  + simpl. trivial.
  + intros wf x.
    unfold sep_guards in *; fold sep_guards in *.
    inversion wf. subst.
    pose (wf_guards_vv_nonfree G Grds H2).
    repeat rewrite subst_distr_andp.
    repeat apply andp_derives.
    rewrite subst_nonfree_prop.
    apply derives_refl.
    apply H1.
    apply n.
    trivial.
Qed.

Lemma subtype_interp_pred :
  forall Γ Ξ φ φ' x b,
    var_not_in ν Γ ->
    wf_guards Γ Ξ ->
    subtype Γ Ξ { ν : b | φ } { ν : b | φ' } ->
    (sep_env Γ && sep_guards Ξ) |--
      sep_pred (subst (subst_one ν x) φ) -->
      sep_pred (subst (subst_one ν x) φ').
Proof.
  intros.
  inversion H1. subst.
  simpl.
  intro.
  rewrite <- (subst_ty_prop φ (subst_one ν x) x0).
  rewrite <- (subst_ty_prop φ' (subst_one ν x) x0).
  apply derives_trans with
    (Q := subst (subst_one ν x) (sep_env Γ) x0 &&
          subst (subst_one ν x) (sep_guards Ξ) x0).
  apply andp_derives.
  apply vv_sub_env; assumption.
  apply vv_sub_guards with (G := Γ); assumption.
  unfold subst, Subst_pred, subst_pred.
  simpl in H5.
  apply H5.
Qed.

Lemma subtype_interp :
  forall Γ Ξ φ φ' x b,
    var_not_in ν Γ ->
    wf_guards Γ Ξ ->
    subtype Γ Ξ { ν : b | φ } { ν : b | φ' } ->
      sep_env Γ && sep_guards Ξ |--
              sep_ty x { ν : b | φ } --> sep_ty x { ν : b | φ' }.
Proof.
  intros.
  unfold sep_ty.
  rewrite <- imp_andp_adjoint.
  repeat apply andp_right.
  apply andp_left2. apply andp_left1. apply andp_left1. apply derives_refl.
  apply derives_trans with (Q := (sep_pred (subst (subst_one ν x) φ)
                              && (sep_pred (subst (subst_one ν x) φ)
                                 --> sep_pred (subst (subst_one ν x) φ')))).
  apply andp_right.
  apply andp_left2. apply andp_left1. apply andp_left2. apply derives_refl.
  apply andp_left1. apply subtype_interp_pred with (b := b); assumption.
  apply modus_ponens.
  repeat apply andp_left1.
  apply sep_env_pure.
Qed.

Lemma vv_sub_env_eval :
  forall e ν x v w,
    x <> ν ->
    eval w (subst (subst_one ν (var_e x)) e)
    = eval (λ i : var, eval w (subst_one ν v i), hp w) (subst (subst_one ν (var_e x)) e).
Proof.
  induction e.
  + intros. unfold subst, subst_one. reflexivity.
  + intros. unfold subst, subst_one.
    foo.
  + intros. unfold subst, subst_one in *.
            unfold Subst_var_expr, subst_var, Language.subst_expr.
            simpl in *.
            unfold Subst_var_expr in *.
            rewrite IHe1 with (v:=v).
            rewrite IHe2 with (v:=v).
            reflexivity.
            assumption.
            assumption.
Qed.

Lemma vv_sub_env_prop :
  forall p ν x v w,
    x <> ν ->
    sep_pred (subst (subst_one ν (var_e x)) p) w =
    sep_pred (subst (subst_one ν (var_e x)) p)
             (λ i : var, eval w (subst_one ν v i), hp w).
Proof.
  intros.
  induction p.
  + constructor.
  + destruct b. unfold subst, Subst_prop, subst_prop. simpl.
    rewrite <- vv_sub_env_eval with (v := v).
    rewrite <- vv_sub_env_eval with (v := v).
    reflexivity.
    assumption.
    assumption.
  + simpl in *. unfold subst in *. unfold imp.
    rewrite IHp.
    reflexivity.
  + simpl. unfold subst, Subst_prop in *.
    unfold andp.
    rewrite IHp1.
    rewrite IHp2.
    reflexivity.
  + simpl. unfold subst, Subst_prop in *.
    unfold orp.
    rewrite IHp1.
    rewrite IHp2.
    reflexivity.
Qed.

Lemma vv_sub_env_ty :
  forall T x v,
    x <> ν ->
    sep_ty (var_e x) T |-- subst (subst_one ν v) (sep_ty (var_e x) T).
Proof.
  intros.
  unfold sep_ty in *.
  destruct T as [b p].
  repeat rewrite subst_distr_andp.
  repeat apply andp_derives.
  unfold subst.
  unfold Subst_pred, subst_pred, subst_one.
  unfold sep_base.
  apply exp_left.
  intro vv.
  simpl.
  intro w.
  rewrite <- exp_andp1.
  apply andp_derives.
  apply prop_left.
  intro EQ.
  apply (exp_right vv).
  apply prop_right.
  destruct (eq_dec x ν). intuition. assumption.
  trivial.
  intro w.
  rewrite vv_sub_env_prop with (v:= v).
  apply derives_refl.
  assumption.
  trivial.
Qed.

Lemma subst_vv_env :
  forall Γ,
    var_not_in ν Γ ->
    nonfreevars (sep_env Γ) ν.
Proof.
  intros.
  induction Γ.
  + unfold nonfreevars. intro. apply derives_refl.
  + unfold sep_env. destruct a as [x [b p]].
    fold sep_env.
    unfold nonfreevars.
    intro e.
    repeat rewrite subst_distr_andp.
    repeat apply andp_derives.
    apply vv_sub_env_ty.
      unfold var_not_in in H.
      rewrite Forall_forall in H.
      apply (H (x, { ν : b | p })); left; reflexivity.
    apply IHΓ.
    inversion H.
    assumption.
    trivial.
Qed.

Lemma sep_env_base_var :
  forall Γ x b p,
    (x, { ν : b | p }) ∈ Γ ->
    sep_env Γ |-- sep_base (var_e x) b.
Proof.
  induction Γ.
  + intros. inversion H.
  + intros.
    apply in_inv in H.
    destruct a as [x' [b' p']].
    destruct H.
    inversion H. subst.
    apply andp_left1.
    apply andp_left1.
    apply andp_left1.
    apply andp_left1.
    apply derives_refl.
    unfold sep_env; fold sep_env.
    apply andp_left1.
    apply andp_left2.
    apply (IHΓ _ _ p).
    assumption.
Qed.

Lemma sep_env_base_val :
  forall Γ (v : value),
    sep_env Γ |-- sep_base v (base_of_val v).
Proof.
  intros.
  unfold sep_base.
  destruct (base_of_val v), v.
  unfold base_of_type.
  apply (exp_right n).
  simpl. intro. apply andp_right. apply prop_right. reflexivity.
  apply sep_env_pure.
Qed.

Lemma type_interp :
  forall Γ Ξ x T,
    var_not_in ν Γ ->
    expr_type Γ Ξ x T ->
    wf_guards Γ Ξ ->
    sep_env Γ && sep_guards Ξ |-- sep_ty x T.
Proof.
  intros Γ Ξ x T vvnotin ET. (* [ ν b φ ]  w SE ET. *)
  unfold sep_ty.
  dependent induction ET.
  {
    intros wfg.
    apply andp_right.
    apply andp_right.
    apply andp_left1.
    apply sep_env_base_val.
    intro w.
    simpl.
    apply andp_right.
    apply prop_right.
    unfold subst, Subst_var_expr, subst_one. simpl. foo.
    apply andp_left1; apply sep_env_pure.
    apply andp_left1; apply sep_env_pure.
  }
  {
    intros wfg.
    apply andp_right.
    apply andp_right.
  * apply andp_left1; apply sep_env_base_var with (p := φ); assumption.
  * clear wfg.
    apply andp_left1.
    induction Γ.
    + intuition.
    + intros.
      destruct a as [x' [ b' p' ]].
      apply in_inv in H.
      destruct H.
      inversion H; subst.
      unfold sep_env; fold sep_env.
      apply andp_left1.
      apply andp_left1.
      apply andp_left1.
      apply andp_left2.
      solve [intuition].
      unfold sep_env; fold sep_env.
      apply andp_left1.
      apply andp_left2.
      apply IHΓ.
      inversion vvnotin. assumption.
      assumption.
   * apply andp_left1; apply sep_env_pure.
  }
  {
    fold (sep_ty e T) in IHET.
    fold (sep_ty e T').
    intro.
    apply derives_trans with (Q := sep_env Γ && sep_guards Ξ && sep_ty e T).
    apply andp_right.
    apply andp_right.
      apply andp_left1; apply derives_refl.
      apply andp_left2; apply derives_refl.
      apply IHET; assumption.
    apply imp_andp_adjoint.
    destruct T, T'. inversion H0. subst.
    apply subtype_interp; assumption.
  }
Qed.

Lemma types_interp :
  forall Γ Ξ xs ts,
    var_not_in ν Γ ->
    wf_guards Γ Ξ ->
    tc_list Γ Ξ (combine xs ts) ->
    sep_env Γ && sep_guards Ξ |-- sep_env (combine xs ts).
Proof.
  intros.
  unfold tc_list in H1.
  rewrite Forall_forall in H1.
  unfold sep_env.
  induction (combine xs ts).
  + normalize. apply andp_left1. apply sep_env_pure.
  + destruct a.
    fold sep_env.
    apply andp_right.
    apply andp_right.
    apply type_interp with (Γ := Γ);
      [ assumption | apply H1 with (x := (v,r)); left; reflexivity | assumption].
    apply IHl.
    intro. intro.
    apply H1.
    unfold In. right. apply H2.
    apply andp_left1; apply sep_env_pure.
Qed.

Lemma funspec_nomem :
  forall Φ p,
    fun_not_in p Φ ->
    Forall (fun ps => fst4 ps <> p) (sep_proc_env Φ).
Proof.
  intros.
  induction Φ.
  + constructor.
  + rewrite Forall_forall in *.
    intros [ [[p' pr] P] Q ] mem.
    destruct a as [p'' [s t]].
    unfold sep_proc_env in mem. fold sep_proc_env in mem.
    apply in_inv in mem.
    destruct mem.
    simpl in *.
    unfold sep_schema in H0.
    destruct t.
    destruct s_ret.
    inversion H0. subst.
    unfold fun_not_in in H.
    rewrite Forall_forall in H.
    specialize (H (p', (s, {| s_formals := s_formals; s_formal_ts := s_formal_ts; s_ret := (v,r) |}))).
    apply H.
    left. reflexivity.
    apply IHΦ.
    inversion H. assumption.
    assumption.
Qed.

Lemma funspec_interp :
  forall F f p t,
    In (f, (p,t)) F -> In (sep_schema f p t) (sep_proc_env F).
Proof.
  intros.
  induction F.
  + inversion H.
  + destruct H. destruct a. destruct p1. inversion H. subst.
    apply in_inv. left. reflexivity.
    apply IHF in H.
    unfold sep_proc_env.
    destruct a.
    destruct p1.
    simpl.
    right.
    apply H.
Qed.
(* Lemma sep_pred_pure : *)
(*   forall p Q, *)
(*     (sep_pred p && emp) && Q = sep_pred p * Q. *)
(* Proof. *)
(*   intros. *)
(*   induction p. *)
(*   simpl. *)
(*   extensionality. *)
(*   rewrite <- sepcon_emp at 1. *)
(*   rewrite sepcon_comm. *)
(*   apply pred_ext. *)
(*   apply sepcon_derives. *)
(*   apply prop_right. trivial. *)
(*   apply andp_left2. apply derives_refl. *)

(*   unfold pure. *)
(*   induction p. *)
(*   simpl.  *)
(*   repeat intro. *)
(*   repeat (unfold join, Join_fun, Join_lower, Join_discrete in H0; hnf in H0). *)
(*   destruct H0. *)
(*   destruct a. destruct a0. destruct b. *)
(*   unfold TT, prop in H. simpl in H. *)
(*   unfold pure. *)

(*   unfold identity. *)
(*   hnf. *)
(*   repeat intro. *)

(*   unfold join in H0. *)
(*   unfold Join_world in H0. *)
(*   destruct a. *)
(*   destruct a0. *)
(*   destruct b.  *)
(*   simpl in H0. *)
(*   hnf in H0. *)
(*   destruct H0. *)
(*   simpl in *. *)
(*   unfold join in *. *)
(*   hnf in *. *)
(*   unfold join, Join_equiv in *. *)
(*   unfold join, Join_lower, Join_discrete in H1. *)
(*   destruct H0 with (x := V 0). *)

Lemma sep_ty_pure_subst :
  forall x t θ,
    pure (subst θ (sep_ty x t)).
Proof.
  intros.
  unfold pure.
  destruct t.
  unfold subst, sep_ty, Subst_pred, subst_pred.
  intro w.
  simpl.
  apply andp_left2.
  trivial.
Qed.

(* Lemma sep_env_pure : *)
(*   forall G, *)
(*     pure (sep_env G). *)
(* Proof. *)
(*   intros. *)
(*   unfold pure. *)
(*   intro. intro. *)
(*   unfold identity. *)
(*   intros w1 w2. *)
(*   intros. *)
(*   apply H0. *)
(* Qed. *)

(* Lemma sep_guards_pure : *)
(*   forall G, *)
(*     pure (sep_guards G). *)
(* Proof. *)
(*   unfold pure. *)
(*   unfold identity. *)
(*   intros. *)
(*   intro. *)
(*   intro. *)
(*   intros w1 w2. *)
(*   intro. *)
(*   apply H0. *)
(* Qed. *)

Lemma sep_proof_skip :
  forall Φ Ξ Γ Γ' (J : (Φ ; Γ ; Ξ) ⊢ skip_s ::: Γ'),
    sep_proc_env Φ |- {{ sep_env Γ * sep_guards Ξ }} skip_s {{ sep_env Γ' * sep_guards Ξ }}.
Proof.
  intros. inversion J. subst. constructor.
Qed.

Lemma sep_proof_assign :
  forall Φ Ξ Γ Γ' x e (J : (Φ ; Γ ; Ξ)⊢ assign_s x e ::: Γ'),
    wf_env Γ ->
    wf_guards Γ Ξ ->
    sep_proc_env Φ |- {{ sep_env Γ * sep_guards Ξ }} assign_s x e {{ sep_env Γ' * sep_guards Ξ }}.
Proof.
  intros Φ Ξ Γ Γ' x e J wfenv wfguards.
  inversion J. subst.
  apply semax_frame.
  apply semax_pre_post with (P' := (EX v : value, (eval_to e v))
                                              && (subst_pred (subst_one x e )
                                                             (sep_env ((x, {ν : τ | (var_e ν) .= e }) :: Γ))))
                            (Q' := sep_env ((x,{ν : τ | (var_e ν) .= e }) :: Γ)).
  apply andp_right.
  unfold eval_to.
  simpl.
  intro w.
  rewrite <- exp_andp1.
  apply andp_right.
  apply (expr_eval Γ Ξ e τ φ H7).
  purity.
  apply derives_trans with (Q := sep_env Γ && subst_pred (subst_one x e) (sep_env Γ)).
  simpl. intro w.
  rewrite subst_dom_env.
    apply andp_right; trivial.
    assumption.
    split. unfold subst_one. foo.
    intros x' x'_in.
    unfold subst_one. destruct (eq_dec x' x). subst.
    unfold var_in, var_not_in in *.
    rewrite Forall_forall in *.
    destruct x'_in.
    apply H5 in H.
    contradiction H. reflexivity. reflexivity.
    unfold subst_one. destruct (eq_dec ν x); congruence.
  apply subst_env_eq_expr with (Grds := Ξ) (φ := φ).
  assumption.
  apply derives_refl.
  rewrite exp_andp1.
  apply semax_assign with (e := e) (x := x) (P := (sep_env ((x, {ν : τ | var_e ν .= e}) :: Γ))).
  unfold subset.
  intros.
  inversion H. subst.
  apply wf_guards_nonfree with (Γ := Γ); assumption.
Qed.

Lemma sep_args_sub :
  forall Γ Ξ (xs' : list var) ts' (θ : subst_t var var) xs ts,
    length xs = length ts ->
    xs' = subst θ xs ->
    ts' = subst θ ts ->
    tc_list Γ Ξ (combine xs' ts') ->
    var_not_in ν Γ ->
    wf_guards Γ Ξ ->
    sep_env Γ && sep_guards Ξ |-- sep_env (subst θ (combine xs ts)).
Proof.
  intros.
  assert (C: subst θ (combine xs ts) =
                      combine xs' ts').
    rewrite H0. rewrite H1.
    rewrite <- subst_combine with (xs := xs) (ys := ts).
    reflexivity.
    assumption.
  rewrite C.
  apply types_interp; assumption.
Qed.

Lemma sep_env_cons :
  forall x t Γ,
    sep_ty (var_e x) t * sep_env Γ |-- sep_env ((x,t) :: Γ).
Proof.
  intros.
  unfold sep_env at 2. fold sep_env.
  rewrite <- sepcon_emp at 1.
  rewrite <- sepcon_pure_andp.
  rewrite <- sepcon_pure_andp.
  apply sepcon_derives.
  apply sepcon_derives.
  apply derives_refl.
  apply derives_refl.
  apply derives_refl.
  apply sep_ty_pure.
  apply sep_env_pure.
  unfold pure. apply andp_left1. apply sep_ty_pure.
  apply derives_refl.
Qed.

Lemma sep_env_cons_sub :
  forall x b p θ Γ,
    θ ν = ν -> (forall x , θ x = ν -> x = ν) ->
    subst θ (sep_ty (var_e x) { ν : b | p }) * sep_env Γ
    |-- sep_env ((subst θ (x,{ ν : b | p })) :: Γ).
Proof.
  intros x b p θ Γ vv_id vv_im.
  unfold sep_env; fold sep_env.
  rewrite sepcon_pure_andp.
  simpl.
  intro w.
  apply andp_right.
  apply andp_derives.
  rewrite subst_lift_assert.
  rewrite <- subst_ty_distr.
  unfold sep_ty. simpl.
  apply andp_derives.
  apply andp_derives.
  unfold subst, Subst_var_var. apply derives_refl.
  unfold subst. simpl.
  rewrite subst_lift_pred. unfold subst. simpl. apply derives_refl.
  apply derives_refl.
  rewrite vv_id. reflexivity.
  apply subst_vv_not_in_range.
  intro v. split. apply vv_im. intro. rewrite H. assumption.
  apply derives_refl.
  apply andp_left2. apply sep_env_pure.
  apply sep_ty_pure_subst.
  apply sep_env_pure.
Qed.

Lemma sep_proof_proc_ret :
  forall (θ : subst_t var var) x t Γ,
    θ ν = ν -> (forall x, θ x = ν -> x = ν) ->
    wf_type (subst θ (x,t) :: Γ) (subst θ t)  ->
   (subst θ (sep_ty (var_e x) t)) * sep_env Γ |--
    sep_env ((subst θ (x,t)) :: Γ).
Proof.
  intros θ x t Γ vvid vvim wf H.
  destruct t as [ b p ].
  simpl in *.
  apply sep_env_cons_sub.
  assumption.
  assumption.
Qed.

Lemma sep_proof_proc_sub :
  forall x v θ,
    v  = subst θ x ->
    (forall x', θ x' = v <-> x = x') ->
    unique_sub θ x.
Proof.
  intros x v θ vdef subprop.
  unfold unique_sub.
  exists v.
  split.
  symmetry. apply vdef.
  intros.
  unfold not_free_in.
  specialize (subprop x0).
  destruct subprop.
  intuition.
  apply H.
  symmetry.
  intuition.
Qed.

Lemma sep_proof_proc_mod :
  forall f xs x x',
    modvars (proc_s f xs x []) x' -> x = x'.
Proof.
  intros.
  inversion H.
  intuition.
  reflexivity.
Qed.

Ltac wfenv_ty_t :=
  match goal with
    | [ X : ?x = ?a, Y : ?y = ?b, H : wf_type _ _ |- _ ] =>
      rewrite X in H; rewrite Y in H; assumption
    | [ H : (?x, ?y) = subst _ (_, _) |- _ ] =>
      unfold subst, Subst_prod, subst_prod in H; inversion H; wfenv_ty_t
    | [ H : wf_env (subst ?x (?f ?z) :: ?G) |- wf_type (subst ?x (?f ?z) :: ?G) _ ]  =>
      inversion H; destruct (f z); simpl in *; wfenv_ty_t
  end.

Lemma lift_assert :
  forall {P Q : assert} w, P |-- Q ->(P w |-- Q w).
Proof.
  intros.
  apply H.
Qed.

Lemma sep_proof_proccall :
  forall Φ Ξ Γ Γ' f xs v (J : (Φ ; Γ ; Ξ) ⊢ proc_s f xs v [] ::: Γ'),
    wf_env Γ ->
    wf_guards Γ Ξ ->
    sep_proc_env Φ |- {{ sep_env Γ * sep_guards Ξ }} proc_s f xs v [] {{ sep_env Γ' * sep_guards Ξ }}.
Proof.
  intros until v.
  intros J wf wfg.
  inversion J as [ | ? ? ? ? ? p S ? ? θ θS fmem wfS wfθ
                     ? ? ? ? retid substid wfenv wfsubty tclist
                     | | | ].
  simpl in *. subst.
  destruct S as [fxs fts [rx rt]] eqn:S_def.
  simpl in *.
  apply funspec_interp in fmem.
  unfold sep_schema in fmem.
  apply semax_pre_post with
  (P' := ((Subst.subst θ (sep_env (combine fxs fts)))) * (sep_env Γ * sep_guards Ξ))
  (Q' := ((Subst.subst θ (sep_ty (var_e rx) rt))) * (sep_env Γ * sep_guards Ξ)).
  intro w.
  simpl.
  rewrite <- (subst_in_env Γ).
  rewrite sepcon_pure_andp at 1.
2: purity.
2: purity.
  rewrite (sepcon_pure_andp (sep_env (subst θ (combine fxs fts)) w)).
2: purity.
2: purity.
  apply andp_right.
  pose sep_args_sub as argstc; simpl in argstc; apply argstc with (xs' := subst θ fxs) (ts' := subst θ fts).
  inversion wfS; assumption.
  reflexivity.
  reflexivity.
  assumption.
  apply wf_env_no_vv; assumption.
  assumption.
  rewrite sepcon_pure_andp; try apply derives_refl; purity.
  wfsubst θ.
  assumption.
  assumption.
  rewrite subst_combine.
  apply forall_p_combine.
  inversion wfS; repeat rewrite <- subst_length; assumption.
  assumption.
  inversion wfS; assumption.
  rewrite <- sepcon_assoc.
  simpl.
  intro w.
  apply sepcon_derives.
  pose sep_proof_proc_ret as RT; simpl in RT; apply RT.
  apply wfθ; reflexivity.
  apply wfθ.
  inversion wfenv; assumption.
  apply derives_refl.
  apply semax_frame.
  subst.
  assert (A : subst θ (proc_s f fxs rx []) = proc_s f (subst θ fxs) (subst θ rx) []).
  unfold subst at 1. simpl. reflexivity.
  rewrite <- A.
  apply semax_subst.
  apply (semax_proc f (mkProc fxs rx [] p)).
  assumption.
  intros.
  assert (rx = x) by
      (apply sep_proof_proc_mod with (f:=f) (xs:= fxs); assumption).
  subst.
  apply sep_proof_proc_sub with (v := subst θ x).
  reflexivity.
  intros.
  specialize (retid x').
  constructor; intro; [ symmetry | idtac ]; apply retid; [ idtac | symmetry]; assumption.
  unfold subset.
  intros.
  unfold nonfreevars.
  intros.
  assert (A : subst θ rx = x).
    apply sep_proof_proc_mod with (f := f) (xs := subst θ fxs).
    assumption.
  assert (B : x <> ν).
    inversion wfenv.
    rewrite <- A.
    assumption.
  rewrite sepcon_pure_andp.
2: purity.
2: purity.
  rewrite subst_distr_andp.
  apply andp_derives.
  simpl.
  unfold subst, Subst_pred.
  intro w.
  rewrite subst_dom_env.
    apply derives_refl.
    assumption.
    apply subst_one_is_disj.
    assumption.
    assumption.
    inversion wfenv. rewrite <- A. assumption.
    unfold subst_one. foo.
  intro w.
  rewrite subst_dom_guards with (Γ := Γ).
  apply derives_refl.
  assumption.
  apply subst_one_is_disj.
  assumption.
  assumption.
  inversion wfenv. rewrite <- A. assumption.
Qed.

Lemma subtype_same_base :
  forall Ξ Γ b b' p p',
    subtype Γ Ξ { ν : b | p } { ν : b' | p' } ->
    subtype Γ Ξ { ν : b | p } { ν : b | p' }.
Proof.
  intros.
  inversion H.
  subst.
  assumption.
Qed.

Lemma types_interp2 :
  forall Ξ Γ Γ',
    wf_env Γ -> wf_guards Γ Ξ ->
   (forall x t, (x,t) ∈ Γ' -> (exists t1, (x,t1) ∈ Γ /\ subtype Γ Ξ t1 t)) ->
   sep_env Γ && sep_guards Ξ |-- sep_env Γ'.
Proof.
  intros Ξ Γ Γ' wfe wfg H.
  induction Γ' as [| [x t]].
  + apply andp_right. normalize. purity.
  + unfold sep_env; fold sep_env.
    apply andp_right.
    apply andp_right.
    specialize (H x t).
    destruct H. left. reflexivity.
    destruct t as [b p].
    destruct x0 as [b0 p0].
    apply derives_trans with (Q := sep_env Γ && sep_guards Ξ && sep_ty (var_e x) {ν : b | p0}).
    apply andp_right. trivial. apply type_interp.
    apply wf_env_no_vv.
    exact wfe.
    constructor.
    destruct H. inversion H0. subst.
    apply H.
    exact wfg.
    rewrite imp_andp_adjoint.
    pose subtype_interp as ST. simpl in ST. simpl. apply ST.
    apply wf_env_no_vv.
    exact wfe.
    exact wfg.
    destruct H.
    inversion H0; subst.
    assumption.
    apply IHΓ'.
    intros x0 t0 x0mem.
    apply H.
    right.
    apply x0mem.
    purity.
Qed.

Lemma join_swap :
  forall Γ1 Γ2 Γ' Ξ,
    join_env Ξ Γ1 Γ2 Γ' <-> join_env Ξ Γ2 Γ1 Γ'.
Proof.
  intros.
  unfold join_env.
  constructor.
  intros [a [b c]].
  split.
  assumption.
  split.
  intros xt.
  specialize (b xt).
  rewrite and_comm.
  apply b.
  unfold join_var in *.
  rewrite Forall_forall in *.
  intros [x t].
  intro.
  destruct c with (x,t).
  apply H.
  split.
  apply H0.
  rewrite and_comm.
  apply H1.
  intros [a [b c]].
  split.
  assumption.
  split.
  intros xt.
  specialize (b xt).
  rewrite and_comm.
  apply b.
  unfold join_var in *.
  rewrite Forall_forall in *.
  intros [x t].
  intro.
  destruct c with (x,t).
  apply H.
  split.
  apply H0.
  rewrite and_comm.
  apply H1.
Qed.

Lemma join_interp :
  forall Γ1 Γ2 Γ' Ξ ,
    wf_env Γ1 -> wf_env Γ2 -> wf_guards Γ1 Ξ ->
    join_env Ξ Γ1 Γ2 Γ' ->
    (sep_env Γ1 && sep_guards Ξ) |-- sep_env Γ' && sep_guards Ξ.
Proof.
  intros until Ξ.
  intros wf1 wf2 wfg J.
  apply andp_right.
  destruct J as [wfJ [J1 J2]].
  rewrite Forall_forall in J2.
  unfold join_var in J2.
  apply types_interp2.
  assumption.
  assumption.
  intros x t xtmem.
  specialize (J2 (x,t) xtmem).
  apply J2.
  apply andp_left2; apply derives_refl.
Qed.

Lemma sep_proof_if_derives :
  forall Ξ Γ Γ1 Γ2 Γ' e t g,
    wf_env Γ ->
    wf_env Γ1 ->
    wf_env Γ2 ->
    wf_guards Γ Ξ ->
    wf_guards Γ1 Ξ ->
    wf_guards Γ2 Ξ ->
    join_env Ξ Γ1 Γ2 Γ' ->
    expr_type Γ Ξ e t ->
    (* (Φ; Γ; not_r (e .= int_v 0) :: Ξ)⊢s1 ::: (Γ1) -> *)
    (* (Φ; Γ; (e .= int_v 0) :: Ξ)⊢s2 ::: (Γ2) -> *)
    sep_env Γ1 * sep_guards (g :: Ξ) |-- sep_env Γ' && sep_guards Ξ.
Proof.
  intros until g. intros wf wf1 wf2 wfg wfg1 wfg2 joinenv et.
  unfold sep_guards; fold sep_guards.
  rewrite sepcon_pure_andp.
2: purity.
2: purity.
  repeat rewrite <- andp_assoc.
  apply andp_left1.
  rewrite andp_assoc.
  rewrite andp_comm.
  rewrite andp_assoc.
  apply andp_left2.
  rewrite andp_comm.
  apply join_interp with (Γ2 := Γ2); assumption.
Qed.

Lemma wf_guard_expr_type1 :
  forall Γ Ξ e t,
    wf_env Γ ->
    expr_type Γ Ξ e t ->
    wf_guard Γ (e .= int_v 1).
Proof.
  intros.
  split.
  repeat constructor.
  apply wf_expr_ty_expr with Ξ t.
    assumption.
  simpl. rewrite  app_nil_r.
  apply wf_expr_ty_expr_fv with Γ Ξ t; assumption.
Qed.

Lemma wf_guard_expr_type2 :
  forall Γ Ξ e t,
    wf_env Γ ->
    expr_type Γ Ξ e t ->
    wf_guard Γ (e .= int_v 0).
Proof.
  intros.
  split.
  repeat constructor.
  apply wf_expr_ty_expr with Ξ t.
    assumption.
  simpl. rewrite  app_nil_r.
  apply wf_expr_ty_expr_fv with Γ Ξ t; assumption.
Qed.

Lemma sep_proof_if :
  forall Φ Ξ Γ Γ1 Γ2 Γ' s1 s2 e t,
    wf_env Γ ->
    wf_guards Γ Ξ ->
    expr_type Γ Ξ e t ->
    (Φ; Γ; (e .= int_v 1) :: Ξ)⊢s1 ::: (Γ1) ->
    (Φ; Γ; (e .= int_v 0) :: Ξ)⊢s2 ::: (Γ2) ->
    join_env Ξ Γ1 Γ2 Γ' ->
    (wf_env Γ
         → wf_guards Γ ((e .= int_v 1) :: Ξ)
           → sep_proc_env Φ |-
             {{sep_env Γ * sep_guards ((e .= int_v 1) :: Ξ)}}s1
             {{sep_env Γ1 * sep_guards ((e .= int_v 1) :: Ξ)}}) ->
    (wf_env Γ
       → wf_guards Γ ((e .= int_v 0) :: Ξ)
         → sep_proc_env Φ |-
           {{sep_env Γ * sep_guards ((e .= int_v 0) :: Ξ)}}s2
           {{sep_env Γ2 * sep_guards ((e .= int_v 0) :: Ξ)}}) ->
    sep_proc_env Φ |- {{ sep_env Γ && sep_guards Ξ }}
                        if_s e s1 s2
                        {{ sep_env Γ' && sep_guards Ξ }}.
Proof.
  intros until t.
  intros wf wfg et H1 H2 joinenv IH1 IH2.
  assert (WF1 : wf_env Γ1).
    apply wf_env_stmt with Φ Γ ((e .= int_v 1) :: Ξ) s1; assumption.
  assert (WF2 : wf_env Γ2).
    apply wf_env_stmt with Φ Γ (((e .= int_v 0)) :: Ξ) s2; assumption.
  assert (WFG1 : wf_guards Γ1 ((e .= int_v 1) :: Ξ)).
    apply wf_guards_stmt with Φ Γ s1. assumption. assumption.
    apply Forall_cons.
      apply wf_guard_expr_type1 with Ξ t; assumption.
      assumption.
  assert (WFG2 : wf_guards Γ2 ((e .= int_v 0) :: Ξ)).
    apply wf_guards_stmt with Φ Γ s2. assumption. assumption.
    apply Forall_cons.
      apply wf_guard_expr_type2 with Ξ t; assumption.
      assumption.
  apply semax_if.
  rewrite andp_comm.
  rewrite andp_assoc.
  rewrite andp_comm with (P := sep_guards Ξ).
  apply semax_pre_post with (P' := sep_env Γ * sep_guards ((e .= int_v 1) :: Ξ))
                            (Q' := sep_env Γ1 * sep_guards ((e .= int_v 1) :: Ξ)).
  rewrite sepcon_pure_andp.
    repeat apply andp_right.
    apply andp_left1. apply derives_refl.
    apply andp_left2. apply andp_left1.
    unfold eval_to. simpl. intro. apply andp_left1. apply derives_refl.
    apply andp_left1. purity.
    fold sep_guards.
    do 2 apply andp_left2. apply derives_refl.
    apply andp_left1. purity.
    purity.
    apply sep_guard_pure.
  apply sep_proof_if_derives with Γ Γ2 e t.
    assumption.
    assumption.
    assumption.
    assumption.
    inversion WFG1; assumption.
    inversion WFG2; assumption.
    assumption.
    assumption.
  apply IH1.
  assumption.
  apply Forall_cons.
    apply wf_guard_expr_type1 with Ξ t; assumption.
    assumption.
  apply semax_pre_post with (P' := sep_env Γ * sep_guards ((e .= int_v 0) :: Ξ))
                            (Q' := sep_env Γ2 * sep_guards ((e .= int_v 0) :: Ξ)).
    rewrite sepcon_pure_andp.
    repeat apply andp_right.
    apply andp_left2. apply andp_left1. apply derives_refl.
    apply andp_left1. unfold eval_to. intro. apply andp_left1. apply derives_refl.
    apply andp_left2. purity.
    fold sep_guards.
    apply andp_left2. apply andp_left2. apply derives_refl.
    apply andp_left2. purity.
    purity.
    apply sep_guard_pure.
  apply sep_proof_if_derives with Γ Γ1 e t;
    repeat first [ assumption | inversion WFG1; assumption | inversion WFG2; assumption].
  apply join_swap. assumption.
  apply IH2.
  assumption.
  apply Forall_cons.
    apply wf_guard_expr_type2 with Ξ t; assumption.
    assumption.
Qed.

Theorem sep_proof_stmt :
  forall Φ Ξ Γ Γ' s (J : (Φ ; Γ ; Ξ) ⊢ s ::: Γ'),
    wf_env Γ ->
    wf_guards Γ Ξ ->
    sep_proc_env Φ |- {{ sep_env Γ && sep_guards Ξ }} s {{ sep_env Γ' && sep_guards Ξ }}.
Proof.
  intros.
  rewrite <- sepcon_pure_andp.
  rewrite <- sepcon_pure_andp.
  dependent induction J.
  + apply sep_proof_skip with (Φ := Φ) (Ξ := Ξ). constructor.
  + apply sep_proof_proccall with (Φ := Φ) (Ξ := Ξ).
    econstructor; eauto.
    assumption.
    assumption.
  + apply sep_proof_assign with (Φ := Φ) (Ξ := Ξ).
    econstructor; eauto.
    assumption.
    assumption.
  + repeat rewrite sepcon_pure_andp.
    apply sep_proof_if with Γ1 Γ2 { ν : int_t | p }; assumption.
    purity.
    purity.
    purity.
    purity.
  + apply semax_seq with (Q := sep_env Γ' * sep_guards Ξ).
    apply IHJ1; assumption.
    apply IHJ2.
    apply wf_env_stmt with (P := Φ) (G := Γ) (X := Ξ) (s := s1); assumption.
    apply wf_guards_stmt with (P := Φ) (G := Γ) (X := Ξ) (s := s1); assumption.
 + apply sep_env_pure.
 + apply sep_guard_pure.
 + apply sep_env_pure.
 + apply sep_guard_pure.
Qed.

Corollary type_safety_stmt :
  forall Φ Γ s, (Φ ; [] ; []) ⊢ s ::: Γ -> sep_proc_env Φ |- {{ emp }} s {{ TT }}.
Proof.
  intros.
  assert (wf_env nil). constructor.
  assert (wf_guards nil nil). constructor.
  apply semax_pre_post with (P' := sep_env nil && sep_guards nil)
                            (Q' := sep_env Γ && sep_guards nil);
  first [ apply sep_proof_stmt with (Φ := Φ) (Ξ := []); assumption
        | unfold sep_guards; normalize ].
Qed.

Theorem sep_proof_program :
  forall Φ p,
    prog_type Φ p -> semax_prog (sep_proc_env Φ) p.
Proof.
  intros Φ p H.
  induction H.
  + constructor.
    apply type_safety_stmt with Γ; assumption.
  + assert (WFΓ : wf_env Γ).
      inversion H.
      pose (wf_env_stmt _ _ Γ _ body H9 H5).
      apply w.
    destruct pr.
    simpl in *.
    subst.
    pose (@semax_procdecl_p (sep_proc_env Φ)
                           e
                           body
                           (sep_schema p (seq_s body (return_s e)) S)
                           prog) as P.
    unfold sep_schema in P.
    destruct S.
    destruct s_ret.
    simpl in *.
    simpl in *.
    apply P.
    reflexivity.
    apply funspec_nomem.
    assumption.
    simpl in *.
    apply semax_pre_post with (P' := sep_env (combine s_formals s_formal_ts) && sep_guards [])
                              (Q' := sep_env Γ && sep_guards []).
    apply andp_right.
      apply derives_refl.
      unfold sep_guards. apply andp_right. normalize. purity.
    destruct r as [ τ φ ].
    apply derives_trans with (Q := sep_ty (subst (subst_one v e) (var_e v))
                                         (subst (subst_one v e) {ν : τ | φ})).
    unfold subst, Subst_var_expr, subst_one at 1, Language.subst_expr.
    destruct (eq_dec v v).
    apply type_interp.
    inversion H.
    apply wf_env_no_vv.
    apply WFΓ.
    assumption.
    constructor.
    intuition.
    intro.
    rewrite subst_ty_distr. apply derives_refl.
    inversion H.
    clear P. clear H1.
    inversion H3.
    unfold subst_one.
    destruct (eq_dec ν v). intuition. subst. reflexivity.
    assert (NEQ : v <> ν).
    inversion H.
    inversion H3. assumption.
    apply subst_vv_not_in_range_exp.
    apply wf_expr_ty_expr_fv with (Γ := Γ) (Ξ := []) (T := subst (subst_one v e) { ν : τ | φ }).
    apply WFΓ.
    assumption.
    apply sep_proof_stmt in H5.
    apply H5.
    inversion H.
    apply H2.
    constructor.
    apply IHprog_type.
Qed.


(*

  Copyright 2014 Cornell University
  Copyright 2015 Cornell University
  Copyright 2016 Cornell University
  Copyright 2017 Cornell University

  This file is part of VPrl (the Verified Nuprl project).

  VPrl is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  VPrl is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with VPrl.  If not, see <http://www.gnu.org/licenses/>.

  Websites: http://nuprl.org/html/verification/
            http://nuprl.org/html/Nuprl2Coq
            https://github.com/vrahli/NuprlInCoq

  Authors: Vincent Rahli

 *)

Require Export computation_preserves_lib.

Definition opabs_of_lib_entry {o} (e : @library_entry o) : opabs :=
  match e with
  | lib_abs oa _ _ _ => oa
  end.

Definition matching_entries {o} (entry1 entry2 : @library_entry o) : Prop :=
  matching_entry_sign (opabs_of_lib_entry entry1) (opabs_of_lib_entry entry2).

Fixpoint entry_in_library {o} (entry : @library_entry o) (lib : library) : Prop :=
  match lib with
  | [] => False
  | entry' :: entries =>
    entry = entry'
    \/
    (~ matching_entries entry entry'
       # entry_in_library entry entries)
  end.

(* [lib1] extends [lib0] *)
Definition lib_extends {o} (lib1 lib0 : @library o) : Prop :=
  forall entry, entry_in_library entry lib0 -> entry_in_library entry lib1.

Definition in_lib {o}
           (opabs : opabs)
           (lib   : @library o) :=
  exists (e : library_entry),
    List.In e lib
    /\ matching_entry_sign opabs (opabs_of_lib_entry e).

Definition entry_not_in_lib {o} (e : @library_entry o) (l : @library o) :=
  !in_lib (opabs_of_lib_entry e) l.

Hint Resolve matching_entry_sign_sym : slow.

Lemma entry_in_library_implies_in {o} :
  forall (entry : @library_entry o) lib,
    entry_in_library entry lib -> List.In entry lib.
Proof.
  induction lib; auto; introv h; simpl in *.
  repndors; subst; tcsp.
Qed.
Hint Resolve entry_in_library_implies_in : slow.

Lemma lib_extends_cons_implies {o} :
  forall (e : @library_entry o) (lib lib0 : library),
    entry_not_in_lib e lib0
    -> lib_extends lib (e :: lib0)
    -> lib_extends lib lib0.
Proof.
  introv ni ext i.
  apply ext; simpl; clear ext.
  right; dands; auto; intro m.
  destruct ni.

  exists entry.
  dands; eauto 3 with slow.
Qed.

Lemma lib_extends_refl {o} :
  forall (lib : @library o), lib_extends lib lib.
Proof.
  introv i; auto.
Qed.
Hint Resolve lib_extends_refl : slow.

Lemma entry_in_library_implies_find_entry {o} :
  forall (lib : @library o) abs opabs vars bs rhs correct,
    matching_entry abs opabs vars bs
    -> entry_in_library (lib_abs opabs vars rhs correct) lib
    -> find_entry lib abs bs = Some (lib_abs opabs vars rhs correct).
Proof.
  induction lib; introv m e; simpl in *; tcsp.
  destruct a.
  repndors; repnd.

  - inversion e; subst; clear e.
    boolvar; tcsp.

    + pose proof (correct_abs_proof_irrelevance _ _ _ correct correct0) as xx; subst; auto.

    + apply not_matching_entry_iff in n; tcsp.

  - boolvar; tcsp.
    apply matching_entry_implies_sign in m.
    apply matching_entry_implies_sign in m0.
    destruct e0.
    unfold matching_entries; simpl.

    eapply matching_entry_sign_trans;[|eauto].
    eapply matching_entry_sign_sym;auto.
Qed.

Lemma find_entry_some_decomp {o} :
  forall (lib : @library o) abs bs e,
    find_entry lib abs bs = Some e
    <=> {lib1 : library
         & {lib2 : library
         & {oa : opabs
         & {vars : list sovar_sig
         & {rhs : SOTerm
         & {correct : correct_abs oa vars rhs
         & lib = lib1 ++ e :: lib2
         # e = lib_abs oa vars rhs correct
         # matching_entry abs oa vars bs
         # find_entry lib1 abs bs = None }}}}}}.
Proof.
  induction lib; introv; split; introv h; simpl in *; ginv.

  - exrepnd.
    destruct lib1; ginv.

  - destruct a.
    boolvar; ginv.

    + exists ([] : @library o) lib opabs vars rhs correct; simpl.
      dands; auto.

    + apply IHlib in h; exrepnd; subst; clear IHlib.
      exists (lib_abs opabs vars rhs correct :: lib1) lib2 oa vars0 rhs0 correct0.
      dands; auto.
      simpl; boolvar; auto.
      apply not_matching_entry_iff in n; tcsp.

  - exrepnd; subst.
    destruct a.
    destruct lib1; simpl in *; ginv.

    + inversion h0; subst; clear h0.
      pose proof (correct_abs_proof_irrelevance _ _ _ correct correct0) as xx; subst; auto.
      boolvar; auto.
      apply not_matching_entry_iff in n; tcsp.

    + boolvar; ginv.
      apply IHlib.
      exists lib1 lib2 oa vars rhs correct; dands; auto.
Qed.

Lemma implies_entry_in_library_app_right {o} :
  forall (lib1 lib2 : @library o) e,
    entry_in_library e lib2
    -> (forall e', LIn e' lib1 -> ~ matching_entries e e')
    -> entry_in_library e (lib1 ++ lib2).
Proof.
  induction lib1; introv h q; simpl in *; auto.
  right; dands; auto.
Qed.

Lemma matching_entry_trans_right {o} :
  forall abs1 abs2 abs3 vars1 vars2 (bs : list (@BTerm o)),
    matching_entry abs1 abs2 vars1 bs
    -> matching_entry abs2 abs3 vars2 bs
    -> matching_entry abs1 abs3 vars2 bs.
Proof.
  introv m1 m2; unfold matching_entry in *; repnd; dands; tcsp;
    try (complete (allrw; auto)).
  eapply matching_parameters_trans; eauto.
Qed.

Lemma matching_entry_sym {o} :
  forall abs1 abs2 vars (bs : list (@BTerm o)),
    matching_entry abs1 abs2 vars bs
    -> matching_entry abs2 abs1 vars bs.
Proof.
  introv m; unfold matching_entry in *; repnd; dands; tcsp;
    try (complete (allrw; auto)).
  apply matching_parameters_sym; auto.
Qed.

Lemma matching_entry_preserves_find_entry {o} :
  forall (lib : @library o) abs1 abs2 vars bs,
    matching_entry abs1 abs2 vars bs
    -> find_entry lib abs1 bs = find_entry lib abs2 bs.
Proof.
  induction lib; introv m; simpl in *; auto.
  destruct a.
  boolvar; auto.
  - apply not_matching_entry_iff in n.
    apply matching_entry_sym in m.
    eapply matching_entry_trans_right in m0;[|exact m]; tcsp.
  - apply not_matching_entry_iff in n.
    eapply matching_entry_trans_right in m0;[|exact m]; tcsp.
  - eapply IHlib; eauto.
Qed.

Lemma matching_entry_sign_implies_matching_entry {o} :
  forall (abs1 abs2 : opabs) (vars : list sovar_sig) (bs : list (@BTerm o)),
    matching_bterms vars bs
    -> matching_entry_sign abs1 abs2
    -> matching_entry abs1 abs2 vars bs.
Proof.
  introv h m; unfold matching_entry_sign in m; unfold matching_entry.
  repnd; dands; auto.
Qed.

Lemma matching_entry_implies_matching_bterms {o} :
  forall (abs1 abs2 : opabs) (vars : list sovar_sig) (bs : list (@BTerm o)),
    matching_entry abs1 abs2 vars bs
    -> matching_bterms vars bs.
Proof.
  introv m; unfold matching_entry in m; tcsp.
Qed.

Lemma correct_abs_implies_matching_sign {o} :
  forall abs vars (t : @SOTerm o),
    correct_abs abs vars t
    -> matching_sign vars (opabs_sign abs).
Proof.
  introv cor.
  unfold correct_abs in cor; tcsp.
Qed.

Lemma matching_entry_sign_implies_eq_opabs_signs :
  forall abs1 abs2,
    matching_entry_sign abs1 abs2
    -> opabs_sign abs1 = opabs_sign abs2.
Proof.
  introv m; unfold matching_entry_sign in m; tcsp.
Qed.

Lemma find_entry_none_implies {o} :
  forall (lib : @library o) abs bs e vars rhs correct,
    matching_sign vars (opabs_sign abs)
    -> matching_sign vars (map num_bvars bs)
    -> find_entry lib abs bs = None
    -> LIn e lib
    -> ~ matching_entries (lib_abs abs vars rhs correct) e.
Proof.
  induction lib; introv ms1 ms2 fe i; simpl in *; tcsp.
  destruct a; repndors; subst; boolvar; tcsp.

  - unfold matching_entries; simpl; intro h.
    apply not_matching_entry_iff in n.
    destruct n.
    apply matching_entry_sign_implies_matching_entry; auto.
    apply matching_bterms_as_matching_sign.
    apply correct_abs_implies_matching_sign in correct0.
    unfold matching_sign in *.

    apply matching_entry_sign_implies_eq_opabs_signs in h.
    rewrite correct0.
    rewrite <- h.
    rewrite <- ms1; rewrite <- ms2; auto.

  - eapply IHlib; eauto.
Qed.

Lemma entry_in_libray_implies_find_entry_some {o} :
  forall lib abs oa vars (t : @SOTerm o) bs correct,
    matching_entry abs oa vars bs
    -> entry_in_library (lib_abs oa vars t correct) lib
    -> find_entry lib abs bs = Some (lib_abs oa vars t correct).
Proof.
  induction lib; introv m i; simpl in *; tcsp.
  destruct a; simpl in *.
  repndors; repnd.

  - inversion i; subst; clear i.
    pose proof (correct_abs_proof_irrelevance _ _ _ correct correct0) as xx; subst; auto.
    boolvar; auto.
    apply not_matching_entry_iff in n; tcsp.

  - unfold matching_entries in i0; simpl in i0.
    boolvar; ginv.

    + destruct i0.
      eapply matching_entry_implies_sign.
      eapply matching_entry_trans_right;[|exact m0].
      apply matching_entry_sym;eauto.

    + apply IHlib; auto.
Qed.

Lemma lib_extends_preserves_find_entry {o} :
  forall (lib1 lib2 : @library o) abs bs (e : library_entry),
    lib_extends lib2 lib1
    -> find_entry lib1 abs bs = Some e
    -> find_entry lib2 abs bs = Some e.
Proof.
  introv ext fe.
  apply find_entry_some_decomp in fe; exrepnd; subst.

  pose proof (ext (lib_abs oa vars rhs correct)) as h.
  simpl in h; autodimp h hyp.

  { apply implies_entry_in_library_app_right;[simpl; tcsp|].
    pose proof (matching_entry_preserves_find_entry lib0 abs oa vars bs) as q.
    autodimp q hyp.
    rewrite q in fe1; clear q.
    applydup @matching_entry_implies_matching_bterms in fe3.
    dup correct as ms.
    apply correct_abs_implies_matching_sign in ms.
    rw @matching_bterms_as_matching_sign in fe0.
    introv i; eapply find_entry_none_implies; eauto. }

  apply entry_in_libray_implies_find_entry_some; auto.
Qed.

Lemma compute_step_preserves_lib_extends {o} :
  forall (lib1 lib2 : library)
         (ext  : lib_extends lib2 lib1) (* lib2 extends lib1 *)
         (a b  : @NTerm o)
         (comp : compute_step lib1 a = csuccess b),
    compute_step lib2 a = csuccess b.
Proof.
  nterm_ind1s a as [v|f ind|op bs ind] Case; introv comp.

  - Case "vterm".
    csunf comp; allsimpl; ginv.

  - Case "sterm".
    csunf comp; allsimpl; ginv.

  - Case "oterm".
    dopid op as [can|ncan|exc|abs] SCase.

    + SCase "Can".
      csunf comp; allsimpl; ginv.

    + SCase "NCan".
      destruct bs as [|b1 bs]; try (complete (allsimpl; ginv)).
      destruct b1 as [l t]; try (complete (allsimpl; ginv)).
      destruct l; try (complete (allsimpl; ginv)).

      { destruct t as [x|f|op bts]; try (complete (allsimpl; ginv));[|].

        - csunf comp; allsimpl.
          dopid_noncan ncan SSCase; allsimpl; ginv.

          SSCase "NEApply".

          apply compute_step_eapply_success in comp; exrepnd; subst.
          repndors; exrepnd; allsimpl; subst.

          + apply compute_step_eapply2_success in comp1; repnd; subst.
            repndors; exrepnd; subst; ginv.
            csunf; simpl.
            dcwf h; simpl.
            boolvar; try omega.
            rewrite Znat.Nat2Z.id; auto.

          + csunf; simpl.
            apply isexc_implies2 in comp0; exrepnd; subst.
            dcwf h; simpl; auto.

          + fold_terms.
            rewrite compute_step_eapply_iscan_isnoncan_like; auto.
            pose proof (ind arg2 arg2 []) as h; clear ind.
            repeat (autodimp h hyp); eauto 3 with slow.
            apply h in comp1; clear h.
            rewrite comp1; auto.

        - dopid op as [can2|ncan2|exc2|abs2] SSCase.

          + SSCase "Can".
            dopid_noncan ncan SSSCase.

            {
              SSSCase "NApply".

              csunf comp; allsimpl.
              apply compute_step_apply_success in comp.
              repndors; exrepnd; subst; auto.
            }

            {
              SSSCase "NEApply".

              csunf comp; allsimpl.
              apply compute_step_eapply_success in comp.
              repndors; exrepnd; subst; auto.
              repndors; exrepnd; subst; allsimpl; auto.

              - apply compute_step_eapply2_success in comp1; repnd; subst.
                repndors; exrepnd; subst; auto; ginv.

                + unfold mk_lam in *; ginv.
                  csunf; simpl.
                  dcwf h; simpl.
                  apply iscan_implies in comp0; repndors; exrepnd; subst; simpl; auto.

                + unfold mk_nseq in *; allsimpl; ginv.
                  csunf; simpl.
                  dcwf h; simpl.
                  boolvar; simpl; auto; try omega.
                  rewrite Znat.Nat2Z.id; auto.

              - fold_terms; rewrite compute_step_eapply_iscan_isexc; auto.

              - fold_terms; rewrite compute_step_eapply_iscan_isnoncan_like; auto.

                pose proof (ind arg2 arg2 []) as q; clear ind.
                repeat (autodimp q hyp); eauto 2 with slow.
                apply q in comp1; clear q.
                rewrite comp1; auto.
            }

            {
              SSSCase "NFix".

              csunf comp; allsimpl.
              apply compute_step_fix_success in comp.
              repndors; exrepnd; subst; auto.
            }

            {
              SSSCase "NSpread".

              csunf comp; allsimpl.
              apply compute_step_spread_success in comp.
              repndors; exrepnd; subst; auto.
            }

            {
              SSSCase "NDsup".

              csunf comp; allsimpl.
              apply compute_step_dsup_success in comp.
              repndors; exrepnd; subst; auto.
            }

            {
              SSSCase "NDecide".

              csunf comp; allsimpl.
              apply compute_step_decide_success in comp.
              repndors; exrepnd; subst; auto.
              repndors; exrepnd; subst; auto.
            }

            {
              SSSCase "NCbv".

              csunf comp; allsimpl.
              apply compute_step_cbv_success in comp.
              repndors; exrepnd; subst; auto.
            }

            {
              SSSCase "NSleep".

              csunf comp; allsimpl.
              apply compute_step_sleep_success in comp.
              repndors; exrepnd; subst; auto.
            }

            {
              SSSCase "NTUni".

              csunf comp; allsimpl.
              apply compute_step_tuni_success in comp.
              repndors; exrepnd; subst; auto.
              csunf; simpl.
              unfold compute_step_tuni; simpl.
              boolvar; try omega.
              rewrite Znat.Nat2Z.id; auto.
            }

            {
              SSSCase "NMinus".

              csunf comp; allsimpl.
              apply compute_step_minus_success in comp.
              repndors; exrepnd; subst; auto.
            }

            {
              SSSCase "NFresh".

              csunf comp; allsimpl; ginv.
            }

            {
              SSSCase "NTryCatch".

              csunf comp; allsimpl.
              apply compute_step_try_success in comp.
              repndors; exrepnd; subst; auto.
            }

            {
              SSSCase "NParallel".

              csunf comp; allsimpl.
              apply compute_step_parallel_success in comp.
              repndors; exrepnd; subst; auto.
            }

            {
              SSSCase "NCompOp".

              apply compute_step_ncompop_can1_success in comp; repnd.
              repndors; exrepnd; allsimpl; subst; tcsp.

              - csunf; simpl.
                dcwf h.

              - rewrite compute_step_ncompop_ncanlike2; auto.
                dcwf h.
                pose proof (ind t t []) as q; clear ind.
                repeat (autodimp q hyp); eauto 2 with slow.
                apply q in comp4; clear q.
                rewrite comp4; auto.

              - csunf; simpl.
                apply isexc_implies2 in comp1; exrepnd; subst.
                dcwf h; simpl; auto.
            }

            {
              SSSCase "NArithOp".

              apply compute_step_narithop_can1_success in comp; repnd.
              repndors; exrepnd; allsimpl; subst; tcsp.

              - csunf; simpl.
                dcwf h.

              - rewrite compute_step_narithop_ncanlike2; auto.
                dcwf h.
                pose proof (ind t t []) as q; clear ind.
                repeat (autodimp q hyp); eauto 2 with slow.
                apply q in comp4; clear q.
                rewrite comp4; auto.

              - csunf; simpl.
                apply isexc_implies2 in comp1; exrepnd; subst.
                dcwf h; simpl; auto.
            }

            {
              SSSCase "NCanTest".

              csunf comp; allsimpl.
              apply compute_step_can_test_success in comp.
              repndors; exrepnd; subst; auto.
            }

          + SSCase "NCan".

            csunf comp; allsimpl.
            remember (compute_step lib1 (oterm (NCan ncan2) bts)) as c.
            destruct c; allsimpl; ginv.
            symmetry in Heqc.

            pose proof (ind (oterm (NCan ncan2) bts) (oterm (NCan ncan2) bts) []) as q; clear ind.
            repeat (autodimp q hyp); eauto 2 with slow.
            apply q in Heqc; clear q.
            csunf; simpl.
            rewrite Heqc; auto.

          + SSCase "Exc".

            csunf comp; allsimpl.
            apply compute_step_catch_success in comp.
            repndors; exrepnd; subst; allsimpl; ginv.

            * csunf; simpl; auto.

            * csunf; simpl; auto.
              rewrite compute_step_catch_if_diff; auto.

          + SSCase "Abs".

            csunf comp; allsimpl.
            remember (compute_step lib1 (oterm (Abs abs2) bts)) as c.
            destruct c; allsimpl; ginv.
            symmetry in Heqc.

            pose proof (ind (oterm (Abs abs2) bts) (oterm (Abs abs2) bts) []) as q; clear ind.
            repeat (autodimp q hyp); eauto 2 with slow.
            apply q in Heqc; clear q.
            csunf; simpl.
            rewrite Heqc; auto.
      }

      {
        csunf comp; allsimpl.
        apply compute_step_fresh_success in comp; exrepnd; subst.
        repndors; exrepnd; subst; ginv.

        - csunf; simpl; boolvar; auto.

        - rewrite compute_step_fresh_if_isvalue_like2; auto.

        - fold (mk_fresh n t).
          rewrite compute_step_fresh_if_isnoncan_like; auto.

          pose proof (ind t (subst t n (mk_utoken (get_fresh_atom t))) [n]) as q; clear ind.
          repeat (autodimp q hyp); eauto 2 with slow.
          { rewrite simple_osize_subst; eauto 2 with slow. }
          apply q in comp2; clear q.
          remember (get_fresh_atom t) as a; simpl.
          rewrite comp2; simpl; auto.
      }

    + SCase "Exc".

      csunf comp; allsimpl; ginv.

    + SCase "Abs".

      csunf comp; allsimpl.
      apply compute_step_lib_success in comp.
      exrepnd; subst.

      csunf; simpl.

      apply (found_entry_implies_compute_step_lib_success _ _ _ _ _ _ correct).
      eapply lib_extends_preserves_find_entry; eauto.
Qed.

Lemma reduces_in_atmost_k_steps_preserves_lib_extends {o} :
  forall (lib1 lib2 : library)
         (ext  : lib_extends lib2 lib1) (* lib2 extends lib1 *)
         (a b  : @NTerm o)
         (n : nat)
         (comp : reduces_in_atmost_k_steps lib1 a b n),
    reduces_in_atmost_k_steps lib2 a b n.
Proof.
  introv ext r.
  revert dependent a.
  induction n; introv r.

  - allrw @reduces_in_atmost_k_steps_0; auto.

  - allrw @reduces_in_atmost_k_steps_S; exrepnd.
    exists u; dands; auto.
    eapply compute_step_preserves_lib_extends; eauto.
Qed.

Lemma reduces_to_preserves_lib_extends {o} :
  forall (lib1 lib2 : library)
         (ext  : lib_extends lib2 lib1) (* lib2 extends lib1 *)
         (a b  : @NTerm o)
         (comp : reduces_to lib1 a b),
    reduces_to lib2 a b.
Proof.
  introv ext r.
  unfold reduces_to in *; exrepnd.
  exists k.
  eapply reduces_in_atmost_k_steps_preserves_lib_extends; eauto.
Qed.


Require Import SpecDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import BaremoreSMC.Spec.
Require Import AbsAccessor.Spec.

Local Open Scope Z_scope.

Section SpecLow.

  Definition granule_undelegate_ops_spec0 (g: Pointer) (addr: Z64) (adt: RData) : option RData :=
    match g, addr with
    | (_g_base, _g_ofst), VZ64 _addr =>
      rely is_int64 _addr;
      when adt == smc_mark_nonsecure_spec (VZ64 _addr) adt;
      when adt == granule_set_state_spec (_g_base, _g_ofst) 0 adt;
      when adt == granule_unlock_spec (_g_base, _g_ofst) adt;
      Some adt
     end
    .

End SpecLow.


(*

  Copyright 2014 Cornell University

  This file is part of VPrl (the Verified Nuprl project).

  VPrl is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  VPrl is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with VPrl.  If not, see <http://www.gnu.org/licenses/>.

  Website: http://nuprl.org/html/verification/
  Authors: Abhishek Anand & Vincent Rahli

*)

Require Export csubst.

Lemma lsubstc_app_cover1 {o} :
  forall (t : @NTerm o) sub1 sub2 p c (c' : cover_vars t sub1),
    lsubstc t p (sub1 ++ sub2) c
    = lsubstc t p sub1 c'.
Proof.
  introv.
  apply cterm_eq; simpl.
  unfold csubst.
  rw <- @csub2sub_app.
  rw <- @simple_lsubst_app.
  - rw @lsubst_trivial; auto.
    introv i.
    applydup @in_csub2sub in i; dands; auto.
    introv k.
    pose proof (eqvars_free_vars_disjoint t (csub2sub sub1)) as h.
    eapply eqvars_prop in h; apply h in k; clear h.
    rw in_app_iff in k; rw in_remove_nvars in k.
    dorn k; repnd.
    + rw @cover_vars_eq in c'.
      rw subvars_prop in c'.
      apply c' in k0.
      rw @dom_csub_eq in k; auto.
    + apply in_sub_free_vars_iff in k; exrepnd.
      apply in_sub_keep_first in k0; repnd.
      apply sub_find_some in k2.
      apply in_csub2sub in k2.
      destruct k2 as [cl wf].
      rw cl in k1; sp.
  - introv i; apply in_csub2sub in i; sp.
  - introv i; apply in_csub2sub in i; sp.
Qed.

Lemma csubst_snoc_app_move_to_last {o} :
  forall (t : @NTerm o) s1 s2 x a,
    !LIn x (dom_csub s2)
    -> csubst t (snoc s1 (x, a) ++ s2)
       = csubst t (snoc (s1 ++ s2) (x, a)).
Proof.
  introv ni1.
  rw <- snoc_append_l.
  symmetry.
  rw <- @csubst_app.
  rewrite <- (csubst_swap (csubst t s1) s2); auto.
  rw @csubst_app.
  rw <- snoc_append_r; auto.
Qed.

Lemma lsubstc_snoc_app_move_to_last {o} :
  forall (t : @NTerm o) s1 s2 x a w c,
    !LIn x (dom_csub s2)
    -> {c' : cover_vars t (snoc (s1 ++ s2) (x,a))
        $ lsubstc t w (snoc s1 (x,a) ++ s2) c
          = lsubstc t w (snoc (s1 ++ s2) (x,a)) c'}.
Proof.
  introv ni.

  assert (cover_vars t (snoc (s1 ++ s2) (x,a))) as cv.
  allrw @cover_vars_eq; allrw subvars_eq.
  introv i; applydup c in i.
  allrw @dom_csub_app; allrw @dom_csub_snoc; allrw @dom_csub_app; allsimpl.
  allrw in_app_iff; allrw in_snoc; allrw in_app_iff.
  sp; subst; sp.

  exists cv.

  apply cterm_eq; simpl.
  apply csubst_snoc_app_move_to_last; auto.
Qed.

Lemma csubst_snoc_app_move_down {o} :
  forall (t : @NTerm o) s1 s2 s3 x a,
    !LIn x (dom_csub s2)
    -> csubst t ((snoc s1 (x, a) ++ s2) ++ s3)
       = csubst t (snoc (s1 ++ s2) (x, a) ++ s3).
Proof.
  introv ni1.
  rw <- @csubst_app.
  symmetry; rw <- @csubst_app.
  rw @csubst_snoc_app_move_to_last; auto.
Qed.

Lemma lsubstc_snoc_app_move_down {o} :
  forall (t : @NTerm o) s1 s2 s3 x a w c,
    !LIn x (dom_csub s2)
    -> {c' : cover_vars t (snoc (s1 ++ s2) (x,a) ++ s3)
        $ lsubstc t w ((snoc s1 (x,a) ++ s2) ++ s3) c
          = lsubstc t w (snoc (s1 ++ s2) (x,a) ++ s3) c'}.
Proof.
  introv ni.

  assert (cover_vars t (snoc (s1 ++ s2) (x,a) ++ s3)) as cv.
  allrw @cover_vars_eq; allrw subvars_eq.
  introv i; applydup c in i.
  allrw @dom_csub_app; allrw @dom_csub_snoc; allrw @dom_csub_app; allsimpl.
  allrw in_app_iff; allrw in_snoc; allrw in_app_iff.
  sp; subst; sp.

  exists cv.

  apply cterm_eq; simpl.
  apply csubst_snoc_app_move_down; auto.
Qed.

Lemma lsubstc_snoc_app_move_down2 {o} :
  forall (t : @NTerm o) s1 s2 s3 x a w c,
    !LIn x (dom_csub s2)
    -> {c' : cover_vars t ((snoc s1 (x,a) ++ s2) ++ s3)
        $ lsubstc t w (snoc (s1 ++ s2) (x,a) ++ s3) c
          = lsubstc t w ((snoc s1 (x,a) ++ s2) ++ s3) c'}.
Proof.
  introv ni.

  assert (cover_vars t ((snoc s1 (x,a) ++ s2) ++ s3)) as cv.
  allrw @cover_vars_eq; allrw subvars_eq.
  introv i; applydup c in i.
  allrw @dom_csub_app; allrw @dom_csub_snoc; allrw @dom_csub_app; allsimpl.
  allrw in_app_iff; allrw in_snoc; allrw in_app_iff.
  sp; subst; sp.

  exists cv.

  apply cterm_eq; simpl.
  symmetry; apply csubst_snoc_app_move_down; auto.
Qed.

Lemma subst_preserves_isprog_vars {p} :
  forall (t : @NTerm p) (v : NVar) (u : NTerm) vs,
    isprog_vars (v :: vs) t
    -> isprog_vars vs u
    -> isprog_vars vs (subst t v u).
Proof.
  introv ispt ispu.
  unfold lsubst.
  allrw @isprog_vars_eq; repnd; dands.
  - unfold subst.
    pose proof (eqvars_free_vars_disjoint t [(v,u)]) as eqv; simpl in eqv.
    allrw subvars_prop; introv i.
    eapply eqvars_prop in eqv.
    apply eqv in i; clear eqv.
    apply in_app_iff in i; dorn i.
    + apply in_remove_nvars in i; rw in_single_iff in i; repnd.
      discover; allsimpl; sp.
    + revert i; boolvar; intro i; allsimpl; tcsp.
      allrw app_nil_r.
      discover; sp.
  - apply lsubst_wf_iff; auto.
    unfold wf_sub, sub_range_sat; simpl; simpl; introv k; sp; cpx.
Qed.

Lemma cover_vars_isprog_vars {o} :
  forall (t : @NTerm o) sub vs1 vs2,
    wf_term t
    -> eqvars vs2 (vs1 ++ dom_csub sub)
    -> (cover_vars_upto t sub vs1 <=> isprog_vars vs2 t).
Proof.
  introv wf eqv.
  unfold cover_vars_upto.
  rw @isprog_vars_eq.
  rw eqvars_prop in eqv.
  split; intro k; repnd; dands; auto.
  - allrw subvars_prop; introv i.
    discover; auto.
  - apply nt_wf_eq; auto.
  - allrw subvars_prop; introv i.
    discover; auto.
Qed.

Lemma cover_vars_implies_isprog_vars {o} :
  forall (t : @NTerm o) sub vs1 vs2,
    wf_term t
    -> subvars (vs1 ++ dom_csub sub) vs2
    -> cover_vars_upto t sub vs1
    -> isprog_vars vs2 t.
Proof.
  introv wf eqv cv.
  unfold cover_vars_upto in cv.
  rw @isprog_vars_eq.
  allrw subvars_prop; dands.
  - introv i; discover; auto.
  - apply nt_wf_eq; auto.
Qed.

Lemma lsubstc_subst_snoc_eq_ex {o} :
  forall (s : @CSub o)
         (b : NTerm)
         (x y : NVar)
         (a : CTerm)
         (w1 : wf_term (subst b x (mk_var y)))
         (c1 : cover_vars (subst b x (mk_var y)) (snoc s (y, a))),
    !LIn y (bound_vars b)
    -> !LIn y (dom_csub s)
    -> (y <> x -> !LIn y (free_vars b))
    -> {w2 : wf_term b
        & {c2 : cover_vars_upto b (csub_filter s [x]) [x]
        & lsubstc (subst b x (mk_var y)) w1 (snoc s (y, a)) c1
          = substc a x (lsubstc_vars b w2 (csub_filter s [x]) [x] c2)}}.
Proof.
  introv ni1 ni2 ni3.

  assert (wf_term b) as w2 by (apply lsubst_wf_term in w1; auto).
  exists w2.

  assert (cover_vars_upto b (csub_filter s [x]) [x]) as c2.
  allrw @cover_vars_eq.
  unfold cover_vars_upto.
  allrw subvars_prop; introv i; simpl.
  destruct (deq_nvar x x0); subst; tcsp.
  right.
  rw @dom_csub_csub_filter; rw in_remove_nvars; rw in_single_iff; dands; tcsp.
  pose proof (c1 x0) as h; autodimp h hyp.
  pose proof (eqvars_free_vars_disjoint b [(x,mk_var y)]) as eqv.
  rw eqvars_prop in eqv; apply eqv; clear eqv; simpl.
  rw in_app_iff; rw in_remove_nvars; rw in_single_iff; left; sp.
  rw @dom_csub_snoc in h; simpl in h; rw in_snoc in h; dorn h; tcsp; subst.
  autodimp ni3 hyp; sp.

  exists c2.
  apply lsubstc_subst_snoc_eq; sp.
Qed.

Lemma lsubst_aux_swap_context {o} :
  forall t (s1 s2 s : @Sub o) v u,
    (forall v t, LIn (v, t) s -> isprogram t)
    -> isprogram u
    -> !LIn v (dom_sub s)
    -> lsubst_aux t ((s1 ++ (v, u) :: s) ++ s2) = lsubst_aux t ((s1 ++ snoc s (v, u)) ++ s2).
Proof.
  nterm_ind t as [v|f|op lbt ind] Case; simpl; intros; auto.

  - Case "vterm".
    repeat (rw @sub_find_app).
    rw @sub_find_snoc; simpl; boolvar.
    + remember (sub_find s1 v) as s1n; destruct s1n; symmetry in Heqs1n; auto.
      remember (sub_find s v) as sn; destruct sn; symmetry in Heqsn; auto.
      apply sub_find_some in Heqsn.
      apply in_dom_sub in Heqsn; sp.
    + remember (sub_find s1 v) as s1n; destruct s1n; symmetry in Heqs1n; auto.
      remember (sub_find s v) as sn; destruct sn; symmetry in Heqsn; auto.

  - Case "oterm".
    apply oterm_eq; auto.
    apply eq_maps; introv i.
    destruct x; simpl.
    apply bterm_eq; auto.

    repeat (rw @sub_filter_app); simpl.
    repeat (rw @sub_filter_snoc); boolvar; auto.

    eapply ind; eauto; introv;
    try (rw @in_sub_filter);
    try (rw <- @dom_sub_sub_filter);
    try (rw in_remove_nvars);
    intro k; repnd; discover; sp.
Qed.

Lemma range_snoc {p} :
  forall (s : @Sub p) v t,
    range (snoc s (v, t))
    = snoc (range s) t.
Proof.
  introv; unfold range; rw map_snoc; sp.
Qed.

Lemma lsubst_swap_context {o} :
  forall t (s1 s2 s : @Sub o) v u,
    (forall v t, LIn (v, t) s -> isprogram t)
    -> (forall v t, LIn (v, t) s1 -> isprogram t)
    -> (forall v t, LIn (v, t) s2 -> isprogram t)
    -> isprogram u
    -> !LIn v (dom_sub s)
    -> lsubst t ((s1 ++ (v, u) :: s) ++ s2) = lsubst t ((s1 ++ snoc s (v, u)) ++ s2).
Proof.
  introv k1 k2 k3 isp ni.
  change_to_lsubst_aux4;
    try (complete (allrw @range_app; allsimpl; try (rw @range_snoc);
                   allrw flat_map_app; allrw flat_map_snoc; allsimpl;
                   destruct isp as [cl w]; rw cl;
                   repeat (rw @closed_sub; auto); simpl; sp)).
  apply lsubst_aux_swap_context; auto.
Qed.

Lemma csubst_swap_context {o} :
  forall t (s1 s2 s : @CSub o) v u,
    !LIn v (dom_csub s)
    -> csubst t ((s1 ++ (v, u) :: s) ++ s2)
       = csubst t ((s1 ++ snoc s (v, u)) ++ s2).
Proof.
  intros.
  unfold csubst; simpl.
  repeat (rw <- @csub2sub_app); simpl.
  allrw @csub2sub_snoc.
  apply lsubst_swap_context; auto;
  try (complete (intros; allapply @in_csub2sub; sp)).
  rw @dom_csub_eq; auto.
Qed.

Lemma csubst_subst_snoc_eq2 {o} :
  forall s b x y (a : @CTerm o),
    !LIn y (bound_vars b)
    -> !LIn y (dom_csub s)
    -> !LIn x (dom_csub s)
    -> x <> y
    -> csubst (subst b x (mk_var y)) (snoc s (y, a))
       = csubst b (snoc (snoc s (x, a)) (y, a)).
Proof.
  introv ni1 ni2 ni3 ni4.
  unfold subst, csubst.
  rewrite simple_lsubst_lsubst; simpl;
  [
  | complete (intros; sp; cpx; simpl; rw disjoint_singleton_l; auto)
  | complete (intros; allapply @in_csub2sub; auto)].

  change_to_lsubst_aux4;
    [ |
      simpl;
        apply disjoint_app_r;
        rw disjoint_flat_map_r;
        dands; [remember (sub_find (csub2sub (snoc s (y,a))) y) as k; destruct k; symmetry in Heqk|]; simpl;
        [ complete (apply sub_find_some in Heqk; apply in_csub2sub in Heqk;
                    destruct Heqk as [cl k]; rw cl; sp)
        | complete (rw disjoint_singleton_r; auto)
        | ]; introv k;
        apply in_range in k; exrepnd;
        apply in_csub2sub in k0; auto; destruct k0 as [cl k]; rw cl; sp
    ].

  simpl.

  rw @csub2sub_snoc.
  rw @sub_find_snoc.

  pose proof (sub_find_none_iff (csub2sub s) y) as k.
  rw @dom_csub_eq in k; apply k in ni2; rw ni2; boolvar.

  rw snoc_as_append.
  pose proof (lsubst_aux_swap_context b []) as h; simpl in h.
  rw h; auto.
  rw <- snoc_as_append.
  repeat (rw @csub2sub_snoc); auto.
  intros; allapply @in_csub2sub; sp.
  rw @dom_csub_eq; auto.
Qed.

Lemma lsubstc_subst_snoc_eq2 {o} :
  forall (s : @CSub o) b x y a w1 w2 c1 c2,
    !LIn y (bound_vars b)
    -> !LIn y (dom_csub s)
    -> !LIn x (dom_csub s)
    -> x <> y
    -> lsubstc (subst b x (mk_var y)) w1 (snoc s (y, a)) c1
       = lsubstc b w2 (snoc (snoc s (x, a)) (y, a)) c2.
Proof.
  intros.

  apply cterm_eq; simpl.
  apply csubst_subst_snoc_eq2; auto.
Qed.

Lemma lsubstc_subst_snoc_eq2_ex {o} :
  forall (s : @CSub o)
         (b : NTerm)
         (x y : NVar)
         (a : CTerm)
         (w1 : wf_term (subst b x (mk_var y)))
         (c1 : cover_vars (subst b x (mk_var y)) (snoc s (y, a))),
    !LIn y (bound_vars b)
    -> !LIn y (dom_csub s)
    -> !LIn x (dom_csub s)
    -> x <> y
    -> {w2 : wf_term b
        & {c2 : cover_vars b (snoc (snoc s (x,a)) (y,a))
        & lsubstc (subst b x (mk_var y)) w1 (snoc s (y, a)) c1
          = lsubstc b w2 (snoc (snoc s (x,a)) (y,a)) c2}}.
Proof.
  introv ni1 ni2.

  assert (wf_term b) as w2 by (apply lsubst_wf_term in w1; auto).
  exists w2.

  assert (cover_vars b (snoc (snoc s (x,a)) (y,a))) as c2.
  allrw @cover_vars_eq; allrw subvars_prop; introv i; simpl.
  repeat (rw @dom_csub_snoc); simpl; repeat (rw in_snoc).
  destruct (deq_nvar x x0); subst; tcsp.
  pose proof (c1 x0) as h; autodimp h hyp.
  pose proof (eqvars_free_vars_disjoint b [(x,mk_var y)]) as eqv.
  rw eqvars_prop in eqv; apply eqv; clear eqv; simpl.
  rw in_app_iff; rw in_remove_nvars; rw in_single_iff; left; sp.
  rw @dom_csub_snoc in h; simpl in h; rw in_snoc in h; dorn h; tcsp; subst.

  exists c2.

  apply lsubstc_subst_snoc_eq2; auto.
Qed.

Lemma lsubst_aux_snoc_cover_vars {p} :
  forall (t : @NTerm p) sub v u,
    (LIn v (free_vars t) -> LIn v (dom_sub sub))
    -> lsubst_aux t (snoc sub (v, u)) = lsubst_aux t sub.
Proof.
  nterm_ind t as [v|f|o lbt ind] Case; simpl; introv ni; auto.

  - Case "vterm".
    allunfold @covered; allsimpl; allrw subvars_singleton_l.
    rw @sub_find_snoc.
    remember (sub_find sub v); destruct o; symmetry in Heqo; sp.
    boolvar; auto.
    applydup @sub_find_none2 in Heqo; sp.

  - Case "oterm".
    f_equal.
    apply eq_maps; sp.
    destruct x; simpl.

    rw @sub_filter_snoc; boolvar; auto.
    apply bterm_eq; auto.
    apply ind with (lv := l); auto.

    introv i.
    rw <- @dom_sub_sub_filter.
    apply in_remove_nvars; dands; auto.
    assert (LIn v (flat_map free_vars_bterm lbt)); discover; auto.
    apply lin_flat_map.
    exists (bterm l n); dands; auto.
    simpl; apply in_remove_nvars; sp.
Qed.

Lemma lsubst_snoc_cover_vars {p} :
  forall (t : @NTerm p) sub v u,
    disjoint (bound_vars t) (flat_map free_vars (range sub))
    -> disjoint (bound_vars t) (free_vars u)
    -> (LIn v (free_vars t) -> LIn v (dom_sub sub))
    -> lsubst t (snoc sub (v, u)) = lsubst t sub.
Proof.
  introv d1 d2 ni.
  change_to_lsubst_aux4.
  - apply lsubst_aux_snoc_cover_vars; auto.
  - allrw @range_snoc.
    allrw flat_map_snoc.
    allrw disjoint_app_r; sp.
Qed.

Lemma prog_sub_nil {o} : @prog_sub o [].
Proof.
  unfold prog_sub, sub_range_sat; simpl; sp.
Qed.
Hint Immediate prog_sub_nil.

Lemma closed_sub_cl {p} :
  forall (sub : @Sub p),
    (forall v t, LIn (v, t) sub -> closed t)
    -> flat_map free_vars (range sub) = [].
Proof.
  induction sub; allsimpl; introv h; auto.
  destruct a; allsimpl.
  pose proof (h n n0) as k; autodimp k hyp.
  rw k.
  rw IHsub; auto.
  introv i; eapply h; eauto.
Qed.

Lemma disjoint_sub_if_cl {p} :
  forall (sub : @Sub p),
    (forall v t, LIn (v, t) sub -> closed t)
    -> forall t : @NTerm p, disjoint (bound_vars t) (flat_map free_vars (range sub)).
Proof.
  introv i.
  rw @closed_sub_cl; auto.
Qed.

Lemma dom_sub_lsubst_sub {o} :
  forall (sub1 sub2 : @Sub o),
    dom_sub (lsubst_sub sub1 sub2) = dom_sub sub1.
Proof.
  induction sub1; introv; simpl; auto.
  destruct a; simpl.
  apply eq_cons; auto.
Qed.


From CoreErlang.BigStep Require Export DeterminismHelpers.

(** Proofs about the semantics *)

Import ListNotations.
(* Import Coq.Init.Logic. *)

Proposition length_split_eq {A B : Type} (l : list (A * B)) :
  length (fst (split l)) = length (snd (split l)).
Proof.
  rewrite split_length_l, split_length_r. auto.
Qed.

Proposition split_eq {A B : Type} {l l0 : list (A * B)} :
  split l = split l0 <-> l = l0.
Proof.
  split; generalize dependent l0.
  * induction l; intros.
    - inversion H. destruct l0.
      + reflexivity.
      + inversion H1. destruct p. destruct (split l0). inversion H2.
    - destruct l0.
      + inversion H. destruct a. destruct (split l). inversion H1.
      + inversion H. subst. assert (split l = split l0). {
        destruct a, p. destruct (split l), (split l0). inversion H1. subst. auto.
        }
        pose (IH := IHl l0 H0).
        destruct a, p. destruct (split l), (split l0) in H1. inversion H1. rewrite IH. auto.
  * intros. rewrite H. reflexivity.
Qed.

Theorem determinism :
(
  forall {env modules own_module id e eff id' v1 eff'},
  |env, modules, own_module, id, e, eff| -e> | id', v1, eff'|
->
  (forall v2 eff'' id'', |env, modules, own_module, id, e, eff| -e> |id'', v2, eff''| -> v1 = v2 /\ eff' = eff''
      /\ id' = id'')
).
Proof.
  intros env modules own_module id e eff id' v1 eff' H. induction H; intros.

  (* VALUE LIST *)
  * inversion H6; subst.
    - pose (P := explist_equality _ _ _ _ _ _ _ H3 H11 H8 H9 H H0 H1 H10).
      destruct P. destruct H5. subst. auto.
    - pose (P := explist_prefix_eq _ _ _ _ _ _ _ _ _ _ _ H H0 H10 H8 H1 H11 H3 H12 H17).
      inversion P.

  (* VALUE LIST EXCEPTION *)
  * inversion H6; subst.
    - epose (P := explist_prefix_eq_rev _ _ _ _ _ _ _ _ _ _ _ H4 H11 IHeval_expr H H1 H8 H9 H10 H2).
      inversion P.
    - epose (P := exception_equality _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H4 H17 IHeval_expr H12
        _ _ _ _ _ _ _ _).
      destruct P, H7, H9. subst. auto.
      Unshelve.
      all: auto.

(*   (* SINGLE EXPRESSION *)
  * apply H. inversion H0. auto. *)

  (* NIL *)
  * inversion H. auto.

  (* LIT *)
  * inversion H. auto.

  (* VAR *)
  * inversion H0. subst. rewrite H6 in H. inversion H. auto.

  (* FUNID *)
  * inversion H0.
    - subst. rewrite H6 in H. inversion H. auto.
    - congruence.

  (* FUNID WITH MODULE *)
  * inversion H3.
    - subst. congruence.
    - subst. rewrite H6 in H0. inversion H0. subst. auto.

  (* FUN *)
  * inversion H. auto.

  (* TUPLE *)
  * inversion H6; subst.
    - pose (P := explist_equality _ _ _ _ _ _ _ H3 H11 H8 H9 H H0 H1 H10).
      destruct P, H5. subst. auto.
    - pose (P := explist_prefix_eq _ _ _ _ _ _ _ _ _ _ _ H H0 H10 H8 H1 H11 H3 H12 H17).
      inversion P.

  (* CONS *)
  * inversion H1; subst.
    - apply IHeval_expr1 in H8. destruct H8, H3. inversion H2. subst.
      apply IHeval_expr2 in H13. destruct H13, H4. inversion H3. subst. auto.
    - apply IHeval_expr1 in H12. destruct H12. congruence.
    - apply IHeval_expr1 in H8. destruct H8, H3. inversion H2. subst.
      apply IHeval_expr2 in H13. destruct H13, H4. congruence.

  (* CASE *)
  * inversion H6; subst.
    - apply IHeval_expr1 in H9. destruct H9, H8. inversion H7. subst.
      pose (P := index_case_equality _ _ _ _ _ _ _ _ _ _ H3 H12 H1 H11 H17 H4 IHeval_expr2).
      assert (i = i0). { auto. }
      clear P. subst. rewrite H1 in H11. inversion H11. subst.
      apply IHeval_expr2 in H17. apply IHeval_expr3 in H22. auto.
    - apply IHeval_expr1 in H17. destruct H17. congruence.
    - apply IHeval_expr1 in H13. destruct H13, H8. inversion H7. subst.
      pose (P := H18 i H0 _ _ _ H1).
      apply IHeval_expr2 in P. destruct P. inversion H8.

  (* CALL *)
   * inversion H9; subst.
    - apply IHeval_expr1 in H16. destruct H16, H10. inversion H8. subst.
      apply IHeval_expr2 in H17. destruct H17, H11. inversion H10. subst.
      pose (P := explist_equality _ _ _ _ _ _ _ H5 H18 H13 H14 H H0 H1 H15).
      destruct P, H12. subst. rewrite H7 in H28. inversion H28. auto.
    - apply IHeval_expr1 in H16. destruct H16 , H10. inversion H8. subst.
      apply IHeval_expr2 in H17. destruct H17  , H11. inversion H10. subst.
      congruence.
    - apply IHeval_expr1 in H17. destruct H17  , H10. destruct H8. subst.
      apply IHeval_expr2 in H22. destruct H22  , H10. destruct H8. subst.
      pose (P := explist_prefix_eq _ _ _ _ _ _ _ _ _ _ _ H H0 H15 H13 H1 H16 H5 H27 H28).
      inversion P.
    - apply IHeval_expr1 in H21. destruct H21. congruence.
    - apply IHeval_expr1 in H21. destruct H21, H10. inversion H8. subst.
      apply IHeval_expr2 in H22. destruct H22. congruence.
    - apply IHeval_expr1 in H16. destruct H16, H10. inversion H8. subst. congruence.
    - apply IHeval_expr1 in H16. destruct H16, H10. inversion H8. subst.
      apply IHeval_expr2 in H17. destruct H17, H11. inversion H10. subst. congruence.

  * inversion H8; subst.
    - apply IHeval_expr1 in H15. destruct H15, H10. inversion H9. subst.
      apply IHeval_expr2 in H16. destruct H16, H11. inversion H10. subst.
      pose (P := explist_equality _ _ _ _ _ _ _ H5 H17 H12 H13 H H0 H1 H14).
      destruct P , H15. subst. congruence.
    - apply IHeval_expr1 in H15. destruct H15, H10. inversion H9. subst.
      apply IHeval_expr2 in H16. destruct H16, H11. inversion H10. subst.
      pose (P := explist_equality _ _ _ _ _ _ _ H5 H21 H12 H13 H H0 H1 H14).
      destruct P , H15. subst. rewrite H6 in H26. inversion H26. subst.
      apply IHeval_expr3 in H27. destruct H27, H15. inversion H11. subst. auto.

    - apply IHeval_expr1 in H16. destruct H16, H10. inversion H9. subst.
      apply IHeval_expr2 in H21. destruct H21, H11. inversion H10. subst.
      pose (P := explist_prefix_eq _ _ _ _ _ _ _ _ _ _ _ H H0 H14 H12 H1 H15 H5 H26 H27).
      inversion P.
    - apply IHeval_expr1 in H20. destruct H20, H10. congruence.
    - apply IHeval_expr1 in H20. destruct H20, H10. inversion H9. subst.
      apply IHeval_expr2 in H21. destruct H21, H11. congruence.
    - apply IHeval_expr1 in H15. destruct H15, H10. inversion H9. subst.
      apply IHeval_expr2 in H16. destruct H16, H11. inversion H10. subst. congruence.
    - apply IHeval_expr1 in H15. destruct H15, H10. inversion H9. subst.
      apply IHeval_expr2 in H16. destruct H16, H11. inversion H10. subst. congruence.

  (* PRIMOP *)
  * inversion H6; subst.
    - pose (P := explist_equality vals vals0 eff eff4 id ids ids0 H3 H12 H9 H10 H H0 H1 H11).
      destruct P, H7. subst. rewrite H4 in H17. inversion H17. auto.
    - pose (P := explist_prefix_eq _ _ _ _ _ _ _ _ _ _ _ H H0 H11 H9 H1 H12 H3 H17 H22).
      inversion P.

  (* APP *)
  * inversion H7; subst.
    - apply IHeval_expr1 in H11. destruct H11, H9. inversion H8. subst.
      pose (P := explist_equality _ _ _ _ _ _ _ H5 H19 H10 H13 H H2 H3 H14).
      destruct P, H11. subst. apply IHeval_expr2. auto.
    - apply IHeval_expr1 in H18. destruct H18. congruence.
    - apply IHeval_expr1 in H14. destruct H14, H9. inversion H8. subst.
      pose (P := explist_prefix_eq _ _ _ _ _ _ _ _ _ _ _ H H2 H12 H10 H3 H13 H5 H19 H24).
      inversion P.
    - apply IHeval_expr1 in H13. destruct H13, H9. inversion H8. subst.
      congruence.
    - apply IHeval_expr1 in H13. destruct H13, H9. inversion H8. subst.
      lia.

  (* LET *)
  * inversion H2; subst.
    - apply IHeval_expr1 in H10. destruct H10, H4. inversion H3. subst.
      apply IHeval_expr2 in H16. auto.
    - apply IHeval_expr1 in H14. destruct H14. congruence.

  (* SEQ *)
  * inversion H1; subst.
    - apply IHeval_expr1 in H8. destruct H8, H3. inversion H2. subst.
      apply IHeval_expr2 in H13. auto.
    - apply IHeval_expr1 in H12. destruct H12. inversion H2.

  (* LETREC *)
  * inversion H0. subst. apply IHeval_expr in H11. auto.

  (* MAP *)
  * inversion H9; subst.
    - assert (exps = exps0). { auto. } rewrite <- H6 in *.
      assert (length vals0 = length l * 2). { unfold vals0. rewrite H12. eapply length_make_map_vals. lia. }
      assert (length vals = length l * 2). { unfold vals. rewrite H0. eapply length_make_map_vals. lia. }
      assert (length exps = length l * 2). { unfold exps. apply length_make_map_exps. }
      rewrite <- H10 in *.
      pose (P := explist_equality _ _ _ _ _ _ _ H4 H15 (eq_sym H7) H13 (eq_sym H8) H1 H2 H14).
      destruct P. destruct H18. subst.
      unfold vals, vals0 in H18. apply make_map_vals_eq in H18.
      2-4: lia.
      destruct H18. subst. rewrite H16 in H5. inversion H5. subst. auto.
    - assert (length exps = length vals). { unfold vals. unfold exps. rewrite length_make_map_vals. rewrite length_make_map_exps. lia. rewrite <- H, <- H0. auto. }
      assert (length eff4 = length vals0).
      {
        unfold vals0. case_eq (modulo_2 (length eff4)); intros.
        * rewrite e in *. rewrite length_make_map_vals. rewrite Nat.add_0_r in H13.
          2: lia. rewrite H13. simpl. apply n_div_2_mod_0. lia.
        * rewrite e in *. rewrite length_make_map_vals2. 2: lia.
          rewrite H12. apply n_div_2_mod_1. lia.
      }
      rewrite H7 in H16, H21.
      epose (P := explist_prefix_eq _ _ _ _ _ _ _ _ _ _ _ H6 _ _ _ _ _ H4 H16 H21).
      inversion P.
      Unshelve.
      + unfold exps. rewrite length_make_map_exps. lia.
      + auto.
      + unfold vals0, exps.
        rewrite length_make_map_exps.
        unfold vals0. case_eq (modulo_2 (length eff4)); intros.
        ** rewrite e in *. rewrite length_make_map_vals. rewrite Nat.add_0_r in H13.
          2: lia. rewrite H13. rewrite <- n_div_2_mod_0. lia. lia.
        ** rewrite e in *. rewrite length_make_map_vals2. 2: lia.
          rewrite H12. rewrite <- n_div_2_mod_1. lia. lia.
      + unfold exps. rewrite length_make_map_exps. lia.
      + lia.

  (* CONS TL EXCEPTION *)
  * inversion H0; subst.
    - apply IHeval_expr in H7. destruct H7. congruence.
    - apply IHeval_expr in H11. auto.
    - apply IHeval_expr in H7. destruct H7. congruence.

  (* CONS HEAD EXCEPTION *)
  * inversion H1; subst.
    - apply IHeval_expr1 in H8. destruct H8, H3. inversion H2. subst.
      apply IHeval_expr2 in H13. destruct H13. congruence.
    - apply IHeval_expr1 in H12. destruct H12. congruence.
    - apply IHeval_expr1 in H8. destruct H8, H3. inversion H2. subst.
      apply IHeval_expr2 in H13. destruct H13, H4. inversion H2. auto.

  (* TUPLE EXCEPTION *)
  * inversion H6; subst.
    - epose (P := explist_prefix_eq_rev _ _ _ _ _ _ _ _ _ _ _ H4 H11 IHeval_expr _ _ _ _ _ _).
      inversion P. Unshelve. all: auto.
    - epose (P := exception_equality _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H4 H17 IHeval_expr H12
        _ _ _ _ _ _ _ _).
      destruct P, H7, H9. subst. auto.
      Unshelve. all: auto.

  (* TRY *)
  * inversion H2; subst.
    - apply IHeval_expr1 in H16. destruct H16, H4. inversion H3. subst.
      apply IHeval_expr2 in H18. destruct H18, H5. auto.
    - apply IHeval_expr1 in H16. destruct H16. congruence.

  (* CATCH *)
  * inversion H1; subst.
    - apply IHeval_expr1 in H15. destruct H15. congruence.
    - apply IHeval_expr1 in H15. destruct H15, H3. inversion H2. subst.
      apply IHeval_expr2 in H16. destruct H16, H4. auto.

  (* CASE EXCEPTION *)
  * inversion H0; subst.
    - apply IHeval_expr in H3. destruct H3. congruence.
    - apply IHeval_expr in H11. auto.
    - apply IHeval_expr in H7. destruct H7. congruence.

  (* CASE IFCLAUSE EXCEPTION *)
  * inversion H2; subst.
    - apply IHeval_expr in H5. destruct H5, H4. inversion H3. subst.
      pose (P := H1 i H6 _ _ _ H7 _ _ _ H13). destruct P. inversion H4.
    - apply IHeval_expr in H13. destruct H13. congruence.
    - apply IHeval_expr in H9. destruct H9, H4. inversion H3. subst.
      auto.

  (* CALL *)

   * inversion H8; subst.
    - apply IHeval_expr1 in H15. destruct H15, H9. destruct H0. subst.
      apply IHeval_expr2 in H16. destruct H16, H9. destruct H0. subst.
      epose (P := explist_prefix_eq_rev _ _ _ _ _ _ _ _ _ _ _ H6 H17 IHeval_expr3 _ _ _ _ _ _).
      inversion P. Unshelve. all: auto.
    - apply IHeval_expr1 in H15. destruct H15, H9. destruct H0. subst.
      apply IHeval_expr2 in H16. destruct H16, H9. destruct H0. subst.
      epose (P := explist_prefix_eq_rev _ _ _ _ _ _ _ _ _ _ _ H6 H21 IHeval_expr3 _ _ _ _ _ _).
      inversion P. Unshelve. all: auto.

    - apply IHeval_expr1 in H16. destruct H16, H9. destruct H0. subst.
      apply IHeval_expr2 in H21. destruct H21, H9. destruct H0. subst.

      epose (P := exception_equality _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H6 H27 IHeval_expr3 H26
        _ _ _ _ _ _ _ _).
      destruct P, H9, H10. subst. auto.
      Unshelve. all: auto.
    - apply IHeval_expr1 in H20. destruct H20. congruence.
    - apply IHeval_expr1 in H20. destruct H20, H9. inversion H9. subst.
      apply IHeval_expr2 in H21. destruct H21. congruence.
    - apply IHeval_expr1 in H15. destruct H15, H9. inversion H0. subst.
      apply IHeval_expr2 in H16. destruct H16, H10. inversion H9. subst.
      epose (P := explist_prefix_eq_rev _ _ _ _ _ _ _ _ _ _ _ H6 H17 IHeval_expr3 _ _ _ _ _ _).
      inversion P. Unshelve. all: auto.
    - apply IHeval_expr1 in H15. destruct H15, H9. inversion H0. subst.
      apply IHeval_expr2 in H16. destruct H16, H10. inversion H9. subst.
      epose (P := explist_prefix_eq_rev _ _ _ _ _ _ _ _ _ _ _ H6 H17 IHeval_expr3 _ _ _ _ _ _).
      inversion P. Unshelve. all: auto.

  * inversion H0; subst.
    - apply IHeval_expr in H7. destruct H7. congruence. (* ezekhez kene egy tactic *)
    -  apply IHeval_expr in H7. destruct H7. congruence.
    - apply IHeval_expr in H8. destruct H8. congruence.
    - apply IHeval_expr in H12. destruct H12. auto.
    - apply IHeval_expr in H12. destruct H12. congruence.
    - apply IHeval_expr in H7. destruct H7. congruence.
    - apply IHeval_expr in H7. destruct H7. congruence.
  * inversion H1; subst.
    - apply IHeval_expr1 in H8. destruct H8, H3. inversion H2. subst.
      apply IHeval_expr2 in H9. destruct H9, H4. congruence.
    - apply IHeval_expr1 in H8. destruct H8, H3. inversion H2. subst.
      apply IHeval_expr2 in H9. destruct H9, H4. congruence.
    - apply IHeval_expr1 in H9. destruct H9, H3. subst.
      apply IHeval_expr2 in H14. destruct H14 , H4. congruence.
    - apply IHeval_expr1 in H13. destruct H13, H3. congruence.
    - apply IHeval_expr1 in H13. destruct H13, H3. inversion H2. subst.
      apply IHeval_expr2 in H14. destruct H14. inversion H3. subst. auto.

    - apply IHeval_expr1 in H8. destruct H8, H3. inversion H2. subst.
      apply IHeval_expr2 in H9. destruct H9, H4. inversion H3.
    - apply IHeval_expr1 in H8. destruct H8, H3. inversion H2. subst.
      apply IHeval_expr2 in H9. destruct H9, H4. inversion H3.
  * inversion H9; subst.
    - apply IHeval_expr1 in H16. destruct H16, H8. inversion H7. subst.
      apply IHeval_expr2 in H17. destruct H17, H10. inversion H10. congruence.
    - apply IHeval_expr1 in H16. destruct H16, H8. inversion H7. subst.
      apply IHeval_expr2 in H17. destruct H17, H10. inversion H10. congruence.
    - apply IHeval_expr1 in H17. destruct H17, H8. inversion H7. subst.
      apply IHeval_expr2 in H22. destruct H22, H10. inversion H8. subst.
      epose (P := explist_prefix_eq _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H5 H27 H28).
      destruct P. Unshelve. all: auto.
    - apply IHeval_expr1 in H21. destruct H21, H8. inversion H7.
    - apply IHeval_expr1 in H21. destruct H21, H8. inversion H7. subst.
      apply IHeval_expr2 in H22. destruct H22. inversion H8.
    - apply IHeval_expr1 in H16. destruct H16, H8. inversion H7. subst.
      apply IHeval_expr2 in H17. destruct H17, H10. inversion H8. subst.
      epose (P := explist_equality _ _ _ _ _ _ _ H5 H18 _ _ _ _ _ _).
      destruct P, H11. subst. auto. Unshelve. all: auto.
    - apply IHeval_expr1 in H16. destruct H16, H8. inversion H7. subst.
      apply IHeval_expr2 in H17. destruct H17, H10. inversion H8. subst. congruence.

  * inversion H9; subst.
    - apply IHeval_expr1 in H16. destruct H16, H8. inversion H7. subst.
      apply IHeval_expr2 in H17. destruct H17, H10. inversion H8. subst. congruence.
   - apply IHeval_expr1 in H16. destruct H16, H8. inversion H7. subst.
      apply IHeval_expr2 in H17. destruct H17, H10. inversion H8. subst. congruence.
    - apply IHeval_expr1 in H17. destruct H17, H8. inversion H7. subst.
      apply IHeval_expr2 in H22. destruct H22, H10. inversion H8. subst.
      epose (P := explist_prefix_eq _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H5 H27 H28).
      destruct P. Unshelve. all: auto.
    - apply IHeval_expr1 in H21. destruct H21. congruence.
    - apply IHeval_expr1 in H21. destruct H21, H8. inversion H7. subst.
      apply IHeval_expr2 in H22. destruct H22. congruence.
    - apply IHeval_expr1 in H16. destruct H16, H8. inversion H7. subst.
      apply IHeval_expr2 in H17. destruct H17, H10. inversion H8. subst. congruence.
    - apply IHeval_expr1 in H16. destruct H16, H8. inversion H7. subst.
      apply IHeval_expr2 in H17. destruct H17, H10. inversion H8. subst.
      epose (P := explist_equality _ _ _ _ _ _ _ H5 H18 _ _ _ _ _ _).
      destruct P, H11. subst. auto. Unshelve. all: auto.

  (* PRIMOP *)
  * inversion H6; subst.
    - epose (P := explist_prefix_eq_rev _ _ _ _ _ _ _ _ _ _ _ H4 H12 IHeval_expr _ _ _ _ _ _).
      inversion P. Unshelve. all: auto.
    - epose (P := exception_equality _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H4 H22 IHeval_expr H17
        _ _ _ _ _ _ _ _).
      destruct P, H7, H8. subst. auto.
      Unshelve. all: auto.

  (* APP FUNEXP EXCEPTION *)
  * inversion H0; subst.
    - apply IHeval_expr in H4. destruct H4. congruence.
    - apply IHeval_expr in H11. auto.
    - apply IHeval_expr in H7. destruct H7. congruence.
    - apply IHeval_expr in H6. destruct H6. congruence.
    - apply IHeval_expr in H6. destruct H6. congruence.

  (* APP PARAM EXCEPTION *)
  * inversion H7; subst.
    - apply IHeval_expr1 in H11. destruct H11, H8. inversion H0. subst.
      epose (P := explist_prefix_eq_rev _ _ _ _ _ _ _ _ _ _ _ H5 H19 IHeval_expr2 _ _ _ _ _ _).
      inversion P.
      Unshelve. all: auto.
    - apply IHeval_expr1 in H18. destruct H18. congruence.
    - apply IHeval_expr1 in H14. destruct H14, H8. inversion H0. subst.
      epose (P := exception_equality _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H5 H24 IHeval_expr2 H19
        _ _ _ _ _ _ _ _).
      destruct P, H9, H11. subst. auto.
      Unshelve. all: auto.
    - apply IHeval_expr1 in H13. destruct H13, H8. inversion H0. subst.
      epose (P := explist_prefix_eq_rev _ _ _ _ _ _ _ _ _ _ _ H5 H14 IHeval_expr2 _ _ _ _ _ _).
      inversion P.
      Unshelve. all: auto.
    - apply IHeval_expr1 in H13. destruct H13, H8. inversion H0. subst.
      epose (P := explist_prefix_eq_rev _ _ _ _ _ _ _ _ _ _ _ H5 H14 IHeval_expr2 _ _ _ _ _ _).
      inversion P.
      Unshelve. all: auto.

  (* APP BADFUN EXCEPTION *)
  * inversion H8; subst.
    - apply IHeval_expr in H12. destruct H12, H7. inversion H6. subst.
      congruence.
    - apply IHeval_expr in H19. destruct H19. congruence.
    - apply IHeval_expr in H15. destruct H15, H7. inversion H6. subst.
      epose (P := explist_prefix_eq _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H4 H20 H25).
      inversion P.
      Unshelve. all: auto.
    - apply IHeval_expr in H14. destruct H14, H7. inversion H6. subst.
      epose (P := explist_equality _ _ _ _ _ _ _ H4 H15 _ _ _ _ _ _).
      destruct P. destruct H9. subst. auto. Unshelve. all: auto.
    - apply IHeval_expr in H14. destruct H14, H7. inversion H6. subst.
      congruence.

  (* APP BADARITY EXCEPTION *)
  * inversion H8; subst.
    -  apply IHeval_expr in H12. destruct H12, H7. inversion H6. subst.
      congruence.
    - apply IHeval_expr in H19. destruct H19. congruence.
    - apply IHeval_expr in H15. destruct H15, H7. inversion H6. subst.
      epose (P := explist_prefix_eq _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H4 H20 H25).
      inversion P.
      Unshelve. all: auto.
    - apply IHeval_expr in H14. destruct H14, H7. inversion H6. subst.
      congruence.
    - apply IHeval_expr in H14. destruct H14, H7. inversion H6. subst.
      epose (P := explist_equality _ _ _ _ _ _ _ H4 H15 _ _ _ _ _ _).
      destruct P. destruct H9. subst. auto.
      Unshelve. all: auto.

  (* LET EXCEPTION *)
  * inversion H0; subst.
    - apply IHeval_expr in H8. destruct H8. congruence.
    - apply IHeval_expr in H12. auto.

  (* SEQ EXCEPTION *)
  * inversion H0; subst.
    - apply IHeval_expr in H7. destruct H7. congruence.
    - apply IHeval_expr in H11. auto.

  (* MAP EXCEPTION *)
  * inversion H7; subst.
    - assert (length eff = length vals).
      {
        unfold vals.
        case_eq (modulo_2 (length eff)); intros.
        * rewrite e in *. rewrite length_make_map_vals. rewrite Nat.add_0_r in H1.
          2: lia. rewrite H1. simpl. apply n_div_2_mod_0. lia.
        * rewrite e in *. rewrite length_make_map_vals2. 2: lia.
          rewrite H0. apply n_div_2_mod_1. lia.
      }
      rewrite H2 in H5, IHeval_expr.
      epose (P := explist_prefix_eq_rev _ _ _ _ _ _ _ _ _ _ _ H5 H13 IHeval_expr _ _ _ _ _ _).
      inversion P.
      Unshelve.
      + unfold vals, exps. rewrite length_make_map_exps.
        case_eq (modulo_2 (length eff)); intros.
        ** rewrite e in *. rewrite length_make_map_vals. rewrite Nat.add_0_r in H1.
           2: lia. rewrite H1. rewrite <- n_div_2_mod_0. lia. lia.
        ** rewrite e in *. rewrite length_make_map_vals2. 2: lia.
           rewrite H0. rewrite <- n_div_2_mod_1. lia. lia.
      + lia.
      + unfold vals0. rewrite length_make_map_vals. 2: lia.
        unfold exps. rewrite length_make_map_exps. lia.
      + unfold exps. rewrite length_make_map_exps. lia.
      + unfold exps. rewrite length_make_map_exps. lia.
      + lia.
    - epose (P := exception_equality _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H5 H19 IHeval_expr H14
        _ _ _ _ _ _ _ _).
      destruct P, H8, H12. subst. apply IHeval_expr in H19. auto.
      Unshelve.
      all: try lia.
      + unfold vals. case_eq (modulo_2 (length eff)); intros.
        ** rewrite e in *. rewrite length_make_map_vals. rewrite Nat.add_0_r in H1.
          2: lia. rewrite H1. rewrite <- n_div_2_mod_0. lia. lia.
        ** rewrite e in *. rewrite length_make_map_vals2. 2: lia.
          rewrite H0. rewrite <- n_div_2_mod_1. lia. lia.
      + unfold exps. rewrite length_make_map_exps. lia.
      + unfold vals0. case_eq (modulo_2 (length eff4)); intros.
        ** rewrite e in *. rewrite length_make_map_vals. rewrite Nat.add_0_r in H11.
           2: lia. rewrite H11. rewrite <- n_div_2_mod_0. lia. lia.
        ** rewrite e in *. rewrite length_make_map_vals2. 2: lia.
           rewrite H10. rewrite <- n_div_2_mod_1. lia. lia.
      + unfold exps. rewrite length_make_map_exps. lia.
Qed.

(** Helper about variables contained in a list of expression *)
Proposition list_variables_not_in (x : Var) (exps : list Expression) :
~ In x ((flat_map variables exps)) ->
(forall exp : Expression, In exp exps -> ~ In x (variables exp)).
Proof.
  intros. induction exps.
  * inversion H0.
  * simpl in H. assert (~ In x (variables a) /\ ~ In x (flat_map variables exps)).
    {
      unfold not in *. split; intros.
      * apply H. apply in_or_app. left. assumption.
      * apply H. apply in_or_app. right. assumption.
    }
    inversion H1. inversion H0.
    - subst. assumption.
    - apply IHexps.
      + assumption.
      + assumption.
Qed.

(** Helpers regarding variables and their containment *)
Proposition var_not_in_neq (var s : Var):
  ~(In var (variables (EVar s))) ->
  s <> var.
Proof.
  intros. unfold not in *. intro. apply H. rewrite H0. simpl. left. reflexivity.
Qed.

Proposition var_neq_not_in (var s : Var) :
  s <> var ->
  ~(In var (variables (EVar s))).
Proof.
  intros. unfold not in *. intro. destruct (string_dec s var).
  * exact (H e).
  * apply H. inversion H0.
    - assumption.
    - inversion H1.
Qed.

(** New variable binding doesn't affect previous ones *)
Proposition irrelevant_append (env : Environment) (s var : Var) (val : Value) (t : option ValueSequence):
  s <> var ->
  get_value env (inl s) = t <->
  get_value (append_vars_to_env [var] [val] env) (inl s) = t.
Proof.
  intros; split; intro.
  * simpl. induction env.
    - simpl in *. subst. apply eqb_neq in H. rewrite H. reflexivity.
    - destruct a. assert (get_value ((s0, v) :: env) (inl s) = t). { auto. }
      unfold get_value in H0. case_eq (var_funid_eqb (inl s) s0).
      + intro. rewrite H2 in H0. subst. inversion H2. destruct s0.
        ** apply eqb_eq in H3. subst. simpl. apply eqb_neq in H. rewrite H. simpl.
           rewrite eqb_refl. reflexivity.
        ** inversion H3.
      + intros. simpl in H1. destruct s0.
        ** inversion H2. rewrite H4 in H1. simpl. destruct ((v0 =? var)%string).
          ++ simpl. apply eqb_neq in H. rewrite H. assumption.
          ++ simpl. rewrite H4. apply eqb_neq in H. simpl. exact (IHenv H1).
        ** simpl. exact (IHenv H1).
  * simpl in H0. induction env.
    - simpl in H0. apply eqb_neq in H. rewrite H in H0. subst. simpl. reflexivity.
    - destruct a. simpl in *. case_eq (var_funid_eqb s0 (inl var)).
      + intro. destruct s0.
        ** inversion H1. apply eqb_eq in H3. rewrite H3. apply eqb_neq in H. rewrite H.
           rewrite H1 in H0. simpl in H0. rewrite H in H0. assumption.
        **  rewrite H1 in H0. simpl in H0. apply eqb_neq in H. rewrite H in H0. assumption.
      + intro. destruct s0.
        ** inversion H1. case_eq ((s =? v0)%string); intro.
          -- rewrite H1 in H0. simpl in H0. rewrite H2 in H0. assumption.
          -- rewrite H1 in H0. simpl in H0. rewrite H2 in H0. exact (IHenv H0).
        ** rewrite H1 in H0. simpl in H0. exact (IHenv H0).
Qed.

(** New variable binding doesn't affect previous ones *)
Proposition irrelevant_append_eq (env : Environment) (s var : Var) (val : Value):
  s <> var ->
  get_value env (inl s) = get_value (append_vars_to_env [var] [val] env) (inl s).
Proof.
  intros. pose (IRA := irrelevant_append env s var val (get_value env (inl s)) H).
  assert (get_value env (inl s) = get_value env (inl s)). reflexivity. inversion IRA.
  pose (P1 := H1 H0). apply eq_sym. assumption.
Qed.

(* Theorem variable_irrelevancy (env: Environment) (cl : Closures) (e : Expression) (t val : Value) (var : Var) :
  ~(In var (variables e)) -> (forall env' a b, t <> VClosure env' a b) ->
  |env, cl, e| -e> t <->
  |append_vars_to_env [var] [val] env, cl, e| -e> t.
Proof.
  intro. split; intro.
  * induction H1 using eval_expr_ind_extended.
    - apply eval_lit.
    - assert (get_value env (inl s) = get_value (append_vars_to_env [var] [val] env) (inl s)). { apply (var_not_in_neq) in H. pose (irrelevant_append_eq env s var val H). assumption. } rewrite H1. apply eval_var.
    - admit.
    - pose (H0 (inl env) (snd (split l)) e).  unfold not in n. assert (VClosure (inl env) (snd (split l)) e = VClosure (inl env) (snd (split l)) e). reflexivity. pose (n H1). inversion f.
    - apply eval_tuple.
      + assumption.
      + intros. apply H3; try(assumption).
        ** simpl in H. apply (list_variables_not_in) with (exps := exps). assumption. apply in_combine_l in H4. assumption.
        ** intros.
Qed.*)

(** Last append result *)
Proposition get_value_here (env : Environment) (var : Var + FunctionIdentifier) (val : Value):
get_value (insert_value env var val) var = Some [val].
Proof.
  induction env.
  * simpl. rewrite var_funid_eqb_refl. reflexivity.
  * simpl. destruct a. case_eq (var_funid_eqb s var); intro.
    - simpl. rewrite var_funid_eqb_refl. reflexivity.
    - simpl. rewrite var_funid_eqb_sym, H. assumption.
Qed.

(** Previous append result *)
Proposition get_value_there (env : Environment) (var var' : Var + FunctionIdentifier)
     (val : Value):
var <> var' ->
get_value (insert_value env var val) var' = get_value env var'.
Proof.
  intro. induction env.
  * simpl. apply var_funid_eqb_neq in H. rewrite var_funid_eqb_sym in H. rewrite H. reflexivity.
  * simpl. destruct a. case_eq (var_funid_eqb s var); intro.
    - apply var_funid_eqb_eq in H0. assert (var <> var'). auto. rewrite <- H0 in H.
      apply var_funid_eqb_neq in H. rewrite var_funid_eqb_sym in H. rewrite H. simpl. apply var_funid_eqb_neq in H1.
      rewrite var_funid_eqb_sym in H1. rewrite H1. reflexivity.
    - simpl. case_eq (var_funid_eqb var' s); intros.
      + reflexivity.
      + apply IHenv.
Qed.