Ltac do_compute_lvalue Delta P Q R e v H :=
let rho := fresh "rho" in
assert (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
local (`(eq v) (eval_lvalue e))) as H by
(first [ assumption |
eapply derives_trans; [| apply msubst_eval_lvalue_eq];
[apply andp_derives; [apply derives_refl |]; apply derives_refl'; apply local2ptree_soundness; try assumption;
let HH := fresh "H" in
construct_local2ptree Q HH;
exact HH |
unfold v;
simpl;
cbv beta iota zeta delta [force_val2 force_val1];
rewrite ?isptr_force_ptr, <- ?offset_val_force_ptr by auto;
reflexivity]
]).
Ltac do_compute_expr Delta P Q R e v H :=
let rho := fresh "rho" in
assert (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
local (`(eq v) (eval_expr e))) as H by
(assumption || (
eapply derives_trans; [| apply msubst_eval_expr_eq];
[apply andp_derives; [apply derives_refl |]; apply derives_refl'; apply local2ptree_soundness; try assumption;
let HH := fresh "H" in
construct_local2ptree Q HH;
exact HH |
unfold v;
match goal with
| |- ?E = Some _ => let E' := eval hnf in E in change E with E'
end;
match goal with
| |- Some ?E = Some _ => let E' := eval hnf in E in
match E' with
| (match ?E'' with
| Some _ => _
| None => Vundef
end)
=> change E with (force_val E'')
| (match ?E'' with
| Vundef => Vundef
| Vint _ => Vundef
| Vlong _ => Vundef
| Vfloat _ => Vundef
| Vsingle _ => Vundef
| Vptr _ _ => Vptr _ (Ptrofs.add _ (Ptrofs.repr ?ofs))
end)
=> change E with (offset_val ofs E'')
| _ => change E with E'
end
| |- ?NotSome = Some _ =>
fail 1000 "The C-language expression " e
" does not necessarily evaluate, perhaps because some variable is missing from your LOCAL clause"
(* fail 1000 "Please make sure hnf can simplify" NotSome "to an expression of the form (Some _)" *)
end;
reflexivity]
)).
(* solve msubst_eval_expr, msubst_eval_lvalue, msubst_eval_LR *)
Ltac solve_msubst_eval :=
let e := match goal with
| |- msubst_eval_expr _ _ _ _ ?a = _ => a
| |- msubst_eval_lvalue _ _ _ _ ?a = _ => a
end in
match goal with
| |- ?E = Some _ => let E' := eval hnf in E in change E with E'
end;
match goal with
| |- Some ?E = Some _ => let E' := eval hnf in E in
match E' with
| (match ?E'' with
| Some _ => _
| None => Vundef
end)
=> change E with (force_val E'')
| (match ?E'' with
| Vundef => Vundef
| Vint _ => Vundef
| Vlong _ => Vundef
| Vfloat _ => Vundef
| Vsingle _ => Vundef
| Vptr _ _ => Vptr _ (Ptrofs.add _ (Ptrofs.repr ?ofs))
end)
=> change E with (offset_val ofs E'')
| _ => change E with E'
end
| |- ?NotSome = Some _ =>
fail 1000 "The C-language expression " e
" does not necessarily evaluate, perhaps because some variable is missing from your LOCAL clause"
end.
Ltac ignore x := idtac.
(*start tactics for forward_while unfolding *)
Ltac intro_ex_local_derives :=
(match goal with
| |- local (_) && exp (fun y => _) |-- _ =>
rewrite exp_andp2; apply exp_left; let y':=fresh y in intro y'
end).
Ltac unfold_and_function_derives_left :=
(repeat match goal with
| |- _ && (exp _) |--  _ => fail 1
| |- _ && (PROPx _ _) |-- _ => fail 1
| |- _ && (?X _ _ _ _ _) |--  _ => unfold X
| |- _ && (?X _ _ _ _) |--  _ => unfold X
| |- _ && (?X _ _ _) |--  _ => unfold X
| |- _ && (?X _ _) |--  _ => unfold X
| |- _ && (?X _) |--  _ => unfold X
| |- _ && (?X) |--  _ => unfold X
end).
Ltac unfold_and_local_derives :=
try rewrite <- local_lift2_and;
unfold_and_function_derives_left;
repeat intro_ex_local_derives;
try rewrite local_lift2_and;
repeat (try rewrite andp_assoc; rewrite insert_local).
Ltac unfold_function_derives_right :=
(repeat match goal with
| |- _ |-- (exp _) => fail 1
| |- _ |-- (PROPx _ _) => fail 1
| |- _ |-- (?X _ _ _ _ _)  => unfold X
| |- _ |-- (?X _ _ _ _)  => unfold X
| |- _ |-- (?X _ _ _)  => unfold X
| |- _ |-- (?X _ _)  => unfold X
| |- _ |-- (?X _)  => unfold X
| |- _ |-- (?X)  => unfold X
end).
Ltac unfold_pre_local_andp :=
(repeat match goal with
| |- semax _ ((local _) && exp _) _ _ => fail 1
| |- semax _ ((local _) && (PROPx _ _)) _ _ => fail 1
| |- semax _ ((local _) && ?X _ _ _ _ _) _ _ => unfold X at 1
| |- semax _ ((local _) && ?X _ _ _ _) _ _ => unfold X at 1
| |- semax _ ((local _) && ?X _ _ _) _ _ => unfold X at 1
| |- semax _ ((local _) && ?X _ _) _ _ => unfold X at 1
| |- semax _ ((local _) && ?X _) _ _ => unfold X at 1
| |- semax _ ((local _) && ?X) _ _ => unfold X at 1
end).
Ltac intro_ex_local_semax :=
(match goal with
| |- semax _ (local (_) && exp (fun y => _)) _ _  =>
rewrite exp_andp2; apply extract_exists_pre; let y':=fresh y in intro y'
end).
Ltac unfold_and_local_semax :=
unfold_pre_local_andp;
repeat intro_ex_local_semax;
try rewrite insert_local.
Ltac do_compute_expr_helper Delta Q v :=
try assumption;
eapply derives_trans; [| apply msubst_eval_expr_eq];
[apply andp_derives; [apply derives_refl | apply derives_refl']; apply local2ptree_soundness; try assumption;
let HH := fresh "H" in
construct_local2ptree Q HH;
exact HH |
unfold v;
simpl;
try unfold force_val2; try unfold force_val1;
autorewrite with norm;
simpl;
reflexivity].
Ltac do_compute_expr1 Delta Pre e :=
match Pre with
| @exp _ _ ?A ?Pre1 =>
let P := fresh "P" in let Q := fresh "Q" in let R := fresh "R" in
let H8 := fresh "DCE" in let H9 := fresh "DCE" in
evar (P: A -> list Prop);
evar (Q: A -> list localdef);
evar (R: A -> list mpred);
assert (H8: Pre1 =  (fun a => PROPx (P a) (LOCALx (Q a) (SEPx (R a)))))
by (extensionality; unfold P,Q,R; reflexivity);
let v := fresh "v" in evar (v: A -> val);
assert (H9: forall a, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a))) |--
local (`(eq (v a)) (eval_expr e)))
by (let a := fresh "a" in intro a; do_compute_expr_helper Delta (Q a) v)
| PROPx ?P (LOCALx ?Q (SEPx ?R)) =>
let H9 := fresh "H" in
let v := fresh "v" in evar (v: val);
assert (H9:  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))|--
local (`(eq v) (eval_expr e)))
by (do_compute_expr_helper Delta Q v)
end.

(* Specifications: *)
Lemma int64_eq_e: forall i, Int64.eq i Int64.zero = true -> i=Int64.zero.
Lemma typed_true_nullptr3:
forall p,
typed_true tint (force_val (sem_cmp_pp Ceq p nullval)) ->
p=nullval.
Lemma typed_false_nullptr3:
forall p,
typed_false tint (force_val (sem_cmp_pp Ceq p nullval)) ->
p<>nullval.
Lemma typed_true_nullptr4:
forall p,
typed_true tint (force_val (sem_cmp_pp Cne p nullval)) ->
p <> nullval.
Lemma typed_false_nullptr4:
forall p,
typed_false tint (force_val (sem_cmp_pp Cne p nullval)) ->
p=nullval.
Lemma ltu_inv:
forall x y, Int.ltu x y = true -> Int.unsigned x < Int.unsigned y.
Lemma ltu_false_inv:
forall x y, Int.ltu x y = false -> Int.unsigned x >= Int.unsigned y.
Lemma lt_repr:
forall i j : Z,
repable_signed i ->
repable_signed j ->
Int.lt (Int.repr i) (Int.repr j) = true -> (i < j)%Z.
Lemma lt_repr_false:
forall i j : Z,
repable_signed i ->
repable_signed j ->
Int.lt (Int.repr i) (Int.repr j) = false -> (i >= j)%Z.
Lemma lt_inv:
forall i j,
Int.lt i j = true -> (Int.signed i < Int.signed j)%Z.
Lemma lt_false_inv:
forall i j,
Int.lt i j = false -> (Int.signed i >= Int.signed j)%Z.