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).

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).