 ### 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
This diff is collapsed.
 ... ... @@ -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.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
 ... ... @@ -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.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
 ... ... @@ -389,7 +389,6 @@ inversion H2; subst; clear H2. generalize (H0 sigma pi _ _ _ H1 H8). generalize (H sigma pi _ _ _ H1 H10). ae. Qed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
 ... ... @@ -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.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!