Library forward

Load seplog_header.

Require Import Omega.

Require Import frag2.

Import Fresh.

Require Import expr_b_dp.

Inductive forward : assrt -> assrt -> cmd -> assrt -> Prop :=

  | forward_str_precond: forall P P' Q Q' c,
    (assrt_interp P ==> assrt_interp P') ->
    forward Q P' c Q' ->
    forward Q P c Q'

  | forward_skip: forall P Q,
    forward Q P skip P

  | forward_assign: forall pi sig x e x' Q,
    fresh_assrt x' (pi, sig) ->
    fresh_e x' e ->
    fresh_e x' (var_e x) ->
    fresh_assrt x' Q ->
    forward Q (pi, sig) (x <- e) (((expr_b_rewrite pi (var_e x) (var_e x')) &&& ((var_e x) == (expr_rewrite e (var_e x) (var_e x')))), subst_Sigma sig x (var_e x'))

  | forward_lookup: forall pi sig e1 e2 e x x' Q,
    (forall s, eval_b pi s = true -> eval_b (e1 == e) s = true) ->
    fresh_assrt x' (pi, star sig (singl e1 e2)) ->
    fresh_e x' e ->
    fresh_e x' (var_e x) ->
    fresh_assrt x' Q ->
    forward Q (pi,star sig (singl e1 e2)) (x <-* e) (((expr_b_rewrite pi (var_e x) (var_e x')) &&& ((var_e x) == (expr_rewrite e2 (var_e x) (var_e x')))), subst_Sigma (star sig (singl e1 e2)) x (var_e x'))

  | forward_mutation: forall pi1 sig1 e1 e2 e3 e4 Q,
    (forall s, eval_b pi1 s = true -> eval_b (e1 == e3) s = true) ->
    forward Q (pi1,star sig1 (singl e1 e2)) (e3 *<- e4) (pi1,star sig1 (singl e1 e4))
    
  | forward_mutation': forall pi1 sig1 e1 e3 e4 Q,
    (forall s, eval_b pi1 s = true -> eval_b (e1 == e3) s = true) ->
    forward Q (pi1,star sig1 (cell e1)) (e3 *<- e4) (pi1,star sig1 (singl e1 e4))

  | forward_unroll_lst: forall pi sig e1 e2 c x' Q Q',
    fresh_assrt x' (pi, star sig (lst e1 e2)) ->
    fresh_cmd x' c ->
    (forall s, s |b= (pi =b> (e1 =/= e2))) ->
    forward Q (pi &&& (e1 == (var_e x')),star sig (star (star (singl e1 (var_e x')) (cell (e1 +e (nat_e 1)))) (lst (var_e x') e2))) c Q' ->
    forward Q (pi,star sig (lst e1 e2)) c Q'.

Lemma forward_sound: forall P c Q Q',
  forward Q P c Q' ->
  ((assrt_interp Q') ==> (assrt_interp Q)) ->
  {{assrt_interp P}} c {{assrt_interp Q}}.












Require Import Max.

Definition forward_fct (Q: assrt) (pi: expr_b) (sig: Sigma) (c:cmd) : option assrt :=
  match c with
    | x <- e =>
      let x' := ((max (var_max_assrt Q) (max (var_max_assrt (pi,sig)) (max x (var_max_expr e)))) +1) in (
        Some (((expr_b_rewrite pi (var_e x) (var_e x')) &&& ((var_e x) == (expr_rewrite e (var_e x) (var_e x')))), subst_Sigma sig x (var_e x'))
      )
    | x <-* e =>
      match sig with
        | (singl e1 e2) =>
          if (expr_b_dp (pi =b> (e1 == e))) then
            let x' := ((max (var_max_assrt Q) (max (var_max_assrt (pi,sig)) (max x (var_max_expr e)))) +1) in (
              Some (((expr_b_rewrite pi (var_e x) (var_e x')) &&& ((var_e x) == (expr_rewrite e (var_e x) (var_e x')))), subst_Sigma sig x (var_e x'))
            ) else None
        | star sig' (singl e1 e2) =>
          if (expr_b_dp (pi =b> (e1 == e))) then
            let x' := ((max (var_max_assrt Q) (max (var_max_assrt (pi,sig)) (max x (var_max_expr e)))) +1) in (
              Some (((expr_b_rewrite pi (var_e x) (var_e x')) &&& ((var_e x) == (expr_rewrite e (var_e x) (var_e x')))), subst_Sigma sig x (var_e x'))
            ) else Some (pi,(Sigma_clean_epsi (Sigma_assoc_left (Sigma_com sig) epsi) pi))
        | _ => Some (pi,(Sigma_clean_epsi (Sigma_assoc_left (Sigma_com sig) epsi) pi))
      end
    | _ => None
  end.