Nominal/activities/cas09/Lec3.thy
changeset 415 f1be8028a4a9
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Nominal/activities/cas09/Lec3.thy	Wed Mar 30 17:27:34 2016 +0100
@@ -0,0 +1,437 @@
+(***************************************************************** 
+  
+  Isabelle Tutorial
+  -----------------
+
+  2st June 2009, Beijing 
+
+*)
+
+theory Lec3
+  imports "Main" 
+begin
+
+
+definition
+  lang_seq :: "string set \<Rightarrow> string set \<Rightarrow> string set" ("_ ; _")
+where 
+  "L1 ; L2 = {s1@s2 | s1 s2. s1 \<in> L1 \<and> s2 \<in> L2}"
+
+fun
+ lang_pow :: "string set \<Rightarrow> nat \<Rightarrow> string set" ("_ \<up> _")
+where
+  "L \<up> 0 = {[]}"
+| "L \<up> (Suc i) = L ; (L \<up> i)"
+
+definition
+  lang_star :: "string set \<Rightarrow> string set" ("_\<star>")
+where
+  "L\<star> \<equiv> \<Union>i. (L \<up> i)" 
+
+lemma lang_seq_cases:
+  shows "(s \<in> L1 ; L2) = (\<exists>s1 s2. s = s1@s2 \<and> s1\<in>L1 \<and> s2\<in>L2)"
+by (simp add: lang_seq_def)
+
+lemma lang_seq_union:
+  shows "(L1 \<union> L2);L3 = (L1;L3) \<union> (L2;L3)"
+  and   "L1;(L2 \<union> L3) = (L1;L2) \<union> (L1;L3)"
+unfolding lang_seq_def by auto
+
+lemma lang_seq_empty:
+  shows "{[]} ; L = L"
+  and   "L ; {[]} = L"
+unfolding lang_seq_def by auto
+
+lemma lang_seq_assoc:
+  shows "(L1 ; L2) ; L3 = L1 ; (L2 ; L3)"
+by (simp add: lang_seq_def Collect_def mem_def expand_fun_eq)
+   (metis append_assoc)
+
+lemma silly:
+  shows "[] \<in> L \<up> 0"
+by simp
+
+lemma lang_star_empty:
+  shows "{[]} \<union> (L\<star>) = L\<star>"
+unfolding lang_star_def 
+by (auto intro: silly)
+
+lemma lang_star_in_empty:
+  shows "[] \<in> L\<star>"
+unfolding lang_star_def 
+by (auto intro: silly)
+
+lemma lang_seq_subseteq: 
+  shows "L \<subseteq> (L'\<star>) ; L"
+  and   "L \<subseteq> L ; (L'\<star>)"
+proof -
+  have "L = {[]} ; L" using lang_seq_empty by simp
+  also have "\<dots> \<subseteq> ({[]} ; L) \<union> ((L'\<star>) ; L)" by auto
+  also have "\<dots> = ({[]} \<union> (L'\<star>)) ; L" by (simp add: lang_seq_union[symmetric])
+  also have "\<dots> = (L'\<star>); L" using lang_star_empty by simp
+  finally show "L \<subseteq> (L'\<star>); L" by simp
+next
+  show "L \<subseteq> L ; (L'\<star>)" sorry
+qed
+
+lemma lang_star_subseteq: 
+  shows "L ; (L\<star>) \<subseteq> (L\<star>)"
+unfolding lang_star_def lang_seq_def
+apply(auto)
+apply(rule_tac x="Suc xa" in exI)
+apply(auto simp add: lang_seq_def)
+done
+
+(* regular expressions *)
+
+datatype rexp =
+  EMPTY
+| CHAR char
+| SEQ rexp rexp
+| ALT rexp rexp
+| STAR rexp
+
+fun
+  L :: "rexp \<Rightarrow> string set"
+where
+  "L(EMPTY) = {[]}"
+| "L(CHAR c) = {[c]}"
+| "L(SEQ r1 r2) = (L r1) ; (L r2)"
+| "L(ALT r1 r2) = (L r1) \<union> (L r2)"
+| "L(STAR r) = (L r)\<star>"
+
+definition
+  Ls :: "rexp set \<Rightarrow> string set"
+where
+  "Ls R = (\<Union>r\<in>R. (L r))"
+
+lemma 
+  shows "Ls {} = {}"
+unfolding Ls_def by simp
+
+lemma Ls_union:
+  "Ls (R1 \<union> R2) = (Ls R1) \<union> (Ls R2)"
+unfolding Ls_def by auto
+
+function
+  dagger :: "rexp \<Rightarrow> char \<Rightarrow> rexp set" ("_ \<dagger> _")
+where
+  r1: "(EMPTY) \<dagger> c = {}"
+| r2: "(CHAR c') \<dagger> c = (if c = c' then {EMPTY} else {})"
+| r3: "(ALT r1 r2) \<dagger> c = r1 \<dagger> c \<union> r2 \<dagger> c"
+| r4: "(SEQ EMPTY r2) \<dagger> c = r2 \<dagger> c" 
+| r5: "(SEQ (CHAR c') r2) \<dagger> c = (if c= c' then {r2} else {})"
+| r6: "(SEQ (SEQ r11 r12) r2) \<dagger> c = (SEQ r11 (SEQ r12 r2)) \<dagger> c" 
+| r7: "(SEQ (ALT r11 r12) r2) \<dagger> c = (SEQ r11 r2) \<dagger> c \<union> (SEQ r12 r2) \<dagger> c" 
+| r8: "(SEQ (STAR r1) r2) \<dagger> c = 
+          r2 \<dagger> c \<union> {SEQ (SEQ r' (STAR r1)) r2 | r'. r' \<in> r1 \<dagger> c}" 
+| r9: "(STAR r) \<dagger> c = {SEQ r' (STAR r) | r'. r' \<in> r \<dagger> c}"
+by (pat_completeness) (auto)
+
+termination
+  dagger sorry
+
+definition
+  OR :: "bool set \<Rightarrow> bool"
+where
+  "OR S \<equiv> (\<exists>b\<in>S. b)"
+
+function
+  matcher :: "rexp \<Rightarrow> string \<Rightarrow> bool" ("_ ! _")
+where
+  s01: "EMPTY ! s = (s =[])"
+| s02: "CHAR c ! s = (s = [c])" 
+| s03: "ALT r1 r2 ! s = (r1 ! s \<or> r2 ! s)"
+| s04: "STAR r ! [] = True"
+| s05: "STAR r ! c#s = (False \<or> OR {SEQ (r') (STAR r)!s | r'. r' \<in> r \<dagger> c})"
+| s06: "SEQ r1 r2 ! [] = (r1 ! [] \<and> r2 ! [])"
+| s07: "SEQ EMPTY r2 ! (c#s) = (r2 ! c#s)"
+| s08: "SEQ (CHAR c') r2 ! (c#s) = (if c'=c then r2 ! s else False)" 
+| s09: "SEQ (SEQ r11 r12) r2 ! (c#s) = (SEQ r11 (SEQ r12 r2) ! c#s)"
+| s10: "SEQ (ALT r11 r12) r2 ! (c#s) = ((SEQ r11 r2) ! (c#s) \<or> (SEQ r12 r2) ! (c#s))"
+| s11: "SEQ (STAR r1) r2 ! (c#s) = 
+         (r2 ! (c#s) \<or> OR {SEQ r' (SEQ (STAR r1) r2) ! s | r'. r' \<in> r1 \<dagger> c})"
+by (pat_completeness) (auto)
+
+termination 
+  matcher sorry
+
+lemma "(CHAR a) ! [a]" by auto
+lemma "\<not>(CHAR a) ! [a,a]" by auto
+lemma "(STAR (CHAR a)) ! []" by auto
+lemma "(STAR (CHAR a)) ! [a,a]" by (auto simp add: OR_def)
+lemma "(SEQ (CHAR a) (SEQ (STAR (CHAR b)) (CHAR c))) ! [a,b,b,b,c]" 
+  by (auto simp add: OR_def) 
+
+lemma holes:
+  assumes a: "Ls (r \<dagger> c) = {s. c#s \<in> L r}"
+  shows "Ls (r \<dagger> c) ; L (STAR r) = {s''. c#s'' \<in> L (STAR r)}"
+proof -
+  have "Ls (r \<dagger> c) ; L (STAR r) = {s. c#s \<in> L r} ; L (STAR r)" by (simp add: a)
+  also have "\<dots> = {s'. c#s' \<in> (L r ; L (STAR r))}" sorry
+  also have "\<dots> =  {s''. c#s'' \<in> L (STAR r)}" sorry
+  finally show "Ls (r \<dagger> c) ; L (STAR r) = {s''. c#s'' \<in> L (STAR r)}" by simp
+qed
+    
+lemma eq: 
+  shows "Ls (STAR r) \<dagger> c = (Ls (r \<dagger> c) ; L (STAR r))"
+proof
+  show "Ls STAR r \<dagger> c \<subseteq> Ls r \<dagger> c ; L (STAR r)"
+    by (auto simp add: lang_star_def lang_seq_def Ls_def) (blast)
+next
+  show "Ls r \<dagger> c ; L (STAR r) \<subseteq> Ls STAR r \<dagger> c"
+    apply(auto simp add: lang_star_def lang_seq_def Ls_def)
+    apply(rule_tac x="SEQ xa (STAR r)" in exI)
+    apply(simp add: lang_star_def lang_seq_def)
+    apply(blast)
+    done
+qed
+
+(* correctness of the matcher *)
+lemma dagger_holes:
+  "Ls (r \<dagger> c) = {s. c#s \<in> L r}"
+proof (induct rule: dagger.induct)
+  case (1 c)
+  show "Ls (EMPTY \<dagger> c) = {s. c#s \<in> L EMPTY}"
+    by (simp add: Ls_def)
+next
+  case (2 c' c)
+  show "Ls (CHAR c') \<dagger> c = {s. c#s \<in> L (CHAR c')}"
+  proof (cases "c=c'")
+    assume "c=c'"
+    then show "Ls (CHAR c') \<dagger> c = {s. c#s \<in> L (CHAR c')}"
+      by (simp add: Ls_def)
+  next
+    assume "c\<noteq>c'"
+    then show "Ls (CHAR c') \<dagger> c = {s. c#s \<in> L (CHAR c')}"
+      by (simp add: Ls_def)
+  qed
+next
+  case (3 r1 r2 c)
+  have ih1: "Ls r1 \<dagger> c = {s. c#s \<in> L r1}" by fact
+  have ih2: "Ls r2 \<dagger> c = {s. c#s \<in> L r2}" by fact
+  show "Ls (ALT r1 r2) \<dagger> c = {s. c#s \<in> L (ALT r1 r2)}"
+    by (auto simp add: Ls_union ih1 ih2)
+next
+  case (4 r2 c)
+  have ih: "Ls r2 \<dagger> c = {s. c#s \<in> L r2}" by fact
+  show "Ls (SEQ EMPTY r2) \<dagger> c = {s. c#s \<in> L (SEQ EMPTY r2)}"
+    by (simp add: ih lang_seq_empty)
+next
+  case (5 c' r2 c)
+  show "Ls (SEQ (CHAR c') r2) \<dagger> c = {s. c#s \<in> L (SEQ (CHAR c') r2)}"
+  proof (cases "c=c'")
+    assume "c=c'"
+    then show "Ls (SEQ (CHAR c') r2) \<dagger> c = {s. c#s \<in> L (SEQ (CHAR c') r2)}"
+      by (simp add: Ls_def lang_seq_def)
+  next
+    assume "c\<noteq>c'"
+    then show "Ls (SEQ (CHAR c') r2) \<dagger> c = {s. c#s \<in> L (SEQ (CHAR c') r2)}"
+      by (simp add: Ls_def lang_seq_def)
+  qed
+next
+  case (6 r11 r12 r2 c)
+  have ih: "Ls (SEQ r11 (SEQ r12 r2)) \<dagger> c = {s. c#s \<in> L (SEQ r11 (SEQ r12 r2))}" by fact
+  show "Ls (SEQ (SEQ r11 r12) r2) \<dagger> c = {s. c # s \<in> L (SEQ (SEQ r11 r12) r2)}"
+    by (simp add: ih lang_seq_assoc)
+next
+  case (7 r11 r12 r2 c)
+  have ih1: "Ls (SEQ r11 r2) \<dagger> c = {s. c#s \<in> L (SEQ r11 r2)}" by fact
+  have ih2: "Ls (SEQ r12 r2) \<dagger> c = {s. c#s \<in> L (SEQ r12 r2)}" by fact
+  show "Ls (SEQ (ALT r11 r12) r2) \<dagger> c = {s. c#s \<in> L (SEQ (ALT r11 r12) r2)}"
+    by (auto simp add: Ls_union ih1 ih2 lang_seq_union)
+next
+  case (8 r1 r2 c)
+  have ih1: "Ls r2 \<dagger> c = {s. c#s \<in> L r2}" by fact
+  have ih2: "Ls r1 \<dagger> c = {s. c#s \<in> L r1}" by fact
+  show "Ls (SEQ (STAR r1) r2) \<dagger> c = {s. c#s \<in> L (SEQ (STAR r1) r2)}"
+    sorry
+next
+  case (9 r c)
+  have ih: "Ls r \<dagger> c = {s. c#s \<in> L r}" by fact
+  show "Ls (STAR r) \<dagger> c = {s. c#s \<in> L (STAR r)}"
+    by (simp only: eq holes[OF ih] del: r9)
+qed
+
+(* correctness of the matcher *)
+lemma macher_holes:
+  shows "r ! s \<Longrightarrow> s \<in> L r"
+  and   "\<not> r ! s \<Longrightarrow> s \<notin> L r"
+proof (induct rule: matcher.induct)
+  case (1 s)
+  { case 1
+    have "EMPTY ! s" by fact
+    then show "s \<in> L EMPTY" by simp
+  next
+    case 2
+    have "\<not> EMPTY ! s" by fact
+    then show "s \<notin> L EMPTY" by simp
+  }
+next
+  case (2 c s)
+  { case 1
+    have "CHAR c ! s" by fact
+    then show "s \<in> L (CHAR c)" by simp
+  next
+    case 2
+    have "\<not> CHAR c ! s" by fact
+    then show "s \<notin> L (CHAR c)" by simp
+  }
+next
+  case (3 r1 r2 s)
+  have ih1: "r1 ! s \<Longrightarrow> s \<in> L r1" by fact
+  have ih2: "\<not> r1 ! s \<Longrightarrow> s \<notin> L r1" by fact
+  have ih3: "r2 ! s \<Longrightarrow> s \<in> L r2" by fact
+  have ih4: "\<not> r2 ! s \<Longrightarrow> s \<notin> L r2" by fact
+  { case 1
+    have "ALT r1 r2 ! s" by fact
+    then show "s \<in> L (ALT r1 r2)" by (auto simp add: ih1 ih3)
+  next
+    case 2
+    have "\<not> ALT r1 r2 ! s" by fact 
+    then show "s \<notin> L (ALT r1 r2)" by (simp add: ih2 ih4)
+  }
+next
+  case (4 r)
+  { case 1
+    have "STAR r ! []" by fact 
+    then show "[] \<in> L (STAR r)" by (simp add: lang_star_in_empty)
+  next
+    case 2
+    have "\<not> STAR r ! []" by fact
+    then show "[] \<notin> L (STAR r)" by (simp)
+  }
+next
+  case (5 r c s)
+  have ih1: "\<And>rx. SEQ rx (STAR r) ! s \<Longrightarrow> s \<in> L (SEQ rx (STAR r))" by fact
+  have ih2: "\<And>rx. \<not>SEQ rx (STAR r) ! s \<Longrightarrow> s \<notin> L (SEQ rx (STAR r))" by fact
+  { case 1
+    have as: "STAR r ! c#s" by fact
+    then have "\<exists>r' \<in> r \<dagger> c. SEQ r' (STAR r) ! s" by (auto simp add: OR_def)
+    then obtain r' where imp1: "r' \<in> r \<dagger> c" and imp2: "SEQ r' (STAR r) ! s" by blast
+    from imp2 have "s \<in> L (SEQ r' (STAR r))" using ih1 by simp
+    then have "s \<in> L r' ; L (STAR r)" by simp
+    then have "c#s \<in> {[c]} ; (L r' ; L (STAR r))" by (simp add: lang_seq_def)
+    also have "\<dots> \<subseteq> L r ; L (STAR r)" using imp1
+      apply(auto simp add: lang_seq_def) sorry
+    also have "\<dots> \<subseteq> L (STAR r)" by (simp add: lang_star_subseteq)
+    finally show "c#s \<in> L (STAR r)" by simp
+  next
+    case 2
+    have as: "\<not> STAR r ! c#s" by fact
+    then have "\<forall>r'\<in> r \<dagger> c. \<not> (SEQ r' (STAR r) ! s)"
+      by (auto simp add: OR_def)
+    then have "\<forall>r'\<in> r \<dagger> c. s \<notin> L (SEQ r' (STAR r))" using ih2 by auto
+    then obtain r' where "r'\<in> r \<dagger> c \<Longrightarrow> s \<notin> L (SEQ r' (STAR r))" by auto
+   
+    show "c#s \<notin> L (STAR r)" sorry
+  }
+next
+  case (6 r1 r2)
+  have ih1: "r1 ! [] \<Longrightarrow> [] \<in> L r1" by fact
+  have ih2: "\<not> r1 ! [] \<Longrightarrow> [] \<notin> L r1" by fact
+  have ih3: "r2 ! [] \<Longrightarrow> [] \<in> L r2" by fact
+  have ih4: "\<not> r2 ! [] \<Longrightarrow> [] \<notin> L r2" by fact
+  { case 1
+    have as: "SEQ r1 r2 ! []" by fact
+    then have "r1 ! [] \<and> r2 ! []" by (simp)
+    then show "[] \<in> L (SEQ r1 r2)" using ih1 ih3 by (simp add: lang_seq_def)
+  next
+    case 2
+    have "\<not> SEQ r1 r2 ! []" by fact
+    then have "(\<not> r1 ! []) \<or> (\<not> r2 ! [])" by (simp)
+    then show "[] \<notin> L (SEQ r1 r2)" using ih2 ih4 
+      by (auto simp add: lang_seq_def)
+  }
+next
+  case (7 r2 c s)
+  have ih1: "r2 ! c#s \<Longrightarrow> c#s \<in> L r2" by fact
+  have ih2: "\<not> r2 ! c#s \<Longrightarrow> c#s \<notin> L r2" by fact
+  { case 1
+    have "SEQ EMPTY r2 ! c#s" by fact
+    then show "c#s \<in> L (SEQ EMPTY r2)"
+      using ih1 by (simp add: lang_seq_def)
+  next
+    case 2
+    have "\<not> SEQ EMPTY r2 ! c#s" by fact
+    then show "c#s \<notin> L (SEQ EMPTY r2)"
+      using ih2 by (simp add: lang_seq_def)
+  }
+next
+  case (8 c' r2 c s)
+  have ih1: "\<lbrakk>c' = c; r2 ! s\<rbrakk> \<Longrightarrow> s \<in> L r2" by fact
+  have ih2: "\<lbrakk>c' = c; \<not>r2 ! s\<rbrakk> \<Longrightarrow> s \<notin> L r2" by fact
+  { case 1
+    have "SEQ (CHAR c') r2 ! c#s" by fact
+    then show "c#s \<in> L (SEQ (CHAR c') r2)"
+      using ih1 by (auto simp add: lang_seq_def split: if_splits)
+  next
+    case 2
+    have "\<not> SEQ (CHAR c') r2 ! c#s" by fact
+    then show "c#s \<notin> L (SEQ (CHAR c') r2)"
+      using ih2 by (auto simp add: lang_seq_def)
+  }
+next
+  case (9 r11 r12 r2 c s)
+  have ih1: "SEQ r11 (SEQ r12 r2) ! c#s \<Longrightarrow> c#s \<in> L (SEQ r11 (SEQ r12 r2))" by fact
+  have ih2: "\<not> SEQ r11 (SEQ r12 r2) ! c#s \<Longrightarrow> c#s \<notin> L (SEQ r11 (SEQ r12 r2))" by fact
+  { case 1
+    have "SEQ (SEQ r11 r12) r2 ! c#s" by fact
+    then show "c#s \<in> L (SEQ (SEQ r11 r12) r2)"
+      using ih1 
+      apply(auto simp add: lang_seq_def)
+      apply(rule_tac x="s1@s1a" in exI)
+      apply(rule_tac x="s2a" in exI)
+      apply(simp)
+      apply(blast)
+      done
+  next
+    case 2
+    have "\<not> SEQ (SEQ r11 r12) r2 ! c#s" by fact
+    then show "c#s \<notin> L (SEQ (SEQ r11 r12) r2)"
+      using ih2 by (auto simp add: lang_seq_def)
+  }
+next
+  case (10 r11 r12 r2 c s)
+  have ih1: "SEQ r11 r2 ! c#s \<Longrightarrow> c#s \<in> L (SEQ r11 r2)" by fact
+  have ih2: "\<not> SEQ r11 r2 ! c#s \<Longrightarrow> c#s \<notin> L (SEQ r11 r2)" by fact
+  have ih3: "SEQ r12 r2 ! c#s \<Longrightarrow> c#s \<in> L (SEQ r12 r2)" by fact
+  have ih4: "\<not> SEQ r12 r2 ! c#s \<Longrightarrow> c#s \<notin> L (SEQ r12 r2)" by fact
+  { case 1
+    have "SEQ (ALT r11 r12) r2 ! c#s" by fact
+    then show "c#s \<in> L (SEQ (ALT r11 r12) r2)"
+      using ih1 ih3 by (auto simp add: lang_seq_union)
+  next
+    case 2
+    have "\<not> SEQ (ALT r11 r12) r2 ! c#s" by fact
+    then show " c#s \<notin> L (SEQ (ALT r11 r12) r2)"
+      using ih2 ih4 by (simp add: lang_seq_union)
+  }
+next
+  case (11 r1 r2 c s)
+  have ih1: "r2 ! c#s \<Longrightarrow> c#s \<in> L r2" by fact
+  have ih2: "\<not>r2 ! c#s \<Longrightarrow> c#s \<notin> L r2" by fact
+  { case 1
+    have "SEQ (STAR r1) r2 ! c#s" by fact
+    then show "c#s \<in> L (SEQ (STAR r1) r2)"
+      using ih1 sorry
+  next
+    case 2
+    have "\<not> SEQ (STAR r1) r2 ! c#s" by fact
+    then show "c#s \<notin> L (SEQ (STAR r1) r2)"
+      using ih2 sorry
+  }
+qed      
+
+   
+end    
+   
+
+
+
+  
+
+  
+  
+
+