diff -r 32b222d77fa0 -r 6746f5e1f1f8 thys/Spec.thy --- a/thys/Spec.thy Fri Aug 11 20:29:01 2017 +0100 +++ b/thys/Spec.thy Fri Aug 18 14:51:29 2017 +0100 @@ -176,35 +176,6 @@ -section {* Lemmas about ders *} - -(* not really needed *) - -lemma ders_ZERO: - shows "ders s (ZERO) = ZERO" -apply(induct s) -apply(simp_all) -done - -lemma ders_ONE: - shows "ders s (ONE) = (if s = [] then ONE else ZERO)" -apply(induct s) -apply(simp_all add: ders_ZERO) -done - -lemma ders_CHAR: - shows "ders s (CHAR c) = - (if s = [c] then ONE else - (if s = [] then (CHAR c) else ZERO))" -apply(induct s) -apply(simp_all add: ders_ZERO ders_ONE) -done - -lemma ders_ALT: - shows "ders s (ALT r1 r2) = ALT (ders s r1) (ders s r2)" -by (induct s arbitrary: r1 r2)(simp_all) - - section {* Values *} datatype val = @@ -236,109 +207,33 @@ "flat (Stars vs) = flats vs" by (induct vs) (auto) - -section {* Relation between values and regular expressions *} - -inductive - Prf :: "val \ rexp \ bool" ("\ _ : _" [100, 100] 100) -where - "\\ v1 : r1; \ v2 : r2\ \ \ Seq v1 v2 : SEQ r1 r2" -| "\ v1 : r1 \ \ Left v1 : ALT r1 r2" -| "\ v2 : r2 \ \ Right v2 : ALT r1 r2" -| "\ Void : ONE" -| "\ Char c : CHAR c" -| "\v \ set vs. \ v : r \ \ Stars vs : STAR r" - -inductive_cases Prf_elims: - "\ v : ZERO" - "\ v : SEQ r1 r2" - "\ v : ALT r1 r2" - "\ v : ONE" - "\ v : CHAR c" - "\ vs : STAR r" - lemma Star_concat: assumes "\s \ set ss. s \ A" shows "concat ss \ A\" using assms by (induct ss) (auto) -lemma Star_string: +lemma Star_cstring: assumes "s \ A\" - shows "\ss. concat ss = s \ (\s \ set ss. s \ A)" + shows "\ss. concat ss = s \ (\s \ set ss. s \ A \ s \ [])" using assms apply(induct rule: Star.induct) -apply(auto) +apply(auto)[1] apply(rule_tac x="[]" in exI) apply(simp) +apply(erule exE) +apply(clarify) +apply(case_tac "s1 = []") +apply(rule_tac x="ss" in exI) +apply(simp) apply(rule_tac x="s1#ss" in exI) apply(simp) done -lemma Star_val: - assumes "\s\set ss. \v. s = flat v \ \ v : r" - shows "\vs. flats vs = concat ss \ (\v\set vs. \ v : r)" -using assms -apply(induct ss) -apply(auto) -apply(rule_tac x="[]" in exI) -apply(simp) -apply(rule_tac x="v#vs" in exI) -apply(simp) -done -lemma Prf_Stars_append: - assumes "\ Stars vs1 : STAR r" "\ Stars vs2 : STAR r" - shows "\ Stars (vs1 @ vs2) : STAR r" -using assms -by (auto intro!: Prf.intros elim!: Prf_elims) - -lemma Prf_flat_L: - assumes "\ v : r" - shows "flat v \ L r" -using assms -by (induct v r rule: Prf.induct) - (auto simp add: Sequ_def Star_concat) - - -lemma L_flat_Prf1: - assumes "\ v : r" - shows "flat v \ L r" -using assms -by (induct) (auto simp add: Sequ_def Star_concat) - -lemma L_flat_Prf2: - assumes "s \ L r" - shows "\v. \ v : r \ flat v = s" -using assms -proof(induct r arbitrary: s) - case (STAR r s) - have IH: "\s. s \ L r \ \v. \ v : r \ flat v = s" by fact - have "s \ L (STAR r)" by fact - then obtain ss where "concat ss = s" "\s \ set ss. s \ L r" - using Star_string by auto - then obtain vs where "flats vs = s" "\v\set vs. \ v : r" - using IH Star_val by blast - then show "\v. \ v : STAR r \ flat v = s" - using Prf.intros(6) flat_Stars by blast -next - case (SEQ r1 r2 s) - then show "\v. \ v : SEQ r1 r2 \ flat v = s" - unfolding Sequ_def L.simps by (fastforce intro: Prf.intros) -next - case (ALT r1 r2 s) - then show "\v. \ v : ALT r1 r2 \ flat v = s" - unfolding L.simps by (fastforce intro: Prf.intros) -qed (auto intro: Prf.intros) - -lemma L_flat_Prf: - shows "L(r) = {flat v | v. \ v : r}" -using L_flat_Prf1 L_flat_Prf2 by blast - - -section {* Canonical Values *} +section {* Lexical Values *} inductive - CPrf :: "val \ rexp \ bool" ("\ _ : _" [100, 100] 100) + Prf :: "val \ rexp \ bool" ("\ _ : _" [100, 100] 100) where "\\ v1 : r1; \ v2 : r2\ \ \ Seq v1 v2 : SEQ r1 r2" | "\ v1 : r1 \ \ Left v1 : ALT r1 r2" @@ -347,34 +242,92 @@ | "\ Char c : CHAR c" | "\v \ set vs. \ v : r \ flat v \ [] \ \ Stars vs : STAR r" -lemma Prf_CPrf: - assumes "\ v : r" - shows "\ v : r" -using assms -by (induct)(auto intro: Prf.intros) +inductive_cases Prf_elims: + "\ v : ZERO" + "\ v : SEQ r1 r2" + "\ v : ALT r1 r2" + "\ v : ONE" + "\ v : CHAR c" + "\ vs : STAR r" -lemma CPrf_Stars_appendE: +lemma Prf_Stars_appendE: assumes "\ Stars (vs1 @ vs2) : STAR r" shows "\ Stars vs1 : STAR r \ \ Stars vs2 : STAR r" using assms -apply(erule_tac CPrf.cases) -apply(auto intro: CPrf.intros) +by (auto intro: Prf.intros elim!: Prf_elims) + + +lemma Star_cval: + assumes "\s\set ss. \v. s = flat v \ \ v : r" + shows "\vs. flats vs = concat ss \ (\v\set vs. \ v : r \ flat v \ [])" +using assms +apply(induct ss) +apply(auto) +apply(rule_tac x="[]" in exI) +apply(simp) +apply(case_tac "flat v = []") +apply(rule_tac x="vs" in exI) +apply(simp) +apply(rule_tac x="v#vs" in exI) +apply(simp) done -section {* Sets of Lexical and Canonical Values *} +lemma L_flat_Prf1: + assumes "\ v : r" + shows "flat v \ L r" +using assms +by (induct) (auto simp add: Sequ_def Star_concat) -definition - LV :: "rexp \ string \ val set" -where "LV r s \ {v. \ v : r \ flat v = s}" +lemma L_flat_Prf2: + assumes "s \ L r" + shows "\v. \ v : r \ flat v = s" +using assms +proof(induct r arbitrary: s) + case (STAR r s) + have IH: "\s. s \ L r \ \v. \ v : r \ flat v = s" by fact + have "s \ L (STAR r)" by fact + then obtain ss where "concat ss = s" "\s \ set ss. s \ L r \ s \ []" + using Star_cstring by auto + then obtain vs where "flats vs = s" "\v\set vs. \ v : r \ flat v \ []" + using IH Star_cval by metis + then show "\v. \ v : STAR r \ flat v = s" + using Prf.intros(6) flat_Stars by blast +next + case (SEQ r1 r2 s) + then show "\v. \ v : SEQ r1 r2 \ flat v = s" + unfolding Sequ_def L.simps by (fastforce intro: Prf.intros) +next + case (ALT r1 r2 s) + then show "\v. \ v : ALT r1 r2 \ flat v = s" + unfolding L.simps by (fastforce intro: Prf.intros) +qed (auto intro: Prf.intros) + + +lemma L_flat_Prf: + shows "L(r) = {flat v | v. \ v : r}" +using L_flat_Prf1 L_flat_Prf2 by blast + + + +section {* Sets of Lexical Values *} + +text {* + Shows that lexical values are finite for a given regex and string. +*} definition - CV :: "rexp \ string \ val set" -where "CV r s \ {v. \ v : r \ flat v = s}" + LV :: "rexp \ string \ val set" +where "LV r s \ {v. \ v : r \ flat v = s}" -lemma LV_CV_subset: - shows "CV r s \ LV r s" -unfolding CV_def LV_def by(auto simp add: Prf_CPrf) +lemma LV_simps: + shows "LV ZERO s = {}" + and "LV ONE s = (if s = [] then {Void} else {})" + and "LV (CHAR c) s = (if s = [c] then {Char c} else {})" + and "LV (ALT r1 r2) s = Left ` LV r1 s \ Right ` LV r2 s" +unfolding LV_def +by (auto intro: Prf.intros elim: Prf.cases) + abbreviation "Prefixes s \ {s'. prefixeq s' s}" @@ -389,13 +342,6 @@ shows "Suffixes (c # s) = Suffixes s \ {c # s}" by (auto simp add: suffixeq_def Cons_eq_append_conv) -lemma CV_simps: - shows "CV ZERO s = {}" - and "CV ONE s = (if s = [] then {Void} else {})" - and "CV (CHAR c) s = (if s = [c] then {Char c} else {})" - and "CV (ALT r1 r2) s = Left ` CV r1 s \ Right ` CV r2 s" -unfolding CV_def -by (auto intro: CPrf.intros elim: CPrf.cases) lemma finite_Suffixes: shows "finite (Suffixes s)" @@ -423,34 +369,17 @@ ultimately show "finite (Prefixes s)" by simp qed -lemma CV_SEQ_subset: - "CV (SEQ r1 r2) s \ (\(v1,v2). Seq v1 v2) ` ((\s' \ Prefixes s. CV r1 s') \ (\s' \ Suffixes s. CV r2 s'))" -unfolding image_def CV_def prefixeq_def suffixeq_def -by (auto elim: CPrf.cases) - -lemma CV_STAR_subset: - "CV (STAR r) s \ {Stars []} \ - (\(v,vs). Stars (v#vs)) ` ((\s' \ Prefixes s. CV r s') \ (\s2 \ SSuffixes s. Stars -` (CV (STAR r) s2)))" -unfolding image_def CV_def prefixeq_def suffix_def -apply(auto) -apply(erule CPrf.cases) -apply(auto) -apply(case_tac vs) -apply(auto intro: CPrf.intros) -done - - -lemma CV_STAR_finite: - assumes "\s. finite (CV r s)" - shows "finite (CV (STAR r) s)" +lemma LV_STAR_finite: + assumes "\s. finite (LV r s)" + shows "finite (LV (STAR r) s)" proof(induct s rule: length_induct) fix s::"char list" - assume "\s'. length s' < length s \ finite (CV (STAR r) s')" - then have IH: "\s' \ SSuffixes s. finite (CV (STAR r) s')" + assume "\s'. length s' < length s \ finite (LV (STAR r) s')" + then have IH: "\s' \ SSuffixes s. finite (LV (STAR r) s')" by (auto simp add: suffix_def) def f \ "\(v, vs). Stars (v # vs)" - def S1 \ "\s' \ Prefixes s. CV r s'" - def S2 \ "\s2 \ SSuffixes s. Stars -` (CV (STAR r) s2)" + def S1 \ "\s' \ Prefixes s. LV r s'" + def S2 \ "\s2 \ SSuffixes s. Stars -` (LV (STAR r) s2)" have "finite S1" using assms unfolding S1_def by (simp_all add: finite_Prefixes) moreover @@ -459,44 +388,53 @@ ultimately have "finite ({Stars []} \ f ` (S1 \ S2))" by simp moreover - have "CV (STAR r) s \ {Stars []} \ f ` (S1 \ S2)" unfolding S1_def S2_def f_def - by (rule CV_STAR_subset) + have "LV (STAR r) s \ {Stars []} \ f ` (S1 \ S2)" + unfolding S1_def S2_def f_def + unfolding LV_def image_def prefixeq_def suffix_def + apply(auto elim: Prf_elims) + apply(erule Prf_elims) + apply(auto) + apply(case_tac vs) + apply(auto intro: Prf.intros) + done ultimately - show "finite (CV (STAR r) s)" by (simp add: finite_subset) + show "finite (LV (STAR r) s)" by (simp add: finite_subset) qed -lemma CV_finite: - shows "finite (CV r s)" +lemma LV_finite: + shows "finite (LV r s)" proof(induct r arbitrary: s) case (ZERO s) - show "finite (CV ZERO s)" by (simp add: CV_simps) + show "finite (LV ZERO s)" by (simp add: LV_simps) next case (ONE s) - show "finite (CV ONE s)" by (simp add: CV_simps) + show "finite (LV ONE s)" by (simp add: LV_simps) next case (CHAR c s) - show "finite (CV (CHAR c) s)" by (simp add: CV_simps) + show "finite (LV (CHAR c) s)" by (simp add: LV_simps) next case (ALT r1 r2 s) - then show "finite (CV (ALT r1 r2) s)" by (simp add: CV_simps) + then show "finite (LV (ALT r1 r2) s)" by (simp add: LV_simps) next case (SEQ r1 r2 s) def f \ "\(v1, v2). Seq v1 v2" - def S1 \ "\s' \ Prefixes s. CV r1 s'" - def S2 \ "\s' \ Suffixes s. CV r2 s'" - have IHs: "\s. finite (CV r1 s)" "\s. finite (CV r2 s)" by fact+ + def S1 \ "\s' \ Prefixes s. LV r1 s'" + def S2 \ "\s' \ Suffixes s. LV r2 s'" + have IHs: "\s. finite (LV r1 s)" "\s. finite (LV r2 s)" by fact+ then have "finite S1" "finite S2" unfolding S1_def S2_def by (simp_all add: finite_Prefixes finite_Suffixes) moreover - have "CV (SEQ r1 r2) s \ f ` (S1 \ S2)" - unfolding f_def S1_def S2_def by (auto simp add: CV_SEQ_subset) + have "LV (SEQ r1 r2) s \ f ` (S1 \ S2)" + unfolding f_def S1_def S2_def + unfolding LV_def image_def prefixeq_def suffixeq_def + by (auto elim: Prf.cases) ultimately - show "finite (CV (SEQ r1 r2) s)" + show "finite (LV (SEQ r1 r2) s)" by (simp add: finite_subset) next case (STAR r s) - then show "finite (CV (STAR r) s)" by (simp add: CV_STAR_finite) + then show "finite (LV (STAR r) s)" by (simp add: LV_STAR_finite) qed @@ -533,14 +471,6 @@ by (induct s r v rule: Posix.induct) (auto simp add: Sequ_def) -lemma Posix_Prf: - assumes "s \ r \ v" - shows "\ v : r" -using assms -apply(induct s r v rule: Posix.induct) -apply(auto intro!: Prf.intros elim!: Prf_elims) -done - text {* Our Posix definition determines a unique value. *} @@ -616,30 +546,31 @@ Our POSIX value is a canonical value. *} -lemma Posix_CV: +lemma Posix_LV: assumes "s \ r \ v" - shows "v \ CV r s" + shows "v \ LV r s" using assms apply(induct rule: Posix.induct) -apply(auto simp add: CV_def intro: CPrf.intros elim: CPrf.cases) +apply(auto simp add: LV_def intro: Prf.intros elim: Prf.cases) apply(rotate_tac 5) -apply(erule CPrf.cases) +apply(erule Prf.cases) apply(simp_all) -apply(rule CPrf.intros) +apply(rule Prf.intros) apply(simp_all) done +(* lemma test2: assumes "\v \ set vs. flat v \ r \ v \ flat v \ []" - shows "(Stars vs) \ CV (STAR r) (flat (Stars vs))" + shows "(Stars vs) \ LV (STAR r) (flat (Stars vs))" using assms apply(induct vs) -apply(auto simp add: CV_def) -apply(rule CPrf.intros) +apply(auto simp add: LV_def) +apply(rule Prf.intros) apply(simp) -apply(rule CPrf.intros) +apply(rule Prf.intros) apply(simp_all) -by (metis (no_types, lifting) CV_def Posix_CV mem_Collect_eq) - +by (metis (no_types, lifting) LV_def Posix_LV mem_Collect_eq) +*) end \ No newline at end of file