(***************************************************************** 

  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