1 |
1 |
2 theory Spec |
2 theory Spec |
3 imports Main "~~/src/HOL/Library/Sublist" |
3 imports RegLangs |
4 begin |
4 begin |
5 |
5 |
6 section {* Sequential Composition of Languages *} |
6 |
7 |
7 section {* "Plain" Values *} |
8 definition |
|
9 Sequ :: "string set \<Rightarrow> string set \<Rightarrow> string set" ("_ ;; _" [100,100] 100) |
|
10 where |
|
11 "A ;; B = {s1 @ s2 | s1 s2. s1 \<in> A \<and> s2 \<in> B}" |
|
12 |
|
13 text {* Two Simple Properties about Sequential Composition *} |
|
14 |
|
15 lemma Sequ_empty_string [simp]: |
|
16 shows "A ;; {[]} = A" |
|
17 and "{[]} ;; A = A" |
|
18 by (simp_all add: Sequ_def) |
|
19 |
|
20 lemma Sequ_empty [simp]: |
|
21 shows "A ;; {} = {}" |
|
22 and "{} ;; A = {}" |
|
23 by (simp_all add: Sequ_def) |
|
24 |
|
25 |
|
26 section {* Semantic Derivative (Left Quotient) of Languages *} |
|
27 |
|
28 definition |
|
29 Der :: "char \<Rightarrow> string set \<Rightarrow> string set" |
|
30 where |
|
31 "Der c A \<equiv> {s. c # s \<in> A}" |
|
32 |
|
33 definition |
|
34 Ders :: "string \<Rightarrow> string set \<Rightarrow> string set" |
|
35 where |
|
36 "Ders s A \<equiv> {s'. s @ s' \<in> A}" |
|
37 |
|
38 lemma Der_null [simp]: |
|
39 shows "Der c {} = {}" |
|
40 unfolding Der_def |
|
41 by auto |
|
42 |
|
43 lemma Der_empty [simp]: |
|
44 shows "Der c {[]} = {}" |
|
45 unfolding Der_def |
|
46 by auto |
|
47 |
|
48 lemma Der_char [simp]: |
|
49 shows "Der c {[d]} = (if c = d then {[]} else {})" |
|
50 unfolding Der_def |
|
51 by auto |
|
52 |
|
53 lemma Der_union [simp]: |
|
54 shows "Der c (A \<union> B) = Der c A \<union> Der c B" |
|
55 unfolding Der_def |
|
56 by auto |
|
57 |
|
58 lemma Der_Sequ [simp]: |
|
59 shows "Der c (A ;; B) = (Der c A) ;; B \<union> (if [] \<in> A then Der c B else {})" |
|
60 unfolding Der_def Sequ_def |
|
61 by (auto simp add: Cons_eq_append_conv) |
|
62 |
|
63 |
|
64 section {* Kleene Star for Languages *} |
|
65 |
|
66 inductive_set |
|
67 Star :: "string set \<Rightarrow> string set" ("_\<star>" [101] 102) |
|
68 for A :: "string set" |
|
69 where |
|
70 start[intro]: "[] \<in> A\<star>" |
|
71 | step[intro]: "\<lbrakk>s1 \<in> A; s2 \<in> A\<star>\<rbrakk> \<Longrightarrow> s1 @ s2 \<in> A\<star>" |
|
72 |
|
73 (* Arden's lemma *) |
|
74 |
|
75 lemma Star_cases: |
|
76 shows "A\<star> = {[]} \<union> A ;; A\<star>" |
|
77 unfolding Sequ_def |
|
78 by (auto) (metis Star.simps) |
|
79 |
|
80 lemma Star_decomp: |
|
81 assumes "c # x \<in> A\<star>" |
|
82 shows "\<exists>s1 s2. x = s1 @ s2 \<and> c # s1 \<in> A \<and> s2 \<in> A\<star>" |
|
83 using assms |
|
84 by (induct x\<equiv>"c # x" rule: Star.induct) |
|
85 (auto simp add: append_eq_Cons_conv) |
|
86 |
|
87 lemma Star_Der_Sequ: |
|
88 shows "Der c (A\<star>) \<subseteq> (Der c A) ;; A\<star>" |
|
89 unfolding Der_def Sequ_def |
|
90 by(auto simp add: Star_decomp) |
|
91 |
|
92 |
|
93 lemma Der_star [simp]: |
|
94 shows "Der c (A\<star>) = (Der c A) ;; A\<star>" |
|
95 proof - |
|
96 have "Der c (A\<star>) = Der c ({[]} \<union> A ;; A\<star>)" |
|
97 by (simp only: Star_cases[symmetric]) |
|
98 also have "... = Der c (A ;; A\<star>)" |
|
99 by (simp only: Der_union Der_empty) (simp) |
|
100 also have "... = (Der c A) ;; A\<star> \<union> (if [] \<in> A then Der c (A\<star>) else {})" |
|
101 by simp |
|
102 also have "... = (Der c A) ;; A\<star>" |
|
103 using Star_Der_Sequ by auto |
|
104 finally show "Der c (A\<star>) = (Der c A) ;; A\<star>" . |
|
105 qed |
|
106 |
|
107 |
|
108 section {* Regular Expressions *} |
|
109 |
|
110 datatype rexp = |
|
111 ZERO |
|
112 | ONE |
|
113 | CHAR char |
|
114 | SEQ rexp rexp |
|
115 | ALT rexp rexp |
|
116 | STAR rexp |
|
117 |
|
118 section {* Semantics of Regular Expressions *} |
|
119 |
|
120 fun |
|
121 L :: "rexp \<Rightarrow> string set" |
|
122 where |
|
123 "L (ZERO) = {}" |
|
124 | "L (ONE) = {[]}" |
|
125 | "L (CHAR c) = {[c]}" |
|
126 | "L (SEQ r1 r2) = (L r1) ;; (L r2)" |
|
127 | "L (ALT r1 r2) = (L r1) \<union> (L r2)" |
|
128 | "L (STAR r) = (L r)\<star>" |
|
129 |
|
130 |
|
131 section {* Nullable, Derivatives *} |
|
132 |
|
133 fun |
|
134 nullable :: "rexp \<Rightarrow> bool" |
|
135 where |
|
136 "nullable (ZERO) = False" |
|
137 | "nullable (ONE) = True" |
|
138 | "nullable (CHAR c) = False" |
|
139 | "nullable (ALT r1 r2) = (nullable r1 \<or> nullable r2)" |
|
140 | "nullable (SEQ r1 r2) = (nullable r1 \<and> nullable r2)" |
|
141 | "nullable (STAR r) = True" |
|
142 |
|
143 |
|
144 fun |
|
145 der :: "char \<Rightarrow> rexp \<Rightarrow> rexp" |
|
146 where |
|
147 "der c (ZERO) = ZERO" |
|
148 | "der c (ONE) = ZERO" |
|
149 | "der c (CHAR d) = (if c = d then ONE else ZERO)" |
|
150 | "der c (ALT r1 r2) = ALT (der c r1) (der c r2)" |
|
151 | "der c (SEQ r1 r2) = |
|
152 (if nullable r1 |
|
153 then ALT (SEQ (der c r1) r2) (der c r2) |
|
154 else SEQ (der c r1) r2)" |
|
155 | "der c (STAR r) = SEQ (der c r) (STAR r)" |
|
156 |
|
157 fun |
|
158 ders :: "string \<Rightarrow> rexp \<Rightarrow> rexp" |
|
159 where |
|
160 "ders [] r = r" |
|
161 | "ders (c # s) r = ders s (der c r)" |
|
162 |
|
163 |
|
164 lemma nullable_correctness: |
|
165 shows "nullable r \<longleftrightarrow> [] \<in> (L r)" |
|
166 by (induct r) (auto simp add: Sequ_def) |
|
167 |
|
168 lemma der_correctness: |
|
169 shows "L (der c r) = Der c (L r)" |
|
170 by (induct r) (simp_all add: nullable_correctness) |
|
171 |
|
172 lemma ders_correctness: |
|
173 shows "L (ders s r) = Ders s (L r)" |
|
174 by (induct s arbitrary: r) |
|
175 (simp_all add: Ders_def der_correctness Der_def) |
|
176 |
|
177 lemma ders_append: |
|
178 shows "ders (s1 @ s2) r = ders s2 (ders s1 r)" |
|
179 apply(induct s1 arbitrary: s2 r) |
|
180 apply(auto) |
|
181 done |
|
182 |
|
183 |
|
184 section {* Values *} |
|
185 |
8 |
186 datatype val = |
9 datatype val = |
187 Void |
10 Void |
188 | Char char |
11 | Char char |
189 | Seq val val |
12 | Seq val val |
210 |
33 |
211 lemma flat_Stars [simp]: |
34 lemma flat_Stars [simp]: |
212 "flat (Stars vs) = flats vs" |
35 "flat (Stars vs) = flats vs" |
213 by (induct vs) (auto) |
36 by (induct vs) (auto) |
214 |
37 |
215 lemma Star_concat: |
|
216 assumes "\<forall>s \<in> set ss. s \<in> A" |
|
217 shows "concat ss \<in> A\<star>" |
|
218 using assms by (induct ss) (auto) |
|
219 |
|
220 lemma Star_cstring: |
|
221 assumes "s \<in> A\<star>" |
|
222 shows "\<exists>ss. concat ss = s \<and> (\<forall>s \<in> set ss. s \<in> A \<and> s \<noteq> [])" |
|
223 using assms |
|
224 apply(induct rule: Star.induct) |
|
225 apply(auto)[1] |
|
226 apply(rule_tac x="[]" in exI) |
|
227 apply(simp) |
|
228 apply(erule exE) |
|
229 apply(clarify) |
|
230 apply(case_tac "s1 = []") |
|
231 apply(rule_tac x="ss" in exI) |
|
232 apply(simp) |
|
233 apply(rule_tac x="s1#ss" in exI) |
|
234 apply(simp) |
|
235 done |
|
236 |
|
237 |
38 |
238 section {* Lexical Values *} |
39 section {* Lexical Values *} |
239 |
40 |
240 inductive |
41 inductive |
241 Prf :: "val \<Rightarrow> rexp \<Rightarrow> bool" ("\<Turnstile> _ : _" [100, 100] 100) |
42 Prf :: "val \<Rightarrow> rexp \<Rightarrow> bool" ("\<Turnstile> _ : _" [100, 100] 100) |
291 proof(induct r arbitrary: s) |
92 proof(induct r arbitrary: s) |
292 case (STAR r s) |
93 case (STAR r s) |
293 have IH: "\<And>s. s \<in> L r \<Longrightarrow> \<exists>v. \<Turnstile> v : r \<and> flat v = s" by fact |
94 have IH: "\<And>s. s \<in> L r \<Longrightarrow> \<exists>v. \<Turnstile> v : r \<and> flat v = s" by fact |
294 have "s \<in> L (STAR r)" by fact |
95 have "s \<in> L (STAR r)" by fact |
295 then obtain ss where "concat ss = s" "\<forall>s \<in> set ss. s \<in> L r \<and> s \<noteq> []" |
96 then obtain ss where "concat ss = s" "\<forall>s \<in> set ss. s \<in> L r \<and> s \<noteq> []" |
296 using Star_cstring by auto |
97 using Star_split by auto |
297 then obtain vs where "flats vs = s" "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> flat v \<noteq> []" |
98 then obtain vs where "flats vs = s" "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> flat v \<noteq> []" |
298 using IH Star_cval by metis |
99 using IH flats_Prf_value by metis |
299 then show "\<exists>v. \<Turnstile> v : STAR r \<and> flat v = s" |
100 then show "\<exists>v. \<Turnstile> v : STAR r \<and> flat v = s" |
300 using Prf.intros(6) flat_Stars by blast |
101 using Prf.intros(6) flat_Stars by blast |
301 next |
102 next |
302 case (SEQ r1 r2 s) |
103 case (SEQ r1 r2 s) |
303 then show "\<exists>v. \<Turnstile> v : SEQ r1 r2 \<and> flat v = s" |
104 then show "\<exists>v. \<Turnstile> v : SEQ r1 r2 \<and> flat v = s" |