Library frag_list_triple
Load seplog_header.
Require Import Omega.
Require Import Bool.
Require Import frag_list_entail.
Require Import Max.
Lemma max_lemma3': forall x1 x2 x3,
x1 >= x2 /\ x1 >= x3 ->
x1 >= max x2 x3.
Ltac Resolve_ge_max :=
match goal with
| |- ?x >= max ?y ?z =>
eapply max_lemma3'; split; [Resolve_ge_max | Resolve_ge_max]
| |- max ?x ?y >= ?z =>
eapply max_lemma5; Resolve_ge_max
| |- max ?x ?y >= ?z =>
eapply max_lemma6; Resolve_ge_max
| |- ?x + 1 > ?z =>
cut (x >= z); [Resolve_ge_max | auto]
| _ => omega
end.
Inductive wpAssrt : Set :=
| wpElt : Assrt -> wpAssrt
| wpSubst : list (var.v * expr) -> wpAssrt -> wpAssrt
| wpLookup : var.v -> expr -> wpAssrt -> wpAssrt
| wpMutation : expr -> expr -> wpAssrt -> wpAssrt
| wpIf : expr_b -> wpAssrt -> wpAssrt -> wpAssrt.
Fixpoint subst_lst2update_store (l:list (var.v * expr)) (P:assert) {struct l} : assert :=
match l with
nil => P
| (x,e)::tl => subst_lst2update_store tl (update_store2 x e P)
end.
Lemma subst_lst2update_store_app : forall l2 l1 P s h,
subst_lst2update_store (l2 ++ l1) P s h ->
subst_lst2update_store l1 (subst_lst2update_store l2 P) s h.
Lemma subst_lst2update_store' : forall l x v s h P,
subst_lst2update_store (l ++ (x,v)::nil) P s h ->
update_store2 x v (subst_lst2update_store l P) s h.
Lemma entails_subst_lst2update_store: forall l P1 P2 s h,
(P1 ==> P2) ->
subst_lst2update_store l P1 s h ->
subst_lst2update_store l P2 s h.
Lemma subst_lst2update_store_and: forall l P1 P2 s h,
subst_lst2update_store l (fun s h => P1 s h /\ P2 s h) s h ->
subst_lst2update_store l P1 s h /\ subst_lst2update_store l P2 s h.
Lemma subst_lst2update_store_and': forall l P1 P2 s h,
subst_lst2update_store l P1 s h /\ subst_lst2update_store l P2 s h ->
subst_lst2update_store l (fun s h => P1 s h /\ P2 s h) s h.
Lemma subst_lst2update_store_imply: forall l P1 P2 s h,
(subst_lst2update_store l P1 s h -> subst_lst2update_store l P2 s h) ->
subst_lst2update_store l (fun s h => P1 s h -> P2 s h) s h.
Lemma subst_lst2update_store_exists: forall l (P: expr -> assert) s h,
(exists x0, (subst_lst2update_store l (P x0)) s h) ->
subst_lst2update_store l (fun s h => exists e0, P e0 s h) s h.
Lemma subst_lst2update_store_sep_con: forall l P1 P2 s h,
((fun s h => subst_lst2update_store l P1 s h) ** (fun s h => subst_lst2update_store l P2 s h)) s h ->
subst_lst2update_store l (P1 ** P2) s h.
Lemma subst_lst2update_store_sepimp: forall l P1 P2 s h,
((fun s h => subst_lst2update_store l P1 s h) -* (fun s h => subst_lst2update_store l P2 s h)) s h ->
subst_lst2update_store l (P1 -* P2) s h.
Fixpoint wpAssrt_interp (a: wpAssrt) : assert :=
match a with
wpElt a1 => Assrt_interp a1
| wpSubst l L => subst_lst2update_store l (wpAssrt_interp L)
| wpLookup x e L => (fun s h => exists e0, (e |-> e0 ** (e |-> e0 -* (update_store2 x e0 (wpAssrt_interp L)))) s h)
| wpMutation e1 e2 L => (fun s h => exists e0, (e1 |-> e0 ** (e1 |-> e2 -* (wpAssrt_interp L))) s h)
| wpIf b L1 L2 => (fun s h => (eval_pi b s = true -> wpAssrt_interp L1 s h) /\
(eval_b b s = false -> wpAssrt_interp L2 s h))
end.
Fixpoint subst_e (e patt repl: expr) {struct e} : expr :=
match e with
var_e w => match expr_eq e patt with
true => repl
| false => e
end
| int_e i => match expr_eq e patt with
true => repl
| false => e
end
| add_e e1 e2 => match expr_eq e patt with
true => repl
| false => add_e (subst_e e1 patt repl) (subst_e e2 patt repl)
end
| min_e e1 e2 => match expr_eq e patt with
true => repl
| false => min_e (subst_e e1 patt repl) (subst_e e2 patt repl)
end
| mul_e e1 e2 => match expr_eq e patt with
true => repl
| false => mul_e (subst_e e1 patt repl) (subst_e e2 patt repl)
end
| div_e e1 e2 => match expr_eq e patt with
true => repl
| false => div_e (subst_e e1 patt repl) (subst_e e2 patt repl)
end
| mod_e e1 e2 => match expr_eq e patt with
true => repl
| false => mod_e (subst_e e1 patt repl) (subst_e e2 patt repl)
end
end.
Fixpoint subst_b (e: expr_b) (patt repl: expr) {struct e} : expr_b :=
match e with
true_b => true_b
| f == g => subst_e f patt repl == subst_e g patt repl
| f =/= g => subst_e f patt repl =/= subst_e g patt repl
| f >>= g => subst_e f patt repl >>= subst_e g patt repl
| f >> g => subst_e f patt repl >> subst_e g patt repl
| f &&& g => (subst_b f patt repl) &&& (subst_b g patt repl)
| f ||| g => (subst_b f patt repl) ||| (subst_b g patt repl)
| neg_b e => neg_b (subst_b e patt repl)
end.
Fixpoint subst_Sigma (a: Sigma) (x: var.v) (e: expr) {struct a} : Sigma :=
match a with
singl e1 e2 => singl (subst_e e1 (var_e x) e) (subst_e e2 (var_e x) e)
| emp => emp
| star s1 s2 => star (subst_Sigma s1 x e) (subst_Sigma s2 x e)
| cell e1 => cell (subst_e e1 (var_e x) e)
| lst e1 e2 => lst (subst_e e1 (var_e x) e) (subst_e e2 (var_e x) e)
end.
Definition subst_assrt (a: assrt) (x: var.v) (e: expr): assrt :=
match a with
(pi, sigm) => (subst_b pi (var_e x) e, subst_Sigma sigm x e)
end.
Fixpoint subst_Assrt (a: Assrt) (x: var.v) (e: expr) {struct a}: Assrt :=
match a with
nil => nil
| hd::tl => (subst_assrt hd x e)::(subst_Assrt tl x e)
end.
Fixpoint subst_e_lst (l: list (var.v * expr)) (e: expr) {struct l}: expr :=
match l with
nil => e
| (x,e')::tl => subst_e_lst tl (subst_e e (var_e x) e')
end.
Fixpoint subst_b_lst (l: list (var.v * expr)) (e: expr_b) {struct l}: expr_b :=
match l with
nil => e
| (x,e')::tl => subst_b_lst tl (subst_b e (var_e x) e')
end.
Fixpoint subst_assrt_lst (l:list (var.v * expr)) (a:assrt) {struct l} : assrt :=
match l with
nil => a
| (x,e)::tl => subst_assrt_lst tl (subst_assrt a x e)
end.
Fixpoint subst_Assrt_lst (l:list (var.v * expr)) (a:Assrt) {struct l} : Assrt :=
match l with
nil => a
| (x,e)::tl => subst_Assrt_lst tl (subst_Assrt a x e)
end.
Lemma subst_e2store_update: forall e s x v,
eval (subst_e e (var_e x) v) s = eval e (store.update x (eval v s) s).
Lemma subst_b2store_update: forall b s x v,
eval_b (subst_b b (var_e x) v) s = eval_b b (store.update x (eval v s) s).
Lemma subst_e_lst_int_e: forall l v s,
eval (subst_e_lst l (int_e v)) s = v.
Lemma subst_Sigma2store_update: forall sigm s h x v,
Sigma_interp (subst_Sigma sigm x v) s h ->
Sigma_interp sigm (store.update x (eval v s) s) h.
Lemma subst_Sigma2store_update': forall sigm s h x v,
Sigma_interp sigm (store.update x (eval v s) s) h ->
Sigma_interp (subst_Sigma sigm x v) s h.
Lemma subst_Assert2store_update: forall A s h x v,
Assrt_interp (subst_Assrt A x v) s h ->
Assrt_interp A (store.update x (eval v s) s) h.
Lemma subst_lst2update_store_assrt_interp: forall l s h pi sigm,
assrt_interp (subst_assrt_lst l (pi, sigm)) s h ->
subst_lst2update_store l (assrt_interp (pi, sigm)) s h.
Lemma subst_lst2update_store_Assrt_interp: forall l A s h,
Assrt_interp (subst_Assrt_lst l A) s h ->
subst_lst2update_store l (Assrt_interp A) s h.
Lemma subst_lst2update_store_subst_b_lst: forall (b':bool) l b s h,
subst_lst2update_store l (fun s h => eval_pi b s = b') s h ->
eval_b (subst_b_lst l b) s = b'.
Lemma subst_lst2update_store_mapsto: forall l e1 e2 s h,
(subst_e_lst l e1 |-> subst_e_lst l e2) s h ->
subst_lst2update_store l (e1 |-> e2) s h.
Lemma subst_lst2update_store_mapsto': forall l e1 e2 s h,
subst_lst2update_store l (e1 |-> e2) s h ->
(subst_e_lst l e1 |-> subst_e_lst l e2) s h.
Lemma subst_lst2update_store_lookup' : forall e x v s,
exists e', eval e s = eval (subst_e e' (var_e x) v) s.
Lemma subst_lst2update_store_lookup: forall l e1 e2 s h P,
(exists e0,
((subst_e_lst l e1 |-> e0) **
(subst_e_lst l e1 |-> subst_e_lst l e2 -* subst_lst2update_store l P)) s h) ->
subst_lst2update_store l (fun s' h' => exists e0, (e1 |-> e0 ** (e1 |-> e2 -* P)) s' h') s h.
Module Type FRESH.
Parameter fresh_e : var.v -> expr -> Prop.
Parameter fresh_b : var.v -> expr_b -> Prop.
Parameter fresh_Sigma : var.v -> Sigma -> Prop.
Parameter fresh_assrt : var.v -> assrt -> Prop.
Parameter fresh_lst : var.v -> (list (var.v * expr)) -> Prop.
Parameter fresh_wpAssrt : var.v -> wpAssrt -> Prop.
Parameter fresh_cmd : var.v -> cmd -> Prop.
Parameter fresh_lst_decompose : forall x hd0 hd1 tl, fresh_lst x ((hd0,hd1)::tl) ->
fresh_e x hd1 /\ x <> hd0 /\ fresh_lst x tl.
Parameter fresh_e_var_e_neq : forall x y, fresh_e x (var_e y) -> x <> y.
Parameter fresh_e_eval: forall e x v s, fresh_e x e ->
eval e (store.update x v s) = eval e s.
Parameter fresh_wpAssrt_inde: forall L x , fresh_wpAssrt x L ->
inde (x::nil) (wpAssrt_interp L).
End FRESH.
Module Fresh <: FRESH.
Fixpoint var_max_expr (e: expr) : var.v :=
match e with
var_e w => w
| int_e i => 0
| add_e e1 e2 => max (var_max_expr e1) (var_max_expr e2)
| min_e e1 e2 => max (var_max_expr e1) (var_max_expr e2)
| mul_e e1 e2 => max (var_max_expr e1) (var_max_expr e2)
| div_e e1 e2 => max (var_max_expr e1) (var_max_expr e2)
| mod_e e1 e2 => max (var_max_expr e1) (var_max_expr e2)
end.
Fixpoint var_max_expr_b (e: expr_b) : var.v :=
match e with
true_b => 0
| eq_b e1 e2 => max (var_max_expr e1) (var_max_expr e2)
| neq_b e1 e2 => max (var_max_expr e1) (var_max_expr e2)
| ge_b e1 e2 => max (var_max_expr e1) (var_max_expr e2)
| gt_b e1 e2 => max (var_max_expr e1) (var_max_expr e2)
| and_b e1 e2 => max (var_max_expr_b e1) (var_max_expr_b e2)
| or_b e1 e2 => max (var_max_expr_b e1) (var_max_expr_b e2)
| neg_b e => (var_max_expr_b e)
end.
Fixpoint var_max_Sigma (s: Sigma) : var.v :=
match s with
singl e1 e2 => max (var_max_expr e1) (var_max_expr e2)
| emp => 0
| star s1 s2 => max (var_max_Sigma s1) (var_max_Sigma s2)
| cell e1 => var_max_expr e1
| lst e1 e2 => max (var_max_expr e1) (var_max_expr e2)
end.
Definition var_max_assrt (a: assrt) : var.v :=
match a with
(pi, sigm) => max (var_max_expr_b pi) (var_max_Sigma sigm)
end.
Fixpoint var_max_Assrt (a: Assrt) : var.v :=
match a with
| nil => 0
| hd::tl => max (var_max_assrt hd) (var_max_Assrt tl)
end.
Fixpoint var_max_lst (l: list (var.v * expr)) : var.v :=
match l with
nil => 0
| (v,e)::tl => max (max v (var_max_expr e)) (var_max_lst tl)
end.
Fixpoint var_max_wpAssrt (a: wpAssrt) : var.v :=
match a with
wpElt a1 => var_max_Assrt a1
| wpSubst l L => max (var_max_lst l) (var_max_wpAssrt L)
| wpLookup x e L=> max (max x (var_max_expr e)) (var_max_wpAssrt L)
| wpMutation e1 e2 L => max (max (var_max_expr e1) (var_max_expr e2)) (var_max_wpAssrt L)
| wpIf b L1 L2 => max (max (var_max_wpAssrt L1) (var_max_wpAssrt L2)) (var_max_expr_b b)
end.
Fixpoint var_max_cmd (c: cmd) : var.v :=
match c with
skip => 0
| assign x e => max (var_max_expr e) x
| lookup x e => max (var_max_expr e) x
| mutation e1 e2 => max (var_max_expr e1) (var_max_expr e2)
| malloc x e => max (var_max_expr e) x
| free e => (var_max_expr e)
| while b c' => max (var_max_expr_b b) (var_max_cmd c')
| seq c1 c2 => max (var_max_cmd c1) (var_max_cmd c2)
| ifte b thendo c1 elsedo c2 => max (max (var_max_cmd c1) (var_max_cmd c2)) (var_max_expr_b b)
end.
Definition fresh_e x e := (x > var_max_expr e).
Definition fresh_b x b := (x > var_max_expr_b b).
Definition fresh_Sigma x s := (x > var_max_Sigma s).
Definition fresh_assrt x a := (x > var_max_assrt a).
Definition fresh_Assrt x a := (x > var_max_Assrt a).
Definition fresh_lst x l := (x > var_max_lst l).
Definition fresh_wpAssrt x L := (x > var_max_wpAssrt L).
Definition fresh_cmd x c := (x > var_max_cmd c).
Lemma fresh_lst_decompose : forall x hd0 hd1 tl, fresh_lst x ((hd0,hd1)::tl) -> fresh_e x hd1 /\ x <> hd0 /\ fresh_lst x tl.
Lemma fresh_e_var_e_neq : forall x y, fresh_e x (var_e y) -> x <> y.
Ltac Max_inf_resolve :=
Max_inf_clean_hyp; Max_inf_resolve_goal
with
Max_inf_clean_hyp :=
match goal with
| id: fresh_e _ _ |- _ => red in id; simpl in id; Max_inf_clean_hyp
| id: fresh_b _ _ |- _ => red in id; simpl in id; Max_inf_clean_hyp
| id: fresh_Sigma _ _ |- _ => red in id; simpl in id; Max_inf_clean_hyp
| id: fresh_assrt _ _ |- _ => red in id; simpl in id; Max_inf_clean_hyp
| id: fresh_Assrt _ _ |- _ => red in id; simpl in id; Max_inf_clean_hyp
| id: fresh_lst _ _ |- _ => red in id; simpl in id; Max_inf_clean_hyp
| id: fresh_wpAssrt _ _ |- _ => red in id; simpl in id; Max_inf_clean_hyp
| id: ?x > max ?y ?z |- _ =>
generalize (max_lemma2 _ _ _ id); intro X; inversion_clear X; clear id; Max_inf_clean_hyp
| |- _ => idtac
end
with
Max_inf_resolve_goal :=
match goal with
| |- fresh_e _ _ => red; simpl; Max_inf_resolve_goal
| |- fresh_b _ _ => red; simpl; Max_inf_resolve_goal
| |- fresh_Sigma _ _ => red; simpl; Max_inf_resolve_goal
| |- fresh_assrt _ _ => red; simpl; Max_inf_resolve_goal
| |- fresh_Assrt _ _ => red; simpl; Max_inf_resolve_goal
| |- fresh_lst _ _ => red; simpl; Max_inf_resolve_goal
| |- fresh_wpAssrt _ _ => red; simpl; Max_inf_resolve_goal
| |- ?x > max ?y ?z =>
eapply max_lemma3; split; [Max_inf_resolve_goal | Max_inf_resolve_goal]
| |- _ => omega || tauto || idtac
end.
Lemma fresh_e_eval: forall e x v s,
fresh_e x e ->
eval e (store.update x v s) = eval e s.
Lemma subst_e_lst_eval_sub1: forall e x v0 e0,
fresh_e x e ->
x <> v0 ->
fresh_e x e0 ->
fresh_e x (subst_e e (var_e v0) e0).
Lemma subst_e_lst_eval: forall l e x v s,
fresh_e x e ->
fresh_lst x l ->
eval (subst_e_lst l e) (store.update x v s) = eval (subst_e_lst l e) s.
Lemma fresh_b_inde: forall b x v,
fresh_b x b ->
inde (x::nil) (fun s h => eval_b b s = v).
Lemma var_max_Sigma_inde: forall sigm x ,
fresh_Sigma x sigm ->
inde (x::nil) (Sigma_interp sigm).
Lemma fresh_assrt_inde: forall a x ,
fresh_assrt x a ->
inde (x::nil) (assrt_interp a).
Lemma fresh_Assrt_inde: forall a x ,
fresh_Assrt x a ->
inde (x::nil) (Assrt_interp a).
Lemma fresh_lst_inde: forall l P x,
inde (x::nil) P ->
fresh_lst x l ->
inde (x::nil) (subst_lst2update_store l P).
Lemma fresh_wpAssrt_inde: forall L x ,
fresh_wpAssrt x L ->
inde (x::nil) (wpAssrt_interp L).
End Fresh.
Import Fresh.
Ltac apply_entails_subst_lst2update_store id :=
match goal with
| id: subst_lst2update_store ?l ?P' ?s ?h |- subst_lst2update_store ?l ?P ?s ?h =>
eapply entails_subst_lst2update_store with P'; [red; simpl; intros; idtac | auto]
end.
Ltac cut_replace_list P :=
match goal with
| |- subst_lst2update_store ?l ?P' ?s ?h =>
cut (subst_lst2update_store l P s h);
[intro cut_replace_listA1; apply_entails_subst_lst2update_store cut_replace_listA1 | idtac]
end.
Lemma subst_lst2update_store_fresh: forall l x' e s h P,
fresh_lst x' l ->
subst_lst2update_store l P (store.update x' (eval e s) s) h ->
subst_lst2update_store l (fun s' h' => P (store.update x' (eval e s) s') h') s h.
Lemma subst_lst2update_store_fresh': forall l x' e s h P,
fresh_lst x' l ->
subst_lst2update_store l (fun s' h' => P (store.update x' (eval e s) s') h') s h ->
subst_lst2update_store l P (store.update x' (eval e s) s) h.
Lemma intro_fresh_var' : forall l x x' e s h P,
fresh_lst x' l ->
fresh_e x' (var_e x) ->
inde (x'::nil) P ->
subst_lst2update_store l (fun s' h' => P (store.update x (eval (var_e x') s') s') h') (store.update x' (eval e s) s) h ->
subst_lst2update_store l (fun s' h' => P (store.update x (eval e s) s') h') s h.
Lemma intro_fresh_var : forall l x x' e s h L,
fresh_lst x' l -> fresh_wpAssrt x' L -> fresh_e x' (var_e x) ->
subst_lst2update_store
l (fun s' h' => wpAssrt_interp L (store.update x (eval (var_e x') s') s') h') (store.update x' (eval e s) s) h ->
subst_lst2update_store
l (fun s' h' => wpAssrt_interp L (store.update x (eval e s) s') h') s h.
Definition triple_fresh (P: assrt) (L: wpAssrt) (x: var.v) : Prop := fresh_assrt x P /\ fresh_wpAssrt x L.
Require Import expr_b_dp.
Fixpoint wp_frag (Q: option wpAssrt) (c: cmd) {struct c}: option wpAssrt :=
match c with
skip => match Q with
None => None
| Some Q' => Some Q'
end
| assign v e => match Q with
None => None
| Some Q' => Some (wpSubst ((v,e)::nil) Q')
end
| lookup v e => match Q with
None => None
| Some Q' => Some (wpLookup v e Q')
end
| mutation e1 e2 => match Q with
None => None
| Some Q' => Some (wpMutation e1 e2 Q')
end
| seq c1 c2 => wp_frag (wp_frag Q c2) c1
| ifte b thendo c1 elsedo c2 => match (wp_frag Q c1) with
None => None
| Some Q1 => match (wp_frag Q c2) with
None => None
| Some Q2 => Some (wpIf b (Q1) (Q2))
end
end
| while a c => None
| malloc v e => None
| free e => None
end.
Lemma wp_frag_None_is_None: forall c, wp_frag None c = None.
Lemma wp_frag_soudness: forall c Q Q',
wp_frag (Some Q) c = Some Q' -> {{ wpAssrt_interp Q' }} c {{ wpAssrt_interp Q }}.
Open Local Scope tmp_scope.
Inductive tritra : assrt -> wpAssrt -> Prop :=
| tritra_incons : forall pi sig Q,
(forall s h, (assrt_interp (pi, sig) s h) -> False) ->
tritra (pi, sig) Q
| tritra_entail : forall P Q,
assrt_interp P ==> Assrt_interp Q ->
tritra P (wpElt Q)
| tritra_precond_stre : forall L1 L1' L2,
assrt_interp L1 ==> assrt_interp L1' ->
tritra L1' L2 ->
tritra L1 L2
| tritra_if : forall pi1 sig1 L1 L2 b,
tritra (pi1 &&& b, sig1) L1 ->
tritra (pi1 &&& (neg_b b), sig1) L2 ->
tritra (pi1, sig1) (wpIf b L1 L2)
| tritra_mutation : forall pi1 sig1 e1 e2 e3 e4 L,
(forall s, eval_pi pi1 s = true -> eval_pi (e1 == e3) s = true) ->
tritra (pi1, sig1 ** (singl e1 e4)) L ->
tritra (pi1, sig1 ** (singl e1 e2)) (wpMutation e3 e4 L)
| tritra_mutation' : forall pi1 sig1 e1 e3 e4 L,
(forall s, eval_pi pi1 s = true -> eval_pi (e1 == e3) s = true) ->
tritra (pi1, sig1 ** (singl e1 e4)) L ->
tritra (pi1, sig1 ** (cell e1)) (wpMutation e3 e4 L)
| tritra_lookup : forall pi1 sig1 e1 e2 e x L,
(forall s, eval_pi pi1 s = true -> eval_pi (e1 == e) s = true) ->
tritra (pi1, sig1 ** (singl e1 e2)) (wpSubst ((x,e2)::nil) L) ->
tritra (pi1, sig1 ** (singl e1 e2)) (wpLookup x e L)
| tritra_lookup' : forall pi1 sig1 e1 e x L x',
(forall s, eval_pi pi1 s = true -> eval_pi (e1 == e) s = true) ->
fresh_assrt x' (pi1, sig1 ** cell e1) ->
fresh_wpAssrt x' (wpLookup x e L) ->
tritra (pi1, sig1 ** (singl e1 (var_e x'))) (wpSubst ((x,var_e x')::nil) L) ->
tritra (pi1, sig1 ** (cell e1)) (wpLookup x e L)
| tritra_subst_elt : forall pi1 sig1 l L,
tritra (pi1, sig1) (wpElt (subst_Assrt_lst l L)) ->
tritra (pi1, sig1) (wpSubst l (wpElt L))
| tritra_subst_subst : forall pi1 sig1 l1 l2 L,
tritra (pi1, sig1) (wpSubst (l2 ++ l1) L) ->
tritra (pi1, sig1) (wpSubst l1 (wpSubst l2 L))
| tritra_subst_lookup : forall pi1 sig1 e1 e2 e x x' l L,
(forall s, eval_pi pi1 s = true -> eval_pi (e1 == (subst_e_lst l e)) s = true) ->
fresh_lst x' l ->
fresh_wpAssrt x' L ->
fresh_e x' (var_e x) ->
tritra (pi1, sig1 ** (singl e1 e2)) (wpSubst ((x, var_e x')::l ++ ((x', e2)::nil)) L) ->
tritra (pi1, sig1 ** (singl e1 e2)) (wpSubst l (wpLookup x e L))
| tritra_subst_lookup2 : forall pi1 sig1 e1 e x x' l L x'',
(forall s, eval_pi pi1 s = true -> eval_pi (e1 == subst_e_lst l e) s = true) ->
fresh_lst x' l ->
fresh_wpAssrt x' L ->
fresh_e x' (var_e x) ->
fresh_wpAssrt x'' (wpSubst l (wpLookup x e L)) ->
fresh_assrt x'' (pi1, sig1 ** cell e1) ->
tritra (pi1, sig1 ** (singl e1 (var_e x''))) (wpSubst ((x, var_e x')::l ++ ((x',var_e x'')::nil)) L) ->
tritra (pi1, sig1 ** cell e1) (wpSubst l (wpLookup x e L))
| tritra_subst_mutation : forall pi1 sig1 e1 e2 l L,
tritra (pi1, sig1) (wpMutation (subst_e_lst l e1) (subst_e_lst l e2) (wpSubst l L)) ->
tritra (pi1, sig1) (wpSubst l (wpMutation e1 e2 L))
| tritra_subst_if : forall pi1 sig1 l b L1 L2,
tritra (pi1, sig1) (wpIf (subst_b_lst l b) (wpSubst l L1) (wpSubst l L2)) ->
tritra (pi1, sig1) (wpSubst l (wpIf b L1 L2))
| tritra_destruct_lst: forall pi1 sig1 e1 e2 L x',
(forall s, eval_pi pi1 s = true -> eval_pi (e1 =/= e2) s = true) ->
fresh_assrt x' (pi1, sig1 ** lst e1 e2) ->
fresh_wpAssrt x' L ->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' == nat_e 0),
sig1 ** (((singl e1 (var_e x')) ** (cell (e1 +e nat_e 1))) ** (lst (var_e x') e2))) L ->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' =/= nat_e 0),
sig1 ** (((singl e1 (var_e x')) ** (cell (e1 +e nat_e 1))) ** (lst (var_e x') e2))) L ->
tritra (pi1,star sig1 (lst e1 e2)) L
(**)
.
Close Local Scope tmp_scope.
Lemma tritra_soundness : forall P Q, tritra P Q ->
assrt_interp P ==> wpAssrt_interp Q.
Definition triple_vfresh (a: assrt) (L: wpAssrt) := (max (var_max_assrt a) (var_max_wpAssrt L)) + 1.
Lemma tritra_lookup_lst: forall pi1 sig1 e1 e2 e x L x',
(forall s, eval_pi pi1 s = true -> (eval_pi (e1 == e) s = true /\ eval_pi (e1 =/= e2) s = true)) ->
x' = triple_vfresh (pi1, star sig1 (lst e1 e2)) (wpLookup x e L) ->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' == nat_e 0),
star (star sig1 (star (lst (var_e x') e2) (cell (e1 +e nat_e 1)))) (singl e1 (var_e x'))) (wpLookup x e L) ->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' =/= nat_e 0),
star (star sig1 (star (lst (var_e x') e2) (cell (e1 +e nat_e 1)))) (singl e1 (var_e x'))) (wpLookup x e L) ->
tritra (pi1, star sig1 (lst e1 e2)) (wpLookup x e L).
Lemma tritra_lookup_lst': forall pi1 sig1 e1 e2 e x L x',
(forall s, eval_pi pi1 s = true -> (eval_pi ((e1 +e nat_e 1) == e) s = true /\ eval_pi (e1 =/= e2) s = true)) ->
x' = triple_vfresh (pi1, star sig1 (lst e1 e2)) (wpLookup x e L) ->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' == nat_e 0),
star (star sig1 (star (lst (var_e x') e2) (cell (e1 +e nat_e 1)))) (singl e1 (var_e x'))) (wpLookup x e L) ->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' =/= nat_e 0),
star (star sig1 (star (lst (var_e x') e2) (cell (e1 +e nat_e 1)))) (singl e1 (var_e x'))) (wpLookup x e L) ->
tritra (pi1, star sig1 (lst e1 e2)) (wpLookup x e L).
Lemma tritra_subst_lookup_lst: forall pi1 sig1 e1 e2 e x L l x',
(forall s, eval_pi pi1 s = true -> (eval_pi (e1 == (subst_e_lst l e)) s = true /\ eval_pi (e1 =/= e2) s = true)) ->
x' = triple_vfresh (pi1, star sig1 (lst e1 e2)) (wpSubst l (wpLookup x e L)) ->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' == nat_e 0),
star (star sig1 (star (lst (var_e x') e2) (cell (e1 +e nat_e 1)))) (singl e1 (var_e x'))) (wpSubst l (wpLookup x e L)) ->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' =/= nat_e 0),
star (star sig1 (star (lst (var_e x') e2) (cell (e1 +e nat_e 1)))) (singl e1 (var_e x'))) (wpSubst l (wpLookup x e L)) ->
tritra (pi1, star sig1 (lst e1 e2)) (wpSubst l (wpLookup x e L)).
Lemma tritra_subst_lookup_lst': forall pi1 sig1 e1 e2 e x L l x',
(forall s, eval_pi pi1 s = true -> (eval_pi ((e1 +e nat_e 1) == (subst_e_lst l e)) s = true /\ eval_pi (e1 =/= e2) s = true)) ->
x' = triple_vfresh (pi1,star sig1 (lst e1 e2)) (wpSubst l (wpLookup x e L)) ->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' == nat_e 0),
star (star sig1 (star (lst (var_e x') e2) (singl e1 (var_e x')))) (cell (e1 +e nat_e 1))) (wpSubst l (wpLookup x e L)) ->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' =/= nat_e 0),
star (star sig1 (star (lst (var_e x') e2) (singl e1 (var_e x')))) (cell (e1 +e nat_e 1))) (wpSubst l (wpLookup x e L)) ->
tritra (pi1,star sig1 (lst e1 e2)) (wpSubst l (wpLookup x e L)).
Lemma tritra_mutation_lst : forall pi1 sig1 e1 e2 e3 e4 L x',
(forall s, eval_pi pi1 s = true -> (eval_pi (e1 == e3) s = true /\ eval_pi (e1 =/= e2) s = true)) ->
x' = triple_vfresh (pi1,star sig1 (lst e1 e2)) (wpMutation e3 e4 L) ->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' == nat_e 0),
star (star sig1 (star (lst (var_e x') e2) (cell (e1 +e nat_e 1)))) (singl e1 (var_e x'))) (wpMutation e3 e4 L) ->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' =/= nat_e 0),
star (star sig1 (star (lst (var_e x') e2) (cell (e1 +e nat_e 1)))) (singl e1 (var_e x'))) (wpMutation e3 e4 L) ->
tritra (pi1,star sig1 (lst e1 e2)) (wpMutation e3 e4 L).
Lemma tritra_mutation_lst': forall pi1 sig1 e1 e2 e3 e4 L x',
(forall s, eval_pi pi1 s = true -> (eval_pi ((e1 +e (nat_e 1)) == e3) s = true /\ eval_pi (e1 =/= e2) s = true)) ->
x' = triple_vfresh (pi1, star sig1 (lst e1 e2)) (wpMutation e3 e4 L) ->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' == nat_e 0),
star (star sig1 (star (lst (var_e x') e2) (singl e1 (var_e x')))) (cell (e1 +e nat_e 1))) (wpMutation e3 e4 L) ->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' =/= nat_e 0),
star (star sig1 (star (lst (var_e x') e2) (singl e1 (var_e x')))) (cell (e1 +e nat_e 1))) (wpMutation e3 e4 L) ->
tritra (pi1, star sig1 (lst e1 e2)) (wpMutation e3 e4 L).
Lemma tritra_subst_mutation_lst: forall pi1 sig1 e1 e2 e3 e4 L l x',
(forall s, eval_pi pi1 s = true -> (eval_pi (e1 == (subst_e_lst l e3)) s = true /\ eval_pi (e1 =/= e2) s = true)) ->
x' = triple_vfresh (pi1,star sig1 (lst e1 e2)) (wpSubst l (wpMutation e3 e4 L))->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' == nat_e 0),
star (star sig1 (star (lst (var_e x') e2) (cell (e1 +e nat_e 1)))) (singl e1 (var_e x'))) (wpSubst l (wpMutation e3 e4 L)) ->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' =/= nat_e 0),
star (star sig1 (star (lst (var_e x') e2) (cell (e1 +e nat_e 1)))) (singl e1 (var_e x'))) (wpSubst l (wpMutation e3 e4 L)) ->
tritra (pi1,star sig1 (lst e1 e2)) (wpSubst l (wpMutation e3 e4 L)).
Lemma tritra_subst_mutation_lst': forall pi1 sig1 e1 e2 e3 e4 L l x',
(forall s, eval_pi pi1 s = true -> (eval_pi ((e1 +e nat_e 1) == (subst_e_lst l e3)) s = true /\ eval_pi (e1 =/= e2) s = true)) ->
x' = triple_vfresh (pi1,star sig1 (lst e1 e2)) (wpSubst l (wpMutation e3 e4 L)) ->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' == nat_e 0),
star (star sig1 (star (lst (var_e x') e2) (singl e1 (var_e x')))) (cell (e1 +e nat_e 1))) (wpSubst l (wpMutation e3 e4 L)) ->
tritra (pi1 &&& (e1 =/= var_e x') &&& (var_e x' =/= nat_e 0),
star (star sig1 (star (lst (var_e x') e2) (singl e1 (var_e x')))) (cell (e1 +e nat_e 1))) (wpSubst l (wpMutation e3 e4 L)) ->
tritra (pi1,star sig1 (lst e1 e2)) (wpSubst l (wpMutation e3 e4 L)).
Lemma tritra_use: forall c P Q R,
wp_frag (Some (wpElt Q)) c = Some R ->
tritra P R ->
{{ assrt_interp P }} c {{ Assrt_interp Q }}.
Lemma tritra_subst_lookup' : forall pi1 sig1 e1 e2 e x x' l L,
(forall s,eval_pi pi1 s = true -> (eval_pi (e1 == (subst_e_lst l e))) s = true) ->
x' = triple_vfresh (pi1,star sig1 (singl e1 e2)) (wpSubst l (wpLookup x e L)) ->
tritra (pi1,star sig1 (singl e1 e2)) (wpSubst ((x,(var_e x'))::l ++ ((x',e2)::nil)) L) ->
tritra (pi1,star sig1 (singl e1 e2)) (wpSubst l (wpLookup x e L)).
Ltac Rotate_tritra_sig_lhs :=
match goal with
| |- tritra (?pi,?sig) ?L' =>
eapply tritra_precond_stre with (
(pi, remove_empty_heap pi (star_assoc_left (star_com sig) emp))
); [apply entail_soundness; simpl; Entail| simpl]
end.
Lemma Decompose_Assrt_interp: forall a hd tl,
(assrt_interp a ==> assrt_interp hd) \/ (assrt_interp a ==> Assrt_interp tl) ->
(assrt_interp a ==> (Assrt_interp (hd::tl))).
Ltac Resolve_entails :=
eapply Decompose_Assrt_interp; ((left; apply entail_soundness; Entail) || (right; Resolve_entails)).
Ltac tritra_resolve :=
match goal with
| |- tritra (?pi1, ?sig1) ?L => eapply tritra_entail; Resolve_entails
| |- tritra (?pi1, star ?sig1 (singl ?e1 ?e2)) (wpMutation ?e3 ?e4 ?L') =>
(eapply tritra_mutation; [unfold eval_pi; Omega_exprb | tritra_resolve] || Rotate_tritra_sig_lhs; idtac)
| |- tritra (?pi1, star ?sig1 (cell ?e1)) (wpMutation ?e3 ?e4 ?L') =>
(eapply tritra_mutation'; [unfold eval_pi; Omega_exprb | tritra_resolve] || Rotate_tritra_sig_lhs; idtac)
| |- tritra (?pi1, star ?sig1 (singl ?e1 ?e2)) (wpLookup ?x ?e ?L') =>
(eapply tritra_lookup; [unfold eval_pi; Omega_exprb | tritra_resolve] || Rotate_tritra_sig_lhs; idtac)
| |- tritra ?L (wpSubst ?l (wpElt ?L')) => eapply tritra_subst_elt; simpl; idtac
| |- tritra ?L (wpSubst ?l (wpSubst ?l' ?L')) => eapply tritra_subst_subst; simpl; idtac
| |- tritra ?L (wpSubst ?l (wpLookup ?x ?e ?L')) =>
(eapply tritra_subst_lookup'; [unfold eval_pi; Omega_exprb | simpl; intuition | tritra_resolve] || Rotate_tritra_sig_lhs; idtac)
| |- tritra ?L (wpSubst ?l (wpMutation ?e1 ?e2 ?L')) => eapply tritra_subst_mutation; simpl; idtac
| |- tritra ?L (wpSubst ?l (wpIf ?b ?L1 ?L2)) => eapply tritra_subst_if; simpl; idtac
| |- tritra ?L (wpIf ?b ?L1 ?L2) => eapply tritra_if; simpl; idtac
end.
Ltac Tritra := Rotate_tritra_sig_lhs; repeat tritra_resolve.
Definition tritra_step' (pi : Pi) (sig : Sigma) (A : wpAssrt) : option (list ((Pi * Sigma) * wpAssrt)) :=
match A with
| wpElt L =>
if entail_fct (pi, sig) L nil then
Some nil else None
| wpSubst l L =>
match L with
| wpElt L' => Some (((pi,sig), wpElt (subst_Assrt_lst l L'))::nil)
| wpSubst l' L' => Some (((pi,sig), wpSubst (l'++ l) L')::nil)
| wpLookup x e L' =>
match sig with
| star s1 (singl e1 e2) =>
if expr_b_dp (pi =b> (e1 == subst_e_lst l e)) then
let x' := (max (max (var_max_lst l) (var_max_wpAssrt L')) x) + 1 in
Some (((pi,sig), wpSubst ((x, var_e x')::l ++ ((x',e2)::nil)) L')::nil)
else
Some (((pi, remove_empty_heap pi (star_assoc_left (star_com sig) emp)), A)::nil)
| star s1 (cell e1) =>
if expr_b_dp (pi =b> (e1 == subst_e_lst l e)) then
let x' := (max (max (var_max_lst l) (var_max_wpAssrt L')) x) + 1 in
let x'' := (max (var_max_assrt (pi,sig)) (var_max_wpAssrt A)) + 1 in
Some (((pi, star s1 (singl e1 (var_e x''))), wpSubst ((x, var_e x')::l ++ ((x', var_e x'')::nil)) L')::nil)
else
Some (((pi, remove_empty_heap pi (star_assoc_left (star_com sig) emp)),A)::nil)
| star s1 (lst e1 e2) =>
if expr_b_dp (pi =b> ((e1 =/= e2) &&& (e1 == subst_e_lst l e))) then
let x' := triple_vfresh (pi,sig) A in
Some ((pi &&& (e1 =/= var_e x') &&& (var_e x' == nat_e 0),
star (star s1 (star (lst (var_e x') e2) (cell (e1 +e nat_e 1)))) (singl e1 (var_e x')), A)::
(pi &&& (e1 =/= var_e x') &&& (var_e x' =/= nat_e 0),
star (star s1 (star (lst (var_e x') e2) (cell (e1 +e nat_e 1)))) (singl e1 (var_e x')), A)::
nil)
else
if expr_b_dp (pi =b> ((e1 =/= e2) &&& ((e1 +e nat_e 1) == subst_e_lst l e))) then
let x' := triple_vfresh (pi,sig) A in
Some (
(((pi &&& (e1 =/= var_e x')) &&& (var_e x' == nat_e 0),
star (star s1 (star (lst (var_e x') e2) (singl e1 (var_e x'))))
(cell (e1 +e nat_e 1))), A)::
(((pi &&& (e1 =/= var_e x')) &&& (var_e x' =/= nat_e 0),
star (star s1 (star (lst (var_e x') e2) (singl e1 (var_e x'))))
(cell (e1 +e nat_e 1))), A)::
nil)
else
Some (((pi, remove_empty_heap pi (star_assoc_left (star_com sig) emp)), A)::nil)
| (singl e1 e2) => Some ((pi, star emp sig, A)::nil)
| (cell e1) => Some ((pi, star emp sig, A)::nil)
| (lst e1 e2) => Some ((pi, star emp sig, A)::nil)
| _ => Some (((pi, remove_empty_heap pi (star_assoc_left (star_com sig) emp)), A)::nil)
end
| wpMutation e1 e2 L' =>
Some (((pi,sig), wpMutation (subst_e_lst l e1) (subst_e_lst l e2) (wpSubst l L'))::nil)
| wpIf b L1 L2 =>
Some (((pi,sig), wpIf (subst_b_lst l b) (wpSubst l L1) (wpSubst l L2))::nil)
end
(**)
| wpIf b L1 L2 =>
Some (((pi &&& b,sig),L1)::((pi &&& (! b),sig),L2)::nil)
(**)
| wpLookup x e L =>
match sig with
| star s1 (singl e1 e2) =>
if expr_b_dp (pi =b> (e1 == e)) then
Some (((pi,sig), wpSubst ((x,e2)::nil) L)::nil)
else
Some (((pi, remove_empty_heap pi (star_assoc_left (star_com sig) emp)), A)::nil)
| star s1 (cell e1) =>
if expr_b_dp (pi =b> (e1 == e)) then
let x' := (max (var_max_assrt (pi, sig)) (var_max_wpAssrt A)) + 1 in
Some (((pi, star s1 (singl e1 (var_e x'))), wpSubst ((x, var_e x')::nil) L)::nil)
else
Some (((pi, remove_empty_heap pi (star_assoc_left (star_com sig) emp)), A)::nil)
| star s1 (lst e1 e2) =>
if expr_b_dp (pi =b> ((e1 =/= e2) &&& (e1 == e))) then
let x' := triple_vfresh (pi,sig) A in
Some (((pi &&& (e1 =/= var_e x') &&& (var_e x' == nat_e 0),
star (star s1 (star (lst (var_e x') e2) (cell (e1 +e nat_e 1)))) (singl e1 (var_e x'))), A)::
((pi &&& (e1 =/= var_e x') &&& (var_e x' =/= nat_e 0),
star (star s1 (star (lst (var_e x') e2) (cell (e1 +e nat_e 1)))) (singl e1 (var_e x'))), A)::
nil)
else
if expr_b_dp (pi =b> ((e1 =/= e2) &&& ((e1 +e nat_e 1) == e))) then
let x' := triple_vfresh (pi,sig) A in
Some (((pi &&& (e1 =/= var_e x') &&& (var_e x' == nat_e 0),
star (star s1 (star (lst (var_e x') e2) (cell (e1 +e nat_e 1)))) (singl e1 (var_e x'))), A)::
((pi &&& (e1 =/= var_e x') &&& (var_e x' =/= nat_e 0),
star (star s1 (star (lst (var_e x') e2) (cell (e1 +e nat_e 1)))) (singl e1 (var_e x'))), A)::
nil)
else Some (((pi, remove_empty_heap pi (star_assoc_left (star_com sig) emp)),A)::nil)
| (singl e1 e2) => Some ((pi, star emp sig, A)::nil)
| (cell e1) => Some ((pi, star emp sig, A)::nil)
| (lst e1 e2) => Some ((pi, star emp sig, A)::nil)
| _ => Some (((pi, remove_empty_heap pi (star_assoc_left (star_com sig) emp)), A)::nil)
end
(**)
| wpMutation e1 e2 L =>
match sig with
| star s1 (cell e3) =>
if expr_b_dp (pi =b> (e1 == e3)) then
Some (((pi, star s1 (singl e3 e2)),L)::nil)
else
Some (((pi, remove_empty_heap pi (star_assoc_left (star_com sig) emp)), A)::nil)
| star s1 (singl e3 e4) =>
if expr_b_dp (pi =b> (e1 == e3)) then
Some (((pi, star s1 (singl e3 e2)), L)::nil)
else
Some (((pi, remove_empty_heap pi (star_assoc_left (star_com sig) emp)), A)::nil)
| star s1 (lst e3 e4) =>
if expr_b_dp (pi =b> ((e1 == e3) &&& (e3 =/= e4))) then
let x' := triple_vfresh (pi,sig) A in
Some (
(((pi &&& (e3 =/= var_e x')) &&& (var_e x' == nat_e 0),
star (star s1 (star (lst (var_e x') e4) (cell (e3 +e nat_e 1))))
(singl e3 (var_e x'))), A)::
(((pi &&& (e3 =/= var_e x')) &&& (var_e x' =/= nat_e 0),
star (star s1 (star (lst (var_e x') e4) (cell (e3 +e nat_e 1))))
(singl e3 (var_e x'))),A)::
nil)
else if expr_b_dp (pi =b> (((e3 +e (nat_e 1)) == e1) &&& (e3 =/= e4))) then
let x' := triple_vfresh (pi,sig) A in
Some (
(((pi &&& (e3 =/= var_e x')) &&& (var_e x' == nat_e 0),
star (star s1 (star (lst (var_e x') e4) (singl e3 (var_e x'))))
(cell (e3 +e nat_e 1))), A)::
(((pi &&& (e3 =/= var_e x')) &&& (var_e x' =/= nat_e 0),
star (star s1 (star (lst (var_e x') e4) (singl e3 (var_e x'))))
(cell (e3 +e nat_e 1))), A)::
nil)
else Some (((pi, remove_empty_heap pi (star_assoc_left (star_com sig) emp)), A)::nil)
| (singl e1 e2) => Some ((pi, star emp sig, A)::nil)
| (cell e1) => Some ((pi, star emp sig, A)::nil)
| (lst e1 e2) => Some ((pi, star emp sig, A)::nil)
| _ => Some (((pi, remove_empty_heap pi (star_assoc_left (star_com sig) emp)), A)::nil)
end
end.
Opaque entail_fct.
Opaque remove_empty_heap.
Opaque star_assoc_left.
Lemma tritra_step'_correct: forall A pi sig l,
tritra_step' pi sig A = Some l ->
(forall pi' sig' A',
In ((pi',sig'),A') l ->
tritra (pi',sig') A'
) ->
tritra (pi,sig) A.
Definition tritra_step (pi: Pi) (sig: Sigma) (A: wpAssrt) : option (list ((Pi * Sigma) * wpAssrt)) :=
if expr_b_dp (!pi) then
Some nil
else
tritra_step' pi sig A.
Lemma tritra_step_correct: forall A pi sig l,
tritra_step pi sig A = Some l ->
(forall pi' sig' A', In ((pi', sig'),A') l -> tritra (pi', sig') A') ->
tritra (pi, sig) A.
Fixpoint tritra_list (l: list ((Pi * Sigma) * wpAssrt)) : option (list ((Pi * Sigma) * wpAssrt)) :=
match l with
| nil => Some nil
| ((pi,sg), A)::tl =>
match tritra_step pi sg A with
| None => None
| Some l' =>
match tritra_list tl with
| None => None
| Some l'' => Some (l' ++ l'')
end
end
end.
Lemma tritra_list_correct: forall l l',
tritra_list l = Some l' ->
(forall pi sig A, In ((pi, sig), A) l' -> tritra (pi, sig) A) ->
(forall pi sig A, In ((pi, sig), A) l -> tritra (pi, sig) A).
Fixpoint tritra_list_rec (l: list ((Pi * Sigma) * wpAssrt)) (size:nat) {struct size} : option (list ((Pi * Sigma) * wpAssrt)) :=
match size with
| 0 => Some l
| S size' =>
match tritra_list l with
| None => None
| Some l' =>
match l' with
| nil => Some nil
| _ => tritra_list_rec l' size'
end
end
end.
Lemma tritra_list_rec_correct : forall n l l',
tritra_list_rec l n = Some l' ->
(forall pi sig A, In ((pi,sig),A) l' -> tritra (pi,sig) A) ->
(forall pi sig A, In ((pi,sig),A) l -> tritra (pi,sig) A).
Lemma tritra_list_rec_correct': forall n l,
tritra_list_rec l n = Some nil ->
(forall pi sig A, In ((pi,sig),A) l -> assrt_interp (pi,sig) ==> wpAssrt_interp A).
Fixpoint wpAssrt_size (A:wpAssrt) : nat :=
match A with
wpElt P => 2
| wpSubst l P => 2 + wpAssrt_size P
| wpLookup x e P => 2 + wpAssrt_size P
| wpMutation e1 e2 P => 2 + wpAssrt_size P
| wpIf b L1 L2 => 2 + wpAssrt_size L1 + wpAssrt_size L2
end.
Definition triple_transformation_complexity (pi: expr_b) (sig: Sigma) (L: wpAssrt) : nat :=
(Expr_B_size pi) * (sigma_size sig) * (wpAssrt_size L).
Fixpoint triple_transformation (P: Assrt) (Q: wpAssrt) {struct P} : option (list ((Pi * Sigma) * wpAssrt)) :=
match P with
| nil => Some nil
| (pi, sig) :: tl =>
match tritra_list_rec
(((compute_constraints (cell_loc_not_null pi sig) sig, sig), Q)::nil)
(triple_transformation_complexity pi sig Q) with
| Some l =>
match triple_transformation tl Q with
| Some l' => Some (l ++ l')
| None => None
end
| None =>
match triple_transformation tl Q with
| Some l' => Some (((pi,sig),Q)::l')
| None => None
end
end
end.
Lemma triple_transformation_correct: forall P Q,
triple_transformation P Q = Some nil ->
Assrt_interp P ==> wpAssrt_interp Q.
Fixpoint triple_transformation2 (P: Assrt) (Q: wpAssrt) {struct P} : bool :=
match P with
| nil => true
| (pi,sig)::tl =>
match tritra_list_rec (((pi,sig),Q)::nil) (triple_transformation_complexity pi sig Q) with
| Some nil =>
triple_transformation2 tl Q
| _ => false
end
end.
Lemma triple_transformation2_correct: forall P Q,
triple_transformation2 P Q = true ->
Assrt_interp P ==> wpAssrt_interp Q.