(***************************************************************** 
  
  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