diff -r d71424eb5d0c -r b3898315e687 Myhill_1.thy --- a/Myhill_1.thy Mon Jan 31 14:51:47 2011 +0000 +++ b/Myhill_1.thy Wed Feb 02 06:05:12 2011 +0000 @@ -36,18 +36,12 @@ where "A ;; B = {s\<^isub>1 @ s\<^isub>2 | s\<^isub>1 s\<^isub>2. s\<^isub>1 \ A \ s\<^isub>2 \ B}" -text {* - Transitive closure of language @{text "L"}. -*} +text {* Some properties of operator @{text ";;"}. *} -inductive_set - Star :: "lang \ lang" ("_\" [101] 102) - for L -where - start[intro]: "[] \ L\" -| step[intro]: "\s1 \ L; s2 \ L\\ \ s1@s2 \ L\" - -text {* Some properties of operator @{text ";;"}. *} +lemma seq_add_left: + assumes a: "A = B" + shows "C ;; A = C ;; B" +using a by simp lemma seq_union_distrib_right: shows "(A \ B) ;; C = (A ;; C) \ (B ;; C)" @@ -73,21 +67,73 @@ and "{[]} ;; A = A" by (simp_all add: Seq_def) +fun + pow :: "lang \ nat \ lang" (infixl "\" 100) +where + "A \ 0 = {[]}" +| "A \ (Suc n) = A ;; (A \ n)" -lemma star_intro1[rule_format]: - "x \ lang\ \ \ y. y \ lang\ \ x @ y \ lang\" -by (erule Star.induct, auto) +definition + Star :: "lang \ lang" ("_\" [101] 102) +where + "A\ \ (\n. A \ n)" + +lemma star_start[intro]: + shows "[] \ A\" +proof - + have "[] \ A \ 0" by auto + then show "[] \ A\" unfolding Star_def by blast +qed + +lemma star_step [intro]: + assumes a: "s1 \ A" + and b: "s2 \ A\" + shows "s1 @ s2 \ A\" +proof - + from b obtain n where "s2 \ A \ n" unfolding Star_def by auto + then have "s1 @ s2 \ A \ (Suc n)" using a by (auto simp add: Seq_def) + then show "s1 @ s2 \ A\" unfolding Star_def by blast +qed -lemma star_intro2: "y \ lang \ y \ lang\" -by (drule step[of y lang "[]"], auto simp:start) +lemma star_induct[consumes 1, case_names start step]: + assumes a: "x \ A\" + and b: "P []" + and c: "\s1 s2. \s1 \ A; s2 \ A\; P s2\ \ P (s1 @ s2)" + shows "P x" +proof - + from a obtain n where "x \ A \ n" unfolding Star_def by auto + then show "P x" + by (induct n arbitrary: x) + (auto intro!: b c simp add: Seq_def Star_def) +qed + +lemma star_intro1: + assumes a: "x \ A\" + and b: "y \ A\" + shows "x @ y \ A\" +using a b +by (induct rule: star_induct) (auto) -lemma star_intro3[rule_format]: - "x \ lang\ \ \y . y \ lang \ x @ y \ lang\" -by (erule Star.induct, auto intro:star_intro2) +lemma star_intro2: + assumes a: "y \ A" + shows "y \ A\" +proof - + from a have "y @ [] \ A\" by blast + then show "y \ A\" by simp +qed + +lemma star_intro3: + assumes a: "x \ A\" + and b: "y \ A" + shows "x @ y \ A\" +using a b by (blast intro: star_intro1 star_intro2) lemma star_decom: - "\x \ lang\; x \ []\ \(\ a b. x = a @ b \ a \ [] \ a \ lang \ b \ lang\)" -by (induct x rule: Star.induct, simp, blast) + "\x \ A\; x \ []\ \(\ a b. x = a @ b \ a \ [] \ a \ A \ b \ A\)" +apply(induct rule: star_induct) +apply(simp) +apply(blast) +done lemma lang_star_cases: shows "L\ = {[]} \ L ;; L\" @@ -95,50 +141,14 @@ { fix x have "x \ L\ \ x \ {[]} \ L ;; L\" unfolding Seq_def - by (induct rule: Star.induct) (auto) + by (induct rule: star_induct) (auto) } then show "L\ \ {[]} \ L ;; L\" by auto next - show "{[]} \ L ;; L\ \ L\" + show "{[]} \ L ;; L\ \ L\" unfolding Seq_def by auto qed -fun - pow :: "lang \ nat \ lang" (infixl "\" 100) -where - "A \ 0 = {[]}" -| "A \ (Suc n) = A ;; (A \ n)" - -lemma star_pow_eq: - shows "A\ = (\n. A \ n)" -proof - - { fix n x - assume "x \ (A \ n)" - then have "x \ A\" - by (induct n arbitrary: x) (auto simp add: Seq_def) - } - moreover - { fix x - assume "x \ A\" - then have "\n. x \ A \ n" - proof (induct rule: Star.induct) - case start - have "[] \ A \ 0" by auto - then show "\n. [] \ A \ n" by blast - next - case (step s1 s2) - have "s1 \ A" by fact - moreover - have "\n. s2 \ A \ n" by fact - then obtain n where "s2 \ A \ n" by blast - ultimately - have "s1 @ s2 \ A \ (Suc n)" by (auto simp add: Seq_def) - then show "\n. s1 @ s2 \ A \ n" by blast - qed - } - ultimately show "A\ = (\n. A \ n)" by auto -qed - lemma shows seq_Union_left: "B ;; (\n. A \ n) = (\n. B ;; (A \ n))" and seq_Union_right: "(\n. A \ n) ;; B = (\n. (A \ n) ;; B)" @@ -150,7 +160,7 @@ lemma seq_star_comm: shows "A ;; A\ = A\ ;; A" -unfolding star_pow_eq +unfolding Star_def unfolding seq_Union_left unfolding seq_pow_comm unfolding seq_Union_right @@ -226,8 +236,8 @@ have "A\ = {[]} \ A\ ;; A" unfolding seq_star_comm[symmetric] by (rule lang_star_cases) - then have "B ;; A\ = B ;; ({[]} \ A\ ;; A)" - unfolding Seq_def by simp + then have "B ;; A\ = B ;; ({[]} \ A\ ;; A)" + by (rule seq_add_left) also have "\ = B \ B ;; (A\ ;; A)" unfolding seq_union_distrib_left by simp also have "\ = B \ (B ;; A\) ;; A" @@ -238,8 +248,9 @@ assume eq: "X = X ;; A \ B" { fix n::nat have "B ;; (A \ n) \ X" using ardens_helper[OF eq, of "n"] by auto } - then have "B ;; A\ \ X" unfolding star_pow_eq Seq_def - by (auto simp add: UNION_def) + then have "B ;; A\ \ X" + unfolding Seq_def Star_def UNION_def + by auto moreover { fix s::string obtain k where "k = length s" by auto @@ -252,7 +263,8 @@ moreover have "(\m\{0..k}. B ;; (A \ m)) \ (\n. B ;; (A \ n))" by auto ultimately - have "s \ B ;; A\" unfolding star_pow_eq seq_Union_left + have "s \ B ;; A\" + unfolding seq_Union_left Star_def by auto } then have "X \ B ;; A\" by auto ultimately