annotate src/whileTestPrimProof.agda.replaced @ 1:73127e0ab57c

(none)
author soto@cr.ie.u-ryukyu.ac.jp
date Tue, 08 Sep 2020 18:38:08 +0900
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
1
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
1 module whileTestPrimProof where
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
2
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
3 open import Function
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
4 open import Data.Nat
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
5 open import Data.Bool hiding ( _@$\stackrel{?}{=}$@_ )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
6 open import Level renaming ( suc to succ ; zero to Zero )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
7 open import Relation.Nullary using (@$\neg$@_; Dec; yes; no)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
8 open import Relation.Binary.PropositionalEquality
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
9
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
10 open import utilities hiding ( _@$\wedge$@_ )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
11 open import whileTestPrim
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
12
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
13 open import Hoare PrimComm Cond Axiom Tautology _and_ neg
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
14
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
15 open Env
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
16
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
17 initCond : Cond
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
18 initCond env = true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
19
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
20 stmt1Cond : {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Cond
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
21 stmt1Cond {c10} env = Equal (varn env) c10
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
22
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
23 init-case : {c10 : @$\mathbb{N}$@} @$\rightarrow$@ (env : Env) @$\rightarrow$@ (( @$\lambda$@ e @$\rightarrow$@ true @$\Rightarrow$@ stmt1Cond {c10} e ) (record { varn = c10 ; vari = vari env }) ) @$\equiv$@ true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
24 init-case {c10} _ = impl@$\Rightarrow$@ ( @$\lambda$@ cond @$\rightarrow$@ @$\equiv$@@$\rightarrow$@Equal refl )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
25
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
26 init-type : {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Axiom (@$\lambda$@ env @$\rightarrow$@ true) (@$\lambda$@ env @$\rightarrow$@ record { varn = c10 ; vari = vari env }) (stmt1Cond {c10})
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
27 init-type {c10} env = init-case env
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
28
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
29 stmt2Cond : {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Cond
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
30 stmt2Cond {c10} env = (Equal (varn env) c10) @$\wedge$@ (Equal (vari env) 0)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
31
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
32 lemma1 : {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Axiom (stmt1Cond {c10}) (@$\lambda$@ env @$\rightarrow$@ record { varn = varn env ; vari = 0 }) (stmt2Cond {c10})
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
33 lemma1 {c10} env = impl@$\Rightarrow$@ ( @$\lambda$@ cond @$\rightarrow$@ let open @$\equiv$@-Reasoning in
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
34 begin
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
35 (Equal (varn env) c10 ) @$\wedge$@ true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
36 @$\equiv$@@$\langle$@ @$\wedge$@true @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
37 Equal (varn env) c10
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
38 @$\equiv$@@$\langle$@ cond @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
39 true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
40 @$\blacksquare$@ )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
41
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
42 -- simple : @$\mathbb{N}$@ @$\rightarrow$@ Comm
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
43 -- simple c10 =
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
44 -- Seq ( PComm (@$\lambda$@ env @$\rightarrow$@ record env {varn = c10}))
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
45 -- $ PComm (@$\lambda$@ env @$\rightarrow$@ record env {vari = 0})
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
46
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
47 proofs : (c10 : @$\mathbb{N}$@) @$\rightarrow$@ HTProof initCond (simple c10) (stmt2Cond {c10})
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
48 proofs c10 =
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
49 SeqRule {initCond} ( PrimRule (init-case {c10} ))
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
50 $ PrimRule {stmt1Cond} {_} {stmt2Cond} (lemma1 {c10})
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
51
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
52 open import Data.Empty
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
53
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
54 open import Data.Nat.Properties
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
55
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
56 whileInv : {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Cond
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
57 whileInv {c10} env = Equal ((varn env) + (vari env)) c10
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
58
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
59 whileInv' : {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Cond
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
60 whileInv'{c10} env = Equal ((varn env) + (vari env)) (suc c10) @$\wedge$@ lt zero (varn env)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
61
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
62 termCond : {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Cond
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
63 termCond {c10} env = Equal (vari env) c10
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
64
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
65
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
66 -- program : @$\mathbb{N}$@ @$\rightarrow$@ Comm
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
67 -- program c10 =
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
68 -- Seq ( PComm (@$\lambda$@ env @$\rightarrow$@ record env {varn = c10}))
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
69 -- $ Seq ( PComm (@$\lambda$@ env @$\rightarrow$@ record env {vari = 0}))
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
70 -- $ While (@$\lambda$@ env @$\rightarrow$@ lt zero (varn env ) )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
71 -- (Seq (PComm (@$\lambda$@ env @$\rightarrow$@ record env {vari = ((vari env) + 1)} ))
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
72 -- $ PComm (@$\lambda$@ env @$\rightarrow$@ record env {varn = ((varn env) - 1)} ))
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
73
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
74
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
75 proof1 : (c10 : @$\mathbb{N}$@) @$\rightarrow$@ HTProof initCond (program c10 ) (termCond {c10})
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
76 proof1 c10 =
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
77 SeqRule {@$\lambda$@ e @$\rightarrow$@ true} ( PrimRule (init-case {c10} ))
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
78 $ SeqRule {@$\lambda$@ e @$\rightarrow$@ Equal (varn e) c10} ( PrimRule lemma1 )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
79 $ WeakeningRule {@$\lambda$@ e @$\rightarrow$@ (Equal (varn e) c10) @$\wedge$@ (Equal (vari e) 0)} lemma2 (
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
80 WhileRule {_} {@$\lambda$@ e @$\rightarrow$@ Equal ((varn e) + (vari e)) c10}
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
81 $ SeqRule (PrimRule {@$\lambda$@ e @$\rightarrow$@ whileInv e @$\wedge$@ lt zero (varn e) } lemma3 )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
82 $ PrimRule {whileInv'} {_} {whileInv} lemma4 ) lemma5
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
83 where
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
84 lemma21 : {env : Env } @$\rightarrow$@ {c10 : @$\mathbb{N}$@} @$\rightarrow$@ stmt2Cond env @$\equiv$@ true @$\rightarrow$@ varn env @$\equiv$@ c10
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
85 lemma21 eq = Equal@$\rightarrow$@@$\equiv$@ (@$\wedge$@-pi1 eq)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
86 lemma22 : {env : Env } @$\rightarrow$@ {c10 : @$\mathbb{N}$@} @$\rightarrow$@ stmt2Cond {c10} env @$\equiv$@ true @$\rightarrow$@ vari env @$\equiv$@ 0
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
87 lemma22 eq = Equal@$\rightarrow$@@$\equiv$@ (@$\wedge$@-pi2 eq)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
88 lemma23 : {env : Env } @$\rightarrow$@ {c10 : @$\mathbb{N}$@} @$\rightarrow$@ stmt2Cond env @$\equiv$@ true @$\rightarrow$@ varn env + vari env @$\equiv$@ c10
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
89 lemma23 {env} {c10} eq = let open @$\equiv$@-Reasoning in
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
90 begin
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
91 varn env + vari env
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
92 @$\equiv$@@$\langle$@ cong ( \ x @$\rightarrow$@ x + vari env ) (lemma21 eq ) @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
93 c10 + vari env
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
94 @$\equiv$@@$\langle$@ cong ( \ x @$\rightarrow$@ c10 + x) (lemma22 {env} {c10} eq ) @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
95 c10 + 0
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
96 @$\equiv$@@$\langle$@ +-sym {c10} {0} @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
97 0 + c10
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
98 @$\equiv$@@$\langle$@@$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
99 c10
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
100 @$\blacksquare$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
101 lemma2 : {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Tautology stmt2Cond whileInv
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
102 lemma2 {c10} env = bool-case (stmt2Cond env) (
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
103 @$\lambda$@ eq @$\rightarrow$@ let open @$\equiv$@-Reasoning in
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
104 begin
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
105 (stmt2Cond env) @$\Rightarrow$@ (whileInv env)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
106 @$\equiv$@@$\langle$@@$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
107 (stmt2Cond env) @$\Rightarrow$@ ( Equal (varn env + vari env) c10 )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
108 @$\equiv$@@$\langle$@ cong ( \ x @$\rightarrow$@ (stmt2Cond {c10} env) @$\Rightarrow$@ ( Equal x c10 ) ) ( lemma23 {env} eq ) @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
109 (stmt2Cond env) @$\Rightarrow$@ (Equal c10 c10)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
110 @$\equiv$@@$\langle$@ cong ( \ x @$\rightarrow$@ (stmt2Cond {c10} env) @$\Rightarrow$@ x ) (@$\equiv$@@$\rightarrow$@Equal refl ) @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
111 (stmt2Cond {c10} env) @$\Rightarrow$@ true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
112 @$\equiv$@@$\langle$@ @$\Rightarrow$@t @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
113 true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
114 @$\blacksquare$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
115 ) (
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
116 @$\lambda$@ ne @$\rightarrow$@ let open @$\equiv$@-Reasoning in
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
117 begin
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
118 (stmt2Cond env) @$\Rightarrow$@ (whileInv env)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
119 @$\equiv$@@$\langle$@ cong ( \ x @$\rightarrow$@ x @$\Rightarrow$@ (whileInv env) ) ne @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
120 false @$\Rightarrow$@ (whileInv {c10} env)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
121 @$\equiv$@@$\langle$@ f@$\Rightarrow$@ {whileInv {c10} env} @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
122 true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
123 @$\blacksquare$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
124 )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
125 lemma3 : Axiom (@$\lambda$@ e @$\rightarrow$@ whileInv e @$\wedge$@ lt zero (varn e)) (@$\lambda$@ env @$\rightarrow$@ record { varn = varn env ; vari = vari env + 1 }) whileInv'
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
126 lemma3 env = impl@$\Rightarrow$@ ( @$\lambda$@ cond @$\rightarrow$@ let open @$\equiv$@-Reasoning in
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
127 begin
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
128 whileInv' (record { varn = varn env ; vari = vari env + 1 })
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
129 @$\equiv$@@$\langle$@@$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
130 Equal (varn env + (vari env + 1)) (suc c10) @$\wedge$@ (lt 0 (varn env) )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
131 @$\equiv$@@$\langle$@ cong ( @$\lambda$@ z @$\rightarrow$@ Equal (varn env + (vari env + 1)) (suc c10) @$\wedge$@ z ) (@$\wedge$@-pi2 cond ) @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
132 Equal (varn env + (vari env + 1)) (suc c10) @$\wedge$@ true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
133 @$\equiv$@@$\langle$@ @$\wedge$@true @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
134 Equal (varn env + (vari env + 1)) (suc c10)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
135 @$\equiv$@@$\langle$@ cong ( \ x @$\rightarrow$@ Equal x (suc c10) ) (sym (+-assoc (varn env) (vari env) 1)) @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
136 Equal ((varn env + vari env) + 1) (suc c10)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
137 @$\equiv$@@$\langle$@ cong ( \ x @$\rightarrow$@ Equal x (suc c10) ) +1@$\equiv$@suc @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
138 Equal (suc (varn env + vari env)) (suc c10)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
139 @$\equiv$@@$\langle$@ sym Equal+1 @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
140 Equal ((varn env + vari env) ) c10
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
141 @$\equiv$@@$\langle$@ @$\wedge$@-pi1 cond @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
142 true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
143 @$\blacksquare$@ )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
144 lemma41 : (env : Env ) @$\rightarrow$@ {c10 : @$\mathbb{N}$@} @$\rightarrow$@ (varn env + vari env) @$\equiv$@ (suc c10) @$\rightarrow$@ lt 0 (varn env) @$\equiv$@ true @$\rightarrow$@ Equal ((varn env - 1) + vari env) c10 @$\equiv$@ true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
145 lemma41 env {c10} c1 c2 = let open @$\equiv$@-Reasoning in
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
146 begin
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
147 Equal ((varn env - 1) + vari env) c10
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
148 @$\equiv$@@$\langle$@ cong ( @$\lambda$@ z @$\rightarrow$@ Equal ((z - 1 ) + vari env ) c10 ) (sym (suc-pred@$\mathbb{N}$@=n c2) ) @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
149 Equal ((suc (pred@$\mathbb{N}$@ {varn env} c2 ) - 1) + vari env) c10
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
150 @$\equiv$@@$\langle$@@$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
151 Equal ((pred@$\mathbb{N}$@ {varn env} c2 ) + vari env) c10
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
152 @$\equiv$@@$\langle$@ Equal+1 @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
153 Equal ((suc (pred@$\mathbb{N}$@ {varn env} c2 )) + vari env) (suc c10)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
154 @$\equiv$@@$\langle$@ cong ( @$\lambda$@ z @$\rightarrow$@ Equal (z + vari env ) (suc c10) ) (suc-pred@$\mathbb{N}$@=n c2 ) @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
155 Equal (varn env + vari env) (suc c10)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
156 @$\equiv$@@$\langle$@ cong ( @$\lambda$@ z @$\rightarrow$@ (Equal z (suc c10) )) c1 @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
157 Equal (suc c10) (suc c10)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
158 @$\equiv$@@$\langle$@ @$\equiv$@@$\rightarrow$@Equal refl @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
159 true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
160 @$\blacksquare$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
161 lemma4 : {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Axiom whileInv' (@$\lambda$@ env @$\rightarrow$@ record { varn = varn env - 1 ; vari = vari env }) whileInv
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
162 lemma4 {c10} env = impl@$\Rightarrow$@ ( @$\lambda$@ cond @$\rightarrow$@ let open @$\equiv$@-Reasoning in
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
163 begin
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
164 whileInv (record { varn = varn env - 1 ; vari = vari env })
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
165 @$\equiv$@@$\langle$@@$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
166 Equal ((varn env - 1) + vari env) c10
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
167 @$\equiv$@@$\langle$@ lemma41 env (Equal@$\rightarrow$@@$\equiv$@ (@$\wedge$@-pi1 cond)) (@$\wedge$@-pi2 cond) @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
168 true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
169 @$\blacksquare$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
170 )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
171 lemma51 : (z : Env ) @$\rightarrow$@ neg (@$\lambda$@ z @$\rightarrow$@ lt zero (varn z)) z @$\equiv$@ true @$\rightarrow$@ varn z @$\equiv$@ zero
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
172 lemma51 z cond with varn z
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
173 lemma51 z refl | zero = refl
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
174 lemma51 z () | suc x
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
175 lemma5 : {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Tautology ((@$\lambda$@ e @$\rightarrow$@ Equal (varn e + vari e) c10) and (neg (@$\lambda$@ z @$\rightarrow$@ lt zero (varn z)))) termCond
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
176 lemma5 {c10} env = impl@$\Rightarrow$@ ( @$\lambda$@ cond @$\rightarrow$@ let open @$\equiv$@-Reasoning in
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
177 begin
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
178 termCond env
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
179 @$\equiv$@@$\langle$@@$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
180 Equal (vari env) c10
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
181 @$\equiv$@@$\langle$@@$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
182 Equal (zero + vari env) c10
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
183 @$\equiv$@@$\langle$@ cong ( @$\lambda$@ z @$\rightarrow$@ Equal (z + vari env) c10 ) (sym ( lemma51 env ( @$\wedge$@-pi2 cond ) )) @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
184 Equal (varn env + vari env) c10
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
185 @$\equiv$@@$\langle$@ @$\wedge$@-pi1 cond @$\rangle$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
186 true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
187 @$\blacksquare$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
188 )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
189
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
190 --- necessary definitions for Hoare.agda ( Soundness )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
191
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
192 State : Set
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
193 State = Env
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
194
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
195 open import RelOp
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
196 module RelOpState = RelOp State
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
197
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
198 open import Data.Product
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
199 open import Relation.Binary
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
200
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
201 NotP : {S : Set} @$\rightarrow$@ Pred S @$\rightarrow$@ Pred S
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
202 NotP X s = @$\neg$@ X s
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
203
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
204 _@$\wedge$@_ : Cond @$\rightarrow$@ Cond @$\rightarrow$@ Cond
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
205 b1 @$\wedge$@ b2 = b1 and b2
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
206
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
207 _\/_ : Cond @$\rightarrow$@ Cond @$\rightarrow$@ Cond
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
208 b1 \/ b2 = neg (neg b1 @$\wedge$@ neg b2)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
209
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
210 SemCond : Cond @$\rightarrow$@ State @$\rightarrow$@ Set
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
211 SemCond c p = c p @$\equiv$@ true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
212
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
213 tautValid : (b1 b2 : Cond) @$\rightarrow$@ Tautology b1 b2 @$\rightarrow$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
214 (s : State) @$\rightarrow$@ SemCond b1 s @$\rightarrow$@ SemCond b2 s
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
215 tautValid b1 b2 taut s cond with b1 s | b2 s | taut s
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
216 tautValid b1 b2 taut s () | false | false | refl
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
217 tautValid b1 b2 taut s _ | false | true | refl = refl
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
218 tautValid b1 b2 taut s _ | true | false | ()
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
219 tautValid b1 b2 taut s _ | true | true | refl = refl
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
220
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
221 respNeg : (b : Cond) @$\rightarrow$@ (s : State) @$\rightarrow$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
222 Iff (SemCond (neg b) s) (@$\neg$@ SemCond b s)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
223 respNeg b s = ( left , right ) where
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
224 left : not (b s) @$\equiv$@ true @$\rightarrow$@ (b s) @$\equiv$@ true @$\rightarrow$@ @$\bot$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
225 left ne with b s
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
226 left refl | false = @$\lambda$@ ()
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
227 left () | true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
228 right : ((b s) @$\equiv$@ true @$\rightarrow$@ @$\bot$@) @$\rightarrow$@ not (b s) @$\equiv$@ true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
229 right ne with b s
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
230 right ne | false = refl
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
231 right ne | true = @$\bot$@-elim ( ne refl )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
232
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
233 respAnd : (b1 b2 : Cond) @$\rightarrow$@ (s : State) @$\rightarrow$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
234 Iff (SemCond (b1 @$\wedge$@ b2) s)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
235 ((SemCond b1 s) @$\times$@ (SemCond b2 s))
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
236 respAnd b1 b2 s = ( left , right ) where
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
237 left : b1 s @$\wedge$@ b2 s @$\equiv$@ true @$\rightarrow$@ (b1 s @$\equiv$@ true) @$\times$@ (b2 s @$\equiv$@ true)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
238 left and with b1 s | b2 s
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
239 left () | false | false
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
240 left () | false | true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
241 left () | true | false
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
242 left refl | true | true = ( refl , refl )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
243 right : (b1 s @$\equiv$@ true) @$\times$@ (b2 s @$\equiv$@ true) @$\rightarrow$@ b1 s @$\wedge$@ b2 s @$\equiv$@ true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
244 right ( x1 , x2 ) with b1 s | b2 s
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
245 right (() , ()) | false | false
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
246 right (() , _) | false | true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
247 right (_ , ()) | true | false
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
248 right (refl , refl) | true | true = refl
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
249
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
250 PrimSemComm : @$\forall$@ {l} @$\rightarrow$@ PrimComm @$\rightarrow$@ Rel State l
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
251 PrimSemComm prim s1 s2 = Id State (prim s1) s2
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
252
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
253
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
254
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
255 axiomValid : @$\forall$@ {l} @$\rightarrow$@ (bPre : Cond) @$\rightarrow$@ (pcm : PrimComm) @$\rightarrow$@ (bPost : Cond) @$\rightarrow$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
256 (ax : Axiom bPre pcm bPost) @$\rightarrow$@ (s1 s2 : State) @$\rightarrow$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
257 SemCond bPre s1 @$\rightarrow$@ PrimSemComm {l} pcm s1 s2 @$\rightarrow$@ SemCond bPost s2
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
258 axiomValid {l} bPre pcm bPost ax s1 .(pcm s1) semPre ref with bPre s1 | bPost (pcm s1) | ax s1
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
259 axiomValid {l} bPre pcm bPost ax s1 .(pcm s1) () ref | false | false | refl
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
260 axiomValid {l} bPre pcm bPost ax s1 .(pcm s1) semPre ref | false | true | refl = refl
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
261 axiomValid {l} bPre pcm bPost ax s1 .(pcm s1) semPre ref | true | false | ()
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
262 axiomValid {l} bPre pcm bPost ax s1 .(pcm s1) semPre ref | true | true | refl = refl
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
263
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
264 open import HoareSoundness
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
265 Cond
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
266 PrimComm
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
267 neg
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
268 _and_
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
269 Tautology
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
270 State
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
271 SemCond
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
272 tautValid
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
273 respNeg
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
274 respAnd
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
275 PrimSemComm
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
276 Axiom
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
277 axiomValid
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
278
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
279 PrimSoundness : {bPre : Cond} @$\rightarrow$@ {cm : Comm} @$\rightarrow$@ {bPost : Cond} @$\rightarrow$@
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
280 HTProof bPre cm bPost @$\rightarrow$@ Satisfies bPre cm bPost
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
281 PrimSoundness {bPre} {cm} {bPost} ht = Soundness ht
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
282
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
283
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
284 proofOfProgram : (c10 : @$\mathbb{N}$@) @$\rightarrow$@ (input output : Env )
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
285 @$\rightarrow$@ initCond input @$\equiv$@ true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
286 @$\rightarrow$@ (SemComm (program c10) input output)
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
287 @$\rightarrow$@ termCond {c10} output @$\equiv$@ true
soto@cr.ie.u-ryukyu.ac.jp
parents:
diff changeset
288 proofOfProgram c10 input output ic sem = PrimSoundness (proof1 c10) input output ic sem