7 |
7 |
8 theory ReflectionEx |
8 theory ReflectionEx |
9 imports Reflection |
9 imports Reflection |
10 begin |
10 begin |
11 |
11 |
12 |
12 text{* This theory presents two methods: reify and reflection *} |
13 (* The type fm represents simple propositional formulae *) |
13 |
|
14 text{* |
|
15 Consider an HOL type 'a, the structure of which is not recongnisable on the theory level. This is the case of bool, arithmetical terms such as int, real etc\<dots> |
|
16 In order to implement a simplification on terms of type 'a we often need its structure. |
|
17 Traditionnaly such simplifications are written in ML, proofs are synthesized. |
|
18 An other strategy is to declare an HOL-datatype tau and an HOL function (the interpretation) that maps elements of tau to elements of 'a. The functionality of @{text reify} is to compute a term s::tau, which is the representant of t. For this it needs equations for the interpretation. |
|
19 |
|
20 NB: All the interpretations supported by @{text reify} must have the type @{text "'b list \<Rightarrow> tau \<Rightarrow> 'a"}. |
|
21 The method @{text reify} can also be told which subterm of the current subgoal should be reified. The general call for @{text reify} is: @{text "reify eqs (t)"}, where @{text eqs} are the defining equations of the interpretation and @{text "(t)"} is an optional parameter which specifies the subterm to which reification should be applied to. If @{text "(t)"} is abscent, @{text reify} tries to reify the whole subgoal. |
|
22 |
|
23 The method reflection uses @{text reify} and has a very similar signature: @{text "reflection corr_thm eqs (t)"}. Here again @{text eqs} and @{text "(t)"} are as described above and @{text corr_thm} is a thorem proving @{term "I vs (f t) = I vs t"}. We assume that @{text I} is the interpretation and @{text f} is some useful and executable simplification of type @{text "tau \<Rightarrow> tau"}. The method @{text reflection} applies reification and hence the theorem @{term "t = I xs s"} and hence using @{text corr_thm} derives @{term "t = I xs (f s)"}. It then uses normalization by evaluation to prove @{term "f s = s'"} which almost finishes the proof of @{term "t = t'"} where @{term "I xs s' = t'"}. |
|
24 *} |
|
25 |
|
26 text{* Example 1 : Propositional formulae and NNF.*} |
|
27 text{* The type @{text fm} represents simple propositional formulae: *} |
|
28 |
14 datatype fm = And fm fm | Or fm fm | Imp fm fm | Iff fm fm | NOT fm | At nat |
29 datatype fm = And fm fm | Or fm fm | Imp fm fm | Iff fm fm | NOT fm | At nat |
15 |
30 |
16 consts Ifm :: "bool list \<Rightarrow> fm \<Rightarrow> bool" |
31 consts Ifm :: "bool list \<Rightarrow> fm \<Rightarrow> bool" |
17 primrec |
32 primrec |
18 "Ifm vs (At n) = vs!n" |
33 "Ifm vs (At n) = vs!n" |
31 "fmsize (Imp p q) = 2 + fmsize p + fmsize q" |
46 "fmsize (Imp p q) = 2 + fmsize p + fmsize q" |
32 "fmsize (Iff p q) = 2 + 2* fmsize p + 2* fmsize q" |
47 "fmsize (Iff p q) = 2 + 2* fmsize p + 2* fmsize q" |
33 |
48 |
34 |
49 |
35 |
50 |
36 (* reify maps a bool to an fm, for this it needs the |
51 text{* Method @{text reify} maps a bool to an fm. For this it needs the |
37 semantics of fm (Ifm.simps)*) |
52 semantics of fm, i.e.\ the rewrite rules in @{text Ifm.simps}. *} |
38 lemma "Q \<longrightarrow> (D & F & ((~ D) & (~ F)))" |
53 lemma "Q \<longrightarrow> (D & F & ((~ D) & (~ F)))" |
39 apply (reify Ifm.simps) |
54 apply (reify Ifm.simps) |
40 oops |
55 oops |
41 |
56 |
42 (* You can also just pick up a subterm to reify \<dots> *) |
57 (* You can also just pick up a subterm to reify \<dots> *) |
43 lemma "Q \<longrightarrow> (D & F & ((~ D) & (~ F)))" |
58 lemma "Q \<longrightarrow> (D & F & ((~ D) & (~ F)))" |
44 apply (reify Ifm.simps ("((~ D) & (~ F))")) |
59 apply (reify Ifm.simps ("((~ D) & (~ F))")) |
45 oops |
60 oops |
46 |
61 |
47 (* Let's perform NNF, A version that tends to disjunctions *) |
62 text{* Let's perform NNF. This is a version that tends to generate disjunctions *} |
48 consts nnf :: "fm \<Rightarrow> fm" |
63 consts nnf :: "fm \<Rightarrow> fm" |
49 recdef nnf "measure fmsize" |
64 recdef nnf "measure fmsize" |
50 "nnf (At n) = At n" |
65 "nnf (At n) = At n" |
51 "nnf (And p q) = And (nnf p) (nnf q)" |
66 "nnf (And p q) = And (nnf p) (nnf q)" |
52 "nnf (Or p q) = Or (nnf p) (nnf q)" |
67 "nnf (Or p q) = Or (nnf p) (nnf q)" |
57 "nnf (NOT (Imp p q)) = And (nnf p) (nnf (NOT q))" |
72 "nnf (NOT (Imp p q)) = And (nnf p) (nnf (NOT q))" |
58 "nnf (NOT (Iff p q)) = Or (And (nnf p) (nnf (NOT q))) (And (nnf (NOT p)) (nnf q))" |
73 "nnf (NOT (Iff p q)) = Or (And (nnf p) (nnf (NOT q))) (And (nnf (NOT p)) (nnf q))" |
59 "nnf (NOT (NOT p)) = nnf p" |
74 "nnf (NOT (NOT p)) = nnf p" |
60 "nnf (NOT p) = NOT p" |
75 "nnf (NOT p) = NOT p" |
61 |
76 |
62 (* nnf preserves the semantics of fm *) |
77 text{* The correctness theorem of nnf: it preserves the semantics of fm *} |
63 lemma nnf: "Ifm vs (nnf p) = Ifm vs p" |
78 lemma nnf: "Ifm vs (nnf p) = Ifm vs p" |
64 by (induct p rule: nnf.induct) auto |
79 by (induct p rule: nnf.induct) auto |
65 |
80 |
66 (* Now let's perform NNF using our function defined above. |
81 text{* Now let's perform NNF using our @{term nnf} function defined above. First to the whole subgoal. *} |
67 reflection takes the correctness theorem (nnf) the semantics of fm |
|
68 and applies the function to the corresponding of the formula *) |
|
69 lemma "(\<not> (A = B)) \<and> (B \<longrightarrow> (A \<noteq> (B | C \<and> (B \<longrightarrow> A | D)))) \<longrightarrow> A \<or> B \<and> D" |
82 lemma "(\<not> (A = B)) \<and> (B \<longrightarrow> (A \<noteq> (B | C \<and> (B \<longrightarrow> A | D)))) \<longrightarrow> A \<or> B \<and> D" |
70 apply (reflection nnf Ifm.simps) |
83 apply (reflection nnf Ifm.simps) |
71 oops |
84 oops |
72 |
85 |
73 (* Here also you can just pick up a subterm \<dots> *) |
86 text{* Now we specify on which subterm it should be applied*} |
74 lemma "(\<not> (A = B)) \<and> (B \<longrightarrow> (A \<noteq> (B | C \<and> (B \<longrightarrow> A | D)))) \<longrightarrow> A \<or> B \<and> D" |
87 lemma "(\<not> (A = B)) \<and> (B \<longrightarrow> (A \<noteq> (B | C \<and> (B \<longrightarrow> A | D)))) \<longrightarrow> A \<or> B \<and> D" |
75 apply (reflection nnf Ifm.simps ("(B | C \<and> (B \<longrightarrow> A | D))")) |
88 apply (reflection nnf Ifm.simps ("(B | C \<and> (B \<longrightarrow> A | D))")) |
76 oops |
89 oops |
77 |
90 |
78 |
91 |
79 (* Example 2 : simple arithmetics formulae *) |
92 (* Example 2 : Simple arithmetic formulae *) |
80 |
93 |
81 (* num reflects linear expressions over natural number *) |
94 text{* The type @{text num} reflects linear expressions over natural number *} |
82 datatype num = C nat | Add num num | Mul nat num | Var nat | CN nat nat num |
95 datatype num = C nat | Add num num | Mul nat num | Var nat | CN nat nat num |
83 |
96 |
|
97 text{* This is just technical to make recursive definitions easier. *} |
84 consts num_size :: "num \<Rightarrow> nat" |
98 consts num_size :: "num \<Rightarrow> nat" |
85 primrec |
99 primrec |
86 "num_size (C c) = 1" |
100 "num_size (C c) = 1" |
87 "num_size (Var n) = 1" |
101 "num_size (Var n) = 1" |
88 "num_size (Add a b) = 1 + num_size a + num_size b" |
102 "num_size (Add a b) = 1 + num_size a + num_size b" |
89 "num_size (Mul c a) = 1 + num_size a" |
103 "num_size (Mul c a) = 1 + num_size a" |
90 "num_size (CN n c a) = 4 + num_size a " |
104 "num_size (CN n c a) = 4 + num_size a " |
91 |
105 |
92 (* The semantics of num *) |
106 text{* The semantics of num *} |
93 consts Inum:: "nat list \<Rightarrow> num \<Rightarrow> nat" |
107 consts Inum:: "nat list \<Rightarrow> num \<Rightarrow> nat" |
94 primrec |
108 primrec |
95 Inum_C : "Inum vs (C i) = i" |
109 Inum_C : "Inum vs (C i) = i" |
96 Inum_Var: "Inum vs (Var n) = vs!n" |
110 Inum_Var: "Inum vs (Var n) = vs!n" |
97 Inum_Add: "Inum vs (Add s t) = Inum vs s + Inum vs t" |
111 Inum_Add: "Inum vs (Add s t) = Inum vs s + Inum vs t" |
98 Inum_Mul: "Inum vs (Mul c t) = c * Inum vs t" |
112 Inum_Mul: "Inum vs (Mul c t) = c * Inum vs t" |
99 Inum_CN : "Inum vs (CN n c t) = c*(vs!n) + Inum vs t" |
113 Inum_CN : "Inum vs (CN n c t) = c*(vs!n) + Inum vs t" |
100 |
114 |
101 (* Let's reify some nat expressions \<dots> *) |
115 text{* Let's reify some nat expressions \<dots> *} |
102 lemma "4 * (2*x + (y::nat)) \<noteq> 0" |
116 lemma "4 * (2*x + (y::nat)) \<noteq> 0" |
103 apply (reify Inum.simps ("4 * (2*x + (y::nat))")) |
117 apply (reify Inum.simps ("4 * (2*x + (y::nat))")) |
104 (* We're in a bad situation!!*) |
118 oops |
105 oops |
119 text{* We're in a bad situation!! The term above has been recongnized as a constant, which is correct but does not correspond to our intuition of the constructor C. It should encapsulate constants, i.e. numbers, i.e. numerals.*} |
106 (* So let's leave the Inum_C equation at the end and see what happens \<dots>*) |
120 |
|
121 text{* So let's leave the Inum_C equation at the end and see what happens \<dots>*} |
107 lemma "4 * (2*x + (y::nat)) \<noteq> 0" |
122 lemma "4 * (2*x + (y::nat)) \<noteq> 0" |
108 apply (reify Inum_Var Inum_Add Inum_Mul Inum_CN Inum_C ("4 * (2*x + (y::nat))")) |
123 apply (reify Inum_Var Inum_Add Inum_Mul Inum_CN Inum_C ("4 * (2*x + (y::nat))")) |
109 (* We're still in a bad situation!!*) |
124 oops |
110 (* BUT!! It's better\<dots> Note that the reification depends on the order of the equations\<dots> *) |
125 text{* Better, but it still reifies @{term x} to @{term "C x"}. Note that the reification depends on the order of the equations. The problem is that the right hand side of @{thm Inum_C} matches any term of type nat, which makes things bad. We want only numerals to match\<dots> So let's specialize @{text Inum_C} with numerals.*} |
111 (* The problem is that Inum_C has the form : Inum vs (C i) = i *) |
|
112 (* So the right handside matches any term of type nat, which makes things bad. *) |
|
113 (* We want only numerals \<dots> So let's specialize Inum_C with numerals.*) |
|
114 oops |
|
115 |
126 |
116 lemma Inum_number: "Inum vs (C (number_of t)) = number_of t" by simp |
127 lemma Inum_number: "Inum vs (C (number_of t)) = number_of t" by simp |
117 lemmas Inum_eqs = Inum_Var Inum_Add Inum_Mul Inum_CN Inum_number |
128 lemmas Inum_eqs = Inum_Var Inum_Add Inum_Mul Inum_CN Inum_number |
118 |
129 |
119 (* Second trial *) |
130 text{* Second attempt *} |
120 lemma "1 * (2*x + (y::nat)) \<noteq> 0" |
131 lemma "1 * (2*x + (y::nat)) \<noteq> 0" |
121 apply (reify Inum_eqs ("1 * (2*x + (y::nat))")) |
132 apply (reify Inum_eqs ("1 * (2*x + (y::nat))")) |
122 oops |
133 oops |
123 (* That was fine, so let's try an other one\<dots> *) |
134 text{* That was fine, so let's try an other one\<dots> *} |
124 |
135 |
125 lemma "1 * (2*x + (y::nat) + 0 + 1) \<noteq> 0" |
136 lemma "1 * (2* x + (y::nat) + 0 + 1) \<noteq> 0" |
126 apply (reify Inum_eqs ("1 * (2*x + (y::nat) + 0 + 1)")) |
137 apply (reify Inum_eqs ("1 * (2*x + (y::nat) + 0 + 1)")) |
127 (* Oh!! 0 is not a variable \<dots> Oh! 0 is not a number_of .. thing *) |
138 oops |
128 (* Tha same for 1, so let's add those equations too *) |
139 text{* Oh!! 0 is not a variable \<dots> Oh! 0 is not a number_of .. thing. The same for 1. So let's add those equations too *} |
129 oops |
|
130 |
140 |
131 lemma Inum_01: "Inum vs (C 0) = 0" "Inum vs (C 1) = 1" "Inum vs (C(Suc n)) = Suc n" |
141 lemma Inum_01: "Inum vs (C 0) = 0" "Inum vs (C 1) = 1" "Inum vs (C(Suc n)) = Suc n" |
132 by simp+ |
142 by simp+ |
|
143 |
133 lemmas Inum_eqs'= Inum_eqs Inum_01 |
144 lemmas Inum_eqs'= Inum_eqs Inum_01 |
134 (* Third Trial *) |
145 |
|
146 text{* Third attempt: *} |
135 |
147 |
136 lemma "1 * (2*x + (y::nat) + 0 + 1) \<noteq> 0" |
148 lemma "1 * (2*x + (y::nat) + 0 + 1) \<noteq> 0" |
137 apply (reify Inum_eqs' ("1 * (2*x + (y::nat) + 0 + 1)")) |
149 apply (reify Inum_eqs' ("1 * (2*x + (y::nat) + 0 + 1)")) |
138 (* Okay *) |
150 oops |
139 oops |
151 text{* Okay, let's try reflection. Some simplifications on num follow. You can skim until the main theorem @{text linum} *} |
140 |
|
141 (* Some simplifications for num terms, you can skimm untill the main theorem linum *) |
|
142 consts lin_add :: "num \<times> num \<Rightarrow> num" |
152 consts lin_add :: "num \<times> num \<Rightarrow> num" |
143 recdef lin_add "measure (\<lambda>(x,y). ((size x) + (size y)))" |
153 recdef lin_add "measure (\<lambda>(x,y). ((size x) + (size y)))" |
144 "lin_add (CN n1 c1 r1,CN n2 c2 r2) = |
154 "lin_add (CN n1 c1 r1,CN n2 c2 r2) = |
145 (if n1=n2 then |
155 (if n1=n2 then |
146 (let c = c1 + c2 |
156 (let c = c1 + c2 |
208 "aform vs (NEq a b) = (Inum vs a \<noteq> Inum vs b)" |
218 "aform vs (NEq a b) = (Inum vs a \<noteq> Inum vs b)" |
209 "aform vs (NEG p) = (\<not> (aform vs p))" |
219 "aform vs (NEG p) = (\<not> (aform vs p))" |
210 "aform vs (Conj p q) = (aform vs p \<and> aform vs q)" |
220 "aform vs (Conj p q) = (aform vs p \<and> aform vs q)" |
211 "aform vs (Disj p q) = (aform vs p \<or> aform vs q)" |
221 "aform vs (Disj p q) = (aform vs p \<or> aform vs q)" |
212 |
222 |
213 (* Let's reify and do reflection .. *) |
223 text{* Let's reify and do reflection. *} |
214 lemma "(3::nat)*x + t < 0 \<and> (2 * x + y \<noteq> 17)" |
224 lemma "(3::nat)*x + t < 0 \<and> (2 * x + y \<noteq> 17)" |
215 apply (reify Inum_eqs' aform.simps) |
225 apply (reify Inum_eqs' aform.simps) |
216 oops |
226 oops |
217 |
227 |
|
228 text{* Note that reification handles several interpretations at the same time*} |
218 lemma "(3::nat)*x + t < 0 & x*x + t*x + 3 + 1 = z*t*4*z | x + x + 1 < 0" |
229 lemma "(3::nat)*x + t < 0 & x*x + t*x + 3 + 1 = z*t*4*z | x + x + 1 < 0" |
219 apply (reflection linum Inum_eqs' aform.simps ("x + x + 1")) |
230 apply (reflection linum Inum_eqs' aform.simps ("x + x + 1")) |
220 oops |
231 oops |
221 |
232 |
222 (* We now define a simple transformation on aform: NNF + linum on atoms *) |
233 text{* For reflection we now define a simple transformation on aform: NNF + linum on atoms *} |
223 consts linaform:: "aform \<Rightarrow> aform" |
234 consts linaform:: "aform \<Rightarrow> aform" |
224 recdef linaform "measure linaformsize" |
235 recdef linaform "measure linaformsize" |
225 "linaform (Lt s t) = Lt (linum s) (linum t)" |
236 "linaform (Lt s t) = Lt (linum s) (linum t)" |
226 "linaform (Eq s t) = Eq (linum s) (linum t)" |
237 "linaform (Eq s t) = Eq (linum s) (linum t)" |
227 "linaform (Ge s t) = Ge (linum s) (linum t)" |
238 "linaform (Ge s t) = Ge (linum s) (linum t)" |