Mercurial > hg > Members > ryokka > HoareLogic
changeset 61:62dcb0ae2c94
add Soundness Proof
author | ryokka |
---|---|
date | Sat, 21 Dec 2019 19:37:41 +0900 |
parents | ad83c2d5e869 |
children | bfe7d83cf9ba |
files | whileTestGears.agda whileTestPrimProof.agda |
diffstat | 2 files changed, 15 insertions(+), 55 deletions(-) [+] |
line wrap: on
line diff
--- a/whileTestGears.agda Sat Dec 21 18:28:46 2019 +0900 +++ b/whileTestGears.agda Sat Dec 21 19:37:41 2019 +0900 @@ -178,6 +178,7 @@ loopPwP : {l : Level} {t : Set l} → (env : Envc ) → whileTestStateP s2 env → (exit : (env : Envc ) → whileTestStateP sf env → t) → t loopPwP env s exit = whileLoopPwP env s (λ env s → loopPwP env s exit ) exit + whileTestPCallwP : (c : ℕ ) → Set whileTestPCallwP c = whileTestPwP {_} {_} c ( λ env s → loopPwP env (conv env s) ( λ env s → vari env ≡ c ) ) where conv : (env : Envc ) → (vari env ≡ 0) /\ (varn env ≡ c10 env) → varn env + vari env ≡ c10 env @@ -189,7 +190,9 @@ -- = whileTestPwP (suc c) (λ env s → loopPwP env (conv1 env s) (λ env₁ s₁ → {!!})) -ProofConnect : {l : Level} {t : Set l} → (prev : Envc → Set → Set) → (Envc → Set → (Envc → Set → t)) → (Envc → Set → Set) + + +ProofConnect : {l : Level} {t : Set l} → (pr1 : Envc → Set → Set) → (Envc → Set → (Envc → Set → t)) → (pr2 : Envc → Set → Set) ProofConnect prev f env post with f env ({!!}) {!!} ... | tt = {!!} @@ -197,60 +200,9 @@ Proof2 _ refl = refl -{-- - Proof1 env s with Proof2 ? ? - ... | tt = ? -のとき agda2 が停まらなくなる ---} - +-- Proof1 : (env : Envc) → (s : varn env + vari env ≡ c10 env) → ((env : Envc) → (vari env ≡ c10 env) → vari env ≡ c10 env) → vari env ≡ c10 env Proof1 : (env : Envc) → (s : varn env + vari env ≡ c10 env) → loopPwP env s ( λ env s → vari env ≡ c10 env ) -Proof1 env s = {!!} -- with Proof2 ? ? <- agda2 don't stop - where - lemm : whileLoopPwP env s (λ env s → {!!} ) (λ env s → {!!} ) - lemm = {!!} -- with Proof2 ? ? +Proof1 env s = {!!} Proof : (c : ℕ ) → whileTestPCallwP c -Proof zero = whileTestPwP {_} {_} zero ( λ env s → loopPwP env (conv env s) ( λ env s → refl) ) - where - conv : (env : Envc ) → (vari env ≡ 0) /\ (varn env ≡ c10 env) → varn env + vari env ≡ c10 env - conv e record { pi1 = refl ; pi2 = refl } = +zero -Proof (suc c) = whileTestPwP {_} {_} c ( λ env s → loopPwP env (conv env s) ( λ env s → lem )) - where - lem : whileLoopPwP (record { c10 = suc c ; varn = c ; vari = 0 + 1 }) ({!!}) - (λ env s → loopPwP env s (λ env₁ s₁ → vari env₁ ≡ suc c)) (λ env s3 → {!!}) - lem = {!!} - conv : (env : Envc ) → (vari env ≡ 0) /\ (varn env ≡ c10 env) → varn env + vari env ≡ c10 env - conv e record { pi1 = refl ; pi2 = refl } = +zero - - -{-- --- whileLoopPwP : {l : Level} {t : Set l} → (env : Envc ) → whileTestStateP s2 env --- → (next : (env : Envc ) → whileTestStateP s2 env → t) --- → (exit : (env : Envc ) → whileTestStateP sf env → t) → t - -next : (whileTestGears.proof5 - (record { c10 = suc c ; varn = suc c ; vari = 0 }) - (<ᵇ⇒< 0 (suc c) Agda.Builtin.Unit.⊤.tt) - (λ x → - Relation.Nullary.Reflects.invert (ofⁿ (λ ())) (≡⇒≡ᵇ 0 (suc c) x)) - (<⇒≯ (<ᵇ⇒< 0 (suc c) Agda.Builtin.Unit.⊤.tt)) - (whileTestGears.conv (suc c) (whileTestP (suc c) (λ env₁ → env₁)) - (record { pi1 = refl ; pi2 = refl })) - (λ env₁ s₁ → loopPwP env₁ s₁ (λ env₂ s₂ → vari env₂ ≡ suc c)) - (λ env₁ s₁ → vari env₁ ≡ suc c) - (<ᵇ⇒< 0 (suc c) Agda.Builtin.Unit.⊤.tt)) - -exit : (whileTestGears.conv (suc c) (whileTestP (suc c) (λ env₁ → env₁)) - (record { pi1 = refl ; pi2 = refl })) - (λ env₁ s₁ → loopPwP env₁ s₁ (λ env₂ s₂ → vari env₂ ≡ suc c)) - (λ env₁ s₁ → vari env₁ ≡ suc c) - (<ᵇ⇒< 0 (suc c) Agda.Builtin.Unit.⊤.tt)) - (λ env₁ s₁ → loopPwP env₁ s₁ (λ env₂ s₂ → vari env₂ ≡ suc c)) - (λ env₁ s₁ → vari env₁ ≡ suc c) - - | (<-cmp 0 c - | Relation.Nullary.Decidable.Core.map′ (≡ᵇ⇒≡ 0 c) (≡⇒≡ᵇ 0 c) - (Data.Bool.Properties.T? (0 ≡ᵇ c)) - | Data.Bool.Properties.T? (0 <ᵇ c)) - ---} +Proof c = {!!}
--- a/whileTestPrimProof.agda Sat Dec 21 18:28:46 2019 +0900 +++ b/whileTestPrimProof.agda Sat Dec 21 19:37:41 2019 +0900 @@ -71,6 +71,7 @@ -- (Seq (PComm (λ env → record env {vari = ((vari env) + 1)} )) -- $ PComm (λ env → record env {varn = ((varn env) - 1)} )) + proof1 : (c10 : ℕ) → HTProof initCond (program c10 ) (termCond {c10}) proof1 c10 = SeqRule {λ e → true} ( PrimRule (init-case {c10} )) @@ -279,3 +280,10 @@ PrimSoundness : {bPre : Cond} -> {cm : Comm} -> {bPost : Cond} -> HTProof bPre cm bPost -> Satisfies bPre cm bPost PrimSoundness {bPre} {cm} {bPost} ht = Soundness ht + + +proofOfProgram : (c10 : ℕ) → (input output : Env ) + → initCond input ≡ true + → (SemComm (program c10) input output) + → termCond {c10} output ≡ true +proofOfProgram c10 input output ic sem = PrimSoundness (proof1 c10) input output ic sem