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.