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).
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.
Fixpoint force_list {A} (al: list (option A)) : option (list A) :=
match al with
| Some a :: al' => match force_list al' with Some bl => Some (a::bl) | _ => None end
| nil => Some nil
| _ => None
end.

Lemma make_func_ptr:
forall id (Espec: OracleKind) (CS: compspecs) Delta P Q R fs gv p c Post,
(var_types Delta) ! id = None ->
(glob_specs Delta) ! id = Some fs ->
(glob_types Delta) ! id = Some (type_of_funspec fs) ->
snd (local2ptree Q) = Some gv /\ gv id = p ->
semax Delta (PROPx P (LOCALx Q (SEPx (func_ptr' fs p :: R)))) c Post ->
semax Delta (PROPx P (LOCALx Q (SEPx R))) c Post.