Commit f9dd92b9 authored by Asma Tafat's avatar Asma Tafat

blocking semantic proof

parent 41e0c512
......@@ -4,6 +4,7 @@ Require Import BuiltIn.
Require BuiltIn.
Require int.Int.
Require int.MinMax.
Require set.Set.
(* Why3 assumption *)
Inductive list (a:Type) {a_WT:WhyType a} :=
......@@ -575,109 +576,32 @@ Definition total_valid_triple(p:fmla) (s:stmt) (q:fmla): Prop :=
exists pi':(list (ident* value)%type), exists n:Z, (many_steps sigma pi s
sigma' pi' Sskip n) /\ (eval_fmla sigma' pi' q).
Axiom set1 : forall (a:Type) {a_WT:WhyType a}, Type.
Parameter set1_WhyType : forall (a:Type) {a_WT:WhyType a}, WhyType (set1 a).
Existing Instance set1_WhyType.
Parameter mem1: forall {a:Type} {a_WT:WhyType a}, a -> (set1 a) -> Prop.
(* Why3 assumption *)
Definition infix_eqeq {a:Type} {a_WT:WhyType a}(s1:(set1 a)) (s2:(set1
a)): Prop := forall (x:a), (mem1 x s1) <-> (mem1 x s2).
Axiom extensionality : forall {a:Type} {a_WT:WhyType a}, forall (s1:(set1 a))
(s2:(set1 a)), (infix_eqeq s1 s2) -> (s1 = s2).
(* Why3 assumption *)
Definition subset {a:Type} {a_WT:WhyType a}(s1:(set1 a)) (s2:(set1
a)): Prop := forall (x:a), (mem1 x s1) -> (mem1 x s2).
Axiom subset_trans : forall {a:Type} {a_WT:WhyType a}, forall (s1:(set1 a))
(s2:(set1 a)) (s3:(set1 a)), (subset s1 s2) -> ((subset s2 s3) ->
(subset s1 s3)).
Parameter empty: forall {a:Type} {a_WT:WhyType a}, (set1 a).
(* Why3 assumption *)
Definition is_empty {a:Type} {a_WT:WhyType a}(s:(set1 a)): Prop :=
forall (x:a), ~ (mem1 x s).
Axiom empty_def1 : forall {a:Type} {a_WT:WhyType a}, (is_empty (empty :(set1
a))).
Parameter add: forall {a:Type} {a_WT:WhyType a}, a -> (set1 a) -> (set1 a).
Axiom add_def1 : forall {a:Type} {a_WT:WhyType a}, forall (x:a) (y:a),
forall (s:(set1 a)), (mem1 x (add y s)) <-> ((x = y) \/ (mem1 x s)).
Parameter remove: forall {a:Type} {a_WT:WhyType a}, a -> (set1 a) -> (set1
a).
Axiom remove_def1 : forall {a:Type} {a_WT:WhyType a}, forall (x:a) (y:a)
(s:(set1 a)), (mem1 x (remove y s)) <-> ((~ (x = y)) /\ (mem1 x s)).
Axiom subset_remove : forall {a:Type} {a_WT:WhyType a}, forall (x:a) (s:(set1
a)), (subset (remove x s) s).
Parameter union: forall {a:Type} {a_WT:WhyType a}, (set1 a) -> (set1 a) ->
(set1 a).
Definition assigns(sigma:(map mident value)) (a:(set.Set.set mident))
(sigma':(map mident value)): Prop := forall (i:mident), (~ (set.Set.mem i
a)) -> ((get sigma i) = (get sigma' i)).
Axiom union_def1 : forall {a:Type} {a_WT:WhyType a}, forall (s1:(set1 a))
(s2:(set1 a)) (x:a), (mem1 x (union s1 s2)) <-> ((mem1 x s1) \/ (mem1 x
s2)).
Parameter inter: forall {a:Type} {a_WT:WhyType a}, (set1 a) -> (set1 a) ->
(set1 a).
Axiom inter_def1 : forall {a:Type} {a_WT:WhyType a}, forall (s1:(set1 a))
(s2:(set1 a)) (x:a), (mem1 x (inter s1 s2)) <-> ((mem1 x s1) /\ (mem1 x
s2)).
Parameter diff: forall {a:Type} {a_WT:WhyType a}, (set1 a) -> (set1 a) ->
(set1 a).
Axiom diff_def1 : forall {a:Type} {a_WT:WhyType a}, forall (s1:(set1 a))
(s2:(set1 a)) (x:a), (mem1 x (diff s1 s2)) <-> ((mem1 x s1) /\ ~ (mem1 x
s2)).
Axiom subset_diff : forall {a:Type} {a_WT:WhyType a}, forall (s1:(set1 a))
(s2:(set1 a)), (subset (diff s1 s2) s1).
Parameter choose: forall {a:Type} {a_WT:WhyType a}, (set1 a) -> a.
Axiom choose_def : forall {a:Type} {a_WT:WhyType a}, forall (s:(set1 a)),
(~ (is_empty s)) -> (mem1 (choose s) s).
Parameter all: forall {a:Type} {a_WT:WhyType a}, (set1 a).
Axiom all_def : forall {a:Type} {a_WT:WhyType a}, forall (x:a), (mem1 x
(all :(set1 a))).
(* Why3 assumption *)
Definition assigns(sigma:(map mident value)) (a:(set1 mident)) (sigma':(map
mident value)): Prop := forall (i:mident), (~ (mem1 i a)) -> ((get sigma
i) = (get sigma' i)).
Axiom assigns_refl : forall (sigma:(map mident value)) (a:(set1 mident)),
(assigns sigma a sigma).
Axiom assigns_refl : forall (sigma:(map mident value)) (a:(set.Set.set
mident)), (assigns sigma a sigma).
Axiom assigns_trans : forall (sigma1:(map mident value)) (sigma2:(map mident
value)) (sigma3:(map mident value)) (a:(set1 mident)), ((assigns sigma1 a
sigma2) /\ (assigns sigma2 a sigma3)) -> (assigns sigma1 a sigma3).
value)) (sigma3:(map mident value)) (a:(set.Set.set mident)),
((assigns sigma1 a sigma2) /\ (assigns sigma2 a sigma3)) -> (assigns sigma1
a sigma3).
Axiom assigns_union_left : forall (sigma:(map mident value)) (sigma':(map
mident value)) (s1:(set1 mident)) (s2:(set1 mident)), (assigns sigma s1
sigma') -> (assigns sigma (union s1 s2) sigma').
mident value)) (s1:(set.Set.set mident)) (s2:(set.Set.set mident)),
(assigns sigma s1 sigma') -> (assigns sigma (set.Set.union s1 s2) sigma').
Axiom assigns_union_right : forall (sigma:(map mident value)) (sigma':(map
mident value)) (s1:(set1 mident)) (s2:(set1 mident)), (assigns sigma s2
sigma') -> (assigns sigma (union s1 s2) sigma').
mident value)) (s1:(set.Set.set mident)) (s2:(set.Set.set mident)),
(assigns sigma s2 sigma') -> (assigns sigma (set.Set.union s1 s2) sigma').
(* Why3 assumption *)
Fixpoint stmt_writes(s:stmt) (w:(set1 mident)) {struct s}: Prop :=
Fixpoint stmt_writes(s:stmt) (w:(set.Set.set mident)) {struct s}: Prop :=
match s with
| (Sskip|(Sassert _)) => True
| (Sassign id _) => (mem1 id w)
| (Sassign id _) => (set.Set.mem id w)
| (Sseq s1 s2) => (stmt_writes s1 w) /\ (stmt_writes s2 w)
| (Sif t s1 s2) => (stmt_writes s1 w) /\ (stmt_writes s2 w)
| (Swhile _ _ body) => (stmt_writes body w)
......@@ -720,6 +644,9 @@ Axiom abstract_effects_writes : forall (sigma:(map mident value)) (pi:(list
Axiom monotonicity : forall (s:stmt) (p:fmla) (q:fmla),
(valid_fmla (Fimplies p q)) -> (valid_fmla (Fimplies (wp s p) (wp s q))).
Require Import Why3.
Ltac ae := why3 "alt-ergo" timelimit 3.
(* Why3 goal *)
Theorem distrib_conj : forall (s:stmt),
match s with
......@@ -738,22 +665,15 @@ Theorem distrib_conj : forall (s:stmt),
end.
destruct s; auto.
simpl.
intros H sigma pi p q ((H0 & H1) & (_ & H2)).
intros H sigma pi p q (H0 & H1).
destruct H0.
destruct H1; clear H1.
split; auto.
apply abstract_effects_monotonic.
red; simpl; intuition.
with (sigma := sigma) (pi:=pi).
simpl.
split; apply abstract_effects_generalize in H1;
simpl in H1; destruct H1; intros (H5 & _).
(* True *)
apply H1; auto.
(* False *)
clear H1.
split; auto.
apply abstract_effects_generalize in H2;
simpl in H2; destruct H2.
apply H2; auto.
apply abstract_effects_generalize in H3;
simpl in H3; destruct H3.
Qed.
......@@ -677,6 +677,4 @@ intros.
do 3 eexists.
econstructor.
eauto.
Qed.
Qed.
\ No newline at end of file
......@@ -434,7 +434,6 @@ end
(** {2 Problématique des variables fraîches} *)
theory FreshVariables
use import SemOp
......@@ -518,7 +517,7 @@ lemma subst_fresh_term :
(*
lemma subst_fresh :
forall f:fmla, x:ident, v:ident.
fresh_in_fmla x f -> subst f x v = f
fresh_in_fmla x f -> subst f x v = f
*)
(* Needed for monotonicity and wp_reduction *)
......@@ -540,29 +539,12 @@ id1 <> id2 ->
(eval_term sigma (l++(Cons (id1,v1) (Cons (id2,v2) pi))) t =
eval_term sigma (l++(Cons (id2,v2) (Cons (id1,v1) pi))) t)
(*
lemma eval_swap_term_2:
forall t:term, sigma:env, pi:stack, id1 id2:ident, v1 v2:value.
id1 <> id2 ->
(eval_term sigma (Cons (id1,v1) (Cons (id2,v2) pi)) t =
eval_term sigma (Cons (id2,v2) (Cons (id1,v1) pi)) t)
*)
lemma eval_swap:
forall f:fmla, sigma:env, pi l:stack, id1 id2:ident, v1 v2:value.
id1 <> id2 ->
(eval_fmla sigma (l++(Cons (id1,v1) (Cons (id2,v2) pi))) f <->
eval_fmla sigma (l++(Cons (id2,v2) (Cons (id1,v1) pi))) f)
(*
lemma eval_swap_2:
forall f:fmla, id1 id2:ident, v1 v2:value.
id1 <> id2 ->
forall sigma:env, pi:stack.
(eval_fmla sigma (Cons (id1,v1) (Cons (id2,v2) pi)) f <->
eval_fmla sigma (Cons (id2,v2) (Cons (id1,v1) pi)) f)
*)
lemma eval_term_change_free :
forall t:term, sigma:env, pi:stack, id:ident, v:value.
fresh_in_term id t ->
......@@ -580,14 +562,6 @@ lemma eval_change_free :
end
(** {2 Hoare logic} *)
theory HoareLogic
......@@ -723,6 +697,7 @@ predicate stmt_writes (s:stmt) (w:Set.set mident) =
end
*)
function fresh_from (f:fmla) : ident
(* Need it for monotonicity*)
......
......@@ -351,6 +351,9 @@ Axiom eval_term_change_free : forall (t:term) (sigma:(map mident value))
(pi:(list (ident* value)%type)) (id:ident) (v:value), (fresh_in_term id
t) -> ((eval_term sigma (Cons (id, v) pi) t) = (eval_term sigma pi t)).
Require Import Why3.
Ltac ae := why3 "alt-ergo" timelimit 3.
(* Why3 goal *)
Theorem eval_change_free : forall (f:fmla),
match f with
......@@ -366,7 +369,18 @@ Theorem eval_change_free : forall (f:fmla),
(Cons (id, v) pi) f) -> (eval_fmla sigma pi f)
| (Fforall i d f1) => True
end.
destruct f; auto.
simpl.
intros.
destruct H0 as (h1 & h2 & h3).
rewrite eval_term_change_free in H1; auto.
assert (eval_fmla sigma (infix_plpl (Nil : (list (ident*value)))
(Cons (i, eval_term sigma pi t) (Cons (id, v) pi))) f =
eval_fmla sigma
(Cons (i, eval_term sigma pi t) (Cons (id, v) pi)) f);
auto.
rewrite <- H0 in H1; clear H0.
apply eval_swap in H1; auto.
apply H in H1; auto.
Qed.
......@@ -330,6 +330,9 @@ Axiom eval_msubst_term : forall (e:term) (sigma:(map mident value)) (pi:(list
((eval_term sigma pi (msubst_term e x v)) = (eval_term (set sigma x
(get_stack v pi)) pi e)).
Require Import Why3.
Ltac ae := why3 "alt-ergo" timelimit 3.
(* Why3 goal *)
Theorem eval_msubst : forall (f:fmla),
match f with
......@@ -348,7 +351,10 @@ Theorem eval_msubst : forall (f:fmla),
end.
destruct f; auto.
simpl.
intros.
destruct H0 as (h1 & h2 & h3).
rewrite eval_msubst_term in H1; auto.
ae.
Qed.
......@@ -389,7 +389,6 @@ inversion H2; subst; clear H2.
generalize (H0 sigma pi _ _ _ H1 H8).
generalize (H sigma pi _ _ _ H1 H10).
ae.
Qed.
......@@ -546,8 +546,16 @@ unfold valid_fmla.
simpl.
intros.
apply eval_msubst.
simpl.
apply fresh_from_fmla.
rewrite eval_msubst in H0.
rewrite get_stack_eq; auto.
rewrite get_stack_eq in H0; auto.
apply eval_change_free.
apply fresh_from_fmla.
rewrite eval_change_free in H0.
apply H; auto.
apply fresh_from_fmla.
apply fresh_from_fmla.
Qed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment