Mercurial > hg > Members > ryokka > HoareLogic
annotate whileTestPrim.agda @ 17:b95a3cf9727c
add Gears1
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Sun, 16 Dec 2018 22:01:40 +0900 |
parents | 8d546766a9a8 |
children | 6417f6d821e6 |
rev | line source |
---|---|
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
1 module whileTestPrim where |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
2 |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
3 open import Function |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
4 open import Data.Nat |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
5 open import Data.Bool hiding ( _≟_ ) |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
6 open import Level renaming ( suc to succ ; zero to Zero ) |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
7 open import Relation.Nullary using (¬_; Dec; yes; no) |
4 | 8 open import Relation.Binary.PropositionalEquality |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
9 |
10 | 10 open import utilities |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
11 |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
12 record Env : Set where |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
13 field |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
14 varn : ℕ |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
15 vari : ℕ |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
16 open Env |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
17 |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
18 PrimComm : Set |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
19 PrimComm = Env → Env |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
20 |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
21 Cond : Set |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
22 Cond = (Env → Bool) |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
23 |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
24 data Comm : Set where |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
25 Skip : Comm |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
26 Abort : Comm |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
27 PComm : PrimComm -> Comm |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
28 Seq : Comm -> Comm -> Comm |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
29 If : Cond -> Comm -> Comm -> Comm |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
30 While : Cond -> Comm -> Comm |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
31 |
8 | 32 --------------------------- |
33 | |
14 | 34 program : ℕ → Comm |
35 program c10 = | |
36 Seq ( PComm (λ env → record env {varn = c10})) | |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
37 $ Seq ( PComm (λ env → record env {vari = 0})) |
7 | 38 $ While (λ env → lt zero (varn env ) ) |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
39 (Seq (PComm (λ env → record env {vari = ((vari env) + 1)} )) |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
40 $ PComm (λ env → record env {varn = ((varn env) - 1)} )) |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
41 |
14 | 42 simple : ℕ → Comm |
43 simple c10 = | |
44 Seq ( PComm (λ env → record env {varn = c10})) | |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
45 $ PComm (λ env → record env {vari = 0}) |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
46 |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
47 {-# TERMINATING #-} |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
48 interpret : Env → Comm → Env |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
49 interpret env Skip = env |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
50 interpret env Abort = env |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
51 interpret env (PComm x) = x env |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
52 interpret env (Seq comm comm1) = interpret (interpret env comm) comm1 |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
53 interpret env (If x then else) with x env |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
54 ... | true = interpret env then |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
55 ... | false = interpret env else |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
56 interpret env (While x comm) with x env |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
57 ... | true = interpret (interpret env comm) (While x comm) |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
58 ... | false = env |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
59 |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
60 test1 : Env |
14 | 61 test1 = interpret ( record { vari = 0 ; varn = 0 } ) (program 10) |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
62 |
8 | 63 eval-proof : vari test1 ≡ 10 |
64 eval-proof = refl | |
65 | |
7 | 66 tests : Env |
14 | 67 tests = interpret ( record { vari = 0 ; varn = 0 } ) (simple 10) |
7 | 68 |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
69 |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
70 empty-case : (env : Env) → (( λ e → true ) env ) ≡ true |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
71 empty-case _ = refl |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
72 |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
73 |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
74 Axiom : Cond -> PrimComm -> Cond -> Set |
10 | 75 Axiom pre comm post = ∀ (env : Env) → (pre env) ⇒ ( post (comm env)) ≡ true |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
76 |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
77 Tautology : Cond -> Cond -> Set |
10 | 78 Tautology pre post = ∀ (env : Env) → (pre env) ⇒ (post env) ≡ true |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
79 |
10 | 80 _and_ : Cond -> Cond -> Cond |
81 x and y = λ env → x env ∧ y env | |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
82 |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
83 neg : Cond -> Cond |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
84 neg x = λ env → not ( x env ) |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
85 |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
86 data HTProof : Cond -> Comm -> Cond -> Set where |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
87 PrimRule : {bPre : Cond} -> {pcm : PrimComm} -> {bPost : Cond} -> |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
88 (pr : Axiom bPre pcm bPost) -> |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
89 HTProof bPre (PComm pcm) bPost |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
90 SkipRule : (b : Cond) -> HTProof b Skip b |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
91 AbortRule : (bPre : Cond) -> (bPost : Cond) -> |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
92 HTProof bPre Abort bPost |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
93 WeakeningRule : {bPre : Cond} -> {bPre' : Cond} -> {cm : Comm} -> |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
94 {bPost' : Cond} -> {bPost : Cond} -> |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
95 Tautology bPre bPre' -> |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
96 HTProof bPre' cm bPost' -> |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
97 Tautology bPost' bPost -> |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
98 HTProof bPre cm bPost |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
99 SeqRule : {bPre : Cond} -> {cm1 : Comm} -> {bMid : Cond} -> |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
100 {cm2 : Comm} -> {bPost : Cond} -> |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
101 HTProof bPre cm1 bMid -> |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
102 HTProof bMid cm2 bPost -> |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
103 HTProof bPre (Seq cm1 cm2) bPost |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
104 IfRule : {cmThen : Comm} -> {cmElse : Comm} -> |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
105 {bPre : Cond} -> {bPost : Cond} -> |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
106 {b : Cond} -> |
10 | 107 HTProof (bPre and b) cmThen bPost -> |
108 HTProof (bPre and neg b) cmElse bPost -> | |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
109 HTProof bPre (If b cmThen cmElse) bPost |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
110 WhileRule : {cm : Comm} -> {bInv : Cond} -> {b : Cond} -> |
10 | 111 HTProof (bInv and b) cm bInv -> |
112 HTProof bInv (While b cm) (bInv and neg b) | |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
113 |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
114 initCond : Cond |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
115 initCond env = true |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
116 |
14 | 117 stmt1Cond : {c10 : ℕ} → Cond |
118 stmt1Cond {c10} env = Equal (varn env) c10 | |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
119 |
15
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
120 init-case : {c10 : ℕ} → (env : Env) → (( λ e → true ⇒ stmt1Cond {c10} e ) (record { varn = c10 ; vari = vari env }) ) ≡ true |
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
121 init-case {c10} _ = impl⇒ ( λ cond → ≡→Equal refl ) |
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
122 |
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
123 init-type : {c10 : ℕ} → Axiom (λ env → true) (λ env → record { varn = c10 ; vari = vari env }) (stmt1Cond {c10}) |
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
124 init-type {c10} env = init-case env |
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
125 |
14 | 126 stmt2Cond : {c10 : ℕ} → Cond |
127 stmt2Cond {c10} env = (Equal (varn env) c10) ∧ (Equal (vari env) 0) | |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
128 |
14 | 129 whileInv : {c10 : ℕ} → Cond |
130 whileInv {c10} env = Equal ((varn env) + (vari env)) c10 | |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
131 |
14 | 132 whileInv' : {c10 : ℕ} → Cond |
133 whileInv'{c10} env = Equal ((varn env) + (vari env)) (suc c10) ∧ lt zero (varn env) | |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
134 |
14 | 135 termCond : {c10 : ℕ} → Cond |
136 termCond {c10} env = Equal (vari env) c10 | |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
137 |
15
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
138 lemma1 : {c10 : ℕ} → Axiom (stmt1Cond {c10}) (λ env → record { varn = varn env ; vari = 0 }) (stmt2Cond {c10}) |
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
139 lemma1 {c10} env = impl⇒ ( λ cond → let open ≡-Reasoning in |
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
140 begin |
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
141 (Equal (varn env) c10 ) ∧ true |
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
142 ≡⟨ ∧true ⟩ |
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
143 Equal (varn env) c10 |
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
144 ≡⟨ cond ⟩ |
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
145 true |
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
146 ∎ ) |
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
147 |
14 | 148 proofs : (c10 : ℕ) → HTProof initCond (simple c10) (stmt2Cond {c10}) |
149 proofs c10 = | |
15
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
150 SeqRule {initCond} ( PrimRule (init-case {c10} )) |
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
151 $ PrimRule {stmt1Cond} {_} {stmt2Cond} (lemma1 {c10}) |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
152 |
8 | 153 open import Data.Empty |
154 | |
155 open import Data.Nat.Properties | |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
156 |
14 | 157 proof1 : (c10 : ℕ) → HTProof initCond (program c10 ) (termCond {c10}) |
158 proof1 c10 = | |
15
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
159 SeqRule {λ e → true} ( PrimRule (init-case {c10} )) |
14 | 160 $ SeqRule {λ e → Equal (varn e) c10} ( PrimRule lemma1 ) |
161 $ WeakeningRule {λ e → (Equal (varn e) c10) ∧ (Equal (vari e) 0)} lemma2 ( | |
162 WhileRule {_} {λ e → Equal ((varn e) + (vari e)) c10} | |
7 | 163 $ SeqRule (PrimRule {λ e → whileInv e ∧ lt zero (varn e) } lemma3 ) |
164 $ PrimRule {whileInv'} {_} {whileInv} lemma4 ) lemma5 | |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
165 where |
14 | 166 lemma21 : {env : Env } → {c10 : ℕ} → stmt2Cond env ≡ true → varn env ≡ c10 |
10 | 167 lemma21 eq = Equal→≡ (∧-pi1 eq) |
14 | 168 lemma22 : {env : Env } → {c10 : ℕ} → stmt2Cond {c10} env ≡ true → vari env ≡ 0 |
10 | 169 lemma22 eq = Equal→≡ (∧-pi2 eq) |
14 | 170 lemma23 : {env : Env } → {c10 : ℕ} → stmt2Cond env ≡ true → varn env + vari env ≡ c10 |
171 lemma23 {env} {c10} eq = let open ≡-Reasoning in | |
8 | 172 begin |
173 varn env + vari env | |
174 ≡⟨ cong ( \ x -> x + vari env ) (lemma21 eq ) ⟩ | |
14 | 175 c10 + vari env |
15
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
176 ≡⟨ cong ( \ x -> c10 + x) (lemma22 {env} {c10} eq ) ⟩ |
14 | 177 c10 + 0 |
178 ≡⟨ +-sym {c10} {0} ⟩ | |
179 0 + c10 | |
180 ≡⟨⟩ | |
181 c10 | |
8 | 182 ∎ |
14 | 183 lemma2 : {c10 : ℕ} → Tautology stmt2Cond whileInv |
184 lemma2 {c10} env = bool-case (stmt2Cond env) ( | |
8 | 185 λ eq → let open ≡-Reasoning in |
186 begin | |
10 | 187 (stmt2Cond env) ⇒ (whileInv env) |
8 | 188 ≡⟨⟩ |
14 | 189 (stmt2Cond env) ⇒ ( Equal (varn env + vari env) c10 ) |
190 ≡⟨ cong ( \ x -> (stmt2Cond {c10} env) ⇒ ( Equal x c10 ) ) ( lemma23 {env} eq ) ⟩ | |
191 (stmt2Cond env) ⇒ (Equal c10 c10) | |
15
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
192 ≡⟨ cong ( \ x -> (stmt2Cond {c10} env) ⇒ x ) (≡→Equal refl ) ⟩ |
14 | 193 (stmt2Cond {c10} env) ⇒ true |
10 | 194 ≡⟨ ⇒t ⟩ |
8 | 195 true |
196 ∎ | |
197 ) ( | |
198 λ ne → let open ≡-Reasoning in | |
199 begin | |
10 | 200 (stmt2Cond env) ⇒ (whileInv env) |
201 ≡⟨ cong ( \ x -> x ⇒ (whileInv env) ) ne ⟩ | |
14 | 202 false ⇒ (whileInv {c10} env) |
203 ≡⟨ f⇒ {whileInv {c10} env} ⟩ | |
8 | 204 true |
205 ∎ | |
206 ) | |
7 | 207 lemma3 : Axiom (λ e → whileInv e ∧ lt zero (varn e)) (λ env → record { varn = varn env ; vari = vari env + 1 }) whileInv' |
10 | 208 lemma3 env = impl⇒ ( λ cond → let open ≡-Reasoning in |
8 | 209 begin |
210 whileInv' (record { varn = varn env ; vari = vari env + 1 }) | |
211 ≡⟨⟩ | |
14 | 212 Equal (varn env + (vari env + 1)) (suc c10) ∧ (lt 0 (varn env) ) |
213 ≡⟨ cong ( λ z → Equal (varn env + (vari env + 1)) (suc c10) ∧ z ) (∧-pi2 cond ) ⟩ | |
214 Equal (varn env + (vari env + 1)) (suc c10) ∧ true | |
10 | 215 ≡⟨ ∧true ⟩ |
14 | 216 Equal (varn env + (vari env + 1)) (suc c10) |
217 ≡⟨ cong ( \ x -> Equal x (suc c10) ) (sym (+-assoc (varn env) (vari env) 1)) ⟩ | |
218 Equal ((varn env + vari env) + 1) (suc c10) | |
219 ≡⟨ cong ( \ x -> Equal x (suc c10) ) +1≡suc ⟩ | |
220 Equal (suc (varn env + vari env)) (suc c10) | |
10 | 221 ≡⟨ sym Equal+1 ⟩ |
14 | 222 Equal ((varn env + vari env) ) c10 |
10 | 223 ≡⟨ ∧-pi1 cond ⟩ |
8 | 224 true |
225 ∎ ) | |
14 | 226 lemma41 : (env : Env ) → {c10 : ℕ} → (varn env + vari env) ≡ (suc c10) → lt 0 (varn env) ≡ true → Equal ((varn env - 1) + vari env) c10 ≡ true |
227 lemma41 env {c10} c1 c2 = let open ≡-Reasoning in | |
10 | 228 begin |
14 | 229 Equal ((varn env - 1) + vari env) c10 |
230 ≡⟨ cong ( λ z → Equal ((z - 1 ) + vari env ) c10 ) (sym (suc-predℕ=n c2) ) ⟩ | |
231 Equal ((suc (predℕ {varn env} c2 ) - 1) + vari env) c10 | |
10 | 232 ≡⟨⟩ |
14 | 233 Equal ((predℕ {varn env} c2 ) + vari env) c10 |
10 | 234 ≡⟨ Equal+1 ⟩ |
14 | 235 Equal ((suc (predℕ {varn env} c2 )) + vari env) (suc c10) |
236 ≡⟨ cong ( λ z → Equal (z + vari env ) (suc c10) ) (suc-predℕ=n c2 ) ⟩ | |
237 Equal (varn env + vari env) (suc c10) | |
238 ≡⟨ cong ( λ z → (Equal z (suc c10) )) c1 ⟩ | |
239 Equal (suc c10) (suc c10) | |
15
8d546766a9a8
Prim variable version done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
14
diff
changeset
|
240 ≡⟨ ≡→Equal refl ⟩ |
10 | 241 true |
242 ∎ | |
14 | 243 lemma4 : {c10 : ℕ} → Axiom whileInv' (λ env → record { varn = varn env - 1 ; vari = vari env }) whileInv |
244 lemma4 {c10} env = impl⇒ ( λ cond → let open ≡-Reasoning in | |
10 | 245 begin |
246 whileInv (record { varn = varn env - 1 ; vari = vari env }) | |
247 ≡⟨⟩ | |
14 | 248 Equal ((varn env - 1) + vari env) c10 |
10 | 249 ≡⟨ lemma41 env (Equal→≡ (∧-pi1 cond)) (∧-pi2 cond) ⟩ |
250 true | |
251 ∎ | |
252 ) | |
253 lemma51 : (z : Env ) → neg (λ z → lt zero (varn z)) z ≡ true → varn z ≡ zero | |
17 | 254 lemma51 z cond with varn z |
255 lemma51 z refl | zero = refl | |
256 lemma51 z () | suc x | |
14 | 257 lemma5 : {c10 : ℕ} → Tautology ((λ e → Equal (varn e + vari e) c10) and (neg (λ z → lt zero (varn z)))) termCond |
258 lemma5 {c10} env = impl⇒ ( λ cond → let open ≡-Reasoning in | |
10 | 259 begin |
260 termCond env | |
261 ≡⟨⟩ | |
14 | 262 Equal (vari env) c10 |
10 | 263 ≡⟨⟩ |
14 | 264 Equal (zero + vari env) c10 |
265 ≡⟨ cong ( λ z → Equal (z + vari env) c10 ) (sym ( lemma51 env ( ∧-pi2 cond ) )) ⟩ | |
266 Equal (varn env + vari env) c10 | |
10 | 267 ≡⟨ ∧-pi1 cond ⟩ |
268 true | |
269 ∎ | |
270 ) | |
3
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
271 |
6be8ee856666
add simple Hoare logic example
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
272 |
10 | 273 |