Require Import VST.msl.msl_standard.
Require Import VST.veric.Clight_base.
Require Import VST.veric.compcert_rmaps.
Require Import VST.veric.Clight_lemmas.
Require Import VST.veric.mpred.
Require Import VST.veric.tycontext.
Require Import VST.veric.expr2.

Lemma eqb_type_eq: forall t1 t2, eqb_type t1 t2 = proj_sumbool (type_eq t1 t2).
Proof.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
intros.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
case_eq (eqb_type t1 t2); intros.
(* Goal: @eq bool true (@proj_sumbool (@eq type t1 t2) (not (@eq type t1 t2)) (type_eq t1 t2)) *)
(* Goal: @eq bool false (@proj_sumbool (@eq type t1 t2) (not (@eq type t1 t2)) (type_eq t1 t2)) *)
apply eqb_type_true in H; subst; simpl; auto.
(* Goal: @eq bool true (@proj_sumbool (@eq type t2 t2) (not (@eq type t2 t2)) (type_eq t2 t2)) *)
(* Goal: @eq bool false (@proj_sumbool (@eq type t1 t2) (not (@eq type t1 t2)) (type_eq t1 t2)) *)
rewrite proj_sumbool_is_true; auto.
(* Goal: @eq bool false (@proj_sumbool (@eq type t1 t2) (not (@eq type t1 t2)) (type_eq t1 t2)) *)
destruct (type_eq t1 t2); simpl; subst.
(* Goal: @eq bool false true *)
(* Goal: @eq bool false false *)
rewrite eqb_type_refl in H; auto.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
auto.
Qed.

Lemma In_fst_split : forall A B i (l: list (A * B)), In i (fst (split l)) <-> exists b : B, In (i,b) l.
Proof.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
intros. split; intros. induction l. inv H. simpl in H. remember (split l). destruct p. destruct a.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
simpl in *. destruct H. subst. clear IHl. eauto.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
destruct IHl. auto. exists x. auto.

(* Goal: @In A i (@fst (list A) (list B) (@split A B l)) *)
induction l. destruct H. inv H. simpl in *. destruct H. destruct H. destruct a. inv H.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
clear IHl. destruct (split l). simpl. auto. destruct (split l). destruct a. simpl.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
right. apply IHl. eauto.
Qed.
(*
Lemma join_te_denote : forall te1 te2 id b t1,
(join_te te1 te2) ! id = Some (t1, b) ->
  (exists b1, te1 ! id = Some (t1, b || b1)) /\
  match te2 ! id with Some (t2,b2) => b = b && b2 | None => True end.
Proof.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
intros.

unfold join_te in *. rewrite PTree.fold_spec in *.
rewrite  <- fold_left_rev_right in *.

assert (forall t : type * bool, In (id, t) (rev (PTree.elements te1)) -> te1 ! id = Some t).
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
intros. apply PTree.elements_complete. apply in_rev. auto.

assert (NOREP := PTree.elements_keys_norepet (te1)).

(* Goal: and (typecheck_temp_environ (te_of (mkEnviron ge ve (@Map.set val id v te))) (temp_types Delta)) (and (typecheck_var_environ (ve_of (mkEnviron ge ve (@Map.set val id v te))) (var_types Delta)) (typecheck_glob_environ (ge_of (mkEnviron ge ve (@Map.set val id v te))) (glob_types Delta))) *)
induction (rev (PTree.elements te1)). simpl in *.
rewrite PTree.gempty in *. congruence.

(* Goal: and (typecheck_temp_environ (te_of (mkEnviron ge ve (@Map.set val id v te))) (temp_types Delta)) (and (typecheck_var_environ (ve_of (mkEnviron ge ve (@Map.set val id v te))) (var_types Delta)) (typecheck_glob_environ (ge_of (mkEnviron ge ve (@Map.set val id v te))) (glob_types Delta))) *)
simpl in *. destruct a as [p [t b0]]. simpl in *.
destruct (te2 ! p) eqn:?.  destruct p0.
rewrite PTree.gsspec in H.
(* Goal: @In A i (@fst (list A) (list B) (let (left, right) := @split A B l in @pair (list A) (list B) (@cons A a left) (@cons B b right))) *)
(* Goal: @In A i (@fst (list A) (list B) (let (x, y) := a in let (left, right) := @split A B l in @pair (list A) (list B) (@cons A x left) (@cons B y right))) *)
if_tac in H. subst. specialize (H0 (t,b0)). inv H.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
 spec H0; auto.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
 split. exists b0. rewrite H0. repeat f_equal. destruct b0,b1; simpl; auto.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
 rewrite Heqo. destruct b0; simpl; auto. destruct b1; simpl; auto.

(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
 auto. auto.
Qed.

Lemma typecheck_environ_join1:
  forall rho Delta1 Delta2,
        var_types Delta1 = var_types Delta2 ->
        glob_types Delta1 = glob_types Delta2 ->

        typecheck_environ Delta1 rho ->
        typecheck_environ (join_tycon Delta1 Delta2) rho.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
Proof. intros.
(* Goal: typecheck_environ Delta (mkEnviron ge ve (@Map.set val id v te)) *)
 unfold typecheck_environ in *.
destruct H1 as [? [? ?]]. split3.
*
clear H2 H3.
(* Goal: and (typecheck_temp_environ (te_of (mkEnviron ge ve (@Map.set val id v te))) (temp_types Delta)) (and (typecheck_var_environ (ve_of (mkEnviron ge ve (@Map.set val id v te))) (var_types Delta)) (typecheck_glob_environ (ge_of (mkEnviron ge ve (@Map.set val id v te))) (glob_types Delta))) *)
destruct rho. simpl in *.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
unfold typecheck_temp_environ in *. intros. unfold temp_types in *.
destruct Delta2 as [temps2 vars2 ret2 globty2 globsp2];
(* Goal: and (typecheck_temp_environ (te_of (mkEnviron ge ve (@Map.set val id v te))) (temp_types Delta)) (and (typecheck_var_environ (ve_of (mkEnviron ge ve (@Map.set val id v te))) (var_types Delta)) (typecheck_glob_environ (ge_of (mkEnviron ge ve (@Map.set val id v te))) (glob_types Delta))) *)
destruct Delta1 as [temps1 vars1 ret1 globty1 globsp1]; simpl in *.
apply join_te_denote in H2.
destruct H2. destruct H2.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
edestruct H1. eauto. destruct H4. destruct H5.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
destruct b; intuition. simpl in *. eauto. eauto.
*
unfold join_tycon.
destruct Delta2 as [temps2 vars2 ret2 globty2 globsp2];
(* Goal: and (typecheck_temp_environ (te_of (mkEnviron ge ve (@Map.set val id v te))) (temp_types Delta)) (and (typecheck_var_environ (ve_of (mkEnviron ge ve (@Map.set val id v te))) (var_types Delta)) (typecheck_glob_environ (ge_of (mkEnviron ge ve (@Map.set val id v te))) (glob_types Delta))) *)
destruct Delta1 as [temps1 vars1 ret1 globty1 globsp1]; simpl in *.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
subst. auto.
*
unfold join_tycon.
destruct Delta2 as [temps2 vars2 ret2 globty2 globsp2];
(* Goal: and (typecheck_temp_environ (te_of (mkEnviron ge ve (@Map.set val id v te))) (temp_types Delta)) (and (typecheck_var_environ (ve_of (mkEnviron ge ve (@Map.set val id v te))) (var_types Delta)) (typecheck_glob_environ (ge_of (mkEnviron ge ve (@Map.set val id v te))) (glob_types Delta))) *)
destruct Delta1 as [temps1 vars1 ret1 globty1 globsp1]; simpl in *.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
unfold glob_types in *; simpl in *; subst; auto.
Qed.
 *)

Definition tycontext_evolve (Delta Delta' : tycontext) :=
 (forall id, match (temp_types Delta) ! id, (temp_types Delta') ! id with
                | Some t, Some t' => t=t'
                | None, None => True
                | _, _ => False
               end)
 /\ (forall id, (var_types Delta) ! id = (var_types Delta') ! id)
 /\ ret_type Delta = ret_type Delta'
 /\ (forall id, (glob_types Delta) ! id = (glob_types Delta') ! id)
 /\ (forall id, (glob_specs Delta) ! id = (glob_specs Delta') ! id)
 /\ (forall id, (annotations Delta) ! id = (annotations Delta') ! id).

(*
Lemma initialized_tycontext_evolve:
  forall i Delta, tycontext_evolve Delta (initialized i Delta).
Proof.
intros i [A B C D E].
 unfold initialized;
 split; [| split; [|split; [|split; [ |split]]]]; intros; unfold temp_types, var_types, glob_types, ret_type;
(* Goal: @In A i (@fst (list A) (list B) (@pair (list A) (list B) (@cons A a l0) (@cons B b l1))) *)
 simpl.
(* Goal: @In A i (@fst (list A) (list B) (@pair (list A) (list B) (@cons A a l0) (@cons B b l1))) *)
 destruct (A ! id) as [[? ?]|] eqn:?; simpl.
(* Goal: @In A i (@fst (list A) (list B) (@pair (list A) (list B) (@cons A a l0) (@cons B b l1))) *)
 destruct (A!i) as [[? ?]|] eqn:?; simpl.
(* Goal: @ex val (fun v0 : val => and (@eq (option val) (@Some val v) (@Some val v0)) (tc_val' ty v0)) *)
 destruct (eq_dec i id). subst. rewrite PTree.gss. inversion2 Heqo Heqo0.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
 split; auto. destruct b; reflexivity.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
 rewrite PTree.gso by auto. rewrite Heqo. split; auto.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
 destruct b; simpl; auto. rewrite Heqo. destruct b; simpl; auto.
(* Goal: @In A i (@fst (list A) (list B) (@pair (list A) (list B) (@cons A a l0) (@cons B b l1))) *)
 destruct (A!i) as [[? ?]|] eqn:?; simpl.
(* Goal: @ex val (fun v0 : val => and (@eq (option val) (@Some val v) (@Some val v0)) (tc_val' ty v0)) *)
 destruct (eq_dec i id). subst. congruence.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
 rewrite PTree.gso by auto. rewrite Heqo. auto.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
 rewrite Heqo. auto.
all: destruct (A!i) as [[? ?]|]; reflexivity.
Qed.
*)
Lemma tycontext_evolve_trans: forall Delta1 Delta2 Delta3,
   tycontext_evolve Delta1 Delta2 ->
   tycontext_evolve Delta2 Delta3 ->
   tycontext_evolve Delta1 Delta3.
Proof.
intros [A B C D E] [A1 B1 C1 D1 E1] [A2 B2 C2 D2 E2]
  [S1 [S2 [S3 [S4 [S5 S6]]]]]  [T1 [T2 [T3 [T4 [T5 T6]]]]];
 split; [| split; [|split; [|split; [|split]]]];
 unfold temp_types,var_types, ret_type in *; simpl in *;
 try congruence.
(* Goal: forall id : positive, match @PTree.get type id A with | Some t => match @PTree.get type id A2 with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id A2 with | Some t => False | None => True end end *)
 clear - S1 T1.
(* Goal: forall id : positive, match @PTree.get type id A with | Some t => match @PTree.get type id A2 with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id A2 with | Some t => False | None => True end end *)
 intro id; specialize (S1 id); specialize (T1 id).
(* Goal: match @PTree.get type id A with | Some t => match @PTree.get type id A2 with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id A2 with | Some t => False | None => True end end *)
 destruct (A!id) as [?|].
(* Goal: match @PTree.get type id A2 with | Some t' => @eq type t t' | None => False end *)
(* Goal: match @PTree.get type id A2 with | Some t => False | None => True end *)
 destruct (A1!id) as [?|]; [ | contradiction]. subst t0.
(* Goal: @eq type t t0 *)
(* Goal: match @PTree.get type id A2 with | Some t => False | None => True end *)
 destruct (A2!id) as [?|]; [ | contradiction]. subst t0.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
 auto.
(* Goal: match @PTree.get type id A2 with | Some t => False | None => True end *)
 destruct (A1!id) as [?|]; [ contradiction| ].
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
 auto.
Qed.
(*
Lemma typecheck_environ_join2:
  forall rho Delta Delta1 Delta2,
        tycontext_evolve Delta Delta1 ->
        tycontext_evolve Delta Delta2 ->
        typecheck_environ Delta2 rho ->
        typecheck_environ (join_tycon Delta1 Delta2) rho.
Proof.
intros [ge ve te]  [A B C D E] [A1 B1 C1 D1 E1] [A2 B2 C2 D2 E2]
  [S1 [S2 [S3 [S4 S5]]]]  [T1 [T2 [T3 [T4 T5]]]]
  [U1 [U2 U3]];
 split; [|split];
 unfold temp_types,var_types, ret_type in *; simpl in *;
 subst C1 C2.
* clear - S1 T1 U1; unfold typecheck_temp_environ in *.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
  intros.
  specialize (S1 id); specialize (T1 id); specialize (U1 id).
  apply join_te_denote in H. destruct H as [[b1 ?] ?].
  rewrite H in *. clear A1 H.
 destruct (A ! id) as [[? ?]|]; [ | contradiction].
 destruct S1; subst ty.
 destruct (A2!id) as [[? ?]|]; [ | contradiction].
(* Goal: @eq type t t0 *)
(* Goal: match @PTree.get type id A2 with | Some t => False | None => True end *)
 destruct T1; subst t0.
 destruct (U1 _ _ (eq_refl _)) as [v [? ?]].
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
 exists v; split; auto.
 destruct H3; auto; left.
 unfold is_true.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
 destruct b; auto. destruct b2; inv H0. contradiction. apply I.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
* unfold typecheck_var_environ in *; intros.
(* Goal: and (typecheck_temp_environ (@Map.set val id v te) (temp_types Delta)) (and (typecheck_var_environ ve (var_types Delta)) (typecheck_glob_environ ge (glob_types Delta))) *)
  rewrite <- S2. rewrite T2. rewrite U2. clear; intuition.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
* unfold typecheck_glob_environ in *; intros.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
  rewrite <- S4 in H. rewrite T4 in H. apply U3 in H. auto.
Qed.
*)
Lemma tc_val_ptr_lemma {CS: compspecs} :
   forall rho m Delta id t a,
   typecheck_environ Delta rho ->
   denote_tc_assert (typecheck_expr Delta (Etempvar id (Tpointer t a))) rho m ->
   (*(temp_types Delta) ! id =  Some (Tpointer t a, init) ->*) (*modified for init changes*)
   strict_bool_val (eval_id id rho) (Tpointer t a) = Some true ->
   tc_val (Tpointer t a) (eval_id id rho).
Proof.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
intros. unfold strict_bool_val in *. unfold tc_val.
(* Goal: (if eqb_type (Tpointer t a) int_or_ptr_type then is_pointer_or_integer else is_pointer_or_null) (eval_id id rho) *)
destruct (eval_id id rho); try congruence.
+ destruct Archi.ptr64; try discriminate;
    destruct (Int.eq i Int.zero); try congruence.
+ unfold is_pointer_or_integer, is_pointer_or_null.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
  destruct Archi.ptr64; inv H1;   simple_if_tac; simpl; auto.
(* Goal: @eq Int64.int i Int64.zero *)
  destruct (Int64.eq i Int64.zero); try congruence.
+
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
   simple_if_tac; simpl; auto.
Qed.

Lemma typecheck_environ_put_te : forall ge te ve Delta id v ,
  typecheck_environ Delta (mkEnviron ge ve te) ->
  (forall t , ((temp_types Delta) ! id = Some t ->
     tc_val' t v)) ->
  typecheck_environ Delta (mkEnviron ge ve (Map.set id v te)).
Proof.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
  intros. unfold typecheck_environ in *. simpl in *.
(* Goal: and (typecheck_temp_environ (@Map.set val id v te) (temp_types Delta)) (and (typecheck_var_environ ve (var_types Delta)) (typecheck_glob_environ ge (glob_types Delta))) *)
  intuition. clear H H3.
(* Goal: and (typecheck_temp_environ (te_of (mkEnviron ge ve (@Map.set val id v te))) (temp_types Delta)) (and (typecheck_var_environ (ve_of (mkEnviron ge ve (@Map.set val id v te))) (var_types Delta)) (typecheck_glob_environ (ge_of (mkEnviron ge ve (@Map.set val id v te))) (glob_types Delta))) *)
  destruct Delta. unfold temp_types in *; simpl in *.
(* Goal: typecheck_temp_environ (@Map.set val id v te) tyc_temps *)
  unfold typecheck_temp_environ.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
  intros. rewrite Map.gsspec.
(* Goal: @ex val (fun v0 : val => and (@eq (option val) (if ident_eq id0 id then @Some val v else @Map.get val te id0) (@Some val v0)) (tc_val' ty v0)) *)
  if_tac.
(* Goal: @ex val (fun v0 : val => and (@eq (option val) (@Some val v) (@Some val v0)) (tc_val' ty v0)) *)
  + subst. exists v; intuition.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
  + simpl in *. specialize (H1 id0 _ H). auto.
Qed.

Lemma typecheck_environ_put_te' : forall ge te ve Delta id v ,
 typecheck_environ  Delta (mkEnviron ge ve te) ->
(forall t , ((temp_types Delta) ! id = Some t -> tc_val' t v)) ->
typecheck_environ Delta (mkEnviron ge ve (Map.set id v te)).
Proof.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
intros.
(* Goal: typecheck_environ Delta (mkEnviron ge ve (@Map.set val id v te)) *)
assert (typecheck_environ Delta (mkEnviron ge ve (Map.set id v te))).
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
apply typecheck_environ_put_te; auto.

(* Goal: and (typecheck_temp_environ (te_of (mkEnviron ge ve (@Map.set val id v te))) (temp_types Delta)) (and (typecheck_var_environ (ve_of (mkEnviron ge ve (@Map.set val id v te))) (var_types Delta)) (typecheck_glob_environ (ge_of (mkEnviron ge ve (@Map.set val id v te))) (glob_types Delta))) *)
unfold typecheck_environ in *. simpl in *.
(* Goal: and (typecheck_temp_environ (@Map.set val id v te) (temp_types Delta)) (and (typecheck_var_environ ve (var_types Delta)) (typecheck_glob_environ ge (glob_types Delta))) *)
intuition.
Qed.

Lemma tycontext_evolve_refl : forall Delta, tycontext_evolve Delta Delta.
Proof.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
intros.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
split; auto.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
intros. destruct ((temp_types Delta)!id); auto.
Qed.

(*
Lemma tycontext_evolve_join:
  forall Delta Delta1 Delta2,
   tycontext_evolve Delta Delta1 ->
   tycontext_evolve Delta Delta2 ->
   tycontext_evolve Delta (join_tycon Delta1 Delta2).
Proof.
intros [A B C D E] [A1 B1 C1 D1 E1] [A2 B2 C2 D2 E2]
  [? [? [? [? [? ?]]]]] [? [? [? [? [? ?]]]]];
simpl in *;
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
 repeat split; auto.
 clear - H H5.
intro id; specialize (H id); specialize (H5 id).
(* Goal: and (typecheck_temp_environ (te_of (mkEnviron ge ve (@Map.set val id v te))) (temp_types Delta)) (and (typecheck_var_environ (ve_of (mkEnviron ge ve (@Map.set val id v te))) (var_types Delta)) (typecheck_glob_environ (ge_of (mkEnviron ge ve (@Map.set val id v te))) (glob_types Delta))) *)
 unfold temp_types in *; simpl in *.
 destruct (A ! id) as [[? ?]|].
 destruct (A1 ! id) as [[? ?]|] eqn:?; [ | contradiction].
 destruct (A2 ! id) as [[? ?]|] eqn:?; [ | contradiction].
 destruct H,H5; subst t1 t0.
 rewrite (join_te_eqv _ _ _ _ _ _ Heqo Heqo0).
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
 split; auto. destruct b,b0; inv H0; auto.
 rewrite join_te_denote2.
 unfold te_one_denote.
 destruct (A1 ! id) as [[? ?]|]; [contradiction|].
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
 auto.
Qed.

Lemma tycontext_evolve_update_tycon:
 forall c Delta, tycontext_evolve Delta (update_tycon Delta c)
 with tycontext_evolve_join_labeled:
 forall l Delta, tycontext_evolve Delta (join_tycon_labeled l Delta).
Proof.
clear tycontext_evolve_update_tycon.
induction c; simpl; intros; try destruct o; try apply tycontext_evolve_refl;
try apply initialized_tycontext_evolve.
eapply tycontext_evolve_trans; [ apply IHc1 | apply IHc2].
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
apply tycontext_evolve_join; auto.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
auto.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
auto.

clear tycontext_evolve_join_labeled.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
induction l; simpl; auto; intros.
apply tycontext_evolve_refl.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
apply tycontext_evolve_join; auto.
Qed.

Lemma join_context_com:
 forall D D1 D2, 
  tycontext_evolve D D1 ->
  tycontext_evolve D D2 ->
  tycontext_eqv (join_tycon D1 D2) (join_tycon D2 D1).
Proof.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
intros.
hnf.
rewrite !var_types_update_dist.
rewrite !ret_type_update_dist.
rewrite !glob_types_update_dist.
rewrite !glob_specs_update_dist.
rewrite !annotations_update_dist.
destruct H as [? [? [? [? [? ?]]]]].
destruct H0 as [? [? [? [? [? ?]]]]].
repeat split; intros; try congruence.
rewrite !temp_types_update_dist.
rewrite !join_te_denote2.
unfold te_one_denote.
clear - H H0.
specialize (H id). specialize (H0 id).
destruct ((temp_types D)!id) as [[? ?]|]; try contradiction.
destruct ((temp_types D1)!id) as [[? ?]|];
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
destruct ((temp_types D2)!id) as [[? ?]|]; auto.
(* Goal: @ex val (fun v0 : val => and (@eq (option val) (@Some val v) (@Some val v0)) (tc_val' ty v0)) *)
destruct H,H0. subst.
f_equal.
f_equal.
apply andb_comm.
destruct ((temp_types D1)!id) as [[? ?]|];
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
destruct ((temp_types D2)!id) as [[? ?]|]; try contradiction; auto.
Qed.

Lemma join_tycon_assoc:
 forall D1 D2 D3,
 tycontext_eqv
  (join_tycon D1 (join_tycon D2 D3))
  (join_tycon (join_tycon D1 D2) D3).
Proof.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
intros.
hnf.
rewrite !var_types_update_dist.
rewrite !ret_type_update_dist.
rewrite !glob_types_update_dist.
rewrite !glob_specs_update_dist.
rewrite !annotations_update_dist.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
split; auto.
intro.
destruct D1 as [a1 ].
destruct D2 as [a2 ].
destruct D3 as [a3 ].
(* Goal: @In A i (@fst (list A) (list B) (@pair (list A) (list B) (@cons A a l0) (@cons B b l1))) *)
simpl.
rewrite !join_te_denote2.
clear.
unfold te_one_denote.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
destruct (a1 ! id) as [[? ?]|] eqn:H1; auto.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
destruct (a2 ! id) as [[? ?]|] eqn:H2; auto.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
destruct (a3 ! id) as [[? ?]|] eqn:H3; auto.
f_equal. f_equal.
apply andb_assoc.
Qed.

Lemma tycontext_eqv_refl: forall Delta : tycontext, 
   tycontext_eqv Delta Delta.
Proof.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
intros.
repeat split.
Qed.

Lemma tycontext_eqv_trans: forall Delta1 Delta2 Delta3 : tycontext, 
   tycontext_eqv Delta1 Delta2 -> tycontext_eqv Delta2 Delta3 ->
   tycontext_eqv Delta1 Delta3.
Proof.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
intros.
hnf in H,H0|-*.
intuition; try congruence.
Qed.

Lemma initialized_join_tycon:
  forall Delta1 Delta2 i,
tycontext_eqv (initialized i (join_tycon Delta1 Delta2))
  (join_tycon (initialized i Delta1) (initialized i Delta2)).
Proof.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
intros.
unfold initialized.
destruct ((temp_types
     (join_tycon Delta1 Delta2)) ! i)
        as [[? ?]|] eqn:?H.
destruct ((temp_types Delta1) ! i)
       as [[? ?]|] eqn:?H.
destruct ((temp_types Delta2) ! i)
       as [[? ?]|] eqn:?H.
unfold join_tycon at 7.
rewrite !var_types_update_dist.
rewrite !ret_type_update_dist.
rewrite !glob_types_update_dist.
rewrite !glob_specs_update_dist.
rewrite !annotations_update_dist.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
split; auto.
intro.
rewrite temp_types_update_dist.
unfold temp_types at 1 4.
destruct (ident_eq id i).
(* Goal: @ex val (fun v0 : val => and (@eq (option val) (@Some val v) (@Some val v0)) (tc_val' ty v0)) *)
subst. 
rewrite join_te_denote2.
unfold te_one_denote.
rewrite !PTree.gss.
rewrite temp_types_update_dist in H.
rewrite join_te_denote2 in H.
unfold te_one_denote in H.
(* Goal: @In A i (@fst (list A) (list B) (let (left, right) := @split A B l in @pair (list A) (list B) (@cons A a left) (@cons B b right))) *)
(* Goal: @In A i (@fst (list A) (list B) (let (x, y) := a in let (left, right) := @split A B l in @pair (list A) (list B) (@cons A x left) (@cons B y right))) *)
rewrite H0 in H. rewrite H1 in H. inv H.
reflexivity.
rewrite !join_te_denote2.
unfold te_one_denote.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
rewrite !PTree.gso by auto.
rewrite join_te_denote2.
unfold te_one_denote.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
auto.
rewrite !var_types_update_dist.
rewrite !ret_type_update_dist.
rewrite !glob_types_update_dist.
rewrite !glob_specs_update_dist.
rewrite !annotations_update_dist.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
split; auto.
intro.
rewrite !temp_types_update_dist.
rewrite join_te_denote2.
(* Goal: and (typecheck_temp_environ (te_of (mkEnviron ge ve (@Map.set val id v te))) (temp_types Delta)) (and (typecheck_var_environ (ve_of (mkEnviron ge ve (@Map.set val id v te))) (var_types Delta)) (typecheck_glob_environ (ge_of (mkEnviron ge ve (@Map.set val id v te))) (glob_types Delta))) *)
destruct Delta1; simpl in *. destruct Delta2; simpl in *.
unfold te_one_denote.
rewrite join_te_denote2 in H.
unfold te_one_denote in H.
(* Goal: @In A i (@fst (list A) (list B) (let (left, right) := @split A B l in @pair (list A) (list B) (@cons A a left) (@cons B b right))) *)
(* Goal: @In A i (@fst (list A) (list B) (let (x, y) := a in let (left, right) := @split A B l in @pair (list A) (list B) (@cons A x left) (@cons B y right))) *)
rewrite H0 in H. rewrite H1 in H. inv H.
clear.
(* Goal: @In A i (@fst (list A) (list B) (@pair (list A) (list B) (@cons A a l0) (@cons B b l1))) *)
destruct Delta2; simpl. intuition.
rewrite temp_types_update_dist in H.
rewrite join_te_denote2 in H.
unfold te_one_denote in H.
(* Goal: @In A i (@fst (list A) (list B) (let (left, right) := @split A B l in @pair (list A) (list B) (@cons A a left) (@cons B b right))) *)
(* Goal: @In A i (@fst (list A) (list B) (let (x, y) := a in let (left, right) := @split A B l in @pair (list A) (list B) (@cons A x left) (@cons B y right))) *)
rewrite H0 in H. inv H.
rewrite temp_types_update_dist in H.
rewrite join_te_denote2 in H.
unfold te_one_denote in H.
destruct ((temp_types Delta1) ! i)
        as [[? ?]|] eqn:?H.
destruct ((temp_types Delta2) ! i)
        as [[? ?]|] eqn:?H.
(* Goal: @In A i (@fst (list A) (list B) (let (left, right) := @split A B l in @pair (list A) (list B) (@cons A a left) (@cons B b right))) *)
(* Goal: @In A i (@fst (list A) (list B) (let (x, y) := a in let (left, right) := @split A B l in @pair (list A) (list B) (@cons A x left) (@cons B y right))) *)
inv H.
hnf.
rewrite !var_types_update_dist.
rewrite !ret_type_update_dist.
rewrite !glob_types_update_dist.
rewrite !glob_specs_update_dist.
rewrite !annotations_update_dist.
split.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
intros.
rewrite !temp_types_update_dist.
(* Goal: @In A i (@fst (list A) (list B) (@pair (list A) (list B) (@cons A a l0) (@cons B b l1))) *)
simpl.
rewrite !join_te_denote2.
unfold te_one_denote.
destruct (ident_eq id i).
(* Goal: @ex val (fun v0 : val => and (@eq (option val) (@Some val v) (@Some val v0)) (tc_val' ty v0)) *)
subst.
rewrite H0,H1.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
rewrite PTree.gss. auto.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
rewrite PTree.gso by auto.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
auto.
(* Goal: and (typecheck_temp_environ (te_of (mkEnviron ge ve (@Map.set val id v te))) (temp_types Delta)) (and (typecheck_var_environ (ve_of (mkEnviron ge ve (@Map.set val id v te))) (var_types Delta)) (typecheck_glob_environ (ge_of (mkEnviron ge ve (@Map.set val id v te))) (glob_types Delta))) *)
destruct Delta2; simpl in *. intuition.
destruct ((temp_types Delta2) ! i)
        as [[? ?]|] eqn:?H.
hnf.
rewrite !var_types_update_dist.
rewrite !ret_type_update_dist.
rewrite !glob_types_update_dist.
rewrite !glob_specs_update_dist.
rewrite !annotations_update_dist.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
split; auto.
(* Goal: forall id : positive, match @PTree.get type id (temp_types Delta) with | Some t => match @PTree.get type id (temp_types Delta) with | Some t' => @eq type t t' | None => False end | None => match @PTree.get type id (temp_types Delta) with | Some t => False | None => True end end *)
intros.
rewrite !temp_types_update_dist.
(* Goal: @In A i (@fst (list A) (list B) (@pair (list A) (list B) (@cons A a l0) (@cons B b l1))) *)
simpl.
rewrite !join_te_denote2.
unfold te_one_denote.
destruct (ident_eq id i).
(* Goal: @ex val (fun v0 : val => and (@eq (option val) (@Some val v) (@Some val v0)) (tc_val' ty v0)) *)
subst.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
rewrite H0. auto.
destruct ((temp_types Delta1) ! id)
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
       as [[? ?]|] eqn:?H; auto.
destruct ((temp_types Delta2) ! id)
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
       as [[? ?]|] eqn:?H; auto.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
rewrite PTree.gso by auto. rewrite H3. auto.
(* Goal: @ex val (fun v : val => and (@eq (option val) (@Map.get val te id0) (@Some val v)) (tc_val' ty v)) *)
rewrite PTree.gso by auto. rewrite H3. auto.
apply tycontext_eqv_refl.
Qed.

*)