Local Open Scope logic.
Definition pTree_from_elements {A} (el: list (positive * A)) : PTree.t A :=
fold_right (fun ia t => PTree.set (fst ia) (snd ia) t) (PTree.empty _) el.
Definition local_trees :=
(PTree.t val * PTree.t (type * val) * list Prop * option globals)%type.
Definition local2ptree1 (Q: localdef)
(T1: PTree.t val) (T2: PTree.t (type * val)) (P': list Prop) (Q': option globals)
(f:  PTree.t val -> PTree.t (type * val) -> list Prop -> option globals -> local_trees)
: local_trees :=
match Q with
| temp i v =>   match T1 ! i with
| None => f (PTree.set i v T1) T2 P' Q'
| Some v' => f T1 T2 ((v=v')::P')  Q'
end
| lvar i t v => match T2 ! i with
| None => f T1 (PTree.set i (t, v) T2) P' Q'
| Some (t', vl) => f T1 T2 ((vl=v)::(t'=t)::P') Q'
end
| gvars gv =>   match Q' with
| None => f T1 T2 P' (Some gv)
| Some gv' => f T1 T2 ((gv' = gv)::P') Q'
end
end.
Fixpoint local2ptree_aux (Q: list localdef)
(T1: PTree.t val) (T2: PTree.t (type * val)) (P': list Prop) (Q': option globals):
local_trees :=
match Q with
| Q1 :: Qr => local2ptree1 Q1 T1 T2 P' Q' (local2ptree_aux Qr)
| nil => (T1,T2,P',Q')
end.
Definition local2ptree (Q: list localdef)
: (PTree.t val * PTree.t (type * val) * list Prop * option globals) :=
local2ptree_aux Q PTree.Leaf PTree.Leaf nil None.
Definition CLEAR_ME {T} (x:T) := x.
Ltac hide_it z := let x := fresh "x" in set (x:=z); change z with (CLEAR_ME z) in x.
(* TODO: compare this with unfold_name method in symbolic_go_lower. *)
Ltac hnf_localdef_list A :=
match A with
| temp _ ?v :: ?Q' => hide_it v; hnf_localdef_list Q'
| lvar _ ?t ?v :: ?Q' => hide_it t; hide_it v; hnf_localdef_list Q'
| gvars ?v :: ?Q' => hide_it v; hnf_localdef_list Q'
| ?B :: ?C => let x := eval hnf in B in change B with x; hnf_localdef_list (x::C)
| nil => idtac
| _ => try (is_evar A; fail 1);
let x := eval hnf in A in (change A with x); hnf_localdef_list x
end.
Ltac grab_gvars L :=
match L with gvars ?A :: ?B => let x := grab_gvars B in let z := constr:(A::x) in z
| nil => let x := constr:(@nil globals) in x
end.
Ltac prove_local2ptree :=
clear;
match goal with |- local2ptree ?A = _ => hnf_localdef_list A end;
etransitivity;
[unfold local2ptree, local2ptree_aux; simpl;
repeat match goal with x := CLEAR_ME _ |- _ => unfold CLEAR_ME in x; subst x end;
reflexivity |
repeat match goal with x := CLEAR_ME _ |- _ => unfold CLEAR_ME in x; subst x end;
apply f_equal;
try reflexivity;
match goal with |- ?L = _ => let x := grab_gvars L in instantiate(1:=x); reflexivity end
].
Goal exists x,  local2ptree (
temp 1%positive Vundef
:: temp 3%positive (Vint (Int.repr (3+4)))
:: lvar 1%positive tint (Vint (Int.repr (1 + 2)))
:: nil) = x.
set (Three := 3). (* This definition should not be unfolded! *)
set (T := temp 1%positive Vundef). (* This should be unfolded! *)
set (Q := (*tc_env empty_tycontext :: *) nil).  (* This should be unfolded! *)
eexists.
etransitivity.
prove_local2ptree.
match goal with |- context [1+2] => idtac end.
match goal with |- context [Three] => idtac end.
Abort.
Ltac construct_local2ptree Q H :=
let t := fresh "t" in
evar (t: (PTree.t val * PTree.t (type * val) * list Prop * option globals)%type);
assert (H: local2ptree Q = t); subst t;
[ prove_local2ptree | ].
Definition LocalD (T1: PTree.t val) (T2: PTree.t (type * val)) (Q: option globals) :=
PTree.fold (fun Q i v => temp i v :: Q) T1
(PTree.fold (fun Q i tv => match tv with (t, v) => lvar i t v end :: Q) T2
match Q with Some gv => (gvars gv) :: nil | None => nil end).

(* Specifications: *)
Lemma PTree_elements_set: forall {A} i (v: A) elm T,
In elm (PTree.elements (PTree.set i v T)) ->
elm = (i, v) \/ In elm (PTree.elements T).
Lemma LocalD_sound_temp:
forall i v T1 T2 Q,
PTree.get i T1 = Some v -> In (temp i v) (LocalD T1 T2 Q).
Lemma LocalD_sound_local:
forall i t v T1 T2 Q,
PTree.get i T2 = Some (t, v) ->
In (lvar i t v) (LocalD T1 T2 Q).
Lemma LocalD_sound_gvars:
forall gv T1 T2 Q,
Q = Some gv->
In (gvars gv) (LocalD T1 T2 Q).
Lemma LocalD_sound: forall q T1 T2 Q,
(exists i v, PTree.get i T1 = Some v /\ q = temp i v) \/
(exists i t v, PTree.get i T2 = Some (t, v) /\ q = lvar i t v) \/
(exists gv, Q = Some gv /\ q = gvars gv) ->
In q (LocalD T1 T2 Q).
Lemma LocalD_complete : forall q T1 T2 Q,
In q (LocalD T1 T2 Q) ->
(exists i v, PTree.get i T1 = Some v /\ q = temp i v) \/
(exists i t v, PTree.get i T2 = Some (t, v) /\ q = lvar i t v) \/
(exists gv, Q = Some gv /\ q = gvars gv).
Lemma in_temp_aux:
forall q L Q,
In q (fold_right
(fun (y : positive * val) (x : list localdef) =>
temp (fst y) (snd y) :: x) Q L) <->
((exists i v, q = temp i v /\ In (i,v) L) \/ In q Q).
Lemma LOCALx_expand_temp_var  : forall i v T1 T2 Q Q0,
In Q0 (LocalD (PTree.set i v T1) T2 Q) <->
In Q0 (temp i v :: LocalD (PTree.remove i T1) T2 Q).
Lemma In_LocalD_remove_set :
forall q T1 i vd T2 Q,
In q (LocalD T1 (PTree.remove i T2) Q) ->
In q (LocalD T1 (PTree.set i vd T2) Q).
Lemma LOCALx_expand_vardesc : forall i vd T1 T2 Q Q0,
In Q0 (LocalD T1 (PTree.set i vd T2) Q) <->
In Q0 (match vd with (t, v) => lvar i t v end :: (LocalD T1 (PTree.remove i T2) Q)).
Lemma LOCALx_expand_gvars: forall T1 T2 gv Q0,
In Q0 (LocalD T1 T2 (Some gv)) <->
In Q0 (gvars gv ::LocalD T1 T2 None).
Lemma LOCALx_shuffle_derives': forall P Q Q' R,
(forall Q0, In Q0 Q' -> In Q0 Q) ->
PROPx P (LOCALx Q R) |-- PROPx P (LOCALx Q' R).
Lemma LOCALx_shuffle_derives: forall P Q Q' R,
(forall Q0, In Q0 Q' -> In Q0 Q) ->
PROPx P (LOCALx Q (SEPx R)) |-- PROPx P (LOCALx Q' (SEPx R)).
Lemma LOCALx_shuffle: forall P Q Q' R,
(forall Q0, In Q0 Q' <-> In Q0 Q) ->
PROPx P (LOCALx Q (SEPx R)) = PROPx P (LOCALx Q' (SEPx R)).
Lemma LocalD_remove_empty_from_PTree1: forall i T1 T2 Q Q0,
T1 ! i = None ->
(In Q0 (LocalD (PTree.remove i T1) T2 Q) <-> In Q0 (LocalD T1 T2 Q)).
Lemma LocalD_remove_empty_from_PTree2: forall i T1 T2 Q Q0,
T2 ! i = None ->
(In Q0 (LocalD T1 (PTree.remove i T2) Q) <-> In Q0 (LocalD T1 T2 Q)).
Lemma nth_error_local':
forall n P Q R (Qn: localdef),
nth_error Q n = Some Qn ->
PROPx P (LOCALx Q R) |-- local (locald_denote Qn).
Lemma in_local': forall Q0 P Q R, In Q0 Q ->
PROPx P (LOCALx Q R) |-- local (locald_denote Q0).
Lemma local2ptree_sound_aux: forall P Q R Q0 Q1 Q2,
Q1 && local (locald_denote Q0) = Q2 && local (locald_denote Q0) ->
In Q0 Q ->
Q1 && PROPx P (LOCALx Q R) = Q2 && PROPx P (LOCALx Q R).
Lemma LOCALx_expand_vardesc': forall P R i vd T1 T2 Q,
PROPx P (LOCALx (LocalD T1 (PTree.set i vd T2) Q) R) =
PROPx P (LOCALx (match vd with (t,v) => lvar i t v end :: LocalD T1 (PTree.remove i T2) Q) R).
Lemma LOCALx_expand_gvars': forall P R gv T1 T2,
PROPx P (LOCALx (LocalD T1 T2 (Some gv)) R) =
PROPx P (LOCALx (gvars gv :: LocalD T1 T2 None) R).
Lemma local_equal_lemma :
forall i t v t' v',
local (locald_denote (lvar i t v)) && local (locald_denote (lvar i t' v')) =
!!(v' = v) && !!(t'=t) && local (locald_denote (lvar i t' v')).
Lemma gvars_equal_lemma :
forall g g0,
local (locald_denote (gvars g)) && local (locald_denote (gvars g0)) = !! (g0 = g) && local (locald_denote (gvars g0)).
Lemma insert_locals:
forall P A B C,
local (fold_right `(and) `(True) (map locald_denote A)) && PROPx P (LOCALx B C) =
PROPx P (LOCALx (A++B) C).
Lemma LOCALx_app_swap:
forall A B, LOCALx (A++B) = LOCALx (B++A).
Lemma local2ptree_soundness' : forall P Q R T1a T2a Pa Qa T1 T2 P' Q',
local2ptree_aux Q T1a T2a Pa Qa = (T1, T2, P', Q') ->
PROPx (Pa++P) (LOCALx (Q ++ LocalD T1a T2a Qa) R)
= PROPx (P' ++ P) (LOCALx (LocalD T1 T2 Q') R).
Lemma local2ptree_soundness  : forall P Q R T1 T2 P' Q',
local2ptree Q = (T1, T2, P', Q') ->
PROPx P (LOCALx Q (SEPx R)) = PROPx (P' ++ P) (LOCALx (LocalD T1 T2 Q') (SEPx R)).
Lemma local2ptree_soundness'' : forall Q T1 T2 gv,
local2ptree Q = (T1, T2, nil, Some gv) ->
LOCALx Q TT = LOCALx (LocalD T1 T2 (Some gv)) TT.
Lemma local_ext: forall Q0 Q rho, In Q0 Q -> fold_right `(and) `(True) Q rho -> Q0 rho.
Lemma local_ext_rev: forall (Q: list (environ -> Prop)) rho, (forall Q0, In Q0 Q -> Q0 rho) -> fold_right `(and) `(True) Q rho.
Fixpoint explicit_cast_exprlist (et: list type) (el: list expr) {struct et} : list expr :=
match et, el with
| t::et', e::el' => Ecast e t :: explicit_cast_exprlist et' el'
| _, _ => nil
end.