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.