--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys4/posix/BasicIdentities.thy Mon Aug 29 23:16:28 2022 +0100
@@ -0,0 +1,1203 @@
+theory BasicIdentities
+ imports "Lexer"
+begin
+
+datatype rrexp =
+ RZERO
+| RONE
+| RCHAR char
+| RSEQ rrexp rrexp
+| RALTS "rrexp list"
+| RSTAR rrexp
+| RNTIMES rrexp nat
+
+abbreviation
+ "RALT r1 r2 \<equiv> RALTS [r1, r2]"
+
+
+fun
+ rnullable :: "rrexp \<Rightarrow> bool"
+where
+ "rnullable (RZERO) = False"
+| "rnullable (RONE) = True"
+| "rnullable (RCHAR c) = False"
+| "rnullable (RALTS rs) = (\<exists>r \<in> set rs. rnullable r)"
+| "rnullable (RSEQ r1 r2) = (rnullable r1 \<and> rnullable r2)"
+| "rnullable (RSTAR r) = True"
+| "rnullable (RNTIMES r n) = (if n = 0 then True else rnullable r)"
+
+fun
+ rder :: "char \<Rightarrow> rrexp \<Rightarrow> rrexp"
+where
+ "rder c (RZERO) = RZERO"
+| "rder c (RONE) = RZERO"
+| "rder c (RCHAR d) = (if c = d then RONE else RZERO)"
+| "rder c (RALTS rs) = RALTS (map (rder c) rs)"
+| "rder c (RSEQ r1 r2) =
+ (if rnullable r1
+ then RALT (RSEQ (rder c r1) r2) (rder c r2)
+ else RSEQ (rder c r1) r2)"
+| "rder c (RSTAR r) = RSEQ (rder c r) (RSTAR r)"
+| "rder c (RNTIMES r n) = (if n = 0 then RZERO else RSEQ (rder c r) (RNTIMES r (n - 1)))"
+
+fun
+ rders :: "rrexp \<Rightarrow> string \<Rightarrow> rrexp"
+where
+ "rders r [] = r"
+| "rders r (c#s) = rders (rder c r) s"
+
+fun rdistinct :: "'a list \<Rightarrow>'a set \<Rightarrow> 'a list"
+ where
+ "rdistinct [] acc = []"
+| "rdistinct (x#xs) acc =
+ (if x \<in> acc then rdistinct xs acc
+ else x # (rdistinct xs ({x} \<union> acc)))"
+
+lemma rdistinct1:
+ assumes "a \<in> acc"
+ shows "a \<notin> set (rdistinct rs acc)"
+ using assms
+ apply(induct rs arbitrary: acc a)
+ apply(auto)
+ done
+
+
+lemma rdistinct_does_the_job:
+ shows "distinct (rdistinct rs s)"
+ apply(induct rs s rule: rdistinct.induct)
+ apply(auto simp add: rdistinct1)
+ done
+
+
+
+lemma rdistinct_concat:
+ assumes "set rs \<subseteq> rset"
+ shows "rdistinct (rs @ rsa) rset = rdistinct rsa rset"
+ using assms
+ apply(induct rs)
+ apply simp+
+ done
+
+lemma distinct_not_exist:
+ assumes "a \<notin> set rs"
+ shows "rdistinct rs rset = rdistinct rs (insert a rset)"
+ using assms
+ apply(induct rs arbitrary: rset)
+ apply(auto)
+ done
+
+lemma rdistinct_on_distinct:
+ shows "distinct rs \<Longrightarrow> rdistinct rs {} = rs"
+ apply(induct rs)
+ apply simp
+ using distinct_not_exist by fastforce
+
+lemma distinct_rdistinct_append:
+ assumes "distinct rs1" "\<forall>r \<in> set rs1. r \<notin> acc"
+ shows "rdistinct (rs1 @ rsa) acc = rs1 @ (rdistinct rsa (acc \<union> set rs1))"
+ using assms
+ apply(induct rs1 arbitrary: rsa acc)
+ apply(auto)[1]
+ apply(auto)[1]
+ apply(drule_tac x="rsa" in meta_spec)
+ apply(drule_tac x="{a} \<union> acc" in meta_spec)
+ apply(simp)
+ apply(drule meta_mp)
+ apply(auto)[1]
+ apply(simp)
+ done
+
+
+lemma rdistinct_set_equality1:
+ shows "set (rdistinct rs acc) = set rs - acc"
+ apply(induct rs acc rule: rdistinct.induct)
+ apply(auto)
+ done
+
+
+lemma rdistinct_set_equality:
+ shows "set (rdistinct rs {}) = set rs"
+ by (simp add: rdistinct_set_equality1)
+
+
+fun rflts :: "rrexp list \<Rightarrow> rrexp list"
+ where
+ "rflts [] = []"
+| "rflts (RZERO # rs) = rflts rs"
+| "rflts ((RALTS rs1) # rs) = rs1 @ rflts rs"
+| "rflts (r1 # rs) = r1 # rflts rs"
+
+
+lemma rflts_def_idiot:
+ shows "\<lbrakk> a \<noteq> RZERO; \<nexists>rs1. a = RALTS rs1\<rbrakk> \<Longrightarrow> rflts (a # rs) = a # rflts rs"
+ apply(case_tac a)
+ apply simp_all
+ done
+
+lemma rflts_def_idiot2:
+ shows "\<lbrakk>a \<noteq> RZERO; \<nexists>rs1. a = RALTS rs1; a \<in> set rs\<rbrakk> \<Longrightarrow> a \<in> set (rflts rs)"
+ apply(induct rs rule: rflts.induct)
+ apply(auto)
+ done
+
+lemma flts_append:
+ shows "rflts (rs1 @ rs2) = rflts rs1 @ rflts rs2"
+ apply(induct rs1)
+ apply simp
+ apply(case_tac a)
+ apply simp+
+ done
+
+
+fun rsimp_ALTs :: " rrexp list \<Rightarrow> rrexp"
+ where
+ "rsimp_ALTs [] = RZERO"
+| "rsimp_ALTs [r] = r"
+| "rsimp_ALTs rs = RALTS rs"
+
+lemma rsimpalts_conscons:
+ shows "rsimp_ALTs (r1 # rsa @ r2 # rsb) = RALTS (r1 # rsa @ r2 # rsb)"
+ by (metis Nil_is_append_conv list.exhaust rsimp_ALTs.simps(3))
+
+lemma rsimp_alts_equal:
+ shows "rsimp_ALTs (rsa @ a # rsb @ a # rsc) = RALTS (rsa @ a # rsb @ a # rsc) "
+ by (metis append_Cons append_Nil neq_Nil_conv rsimpalts_conscons)
+
+
+fun rsimp_SEQ :: " rrexp \<Rightarrow> rrexp \<Rightarrow> rrexp"
+ where
+ "rsimp_SEQ RZERO _ = RZERO"
+| "rsimp_SEQ _ RZERO = RZERO"
+| "rsimp_SEQ RONE r2 = r2"
+| "rsimp_SEQ r1 r2 = RSEQ r1 r2"
+
+
+fun rsimp :: "rrexp \<Rightarrow> rrexp"
+ where
+ "rsimp (RSEQ r1 r2) = rsimp_SEQ (rsimp r1) (rsimp r2)"
+| "rsimp (RALTS rs) = rsimp_ALTs (rdistinct (rflts (map rsimp rs)) {}) "
+| "rsimp r = r"
+
+
+fun
+ rders_simp :: "rrexp \<Rightarrow> string \<Rightarrow> rrexp"
+where
+ "rders_simp r [] = r"
+| "rders_simp r (c#s) = rders_simp (rsimp (rder c r)) s"
+
+fun rsize :: "rrexp \<Rightarrow> nat" where
+ "rsize RZERO = 1"
+| "rsize (RONE) = 1"
+| "rsize (RCHAR c) = 1"
+| "rsize (RALTS rs) = Suc (sum_list (map rsize rs))"
+| "rsize (RSEQ r1 r2) = Suc (rsize r1 + rsize r2)"
+| "rsize (RSTAR r) = Suc (rsize r)"
+| "rsize (RNTIMES r n) = Suc (rsize r) + n"
+
+abbreviation rsizes where
+ "rsizes rs \<equiv> sum_list (map rsize rs)"
+
+
+lemma rder_rsimp_ALTs_commute:
+ shows " (rder x (rsimp_ALTs rs)) = rsimp_ALTs (map (rder x) rs)"
+ apply(induct rs)
+ apply simp
+ apply(case_tac rs)
+ apply simp
+ apply auto
+ done
+
+
+lemma rsimp_aalts_smaller:
+ shows "rsize (rsimp_ALTs rs) \<le> rsize (RALTS rs)"
+ apply(induct rs)
+ apply simp
+ apply simp
+ apply(case_tac "rs = []")
+ apply simp
+ apply(subgoal_tac "\<exists>rsp ap. rs = ap # rsp")
+ apply(erule exE)+
+ apply simp
+ apply simp
+ by(meson neq_Nil_conv)
+
+
+
+
+
+lemma rSEQ_mono:
+ shows "rsize (rsimp_SEQ r1 r2) \<le>rsize (RSEQ r1 r2)"
+ apply auto
+ apply(induct r1)
+ apply auto
+ apply(case_tac "r2")
+ apply simp_all
+ apply(case_tac r2)
+ apply simp_all
+ apply(case_tac r2)
+ apply simp_all
+ apply(case_tac r2)
+ apply simp_all
+ apply(case_tac r2)
+ apply simp_all
+ apply(case_tac r2)
+ apply simp_all
+ done
+
+lemma ralts_cap_mono:
+ shows "rsize (RALTS rs) \<le> Suc (rsizes rs)"
+ by simp
+
+
+
+
+lemma rflts_mono:
+ shows "rsizes (rflts rs) \<le> rsizes rs"
+ apply(induct rs)
+ apply simp
+ apply(case_tac "a = RZERO")
+ apply simp
+ apply(case_tac "\<exists>rs1. a = RALTS rs1")
+ apply(erule exE)
+ apply simp
+ apply(subgoal_tac "rflts (a # rs) = a # (rflts rs)")
+ prefer 2
+
+ using rflts_def_idiot apply blast
+ apply simp
+ done
+
+lemma rdistinct_smaller:
+ shows "rsizes (rdistinct rs ss) \<le> rsizes rs"
+ apply (induct rs arbitrary: ss)
+ apply simp
+ by (simp add: trans_le_add2)
+
+
+lemma rsimp_alts_mono :
+ shows "\<And>x. (\<And>xa. xa \<in> set x \<Longrightarrow> rsize (rsimp xa) \<le> rsize xa) \<Longrightarrow>
+ rsize (rsimp_ALTs (rdistinct (rflts (map rsimp x)) {})) \<le> Suc (rsizes x)"
+ apply(subgoal_tac "rsize (rsimp_ALTs (rdistinct (rflts (map rsimp x)) {} ))
+ \<le> rsize (RALTS (rdistinct (rflts (map rsimp x)) {} ))")
+ prefer 2
+ using rsimp_aalts_smaller apply auto[1]
+ apply(subgoal_tac "rsize (RALTS (rdistinct (rflts (map rsimp x)) {})) \<le>Suc (rsizes (rdistinct (rflts (map rsimp x)) {}))")
+ prefer 2
+ using ralts_cap_mono apply blast
+ apply(subgoal_tac "rsizes (rdistinct (rflts (map rsimp x)) {}) \<le> rsizes (rflts (map rsimp x))")
+ prefer 2
+ using rdistinct_smaller apply presburger
+ apply(subgoal_tac "rsizes (rflts (map rsimp x)) \<le> rsizes (map rsimp x)")
+ prefer 2
+ using rflts_mono apply blast
+ apply(subgoal_tac "rsizes (map rsimp x) \<le> rsizes x")
+ prefer 2
+
+ apply (simp add: sum_list_mono)
+ by linarith
+
+
+
+
+
+lemma rsimp_mono:
+ shows "rsize (rsimp r) \<le> rsize r"
+ apply(induct r)
+ apply simp_all
+ apply(subgoal_tac "rsize (rsimp_SEQ (rsimp r1) (rsimp r2)) \<le> rsize (RSEQ (rsimp r1) (rsimp r2))")
+ apply force
+ using rSEQ_mono
+ apply presburger
+ using rsimp_alts_mono by auto
+
+lemma idiot:
+ shows "rsimp_SEQ RONE r = r"
+ apply(case_tac r)
+ apply simp_all
+ done
+
+
+
+
+
+lemma idiot2:
+ shows " \<lbrakk>r1 \<noteq> RZERO; r1 \<noteq> RONE;r2 \<noteq> RZERO\<rbrakk>
+ \<Longrightarrow> rsimp_SEQ r1 r2 = RSEQ r1 r2"
+ apply(case_tac r1)
+ apply(case_tac r2)
+ apply simp_all
+ apply(case_tac r2)
+ apply simp_all
+ apply(case_tac r2)
+ apply simp_all
+ apply(case_tac r2)
+ apply simp_all
+ apply(case_tac r2)
+ apply simp_all
+apply(case_tac r2)
+ apply simp_all
+ done
+
+lemma rders__onechar:
+ shows " (rders_simp r [c]) = (rsimp (rders r [c]))"
+ by simp
+
+lemma rders_append:
+ "rders c (s1 @ s2) = rders (rders c s1) s2"
+ apply(induct s1 arbitrary: c s2)
+ apply(simp_all)
+ done
+
+lemma rders_simp_append:
+ "rders_simp c (s1 @ s2) = rders_simp (rders_simp c s1) s2"
+ apply(induct s1 arbitrary: c s2)
+ apply(simp_all)
+ done
+
+
+lemma rders_simp_one_char:
+ shows "rders_simp r [c] = rsimp (rder c r)"
+ apply auto
+ done
+
+
+
+fun nonalt :: "rrexp \<Rightarrow> bool"
+ where
+ "nonalt (RALTS rs) = False"
+| "nonalt r = True"
+
+
+fun good :: "rrexp \<Rightarrow> bool" where
+ "good RZERO = False"
+| "good (RONE) = True"
+| "good (RCHAR c) = True"
+| "good (RALTS []) = False"
+| "good (RALTS [r]) = False"
+| "good (RALTS (r1 # r2 # rs)) = ((distinct ( (r1 # r2 # rs))) \<and>(\<forall>r' \<in> set (r1 # r2 # rs). good r' \<and> nonalt r'))"
+| "good (RSEQ RZERO _) = False"
+| "good (RSEQ RONE _) = False"
+| "good (RSEQ _ RZERO) = False"
+| "good (RSEQ r1 r2) = (good r1 \<and> good r2)"
+| "good (RSTAR r) = True"
+| "good (RNTIMES r n) = True"
+
+lemma k0a:
+ shows "rflts [RALTS rs] = rs"
+ apply(simp)
+ done
+
+lemma bbbbs:
+ assumes "good r" "r = RALTS rs"
+ shows "rsimp_ALTs (rflts [r]) = RALTS rs"
+ using assms
+ by (metis good.simps(4) good.simps(5) k0a rsimp_ALTs.elims)
+
+lemma bbbbs1:
+ shows "nonalt r \<or> (\<exists> rs. r = RALTS rs)"
+ by (meson nonalt.elims(3))
+
+
+
+lemma good0:
+ assumes "rs \<noteq> Nil" "\<forall>r \<in> set rs. nonalt r" "distinct rs"
+ shows "good (rsimp_ALTs rs) \<longleftrightarrow> (\<forall>r \<in> set rs. good r)"
+ using assms
+ apply(induct rs rule: rsimp_ALTs.induct)
+ apply(auto)
+ done
+
+lemma flts1:
+ assumes "good r"
+ shows "rflts [r] \<noteq> []"
+ using assms
+ apply(induct r)
+ apply(simp_all)
+ using good.simps(4) by blast
+
+lemma flts2:
+ assumes "good r"
+ shows "\<forall>r' \<in> set (rflts [r]). good r' \<and> nonalt r'"
+ using assms
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 2
+ apply(simp)
+ apply(auto)[1]
+
+ apply (metis flts1 good.simps(5) good.simps(6) k0a neq_Nil_conv)
+ apply (metis flts1 good.simps(5) good.simps(6) k0a neq_Nil_conv)
+ apply fastforce
+ apply(simp)
+ by simp
+
+
+lemma flts3:
+ assumes "\<forall>r \<in> set rs. good r \<or> r = RZERO"
+ shows "\<forall>r \<in> set (rflts rs). good r"
+ using assms
+ apply(induct rs arbitrary: rule: rflts.induct)
+ apply(simp_all)
+ by (metis UnE flts2 k0a)
+
+
+lemma k0:
+ shows "rflts (r # rs1) = rflts [r] @ rflts rs1"
+ apply(induct r arbitrary: rs1)
+ apply(auto)
+ done
+
+
+lemma good_SEQ:
+ assumes "r1 \<noteq> RZERO" "r2 \<noteq> RZERO" " r1 \<noteq> RONE"
+ shows "good (RSEQ r1 r2) = (good r1 \<and> good r2)"
+ using assms
+ apply(case_tac r1)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+apply(case_tac r2)
+ apply(simp_all)
+ done
+
+lemma rsize0:
+ shows "0 < rsize r"
+ apply(induct r)
+ apply(auto)
+ done
+
+
+fun nonnested :: "rrexp \<Rightarrow> bool"
+ where
+ "nonnested (RALTS []) = True"
+| "nonnested (RALTS ((RALTS rs1) # rs2)) = False"
+| "nonnested (RALTS (r # rs2)) = nonnested (RALTS rs2)"
+| "nonnested r = True"
+
+
+
+lemma k00:
+ shows "rflts (rs1 @ rs2) = rflts rs1 @ rflts rs2"
+ apply(induct rs1 arbitrary: rs2)
+ apply(auto)
+ by (metis append.assoc k0)
+
+
+
+
+lemma k0b:
+ assumes "nonalt r" "r \<noteq> RZERO"
+ shows "rflts [r] = [r]"
+ using assms
+ apply(case_tac r)
+ apply(simp_all)
+ done
+
+lemma nn1qq:
+ assumes "nonnested (RALTS rs)"
+ shows "\<nexists> rs1. RALTS rs1 \<in> set rs"
+ using assms
+ apply(induct rs rule: rflts.induct)
+ apply(auto)
+ done
+
+
+
+lemma n0:
+ shows "nonnested (RALTS rs) \<longleftrightarrow> (\<forall>r \<in> set rs. nonalt r)"
+ apply(induct rs )
+ apply(auto)
+ apply (metis list.set_intros(1) nn1qq nonalt.elims(3))
+ apply (metis nonalt.elims(2) nonnested.simps(3) nonnested.simps(4) nonnested.simps(5) nonnested.simps(6) nonnested.simps(7) nonnested.simps(8))
+ using bbbbs1 apply fastforce
+ by (metis bbbbs1 list.set_intros(2) nn1qq)
+
+
+
+
+lemma nn1c:
+ assumes "\<forall>r \<in> set rs. nonnested r"
+ shows "\<forall>r \<in> set (rflts rs). nonalt r"
+ using assms
+ apply(induct rs rule: rflts.induct)
+ apply(auto)
+ using n0 by blast
+
+lemma nn1bb:
+ assumes "\<forall>r \<in> set rs. nonalt r"
+ shows "nonnested (rsimp_ALTs rs)"
+ using assms
+ apply(induct rs rule: rsimp_ALTs.induct)
+ apply(auto)
+ using nonalt.simps(1) nonnested.elims(3) apply blast
+ using n0 by auto
+
+lemma bsimp_ASEQ0:
+ shows "rsimp_SEQ r1 RZERO = RZERO"
+ apply(induct r1)
+ apply(auto)
+ done
+
+lemma nn1b:
+ shows "nonnested (rsimp r)"
+ apply(induct r)
+ apply(simp_all)
+ apply(case_tac "rsimp r1 = RZERO")
+ apply(simp)
+ apply(case_tac "rsimp r2 = RZERO")
+ apply(simp)
+ apply(subst bsimp_ASEQ0)
+ apply(simp)
+ apply(case_tac "\<exists>bs. rsimp r1 = RONE")
+ apply(auto)[1]
+ using idiot apply fastforce
+ apply (simp add: idiot2)
+ by (metis (mono_tags, lifting) image_iff list.set_map nn1bb nn1c rdistinct_set_equality)
+
+lemma nonalt_flts_rd:
+ shows "\<lbrakk>xa \<in> set (rdistinct (rflts (map rsimp rs)) {})\<rbrakk>
+ \<Longrightarrow> nonalt xa"
+ by (metis Diff_empty ex_map_conv nn1b nn1c rdistinct_set_equality1)
+
+
+lemma rsimpalts_implies1:
+ shows " rsimp_ALTs (a # rdistinct rs {a}) = RZERO \<Longrightarrow> a = RZERO"
+ using rsimp_ALTs.elims by auto
+
+
+lemma rsimpalts_implies2:
+ shows "rsimp_ALTs (a # rdistinct rs rset) = RZERO \<Longrightarrow> rdistinct rs rset = []"
+ by (metis append_butlast_last_id rrexp.distinct(7) rsimpalts_conscons)
+
+lemma rsimpalts_implies21:
+ shows "rsimp_ALTs (a # rdistinct rs {a}) = RZERO \<Longrightarrow> rdistinct rs {a} = []"
+ using rsimpalts_implies2 by blast
+
+
+lemma bsimp_ASEQ2:
+ shows "rsimp_SEQ RONE r2 = r2"
+ apply(induct r2)
+ apply(auto)
+ done
+
+lemma elem_smaller_than_set:
+ shows "xa \<in> set list \<Longrightarrow> rsize xa < Suc (rsizes list)"
+ apply(induct list)
+ apply simp
+ by (metis image_eqI le_imp_less_Suc list.set_map member_le_sum_list)
+
+lemma rsimp_list_mono:
+ shows "rsizes (map rsimp rs) \<le> rsizes rs"
+ apply(induct rs)
+ apply simp+
+ by (simp add: add_mono_thms_linordered_semiring(1) rsimp_mono)
+
+
+(*says anything coming out of simp+flts+db will be good*)
+lemma good2_obv_simplified:
+ shows " \<lbrakk>\<forall>y. rsize y < Suc (rsizes rs) \<longrightarrow> good (rsimp y) \<or> rsimp y = RZERO;
+ xa \<in> set (rdistinct (rflts (map rsimp rs)) {}); good (rsimp xa) \<or> rsimp xa = RZERO\<rbrakk> \<Longrightarrow> good xa"
+ apply(subgoal_tac " \<forall>xa' \<in> set (map rsimp rs). good xa' \<or> xa' = RZERO")
+ prefer 2
+ apply (simp add: elem_smaller_than_set)
+ by (metis Diff_empty flts3 rdistinct_set_equality1)
+
+thm Diff_empty flts3 rdistinct_set_equality1
+
+lemma good1:
+ shows "good (rsimp a) \<or> rsimp a = RZERO"
+ apply(induct a taking: rsize rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ prefer 2
+ apply(simp only:)
+ apply simp
+ apply (smt (verit, ccfv_threshold) add_mono_thms_linordered_semiring(1) elem_smaller_than_set good0 good2_obv_simplified le_eq_less_or_eq nonalt_flts_rd order_less_trans plus_1_eq_Suc rdistinct_does_the_job rdistinct_smaller rflts_mono rsimp_ALTs.simps(1) rsimp_list_mono)
+ apply simp
+ apply(subgoal_tac "good (rsimp x41) \<or> rsimp x41 = RZERO")
+ apply(subgoal_tac "good (rsimp x42) \<or> rsimp x42 = RZERO")
+ apply(case_tac "rsimp x41 = RZERO")
+ apply simp
+ apply(case_tac "rsimp x42 = RZERO")
+ apply simp
+ using bsimp_ASEQ0 apply blast
+ apply(subgoal_tac "good (rsimp x41)")
+ apply(subgoal_tac "good (rsimp x42)")
+ apply simp
+ apply (metis bsimp_ASEQ2 good_SEQ idiot2)
+ apply blast
+ apply fastforce
+ using less_add_Suc2 apply blast
+ using less_iff_Suc_add apply blast
+ using good.simps(45) rsimp.simps(7) by presburger
+
+
+
+fun
+ RL :: "rrexp \<Rightarrow> string set"
+where
+ "RL (RZERO) = {}"
+| "RL (RONE) = {[]}"
+| "RL (RCHAR c) = {[c]}"
+| "RL (RSEQ r1 r2) = (RL r1) ;; (RL r2)"
+| "RL (RALTS rs) = (\<Union> (set (map RL rs)))"
+| "RL (RSTAR r) = (RL r)\<star>"
+| "RL (RNTIMES r n) = (RL r) ^^ n"
+
+lemma pow_rempty_iff:
+ shows "[] \<in> (RL r) ^^ n \<longleftrightarrow> (if n = 0 then True else [] \<in> (RL r))"
+ by (induct n) (auto simp add: Sequ_def)
+
+lemma RL_rnullable:
+ shows "rnullable r = ([] \<in> RL r)"
+ apply(induct r)
+ apply(auto simp add: Sequ_def pow_rempty_iff)
+ done
+
+lemma concI_if_Nil1: "[] \<in> A \<Longrightarrow> xs : B \<Longrightarrow> xs \<in> A ;; B"
+by (metis append_Nil concI)
+
+
+lemma empty_pow_add:
+ fixes A::"string set"
+ assumes "[] \<in> A" "s \<in> A ^^ n"
+ shows "s \<in> A ^^ (n + m)"
+ using assms
+ apply(induct m arbitrary: n)
+ apply(auto simp add: Sequ_def)
+ done
+
+(*
+lemma der_pow:
+ shows "Der c (A ^^ n) = (if n = 0 then {} else (Der c A) ;; (A ^^ (n - 1)))"
+ apply(induct n arbitrary: A)
+ apply(auto)
+ by (smt (verit, best) Suc_pred concE concI concI_if_Nil2 conc_pow_comm lang_pow.simps(2))
+*)
+
+lemma RL_rder:
+ shows "RL (rder c r) = Der c (RL r)"
+ apply(induct r)
+ apply(auto simp add: Sequ_def Der_def)[5]
+ apply (metis append_Cons)
+ using RL_rnullable apply blast
+ apply (metis append_eq_Cons_conv)
+ apply (metis append_Cons)
+ apply (metis RL_rnullable append_eq_Cons_conv)
+ apply simp
+ apply(simp)
+ done
+
+lemma RL_rsimp_RSEQ:
+ shows "RL (rsimp_SEQ r1 r2) = (RL r1 ;; RL r2)"
+ apply(induct r1 r2 rule: rsimp_SEQ.induct)
+ apply(simp_all)
+ done
+
+lemma RL_rsimp_RALTS:
+ shows "RL (rsimp_ALTs rs) = (\<Union> (set (map RL rs)))"
+ apply(induct rs rule: rsimp_ALTs.induct)
+ apply(simp_all)
+ done
+
+lemma RL_rsimp_rdistinct:
+ shows "(\<Union> (set (map RL (rdistinct rs {})))) = (\<Union> (set (map RL rs)))"
+ apply(auto)
+ apply (metis Diff_iff rdistinct_set_equality1)
+ by (metis Diff_empty rdistinct_set_equality1)
+
+lemma RL_rsimp_rflts:
+ shows "(\<Union> (set (map RL (rflts rs)))) = (\<Union> (set (map RL rs)))"
+ apply(induct rs rule: rflts.induct)
+ apply(simp_all)
+ done
+
+lemma RL_rsimp:
+ shows "RL r = RL (rsimp r)"
+ apply(induct r rule: rsimp.induct)
+ apply(auto simp add: Sequ_def RL_rsimp_RSEQ)
+ using RL_rsimp_RALTS RL_rsimp_rdistinct RL_rsimp_rflts apply auto[1]
+ by (smt (verit, del_insts) RL_rsimp_RALTS RL_rsimp_rdistinct RL_rsimp_rflts UN_E image_iff list.set_map)
+
+
+lemma qqq1:
+ shows "RZERO \<notin> set (rflts (map rsimp rs))"
+ by (metis ex_map_conv flts3 good.simps(1) good1)
+
+
+fun nonazero :: "rrexp \<Rightarrow> bool"
+ where
+ "nonazero RZERO = False"
+| "nonazero r = True"
+
+
+lemma flts_single1:
+ assumes "nonalt r" "nonazero r"
+ shows "rflts [r] = [r]"
+ using assms
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma nonalt0_flts_keeps:
+ shows "(a \<noteq> RZERO) \<and> (\<forall>rs. a \<noteq> RALTS rs) \<Longrightarrow> rflts (a # xs) = a # rflts xs"
+ apply(case_tac a)
+ apply simp+
+ done
+
+
+lemma nonalt0_fltseq:
+ shows "\<forall>r \<in> set rs. r \<noteq> RZERO \<and> nonalt r \<Longrightarrow> rflts rs = rs"
+ apply(induct rs)
+ apply simp
+ apply(case_tac "a = RZERO")
+ apply fastforce
+ apply(case_tac "\<exists>rs1. a = RALTS rs1")
+ apply(erule exE)
+ apply simp+
+ using nonalt0_flts_keeps by presburger
+
+
+
+
+lemma goodalts_nonalt:
+ shows "good (RALTS rs) \<Longrightarrow> rflts rs = rs"
+ apply(induct x == "RALTS rs" arbitrary: rs rule: good.induct)
+ apply simp
+
+ using good.simps(5) apply blast
+ apply simp
+ apply(case_tac "r1 = RZERO")
+ using good.simps(1) apply force
+ apply(case_tac "r2 = RZERO")
+ using good.simps(1) apply force
+ apply(subgoal_tac "rflts (r1 # r2 # rs) = r1 # r2 # rflts rs")
+ prefer 2
+ apply (metis nonalt.simps(1) rflts_def_idiot)
+ apply(subgoal_tac "\<forall>r \<in> set rs. r \<noteq> RZERO \<and> nonalt r")
+ apply(subgoal_tac "rflts rs = rs")
+ apply presburger
+ using nonalt0_fltseq apply presburger
+ using good.simps(1) by blast
+
+
+
+
+
+lemma test:
+ assumes "good r"
+ shows "rsimp r = r"
+
+ using assms
+ apply(induct rule: good.induct)
+ apply simp
+ apply simp
+ apply simp
+ apply simp
+ apply simp
+ apply(subgoal_tac "distinct (r1 # r2 # rs)")
+ prefer 2
+ using good.simps(6) apply blast
+ apply(subgoal_tac "rflts (r1 # r2 # rs ) = r1 # r2 # rs")
+ prefer 2
+ using goodalts_nonalt apply blast
+
+ apply(subgoal_tac "r1 \<noteq> r2")
+ prefer 2
+ apply (meson distinct_length_2_or_more)
+ apply(subgoal_tac "r1 \<notin> set rs")
+ apply(subgoal_tac "r2 \<notin> set rs")
+ apply(subgoal_tac "\<forall>r \<in> set rs. rsimp r = r")
+ apply(subgoal_tac "map rsimp rs = rs")
+ apply simp
+ apply(subgoal_tac "\<forall>r \<in> {r1, r2}. r \<notin> set rs")
+ apply (metis distinct_not_exist rdistinct_on_distinct)
+
+ apply blast
+ apply (meson map_idI)
+ apply (metis good.simps(6) insert_iff list.simps(15))
+
+ apply (meson distinct.simps(2))
+ apply (simp add: distinct_length_2_or_more)
+ apply simp+
+ done
+
+
+
+lemma rsimp_idem:
+ shows "rsimp (rsimp r) = rsimp r"
+ using test good1
+ by force
+
+corollary rsimp_inner_idem4:
+ shows "rsimp r = RALTS rs \<Longrightarrow> rflts rs = rs"
+ by (metis good1 goodalts_nonalt rrexp.simps(12))
+
+
+lemma head_one_more_simp:
+ shows "map rsimp (r # rs) = map rsimp (( rsimp r) # rs)"
+ by (simp add: rsimp_idem)
+
+
+lemma der_simp_nullability:
+ shows "rnullable r = rnullable (rsimp r)"
+ using RL_rnullable RL_rsimp by auto
+
+
+lemma no_alt_short_list_after_simp:
+ shows "RALTS rs = rsimp r \<Longrightarrow> rsimp_ALTs rs = RALTS rs"
+ by (metis bbbbs good1 k0a rrexp.simps(12))
+
+
+lemma no_further_dB_after_simp:
+ shows "RALTS rs = rsimp r \<Longrightarrow> rdistinct rs {} = rs"
+ apply(subgoal_tac "good (RALTS rs)")
+ apply(subgoal_tac "distinct rs")
+ using rdistinct_on_distinct apply blast
+ apply (metis distinct.simps(1) distinct.simps(2) empty_iff good.simps(6) list.exhaust set_empty2)
+ using good1 by fastforce
+
+
+lemma idem_after_simp1:
+ shows "rsimp_ALTs (rdistinct (rflts [rsimp aa]) {}) = rsimp aa"
+ apply(case_tac "rsimp aa")
+ apply simp+
+ apply (metis no_alt_short_list_after_simp no_further_dB_after_simp)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma identity_wwo0:
+ shows "rsimp (rsimp_ALTs (RZERO # rs)) = rsimp (rsimp_ALTs rs)"
+ apply (metis idem_after_simp1 list.exhaust list.simps(8) list.simps(9) rflts.simps(2) rsimp.simps(2) rsimp.simps(3) rsimp_ALTs.simps(1) rsimp_ALTs.simps(2) rsimp_ALTs.simps(3))
+ done
+
+lemma distinct_removes_last:
+ shows "\<lbrakk>a \<in> set as\<rbrakk>
+ \<Longrightarrow> rdistinct as rset = rdistinct (as @ [a]) rset"
+and "rdistinct (ab # as @ [ab]) rset1 = rdistinct (ab # as) rset1"
+ apply(induct as arbitrary: rset ab rset1 a)
+ apply simp
+ apply simp
+ apply(case_tac "aa \<in> rset")
+ apply(case_tac "a = aa")
+ apply (metis append_Cons)
+ apply simp
+ apply(case_tac "a \<in> set as")
+ apply (metis append_Cons rdistinct.simps(2) set_ConsD)
+ apply(case_tac "a = aa")
+ prefer 2
+ apply simp
+ apply (metis append_Cons)
+ apply(case_tac "ab \<in> rset1")
+ prefer 2
+ apply(subgoal_tac "rdistinct (ab # (a # as) @ [ab]) rset1 =
+ ab # (rdistinct ((a # as) @ [ab]) (insert ab rset1))")
+ prefer 2
+ apply force
+ apply(simp only:)
+ apply(subgoal_tac "rdistinct (ab # a # as) rset1 = ab # (rdistinct (a # as) (insert ab rset1))")
+ apply(simp only:)
+ apply(subgoal_tac "rdistinct ((a # as) @ [ab]) (insert ab rset1) = rdistinct (a # as) (insert ab rset1)")
+ apply blast
+ apply(case_tac "a \<in> insert ab rset1")
+ apply simp
+ apply (metis insertI1)
+ apply simp
+ apply (meson insertI1)
+ apply simp
+ apply(subgoal_tac "rdistinct ((a # as) @ [ab]) rset1 = rdistinct (a # as) rset1")
+ apply simp
+ by (metis append_Cons insert_iff insert_is_Un rdistinct.simps(2))
+
+
+lemma distinct_removes_middle:
+ shows "\<lbrakk>a \<in> set as\<rbrakk>
+ \<Longrightarrow> rdistinct (as @ as2) rset = rdistinct (as @ [a] @ as2) rset"
+and "rdistinct (ab # as @ [ab] @ as3) rset1 = rdistinct (ab # as @ as3) rset1"
+ apply(induct as arbitrary: rset rset1 ab as2 as3 a)
+ apply simp
+ apply simp
+ apply(case_tac "a \<in> rset")
+ apply simp
+ apply metis
+ apply simp
+ apply (metis insertI1)
+ apply(case_tac "a = ab")
+ apply simp
+ apply(case_tac "ab \<in> rset")
+ apply simp
+ apply presburger
+ apply (meson insertI1)
+ apply(case_tac "a \<in> rset")
+ apply (metis (no_types, opaque_lifting) Un_insert_left append_Cons insert_iff rdistinct.simps(2) sup_bot_left)
+ apply(case_tac "ab \<in> rset")
+ apply simp
+ apply (meson insert_iff)
+ apply simp
+ by (metis insertI1)
+
+
+lemma distinct_removes_middle3:
+ shows "\<lbrakk>a \<in> set as\<rbrakk>
+ \<Longrightarrow> rdistinct (as @ a #as2) rset = rdistinct (as @ as2) rset"
+ using distinct_removes_middle(1) by fastforce
+
+
+lemma distinct_removes_list:
+ shows "\<lbrakk> \<forall>r \<in> set rs. r \<in> set as\<rbrakk> \<Longrightarrow> rdistinct (as @ rs) {} = rdistinct as {}"
+ apply(induct rs)
+ apply simp+
+ apply(subgoal_tac "rdistinct (as @ a # rs) {} = rdistinct (as @ rs) {}")
+ prefer 2
+ apply (metis append_Cons append_Nil distinct_removes_middle(1))
+ by presburger
+
+
+lemma spawn_simp_rsimpalts:
+ shows "rsimp (rsimp_ALTs rs) = rsimp (rsimp_ALTs (map rsimp rs))"
+ apply(cases rs)
+ apply simp
+ apply(case_tac list)
+ apply simp
+ apply(subst rsimp_idem[symmetric])
+ apply simp
+ apply(subgoal_tac "rsimp_ALTs rs = RALTS rs")
+ apply(simp only:)
+ apply(subgoal_tac "rsimp_ALTs (map rsimp rs) = RALTS (map rsimp rs)")
+ apply(simp only:)
+ prefer 2
+ apply simp
+ prefer 2
+ using rsimp_ALTs.simps(3) apply presburger
+ apply auto
+ apply(subst rsimp_idem)+
+ by (metis comp_apply rsimp_idem)
+
+
+lemma simp_singlealt_flatten:
+ shows "rsimp (RALTS [RALTS rsa]) = rsimp (RALTS (rsa @ []))"
+ apply(induct rsa)
+ apply simp
+ apply simp
+ by (metis idem_after_simp1 list.simps(9) rsimp.simps(2))
+
+
+lemma good1_rsimpalts:
+ shows "rsimp r = RALTS rs \<Longrightarrow> rsimp_ALTs rs = RALTS rs"
+ by (metis no_alt_short_list_after_simp)
+
+
+
+
+lemma good1_flatten:
+ shows "\<lbrakk> rsimp r = (RALTS rs1)\<rbrakk>
+ \<Longrightarrow> rflts (rsimp_ALTs rs1 # map rsimp rsb) = rflts (rs1 @ map rsimp rsb)"
+ apply(subst good1_rsimpalts)
+ apply simp+
+ apply(subgoal_tac "rflts (rs1 @ map rsimp rsb) = rs1 @ rflts (map rsimp rsb)")
+ apply simp
+ using flts_append rsimp_inner_idem4 by presburger
+
+
+lemma flatten_rsimpalts:
+ shows "rflts (rsimp_ALTs (rdistinct (rflts (map rsimp rsa)) {}) # map rsimp rsb) =
+ rflts ( (rdistinct (rflts (map rsimp rsa)) {}) @ map rsimp rsb)"
+ apply(case_tac "map rsimp rsa")
+ apply simp
+ apply(case_tac "list")
+ apply simp
+ apply(case_tac a)
+ apply simp+
+ apply(rename_tac rs1)
+ apply (metis good1_flatten map_eq_Cons_D no_further_dB_after_simp)
+
+ apply simp
+
+ apply(subgoal_tac "\<forall>r \<in> set( rflts (map rsimp rsa)). good r")
+ apply(case_tac "rdistinct (rflts (map rsimp rsa)) {}")
+ apply simp
+ apply auto[1]
+ apply simp
+ apply(simp)
+ apply(case_tac "lista")
+ apply simp_all
+
+ apply (metis append_Cons append_Nil good1_flatten rflts.simps(2) rsimp.simps(2) rsimp_ALTs.elims)
+ by (metis (no_types, opaque_lifting) append_Cons append_Nil good1_flatten rflts.simps(2) rsimp.simps(2) rsimp_ALTs.elims)
+
+lemma last_elem_out:
+ shows "\<lbrakk>x \<notin> set xs; x \<notin> rset \<rbrakk> \<Longrightarrow> rdistinct (xs @ [x]) rset = rdistinct xs rset @ [x]"
+ apply(induct xs arbitrary: rset)
+ apply simp+
+ done
+
+
+
+
+lemma rdistinct_concat_general:
+ shows "rdistinct (rs1 @ rs2) {} = (rdistinct rs1 {}) @ (rdistinct rs2 (set rs1))"
+ apply(induct rs1 arbitrary: rs2 rule: rev_induct)
+ apply simp
+ apply(drule_tac x = "x # rs2" in meta_spec)
+ apply simp
+ apply(case_tac "x \<in> set xs")
+ apply simp
+
+ apply (simp add: distinct_removes_middle3 insert_absorb)
+ apply simp
+ by (simp add: last_elem_out)
+
+
+
+
+lemma distinct_once_enough:
+ shows "rdistinct (rs @ rsa) {} = rdistinct (rdistinct rs {} @ rsa) {}"
+ apply(subgoal_tac "distinct (rdistinct rs {})")
+ apply(subgoal_tac
+" rdistinct (rdistinct rs {} @ rsa) {} = rdistinct rs {} @ (rdistinct rsa (set rs))")
+ apply(simp only:)
+ using rdistinct_concat_general apply blast
+ apply (simp add: distinct_rdistinct_append rdistinct_set_equality1)
+ by (simp add: rdistinct_does_the_job)
+
+
+lemma simp_flatten:
+ shows "rsimp (RALTS ((RALTS rsa) # rsb)) = rsimp (RALTS (rsa @ rsb))"
+ apply simp
+ apply(subst flatten_rsimpalts)
+ apply(simp add: flts_append)
+ by (metis Diff_empty distinct_once_enough flts_append nonalt0_fltseq nonalt_flts_rd qqq1 rdistinct_set_equality1)
+
+lemma basic_rsimp_SEQ_property1:
+ shows "rsimp_SEQ RONE r = r"
+ by (simp add: idiot)
+
+
+
+lemma basic_rsimp_SEQ_property3:
+ shows "rsimp_SEQ r RZERO = RZERO"
+ using rsimp_SEQ.elims by blast
+
+
+
+fun vsuf :: "char list \<Rightarrow> rrexp \<Rightarrow> char list list" where
+"vsuf [] _ = []"
+|"vsuf (c#cs) r1 = (if (rnullable r1) then (vsuf cs (rder c r1)) @ [c # cs]
+ else (vsuf cs (rder c r1))
+ ) "
+
+
+
+
+
+
+fun star_update :: "char \<Rightarrow> rrexp \<Rightarrow> char list list \<Rightarrow> char list list" where
+"star_update c r [] = []"
+|"star_update c r (s # Ss) = (if (rnullable (rders r s))
+ then (s@[c]) # [c] # (star_update c r Ss)
+ else (s@[c]) # (star_update c r Ss) )"
+
+
+fun star_updates :: "char list \<Rightarrow> rrexp \<Rightarrow> char list list \<Rightarrow> char list list"
+ where
+"star_updates [] r Ss = Ss"
+| "star_updates (c # cs) r Ss = star_updates cs r (star_update c r Ss)"
+
+lemma stupdates_append: shows
+"star_updates (s @ [c]) r Ss = star_update c r (star_updates s r Ss)"
+ apply(induct s arbitrary: Ss)
+ apply simp
+ apply simp
+ done
+
+lemma flts_removes0:
+ shows " rflts (rs @ [RZERO]) =
+ rflts rs"
+ apply(induct rs)
+ apply simp
+ by (metis append_Cons rflts.simps(2) rflts.simps(3) rflts_def_idiot)
+
+
+lemma rflts_spills_last:
+ shows "rflts (rs1 @ [RALTS rs]) = rflts rs1 @ rs"
+ apply (induct rs1 rule: rflts.induct)
+ apply(auto)
+ done
+
+lemma flts_keeps1:
+ shows "rflts (rs @ [RONE]) = rflts rs @ [RONE]"
+ apply (induct rs rule: rflts.induct)
+ apply(auto)
+ done
+
+lemma flts_keeps_others:
+ shows "\<lbrakk>a \<noteq> RZERO; \<nexists>rs1. a = RALTS rs1\<rbrakk> \<Longrightarrow>rflts (rs @ [a]) = rflts rs @ [a]"
+ apply(induct rs rule: rflts.induct)
+ apply(auto)
+ by (meson k0b nonalt.elims(3))
+
+lemma spilled_alts_contained:
+ shows "\<lbrakk>a = RALTS rs ; a \<in> set rs1\<rbrakk> \<Longrightarrow> \<forall>r \<in> set rs. r \<in> set (rflts rs1)"
+ apply(induct rs1)
+ apply simp
+ apply(case_tac "a = aa")
+ apply simp
+ apply(subgoal_tac " a \<in> set rs1")
+ prefer 2
+ apply (meson set_ConsD)
+ apply(case_tac aa)
+ using rflts.simps(2) apply presburger
+ apply fastforce
+ apply fastforce
+ apply fastforce
+ apply fastforce
+ apply fastforce
+ by simp
+
+
+lemma distinct_removes_duplicate_flts:
+ shows " a \<in> set rsa
+ \<Longrightarrow> rdistinct (rflts (map rsimp rsa @ [rsimp a])) {} =
+ rdistinct (rflts (map rsimp rsa)) {}"
+ apply(subgoal_tac "rsimp a \<in> set (map rsimp rsa)")
+ prefer 2
+ apply simp
+ apply(induct "rsimp a")
+ apply simp
+ using flts_removes0 apply presburger
+ apply(subgoal_tac " rdistinct (rflts (map rsimp rsa @ [rsimp a])) {} =
+ rdistinct (rflts (map rsimp rsa @ [RONE])) {}")
+ apply (simp only:)
+ apply(subst flts_keeps1)
+ apply (metis distinct_removes_last(1) flts_append in_set_conv_decomp rflts.simps(4))
+ apply presburger
+ apply(subgoal_tac " rdistinct (rflts (map rsimp rsa @ [rsimp a])) {} =
+ rdistinct ((rflts (map rsimp rsa)) @ [RCHAR x]) {}")
+ apply (simp only:)
+ prefer 2
+ apply (metis flts_append rflts.simps(1) rflts.simps(5))
+ apply (metis distinct_removes_last(1) rflts_def_idiot2 rrexp.distinct(25) rrexp.distinct(3))
+ apply (metis distinct_removes_last(1) flts_append rflts.simps(1) rflts.simps(6) rflts_def_idiot2 rrexp.distinct(31) rrexp.distinct(5))
+ apply (metis distinct_removes_list rflts_spills_last spilled_alts_contained)
+ apply (metis distinct_removes_last(1) flts_append good.simps(1) good.simps(44) rflts.simps(1) rflts.simps(7) rflts_def_idiot2 rrexp.distinct(37))
+ by (metis distinct_removes_last(1) flts_append rflts.simps(1) rflts.simps(8) rflts_def_idiot2 rrexp.distinct(11) rrexp.distinct(39))
+
+(*some basic facts about rsimp*)
+
+unused_thms
+
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys4/posix/Blexer.thy Mon Aug 29 23:16:28 2022 +0100
@@ -0,0 +1,544 @@
+
+theory Blexer
+ imports "Lexer"
+begin
+
+section \<open>Bit-Encodings\<close>
+
+datatype bit = Z | S
+
+fun code :: "val \<Rightarrow> bit list"
+where
+ "code Void = []"
+| "code (Char c) = []"
+| "code (Left v) = Z # (code v)"
+| "code (Right v) = S # (code v)"
+| "code (Seq v1 v2) = (code v1) @ (code v2)"
+| "code (Stars []) = [S]"
+| "code (Stars (v # vs)) = (Z # code v) @ code (Stars vs)"
+
+fun sz where
+ "sz ZERO = 0"
+| "sz ONE = 0"
+| "sz (CH _) = 0"
+| "sz (SEQ r1 r2) = 1 + sz r1 + sz r2"
+| "sz (ALT r1 r2) = 1 + sz r1 + sz r2"
+| "sz (STAR r) = 1 + sz r"
+| "sz (NTIMES r n) = 1 + n + sz r"
+
+
+fun
+ Stars_add :: "val \<Rightarrow> val \<Rightarrow> val"
+where
+ "Stars_add v (Stars vs) = Stars (v # vs)"
+
+function (sequential)
+ decode' :: "bit list \<Rightarrow> rexp \<Rightarrow> (val * bit list)"
+where
+ "decode' bs ZERO = (undefined, bs)"
+| "decode' bs ONE = (Void, bs)"
+| "decode' bs (CH d) = (Char d, bs)"
+| "decode' [] (ALT r1 r2) = (Void, [])"
+| "decode' (Z # bs) (ALT r1 r2) = (let (v, bs') = decode' bs r1 in (Left v, bs'))"
+| "decode' (S # bs) (ALT r1 r2) = (let (v, bs') = decode' bs r2 in (Right v, bs'))"
+| "decode' bs (SEQ r1 r2) = (let (v1, bs') = decode' bs r1 in
+ let (v2, bs'') = decode' bs' r2 in (Seq v1 v2, bs''))"
+| "decode' [] (STAR r) = (Void, [])"
+| "decode' (S # bs) (STAR r) = (Stars [], bs)"
+| "decode' (Z # bs) (STAR r) = (let (v, bs') = decode' bs r in
+ let (vs, bs'') = decode' bs' (STAR r)
+ in (Stars_add v vs, bs''))"
+| "decode' [] (NTIMES r n) = (Void, [])"
+| "decode' (S # bs) (NTIMES r n) = (Stars [], bs)"
+(*| "decode' (Z # bs) (NTIMES r 0) = (undefined, bs)"*)
+| "decode' (Z # bs) (NTIMES r n) = (let (v, bs') = decode' bs r in
+ let (vs, bs'') = decode' bs' (NTIMES r (n - 1))
+ in (Stars_add v vs, bs''))"
+by pat_completeness auto
+
+lemma decode'_smaller:
+ assumes "decode'_dom (bs, r)"
+ shows "length (snd (decode' bs r)) \<le> length bs"
+using assms
+apply(induct bs r)
+apply(auto simp add: decode'.psimps split: prod.split)
+using dual_order.trans apply blast
+apply (meson dual_order.trans le_SucI)
+ apply (meson le_SucI le_trans)
+ done
+
+termination "decode'"
+apply(relation "inv_image (measure(%cs. sz cs) <*lex*> measure(%s. size s)) (%(ds,r). (r,ds))")
+apply(auto dest!: decode'_smaller)
+ apply (metis less_Suc_eq_le snd_conv)
+ by (metis less_Suc_eq_le snd_conv)
+
+definition
+ decode :: "bit list \<Rightarrow> rexp \<Rightarrow> val option"
+where
+ "decode ds r \<equiv> (let (v, ds') = decode' ds r
+ in (if ds' = [] then Some v else None))"
+
+lemma decode'_code_Stars:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> (\<forall>x. decode' (code v @ x) r = (v, x)) \<and> flat v \<noteq> []"
+ shows "decode' (code (Stars vs) @ ds) (STAR r) = (Stars vs, ds)"
+ using assms
+ apply(induct vs)
+ apply(auto)
+ done
+
+lemma decode'_code_NTIMES:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> (\<forall>x. decode' (code v @ x) r = (v, x))"
+ shows "decode' (code (Stars vs) @ ds) (NTIMES r n) = (Stars vs, ds)"
+ using assms
+ apply(induct vs arbitrary: n r ds)
+ apply(auto)
+ done
+
+
+lemma decode'_code:
+ assumes "\<Turnstile> v : r"
+ shows "decode' ((code v) @ ds) r = (v, ds)"
+using assms
+ apply(induct v r arbitrary: ds)
+ apply(auto)
+ using decode'_code_Stars apply blast
+ by (metis Un_iff decode'_code_NTIMES set_append)
+
+lemma decode_code:
+ assumes "\<Turnstile> v : r"
+ shows "decode (code v) r = Some v"
+ using assms unfolding decode_def
+ by (smt append_Nil2 decode'_code old.prod.case)
+
+
+section {* Annotated Regular Expressions *}
+
+datatype arexp =
+ AZERO
+| AONE "bit list"
+| ACHAR "bit list" char
+| ASEQ "bit list" arexp arexp
+| AALTs "bit list" "arexp list"
+| ASTAR "bit list" arexp
+| ANTIMES "bit list" arexp nat
+
+abbreviation
+ "AALT bs r1 r2 \<equiv> AALTs bs [r1, r2]"
+
+fun asize :: "arexp \<Rightarrow> nat" where
+ "asize AZERO = 1"
+| "asize (AONE cs) = 1"
+| "asize (ACHAR cs c) = 1"
+| "asize (AALTs cs rs) = Suc (sum_list (map asize rs))"
+| "asize (ASEQ cs r1 r2) = Suc (asize r1 + asize r2)"
+| "asize (ASTAR cs r) = Suc (asize r)"
+| "asize (ANTIMES cs r n) = Suc (asize r) + n"
+
+fun
+ erase :: "arexp \<Rightarrow> rexp"
+where
+ "erase AZERO = ZERO"
+| "erase (AONE _) = ONE"
+| "erase (ACHAR _ c) = CH c"
+| "erase (AALTs _ []) = ZERO"
+| "erase (AALTs _ [r]) = (erase r)"
+| "erase (AALTs bs (r#rs)) = ALT (erase r) (erase (AALTs bs rs))"
+| "erase (ASEQ _ r1 r2) = SEQ (erase r1) (erase r2)"
+| "erase (ASTAR _ r) = STAR (erase r)"
+| "erase (ANTIMES _ r n) = NTIMES (erase r) n"
+
+
+fun fuse :: "bit list \<Rightarrow> arexp \<Rightarrow> arexp" where
+ "fuse bs AZERO = AZERO"
+| "fuse bs (AONE cs) = AONE (bs @ cs)"
+| "fuse bs (ACHAR cs c) = ACHAR (bs @ cs) c"
+| "fuse bs (AALTs cs rs) = AALTs (bs @ cs) rs"
+| "fuse bs (ASEQ cs r1 r2) = ASEQ (bs @ cs) r1 r2"
+| "fuse bs (ASTAR cs r) = ASTAR (bs @ cs) r"
+| "fuse bs (ANTIMES cs r n) = ANTIMES (bs @ cs) r n"
+
+lemma fuse_append:
+ shows "fuse (bs1 @ bs2) r = fuse bs1 (fuse bs2 r)"
+ apply(induct r)
+ apply(auto)
+ done
+
+
+fun intern :: "rexp \<Rightarrow> arexp" where
+ "intern ZERO = AZERO"
+| "intern ONE = AONE []"
+| "intern (CH c) = ACHAR [] c"
+| "intern (ALT r1 r2) = AALT [] (fuse [Z] (intern r1))
+ (fuse [S] (intern r2))"
+| "intern (SEQ r1 r2) = ASEQ [] (intern r1) (intern r2)"
+| "intern (STAR r) = ASTAR [] (intern r)"
+| "intern (NTIMES r n) = ANTIMES [] (intern r) n"
+
+
+fun retrieve :: "arexp \<Rightarrow> val \<Rightarrow> bit list" where
+ "retrieve (AONE bs) Void = bs"
+| "retrieve (ACHAR bs c) (Char d) = bs"
+| "retrieve (AALTs bs [r]) v = bs @ retrieve r v"
+| "retrieve (AALTs bs (r#rs)) (Left v) = bs @ retrieve r v"
+| "retrieve (AALTs bs (r#rs)) (Right v) = bs @ retrieve (AALTs [] rs) v"
+| "retrieve (ASEQ bs r1 r2) (Seq v1 v2) = bs @ retrieve r1 v1 @ retrieve r2 v2"
+| "retrieve (ASTAR bs r) (Stars []) = bs @ [S]"
+| "retrieve (ASTAR bs r) (Stars (v#vs)) =
+ bs @ [Z] @ retrieve r v @ retrieve (ASTAR [] r) (Stars vs)"
+| "retrieve (ANTIMES bs r 0) (Stars []) = bs @ [S]"
+| "retrieve (ANTIMES bs r (Suc n)) (Stars (v#vs)) =
+ bs @ [Z] @ retrieve r v @ retrieve (ANTIMES [] r n) (Stars vs)"
+
+
+fun
+ bnullable :: "arexp \<Rightarrow> bool"
+where
+ "bnullable (AZERO) = False"
+| "bnullable (AONE bs) = True"
+| "bnullable (ACHAR bs c) = False"
+| "bnullable (AALTs bs rs) = (\<exists>r \<in> set rs. bnullable r)"
+| "bnullable (ASEQ bs r1 r2) = (bnullable r1 \<and> bnullable r2)"
+| "bnullable (ASTAR bs r) = True"
+| "bnullable (ANTIMES bs r n) = (if n = 0 then True else bnullable r)"
+
+abbreviation
+ bnullables :: "arexp list \<Rightarrow> bool"
+where
+ "bnullables rs \<equiv> (\<exists>r \<in> set rs. bnullable r)"
+
+function (sequential)
+ bmkeps :: "arexp \<Rightarrow> bit list"
+where
+ "bmkeps(AONE bs) = bs"
+| "bmkeps(ASEQ bs r1 r2) = bs @ (bmkeps r1) @ (bmkeps r2)"
+| "bmkeps(AALTs bs (r#rs)) =
+ (if bnullable(r) then (bs @ bmkeps r) else (bmkeps (AALTs bs rs)))"
+| "bmkeps(ASTAR bs r) = bs @ [S]"
+| "bmkeps(ANTIMES bs r 0) = bs @ [S]"
+| "bmkeps(ANTIMES bs r (Suc n)) = bs @ [Z] @ (bmkeps r) @ bmkeps(ANTIMES [] r n)"
+apply(pat_completeness)
+apply(auto)
+done
+
+termination "bmkeps"
+apply(relation "measure asize")
+ apply(auto)
+ using asize.elims by force
+
+fun
+ bmkepss :: "arexp list \<Rightarrow> bit list"
+where
+ "bmkepss (r # rs) = (if bnullable(r) then (bmkeps r) else (bmkepss rs))"
+
+
+lemma bmkepss1:
+ assumes "\<not> bnullables rs1"
+ shows "bmkepss (rs1 @ rs2) = bmkepss rs2"
+ using assms
+ by(induct rs1) (auto)
+
+
+lemma bmkepss2:
+ assumes "bnullables rs1"
+ shows "bmkepss (rs1 @ rs2) = bmkepss rs1"
+ using assms
+ by (induct rs1) (auto)
+
+
+fun
+ bder :: "char \<Rightarrow> arexp \<Rightarrow> arexp"
+where
+ "bder c (AZERO) = AZERO"
+| "bder c (AONE bs) = AZERO"
+| "bder c (ACHAR bs d) = (if c = d then AONE bs else AZERO)"
+| "bder c (AALTs bs rs) = AALTs bs (map (bder c) rs)"
+| "bder c (ASEQ bs r1 r2) =
+ (if bnullable r1
+ then AALT bs (ASEQ [] (bder c r1) r2) (fuse (bmkeps r1) (bder c r2))
+ else ASEQ bs (bder c r1) r2)"
+| "bder c (ASTAR bs r) = ASEQ (bs @ [Z]) (bder c r) (ASTAR [] r)"
+| "bder c (ANTIMES bs r n) = (if n = 0 then AZERO else ASEQ (bs @ [Z]) (bder c r) (ANTIMES [] r (n - 1)))"
+
+fun
+ bders :: "arexp \<Rightarrow> string \<Rightarrow> arexp"
+where
+ "bders r [] = r"
+| "bders r (c#s) = bders (bder c r) s"
+
+lemma bders_append:
+ "bders c (s1 @ s2) = bders (bders c s1) s2"
+ apply(induct s1 arbitrary: c s2)
+ apply(simp_all)
+ done
+
+lemma bnullable_correctness:
+ shows "nullable (erase r) = bnullable r"
+ apply(induct r rule: erase.induct)
+ apply(simp_all)
+ done
+
+lemma erase_fuse:
+ shows "erase (fuse bs r) = erase r"
+ apply(induct r rule: erase.induct)
+ apply(simp_all)
+ done
+
+lemma erase_intern [simp]:
+ shows "erase (intern r) = r"
+ apply(induct r)
+ apply(simp_all add: erase_fuse)
+ done
+
+lemma erase_bder [simp]:
+ shows "erase (bder a r) = der a (erase r)"
+ apply(induct r rule: erase.induct)
+ apply(simp_all add: erase_fuse bnullable_correctness)
+ done
+
+lemma erase_bders [simp]:
+ shows "erase (bders r s) = ders s (erase r)"
+ apply(induct s arbitrary: r )
+ apply(simp_all)
+ done
+
+lemma bnullable_fuse:
+ shows "bnullable (fuse bs r) = bnullable r"
+ apply(induct r arbitrary: bs)
+ apply(auto)
+ done
+
+lemma retrieve_encode_STARS:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> code v = retrieve (intern r) v"
+ shows "code (Stars vs) = retrieve (ASTAR [] (intern r)) (Stars vs)"
+ using assms
+ apply(induct vs)
+ apply(simp_all)
+ done
+
+lemma retrieve_encode_NTIMES:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> code v = retrieve (intern r) v" "length vs = n"
+ shows "code (Stars vs) = retrieve (ANTIMES [] (intern r) n) (Stars vs)"
+ using assms
+ apply(induct vs arbitrary: n)
+ apply(simp_all)
+ by force
+
+
+lemma retrieve_fuse2:
+ assumes "\<Turnstile> v : (erase r)"
+ shows "retrieve (fuse bs r) v = bs @ retrieve r v"
+ using assms
+ apply(induct r arbitrary: v bs)
+ apply(auto elim: Prf_elims)[4]
+ apply(case_tac x2a)
+ apply(simp)
+ using Prf_elims(1) apply blast
+ apply(case_tac x2a)
+ apply(simp)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply (smt (verit, best) Prf_elims(3) append_assoc retrieve.simps(4) retrieve.simps(5))
+ apply(simp)
+ using retrieve_encode_STARS
+ apply(auto elim!: Prf_elims)[1]
+ apply(case_tac vs)
+ apply(simp)
+ apply(simp)
+ (* NTIMES *)
+ apply(auto elim!: Prf_elims)[1]
+ apply(case_tac vs1)
+ apply(simp_all)
+ apply(case_tac vs2)
+ apply(simp_all)
+ done
+
+lemma retrieve_fuse:
+ assumes "\<Turnstile> v : r"
+ shows "retrieve (fuse bs (intern r)) v = bs @ retrieve (intern r) v"
+ using assms
+ by (simp_all add: retrieve_fuse2)
+
+
+lemma retrieve_code:
+ assumes "\<Turnstile> v : r"
+ shows "code v = retrieve (intern r) v"
+ using assms
+ apply(induct v r )
+ apply(simp_all add: retrieve_fuse retrieve_encode_STARS)
+ apply(subst retrieve_encode_NTIMES)
+ apply(auto)
+ done
+
+
+
+lemma retrieve_AALTs_bnullable1:
+ assumes "bnullable r"
+ shows "retrieve (AALTs bs (r # rs)) (mkeps (erase (AALTs bs (r # rs))))
+ = bs @ retrieve r (mkeps (erase r))"
+ using assms
+ apply(case_tac rs)
+ apply(auto simp add: bnullable_correctness)
+ done
+
+lemma retrieve_AALTs_bnullable2:
+ assumes "\<not>bnullable r" "bnullables rs"
+ shows "retrieve (AALTs bs (r # rs)) (mkeps (erase (AALTs bs (r # rs))))
+ = retrieve (AALTs bs rs) (mkeps (erase (AALTs bs rs)))"
+ using assms
+ apply(induct rs arbitrary: r bs)
+ apply(auto)
+ using bnullable_correctness apply blast
+ apply(case_tac rs)
+ apply(auto)
+ using bnullable_correctness apply blast
+ apply(case_tac rs)
+ apply(auto)
+ done
+
+lemma bmkeps_retrieve_AALTs:
+ assumes "\<forall>r \<in> set rs. bnullable r \<longrightarrow> bmkeps r = retrieve r (mkeps (erase r))"
+ "bnullables rs"
+ shows "bs @ bmkepss rs = retrieve (AALTs bs rs) (mkeps (erase (AALTs bs rs)))"
+ using assms
+ apply(induct rs arbitrary: bs)
+ apply(auto)
+ using retrieve_AALTs_bnullable1 apply presburger
+ apply (metis retrieve_AALTs_bnullable2)
+ apply (simp add: retrieve_AALTs_bnullable1)
+ by (metis retrieve_AALTs_bnullable2)
+
+lemma bmkeps_retrieve_ANTIMES:
+ assumes "if n = 0 then True else bmkeps r = retrieve r (mkeps (erase r))"
+ and "bnullable (ANTIMES bs r n)"
+ shows "bmkeps (ANTIMES bs r n) = retrieve (ANTIMES bs r n) (Stars (replicate n (mkeps (erase r))))"
+ using assms
+ apply(induct n arbitrary: r bs)
+ apply(auto)[1]
+ apply(simp)
+ done
+
+lemma bmkeps_retrieve:
+ assumes "bnullable r"
+ shows "bmkeps r = retrieve r (mkeps (erase r))"
+ using assms
+ apply(induct r rule: bmkeps.induct)
+ apply(auto)
+ apply (simp add: retrieve_AALTs_bnullable1)
+ using retrieve_AALTs_bnullable1 apply force
+ by (metis retrieve_AALTs_bnullable2)
+
+
+lemma bder_retrieve:
+ assumes "\<Turnstile> v : der c (erase r)"
+ shows "retrieve (bder c r) v = retrieve r (injval (erase r) c v)"
+ using assms
+ apply(induct r arbitrary: v rule: erase.induct)
+ using Prf_elims(1) apply auto[1]
+ using Prf_elims(1) apply auto[1]
+ apply(auto)[1]
+ apply (metis Prf_elims(4) injval.simps(1) retrieve.simps(1) retrieve.simps(2))
+ using Prf_elims(1) apply blast
+ (* AALTs case *)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(simp)
+ apply(rename_tac "r\<^sub>1" "r\<^sub>2" rs v)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp)
+ apply(simp)
+ using Prf_elims(3) apply fastforce
+ (* ASEQ case *)
+ apply(simp)
+ apply(case_tac "nullable (erase r1)")
+ apply(simp)
+ apply(erule Prf_elims)
+ using Prf_elims(2) bnullable_correctness apply force
+ apply (simp add: bmkeps_retrieve bnullable_correctness retrieve_fuse2)
+ apply (simp add: bmkeps_retrieve bnullable_correctness retrieve_fuse2)
+ using Prf_elims(2) apply force
+ (* ASTAR case *)
+ apply(rename_tac bs r v)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(clarify)
+ apply(erule Prf_elims)
+ apply(clarify)
+ apply (simp add: retrieve_fuse2)
+ (* ANTIMES case *)
+ apply(auto)
+ apply(erule Prf_elims)
+ apply(erule Prf_elims)
+ apply(clarify)
+ apply(erule Prf_elims)
+ apply(clarify)
+ by (metis (full_types) Suc_pred append_assoc injval.simps(8) retrieve.simps(10) retrieve.simps(6))
+
+
+lemma MAIN_decode:
+ assumes "\<Turnstile> v : ders s r"
+ shows "Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r"
+ using assms
+proof (induct s arbitrary: v rule: rev_induct)
+ case Nil
+ have "\<Turnstile> v : ders [] r" by fact
+ then have "\<Turnstile> v : r" by simp
+ then have "Some v = decode (retrieve (intern r) v) r"
+ using decode_code retrieve_code by auto
+ then show "Some (flex r id [] v) = decode (retrieve (bders (intern r) []) v) r"
+ by simp
+next
+ case (snoc c s v)
+ have IH: "\<And>v. \<Turnstile> v : ders s r \<Longrightarrow>
+ Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r" by fact
+ have asm: "\<Turnstile> v : ders (s @ [c]) r" by fact
+ then have asm2: "\<Turnstile> injval (ders s r) c v : ders s r"
+ by (simp add: Prf_injval ders_append)
+ have "Some (flex r id (s @ [c]) v) = Some (flex r id s (injval (ders s r) c v))"
+ by (simp add: flex_append)
+ also have "... = decode (retrieve (bders (intern r) s) (injval (ders s r) c v)) r"
+ using asm2 IH by simp
+ also have "... = decode (retrieve (bder c (bders (intern r) s)) v) r"
+ using asm by (simp_all add: bder_retrieve ders_append)
+ finally show "Some (flex r id (s @ [c]) v) =
+ decode (retrieve (bders (intern r) (s @ [c])) v) r" by (simp add: bders_append)
+qed
+
+definition blexer where
+ "blexer r s \<equiv> if bnullable (bders (intern r) s) then
+ decode (bmkeps (bders (intern r) s)) r else None"
+
+lemma blexer_correctness:
+ shows "blexer r s = lexer r s"
+proof -
+ { define bds where "bds \<equiv> bders (intern r) s"
+ define ds where "ds \<equiv> ders s r"
+ assume asm: "nullable ds"
+ have era: "erase bds = ds"
+ unfolding ds_def bds_def by simp
+ have mke: "\<Turnstile> mkeps ds : ds"
+ using asm by (simp add: mkeps_nullable)
+ have "decode (bmkeps bds) r = decode (retrieve bds (mkeps ds)) r"
+ using bmkeps_retrieve
+ using asm era
+ using bnullable_correctness by force
+ also have "... = Some (flex r id s (mkeps ds))"
+ using mke by (simp_all add: MAIN_decode ds_def bds_def)
+ finally have "decode (bmkeps bds) r = Some (flex r id s (mkeps ds))"
+ unfolding bds_def ds_def .
+ }
+ then show "blexer r s = lexer r s"
+ unfolding blexer_def lexer_flex
+ by (auto simp add: bnullable_correctness[symmetric])
+qed
+
+
+unused_thms
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys4/posix/BlexerSimp.thy Mon Aug 29 23:16:28 2022 +0100
@@ -0,0 +1,635 @@
+theory BlexerSimp
+ imports Blexer
+begin
+
+fun distinctWith :: "'a list \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> 'a list"
+ where
+ "distinctWith [] eq acc = []"
+| "distinctWith (x # xs) eq acc =
+ (if (\<exists> y \<in> acc. eq x y) then distinctWith xs eq acc
+ else x # (distinctWith xs eq ({x} \<union> acc)))"
+
+
+fun eq1 ("_ ~1 _" [80, 80] 80) where
+ "AZERO ~1 AZERO = True"
+| "(AONE bs1) ~1 (AONE bs2) = True"
+| "(ACHAR bs1 c) ~1 (ACHAR bs2 d) = (if c = d then True else False)"
+| "(ASEQ bs1 ra1 ra2) ~1 (ASEQ bs2 rb1 rb2) = (ra1 ~1 rb1 \<and> ra2 ~1 rb2)"
+| "(AALTs bs1 []) ~1 (AALTs bs2 []) = True"
+| "(AALTs bs1 (r1 # rs1)) ~1 (AALTs bs2 (r2 # rs2)) = (r1 ~1 r2 \<and> (AALTs bs1 rs1) ~1 (AALTs bs2 rs2))"
+| "(ASTAR bs1 r1) ~1 (ASTAR bs2 r2) = r1 ~1 r2"
+| "(ANTIMES bs1 r1 n1) ~1 (ANTIMES bs2 r2 n2) = (r1 ~1 r2 \<and> n1 = n2)"
+| "_ ~1 _ = False"
+
+
+
+lemma eq1_L:
+ assumes "x ~1 y"
+ shows "L (erase x) = L (erase y)"
+ using assms
+ apply(induct rule: eq1.induct)
+ apply(auto elim: eq1.elims)
+ apply presburger
+ done
+
+fun flts :: "arexp list \<Rightarrow> arexp list"
+ where
+ "flts [] = []"
+| "flts (AZERO # rs) = flts rs"
+| "flts ((AALTs bs rs1) # rs) = (map (fuse bs) rs1) @ flts rs"
+| "flts (r1 # rs) = r1 # flts rs"
+
+
+
+fun bsimp_ASEQ :: "bit list \<Rightarrow> arexp \<Rightarrow> arexp \<Rightarrow> arexp"
+ where
+ "bsimp_ASEQ _ AZERO _ = AZERO"
+| "bsimp_ASEQ _ _ AZERO = AZERO"
+| "bsimp_ASEQ bs1 (AONE bs2) r2 = fuse (bs1 @ bs2) r2"
+| "bsimp_ASEQ bs1 r1 r2 = ASEQ bs1 r1 r2"
+
+lemma bsimp_ASEQ0[simp]:
+ shows "bsimp_ASEQ bs r1 AZERO = AZERO"
+ by (case_tac r1)(simp_all)
+
+lemma bsimp_ASEQ1:
+ assumes "r1 \<noteq> AZERO" "r2 \<noteq> AZERO" "\<nexists>bs. r1 = AONE bs"
+ shows "bsimp_ASEQ bs r1 r2 = ASEQ bs r1 r2"
+ using assms
+ apply(induct bs r1 r2 rule: bsimp_ASEQ.induct)
+ apply(auto)
+ done
+
+lemma bsimp_ASEQ2[simp]:
+ shows "bsimp_ASEQ bs1 (AONE bs2) r2 = fuse (bs1 @ bs2) r2"
+ by (case_tac r2) (simp_all)
+
+
+fun bsimp_AALTs :: "bit list \<Rightarrow> arexp list \<Rightarrow> arexp"
+ where
+ "bsimp_AALTs _ [] = AZERO"
+| "bsimp_AALTs bs1 [r] = fuse bs1 r"
+| "bsimp_AALTs bs1 rs = AALTs bs1 rs"
+
+
+
+
+fun bsimp :: "arexp \<Rightarrow> arexp"
+ where
+ "bsimp (ASEQ bs1 r1 r2) = bsimp_ASEQ bs1 (bsimp r1) (bsimp r2)"
+| "bsimp (AALTs bs1 rs) = bsimp_AALTs bs1 (distinctWith (flts (map bsimp rs)) eq1 {}) "
+| "bsimp r = r"
+
+
+fun
+ bders_simp :: "arexp \<Rightarrow> string \<Rightarrow> arexp"
+where
+ "bders_simp r [] = r"
+| "bders_simp r (c # s) = bders_simp (bsimp (bder c r)) s"
+
+definition blexer_simp where
+ "blexer_simp r s \<equiv> if bnullable (bders_simp (intern r) s) then
+ decode (bmkeps (bders_simp (intern r) s)) r else None"
+
+
+
+lemma bders_simp_append:
+ shows "bders_simp r (s1 @ s2) = bders_simp (bders_simp r s1) s2"
+ apply(induct s1 arbitrary: r s2)
+ apply(simp_all)
+ done
+
+lemma bmkeps_fuse:
+ assumes "bnullable r"
+ shows "bmkeps (fuse bs r) = bs @ bmkeps r"
+ using assms
+ apply(induct r rule: bnullable.induct)
+ apply(auto)
+ apply (metis append.assoc bmkeps_retrieve bmkeps_retrieve_AALTs bnullable.simps(4))
+ apply(case_tac n)
+ apply(auto)
+ done
+
+lemma bmkepss_fuse:
+ assumes "bnullables rs"
+ shows "bmkepss (map (fuse bs) rs) = bs @ bmkepss rs"
+ using assms
+ apply(induct rs arbitrary: bs)
+ apply(auto simp add: bmkeps_fuse bnullable_fuse)
+ done
+
+lemma bder_fuse:
+ shows "bder c (fuse bs a) = fuse bs (bder c a)"
+ apply(induct a arbitrary: bs c)
+ apply(simp_all)
+ done
+
+
+
+
+inductive
+ rrewrite:: "arexp \<Rightarrow> arexp \<Rightarrow> bool" ("_ \<leadsto> _" [99, 99] 99)
+and
+ srewrite:: "arexp list \<Rightarrow> arexp list \<Rightarrow> bool" (" _ s\<leadsto> _" [100, 100] 100)
+where
+ bs1: "ASEQ bs AZERO r2 \<leadsto> AZERO"
+| bs2: "ASEQ bs r1 AZERO \<leadsto> AZERO"
+| bs3: "ASEQ bs1 (AONE bs2) r \<leadsto> fuse (bs1@bs2) r"
+| bs4: "r1 \<leadsto> r2 \<Longrightarrow> ASEQ bs r1 r3 \<leadsto> ASEQ bs r2 r3"
+| bs5: "r3 \<leadsto> r4 \<Longrightarrow> ASEQ bs r1 r3 \<leadsto> ASEQ bs r1 r4"
+| bs6: "AALTs bs [] \<leadsto> AZERO"
+| bs7: "AALTs bs [r] \<leadsto> fuse bs r"
+| bs10: "rs1 s\<leadsto> rs2 \<Longrightarrow> AALTs bs rs1 \<leadsto> AALTs bs rs2"
+| ss1: "[] s\<leadsto> []"
+| ss2: "rs1 s\<leadsto> rs2 \<Longrightarrow> (r # rs1) s\<leadsto> (r # rs2)"
+| ss3: "r1 \<leadsto> r2 \<Longrightarrow> (r1 # rs) s\<leadsto> (r2 # rs)"
+| ss4: "(AZERO # rs) s\<leadsto> rs"
+| ss5: "(AALTs bs1 rs1 # rsb) s\<leadsto> ((map (fuse bs1) rs1) @ rsb)"
+| ss6: "L (erase a2) \<subseteq> L (erase a1) \<Longrightarrow> (rsa@[a1]@rsb@[a2]@rsc) s\<leadsto> (rsa@[a1]@rsb@rsc)"
+
+
+inductive
+ rrewrites:: "arexp \<Rightarrow> arexp \<Rightarrow> bool" ("_ \<leadsto>* _" [100, 100] 100)
+where
+ rs1[intro, simp]:"r \<leadsto>* r"
+| rs2[intro]: "\<lbrakk>r1 \<leadsto>* r2; r2 \<leadsto> r3\<rbrakk> \<Longrightarrow> r1 \<leadsto>* r3"
+
+inductive
+ srewrites:: "arexp list \<Rightarrow> arexp list \<Rightarrow> bool" ("_ s\<leadsto>* _" [100, 100] 100)
+where
+ sss1[intro, simp]:"rs s\<leadsto>* rs"
+| sss2[intro]: "\<lbrakk>rs1 s\<leadsto> rs2; rs2 s\<leadsto>* rs3\<rbrakk> \<Longrightarrow> rs1 s\<leadsto>* rs3"
+
+
+lemma r_in_rstar : "r1 \<leadsto> r2 \<Longrightarrow> r1 \<leadsto>* r2"
+ using rrewrites.intros(1) rrewrites.intros(2) by blast
+
+lemma rs_in_rstar:
+ shows "r1 s\<leadsto> r2 \<Longrightarrow> r1 s\<leadsto>* r2"
+ using rrewrites.intros(1) rrewrites.intros(2) by blast
+
+
+lemma rrewrites_trans[trans]:
+ assumes a1: "r1 \<leadsto>* r2" and a2: "r2 \<leadsto>* r3"
+ shows "r1 \<leadsto>* r3"
+ using a2 a1
+ apply(induct r2 r3 arbitrary: r1 rule: rrewrites.induct)
+ apply(auto)
+ done
+
+lemma srewrites_trans[trans]:
+ assumes a1: "r1 s\<leadsto>* r2" and a2: "r2 s\<leadsto>* r3"
+ shows "r1 s\<leadsto>* r3"
+ using a1 a2
+ apply(induct r1 r2 arbitrary: r3 rule: srewrites.induct)
+ apply(auto)
+ done
+
+
+
+lemma contextrewrites0:
+ "rs1 s\<leadsto>* rs2 \<Longrightarrow> AALTs bs rs1 \<leadsto>* AALTs bs rs2"
+ apply(induct rs1 rs2 rule: srewrites.inducts)
+ apply simp
+ using bs10 r_in_rstar rrewrites_trans by blast
+
+lemma contextrewrites1:
+ "r \<leadsto>* r' \<Longrightarrow> AALTs bs (r # rs) \<leadsto>* AALTs bs (r' # rs)"
+ apply(induct r r' rule: rrewrites.induct)
+ apply simp
+ using bs10 ss3 by blast
+
+lemma srewrite1:
+ shows "rs1 s\<leadsto> rs2 \<Longrightarrow> (rs @ rs1) s\<leadsto> (rs @ rs2)"
+ apply(induct rs)
+ apply(auto)
+ using ss2 by auto
+
+lemma srewrites1:
+ shows "rs1 s\<leadsto>* rs2 \<Longrightarrow> (rs @ rs1) s\<leadsto>* (rs @ rs2)"
+ apply(induct rs1 rs2 rule: srewrites.induct)
+ apply(auto)
+ using srewrite1 by blast
+
+lemma srewrite2:
+ shows "r1 \<leadsto> r2 \<Longrightarrow> True"
+ and "rs1 s\<leadsto> rs2 \<Longrightarrow> (rs1 @ rs) s\<leadsto>* (rs2 @ rs)"
+ apply(induct rule: rrewrite_srewrite.inducts)
+ apply(auto)
+ apply (metis append_Cons append_Nil srewrites1)
+ apply(meson srewrites.simps ss3)
+ apply (meson srewrites.simps ss4)
+ apply (meson srewrites.simps ss5)
+ by (metis append_Cons append_Nil srewrites.simps ss6)
+
+
+lemma srewrites3:
+ shows "rs1 s\<leadsto>* rs2 \<Longrightarrow> (rs1 @ rs) s\<leadsto>* (rs2 @ rs)"
+ apply(induct rs1 rs2 arbitrary: rs rule: srewrites.induct)
+ apply(auto)
+ by (meson srewrite2(2) srewrites_trans)
+
+(*
+lemma srewrites4:
+ assumes "rs3 s\<leadsto>* rs4" "rs1 s\<leadsto>* rs2"
+ shows "(rs1 @ rs3) s\<leadsto>* (rs2 @ rs4)"
+ using assms
+ apply(induct rs3 rs4 arbitrary: rs1 rs2 rule: srewrites.induct)
+ apply (simp add: srewrites3)
+ using srewrite1 by blast
+*)
+
+lemma srewrites6:
+ assumes "r1 \<leadsto>* r2"
+ shows "[r1] s\<leadsto>* [r2]"
+ using assms
+ apply(induct r1 r2 rule: rrewrites.induct)
+ apply(auto)
+ by (meson srewrites.simps srewrites_trans ss3)
+
+lemma srewrites7:
+ assumes "rs3 s\<leadsto>* rs4" "r1 \<leadsto>* r2"
+ shows "(r1 # rs3) s\<leadsto>* (r2 # rs4)"
+ using assms
+ by (smt (verit, best) append_Cons append_Nil srewrites1 srewrites3 srewrites6 srewrites_trans)
+
+lemma ss6_stronger_aux:
+ shows "(rs1 @ rs2) s\<leadsto>* (rs1 @ distinctWith rs2 eq1 (set rs1))"
+ apply(induct rs2 arbitrary: rs1)
+ apply(auto)
+ prefer 2
+ apply(drule_tac x="rs1 @ [a]" in meta_spec)
+ apply(simp)
+ apply(drule_tac x="rs1" in meta_spec)
+ apply(subgoal_tac "(rs1 @ a # rs2) s\<leadsto>* (rs1 @ rs2)")
+ using srewrites_trans apply blast
+ apply(subgoal_tac "\<exists>rs1a rs1b. rs1 = rs1a @ [x] @ rs1b")
+ prefer 2
+ apply (simp add: split_list)
+ apply(erule exE)+
+ apply(simp)
+ using eq1_L rs_in_rstar ss6 by force
+
+lemma ss6_stronger:
+ shows "rs1 s\<leadsto>* distinctWith rs1 eq1 {}"
+ by (metis append_Nil list.set(1) ss6_stronger_aux)
+
+
+lemma rewrite_preserves_fuse:
+ shows "r2 \<leadsto> r3 \<Longrightarrow> fuse bs r2 \<leadsto> fuse bs r3"
+ and "rs2 s\<leadsto> rs3 \<Longrightarrow> map (fuse bs) rs2 s\<leadsto>* map (fuse bs) rs3"
+proof(induct rule: rrewrite_srewrite.inducts)
+ case (bs3 bs1 bs2 r)
+ then show ?case
+ by (metis fuse.simps(5) fuse_append rrewrite_srewrite.bs3)
+next
+ case (bs7 bs r)
+ then show ?case
+ by (metis fuse.simps(4) fuse_append rrewrite_srewrite.bs7)
+next
+ case (ss2 rs1 rs2 r)
+ then show ?case
+ using srewrites7 by force
+next
+ case (ss3 r1 r2 rs)
+ then show ?case by (simp add: r_in_rstar srewrites7)
+next
+ case (ss5 bs1 rs1 rsb)
+ then show ?case
+ apply(simp)
+ by (metis (mono_tags, lifting) comp_def fuse_append map_eq_conv rrewrite_srewrite.ss5 srewrites.simps)
+next
+ case (ss6 a1 a2 rsa rsb rsc)
+ then show ?case
+ apply(simp only: map_append)
+ by (smt (verit, best) erase_fuse list.simps(8) list.simps(9) rrewrite_srewrite.ss6 srewrites.simps)
+qed (auto intro: rrewrite_srewrite.intros)
+
+
+lemma rewrites_fuse:
+ assumes "r1 \<leadsto>* r2"
+ shows "fuse bs r1 \<leadsto>* fuse bs r2"
+using assms
+apply(induction r1 r2 arbitrary: bs rule: rrewrites.induct)
+apply(auto intro: rewrite_preserves_fuse rrewrites_trans)
+done
+
+
+lemma star_seq:
+ assumes "r1 \<leadsto>* r2"
+ shows "ASEQ bs r1 r3 \<leadsto>* ASEQ bs r2 r3"
+using assms
+apply(induct r1 r2 arbitrary: r3 rule: rrewrites.induct)
+apply(auto intro: rrewrite_srewrite.intros)
+done
+
+lemma star_seq2:
+ assumes "r3 \<leadsto>* r4"
+ shows "ASEQ bs r1 r3 \<leadsto>* ASEQ bs r1 r4"
+ using assms
+apply(induct r3 r4 arbitrary: r1 rule: rrewrites.induct)
+apply(auto intro: rrewrite_srewrite.intros)
+done
+
+lemma continuous_rewrite:
+ assumes "r1 \<leadsto>* AZERO"
+ shows "ASEQ bs1 r1 r2 \<leadsto>* AZERO"
+using assms bs1 star_seq by blast
+
+(*
+lemma continuous_rewrite2:
+ assumes "r1 \<leadsto>* AONE bs"
+ shows "ASEQ bs1 r1 r2 \<leadsto>* (fuse (bs1 @ bs) r2)"
+ using assms by (meson bs3 rrewrites.simps star_seq)
+*)
+
+lemma bsimp_aalts_simpcases:
+ shows "AONE bs \<leadsto>* bsimp (AONE bs)"
+ and "AZERO \<leadsto>* bsimp AZERO"
+ and "ACHAR bs c \<leadsto>* bsimp (ACHAR bs c)"
+ by (simp_all)
+
+lemma bsimp_AALTs_rewrites:
+ shows "AALTs bs1 rs \<leadsto>* bsimp_AALTs bs1 rs"
+ by (smt (verit) bs6 bs7 bsimp_AALTs.elims rrewrites.simps)
+
+lemma trivialbsimp_srewrites:
+ "\<lbrakk>\<And>x. x \<in> set rs \<Longrightarrow> x \<leadsto>* f x \<rbrakk> \<Longrightarrow> rs s\<leadsto>* (map f rs)"
+ apply(induction rs)
+ apply simp
+ apply(simp)
+ using srewrites7 by auto
+
+
+
+lemma fltsfrewrites: "rs s\<leadsto>* flts rs"
+ apply(induction rs rule: flts.induct)
+ apply(auto intro: rrewrite_srewrite.intros)
+ apply (meson srewrites.simps srewrites1 ss5)
+ using rs1 srewrites7 apply presburger
+ using srewrites7 apply force
+ apply (simp add: srewrites7)
+ apply(simp add: srewrites7)
+ by (simp add: srewrites7)
+
+
+lemma bnullable0:
+shows "r1 \<leadsto> r2 \<Longrightarrow> bnullable r1 = bnullable r2"
+ and "rs1 s\<leadsto> rs2 \<Longrightarrow> bnullables rs1 = bnullables rs2"
+ apply(induct rule: rrewrite_srewrite.inducts)
+ apply(auto simp add: bnullable_fuse)
+ apply (meson UnCI bnullable_fuse imageI)
+ using bnullable_correctness nullable_correctness by blast
+
+
+lemma rewritesnullable:
+ assumes "r1 \<leadsto>* r2"
+ shows "bnullable r1 = bnullable r2"
+using assms
+ apply(induction r1 r2 rule: rrewrites.induct)
+ apply simp
+ using bnullable0(1) by auto
+
+lemma rewrite_bmkeps_aux:
+ shows "r1 \<leadsto> r2 \<Longrightarrow> (bnullable r1 \<and> bnullable r2 \<Longrightarrow> bmkeps r1 = bmkeps r2)"
+ and "rs1 s\<leadsto> rs2 \<Longrightarrow> (bnullables rs1 \<and> bnullables rs2 \<Longrightarrow> bmkepss rs1 = bmkepss rs2)"
+proof (induct rule: rrewrite_srewrite.inducts)
+ case (bs3 bs1 bs2 r)
+ then show ?case by (simp add: bmkeps_fuse)
+next
+ case (bs7 bs r)
+ then show ?case by (simp add: bmkeps_fuse)
+next
+ case (ss3 r1 r2 rs)
+ then show ?case
+ using bmkepss.simps bnullable0(1) by presburger
+next
+ case (ss5 bs1 rs1 rsb)
+ then show ?case
+ apply (simp add: bmkepss1 bmkepss2 bmkepss_fuse bnullable_fuse)
+ apply(case_tac rs1)
+ apply(auto simp add: bnullable_fuse)
+ apply (metis bmkeps_retrieve bmkeps_retrieve_AALTs bnullable.simps(4))
+ apply (metis bmkeps_retrieve bmkeps_retrieve_AALTs bnullable.simps(4))
+ apply (metis bmkeps_retrieve bmkeps_retrieve_AALTs bnullable.simps(4))
+ by (metis bmkeps_retrieve bmkeps_retrieve_AALTs bnullable.simps(4))
+next
+ case (ss6 a1 a2 rsa rsb rsc)
+ then show ?case
+ by (smt (verit, best) Nil_is_append_conv bmkepss1 bmkepss2 bnullable_correctness in_set_conv_decomp list.distinct(1) list.set_intros(1) nullable_correctness set_ConsD subsetD)
+next
+ case (bs10 rs1 rs2 bs)
+ then show ?case
+ by (metis bmkeps_retrieve bmkeps_retrieve_AALTs bnullable.simps(4))
+qed (auto)
+
+lemma rewrites_bmkeps:
+ assumes "r1 \<leadsto>* r2" "bnullable r1"
+ shows "bmkeps r1 = bmkeps r2"
+ using assms
+proof(induction r1 r2 rule: rrewrites.induct)
+ case (rs1 r)
+ then show "bmkeps r = bmkeps r" by simp
+next
+ case (rs2 r1 r2 r3)
+ then have IH: "bmkeps r1 = bmkeps r2" by simp
+ have a1: "bnullable r1" by fact
+ have a2: "r1 \<leadsto>* r2" by fact
+ have a3: "r2 \<leadsto> r3" by fact
+ have a4: "bnullable r2" using a1 a2 by (simp add: rewritesnullable)
+ then have "bmkeps r2 = bmkeps r3"
+ using a3 bnullable0(1) rewrite_bmkeps_aux(1) by blast
+ then show "bmkeps r1 = bmkeps r3" using IH by simp
+qed
+
+
+lemma rewrites_to_bsimp:
+ shows "r \<leadsto>* bsimp r"
+proof (induction r rule: bsimp.induct)
+ case (1 bs1 r1 r2)
+ have IH1: "r1 \<leadsto>* bsimp r1" by fact
+ have IH2: "r2 \<leadsto>* bsimp r2" by fact
+ { assume as: "bsimp r1 = AZERO \<or> bsimp r2 = AZERO"
+ with IH1 IH2 have "r1 \<leadsto>* AZERO \<or> r2 \<leadsto>* AZERO" by auto
+ then have "ASEQ bs1 r1 r2 \<leadsto>* AZERO"
+ by (metis bs2 continuous_rewrite rrewrites.simps star_seq2)
+ then have "ASEQ bs1 r1 r2 \<leadsto>* bsimp (ASEQ bs1 r1 r2)" using as by auto
+ }
+ moreover
+ { assume "\<exists>bs. bsimp r1 = AONE bs"
+ then obtain bs where as: "bsimp r1 = AONE bs" by blast
+ with IH1 have "r1 \<leadsto>* AONE bs" by simp
+ then have "ASEQ bs1 r1 r2 \<leadsto>* fuse (bs1 @ bs) r2" using bs3 star_seq by blast
+ with IH2 have "ASEQ bs1 r1 r2 \<leadsto>* fuse (bs1 @ bs) (bsimp r2)"
+ using rewrites_fuse by (meson rrewrites_trans)
+ then have "ASEQ bs1 r1 r2 \<leadsto>* bsimp (ASEQ bs1 (AONE bs) r2)" by simp
+ then have "ASEQ bs1 r1 r2 \<leadsto>* bsimp (ASEQ bs1 r1 r2)" by (simp add: as)
+ }
+ moreover
+ { assume as1: "bsimp r1 \<noteq> AZERO" "bsimp r2 \<noteq> AZERO" and as2: "(\<nexists>bs. bsimp r1 = AONE bs)"
+ then have "bsimp_ASEQ bs1 (bsimp r1) (bsimp r2) = ASEQ bs1 (bsimp r1) (bsimp r2)"
+ by (simp add: bsimp_ASEQ1)
+ then have "ASEQ bs1 r1 r2 \<leadsto>* bsimp_ASEQ bs1 (bsimp r1) (bsimp r2)" using as1 as2 IH1 IH2
+ by (metis rrewrites_trans star_seq star_seq2)
+ then have "ASEQ bs1 r1 r2 \<leadsto>* bsimp (ASEQ bs1 r1 r2)" by simp
+ }
+ ultimately show "ASEQ bs1 r1 r2 \<leadsto>* bsimp (ASEQ bs1 r1 r2)" by blast
+next
+ case (2 bs1 rs)
+ have IH: "\<And>x. x \<in> set rs \<Longrightarrow> x \<leadsto>* bsimp x" by fact
+ then have "rs s\<leadsto>* (map bsimp rs)" by (simp add: trivialbsimp_srewrites)
+ also have "... s\<leadsto>* flts (map bsimp rs)" by (simp add: fltsfrewrites)
+ also have "... s\<leadsto>* distinctWith (flts (map bsimp rs)) eq1 {}" by (simp add: ss6_stronger)
+ finally have "AALTs bs1 rs \<leadsto>* AALTs bs1 (distinctWith (flts (map bsimp rs)) eq1 {})"
+ using contextrewrites0 by auto
+ also have "... \<leadsto>* bsimp_AALTs bs1 (distinctWith (flts (map bsimp rs)) eq1 {})"
+ by (simp add: bsimp_AALTs_rewrites)
+ finally show "AALTs bs1 rs \<leadsto>* bsimp (AALTs bs1 rs)" by simp
+qed (simp_all)
+
+
+lemma to_zero_in_alt:
+ shows "AALT bs (ASEQ [] AZERO r) r2 \<leadsto> AALT bs AZERO r2"
+ by (simp add: bs1 bs10 ss3)
+
+
+
+lemma bder_fuse_list:
+ shows "map (bder c \<circ> fuse bs1) rs1 = map (fuse bs1 \<circ> bder c) rs1"
+ apply(induction rs1)
+ apply(simp_all add: bder_fuse)
+ done
+
+lemma map1:
+ shows "(map f [a]) = [f a]"
+ by (simp)
+
+lemma rewrite_preserves_bder:
+ shows "r1 \<leadsto> r2 \<Longrightarrow> (bder c r1) \<leadsto>* (bder c r2)"
+ and "rs1 s\<leadsto> rs2 \<Longrightarrow> map (bder c) rs1 s\<leadsto>* map (bder c) rs2"
+proof(induction rule: rrewrite_srewrite.inducts)
+ case (bs1 bs r2)
+ then show ?case
+ by (simp add: continuous_rewrite)
+next
+ case (bs2 bs r1)
+ then show ?case
+ apply(auto)
+ apply (meson bs6 contextrewrites0 rrewrite_srewrite.bs2 rs2 ss3 ss4 sss1 sss2)
+ by (simp add: r_in_rstar rrewrite_srewrite.bs2)
+next
+ case (bs3 bs1 bs2 r)
+ then show ?case
+ apply(simp)
+
+ by (metis (no_types, lifting) bder_fuse bs10 bs7 fuse_append rrewrites.simps ss4 to_zero_in_alt)
+next
+ case (bs4 r1 r2 bs r3)
+ have as: "r1 \<leadsto> r2" by fact
+ have IH: "bder c r1 \<leadsto>* bder c r2" by fact
+ from as IH show "bder c (ASEQ bs r1 r3) \<leadsto>* bder c (ASEQ bs r2 r3)"
+ by (metis bder.simps(5) bnullable0(1) contextrewrites1 rewrite_bmkeps_aux(1) star_seq)
+next
+ case (bs5 r3 r4 bs r1)
+ have as: "r3 \<leadsto> r4" by fact
+ have IH: "bder c r3 \<leadsto>* bder c r4" by fact
+ from as IH show "bder c (ASEQ bs r1 r3) \<leadsto>* bder c (ASEQ bs r1 r4)"
+ apply(simp)
+ apply(auto)
+ using contextrewrites0 r_in_rstar rewrites_fuse srewrites6 srewrites7 star_seq2 apply presburger
+ using star_seq2 by blast
+next
+ case (bs6 bs)
+ then show ?case
+ using rrewrite_srewrite.bs6 by force
+next
+ case (bs7 bs r)
+ then show ?case
+ by (simp add: bder_fuse r_in_rstar rrewrite_srewrite.bs7)
+next
+ case (bs10 rs1 rs2 bs)
+ then show ?case
+ using contextrewrites0 by force
+next
+ case ss1
+ then show ?case by simp
+next
+ case (ss2 rs1 rs2 r)
+ then show ?case
+ by (simp add: srewrites7)
+next
+ case (ss3 r1 r2 rs)
+ then show ?case
+ by (simp add: srewrites7)
+next
+ case (ss4 rs)
+ then show ?case
+ using rrewrite_srewrite.ss4 by fastforce
+next
+ case (ss5 bs1 rs1 rsb)
+ then show ?case
+ apply(simp)
+ using bder_fuse_list map_map rrewrite_srewrite.ss5 srewrites.simps by blast
+next
+ case (ss6 a1 a2 bs rsa rsb)
+ then show ?case
+ apply(simp only: map_append map1)
+ apply(rule srewrites_trans)
+ apply(rule rs_in_rstar)
+ apply(rule_tac rrewrite_srewrite.ss6)
+ using Der_def der_correctness apply auto[1]
+ by blast
+qed
+
+lemma rewrites_preserves_bder:
+ assumes "r1 \<leadsto>* r2"
+ shows "bder c r1 \<leadsto>* bder c r2"
+using assms
+apply(induction r1 r2 rule: rrewrites.induct)
+apply(simp_all add: rewrite_preserves_bder rrewrites_trans)
+done
+
+
+lemma central:
+ shows "bders r s \<leadsto>* bders_simp r s"
+proof(induct s arbitrary: r rule: rev_induct)
+ case Nil
+ then show "bders r [] \<leadsto>* bders_simp r []" by simp
+next
+ case (snoc x xs)
+ have IH: "\<And>r. bders r xs \<leadsto>* bders_simp r xs" by fact
+ have "bders r (xs @ [x]) = bders (bders r xs) [x]" by (simp add: bders_append)
+ also have "... \<leadsto>* bders (bders_simp r xs) [x]" using IH
+ by (simp add: rewrites_preserves_bder)
+ also have "... \<leadsto>* bders_simp (bders_simp r xs) [x]" using IH
+ by (simp add: rewrites_to_bsimp)
+ finally show "bders r (xs @ [x]) \<leadsto>* bders_simp r (xs @ [x])"
+ by (simp add: bders_simp_append)
+qed
+
+lemma main_aux:
+ assumes "bnullable (bders r s)"
+ shows "bmkeps (bders r s) = bmkeps (bders_simp r s)"
+proof -
+ have "bders r s \<leadsto>* bders_simp r s" by (rule central)
+ then
+ show "bmkeps (bders r s) = bmkeps (bders_simp r s)" using assms
+ by (rule rewrites_bmkeps)
+qed
+
+
+
+
+theorem main_blexer_simp:
+ shows "blexer r s = blexer_simp r s"
+ unfolding blexer_def blexer_simp_def
+ by (metis central main_aux rewritesnullable)
+
+theorem blexersimp_correctness:
+ shows "lexer r s = blexer_simp r s"
+ using blexer_correctness main_blexer_simp by simp
+
+
+unused_thms
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys4/posix/ClosedForms.thy Mon Aug 29 23:16:28 2022 +0100
@@ -0,0 +1,2197 @@
+theory ClosedForms
+ imports "BasicIdentities"
+begin
+
+lemma flts_middle0:
+ shows "rflts (rsa @ RZERO # rsb) = rflts (rsa @ rsb)"
+ apply(induct rsa)
+ apply simp
+ by (metis append_Cons rflts.simps(2) rflts.simps(3) rflts_def_idiot)
+
+
+
+lemma simp_flatten_aux0:
+ shows "rsimp (RALTS rs) = rsimp (RALTS (map rsimp rs))"
+ by (metis append_Nil head_one_more_simp identity_wwo0 list.simps(8) rdistinct.simps(1) rflts.simps(1) rsimp.simps(2) rsimp_ALTs.simps(1) rsimp_ALTs.simps(3) simp_flatten spawn_simp_rsimpalts)
+
+
+inductive
+ hrewrite:: "rrexp \<Rightarrow> rrexp \<Rightarrow> bool" ("_ h\<leadsto> _" [99, 99] 99)
+where
+ "RSEQ RZERO r2 h\<leadsto> RZERO"
+| "RSEQ r1 RZERO h\<leadsto> RZERO"
+| "RSEQ RONE r h\<leadsto> r"
+| "r1 h\<leadsto> r2 \<Longrightarrow> RSEQ r1 r3 h\<leadsto> RSEQ r2 r3"
+| "r3 h\<leadsto> r4 \<Longrightarrow> RSEQ r1 r3 h\<leadsto> RSEQ r1 r4"
+| "r h\<leadsto> r' \<Longrightarrow> (RALTS (rs1 @ [r] @ rs2)) h\<leadsto> (RALTS (rs1 @ [r'] @ rs2))"
+(*context rule for eliminating 0, alts--corresponds to the recursive call flts r::rs = r::(flts rs)*)
+| "RALTS (rsa @ [RZERO] @ rsb) h\<leadsto> RALTS (rsa @ rsb)"
+| "RALTS (rsa @ [RALTS rs1] @ rsb) h\<leadsto> RALTS (rsa @ rs1 @ rsb)"
+| "RALTS [] h\<leadsto> RZERO"
+| "RALTS [r] h\<leadsto> r"
+| "a1 = a2 \<Longrightarrow> RALTS (rsa@[a1]@rsb@[a2]@rsc) h\<leadsto> RALTS (rsa @ [a1] @ rsb @ rsc)"
+
+inductive
+ hrewrites:: "rrexp \<Rightarrow> rrexp \<Rightarrow> bool" ("_ h\<leadsto>* _" [100, 100] 100)
+where
+ rs1[intro, simp]:"r h\<leadsto>* r"
+| rs2[intro]: "\<lbrakk>r1 h\<leadsto>* r2; r2 h\<leadsto> r3\<rbrakk> \<Longrightarrow> r1 h\<leadsto>* r3"
+
+
+lemma hr_in_rstar : "r1 h\<leadsto> r2 \<Longrightarrow> r1 h\<leadsto>* r2"
+ using hrewrites.intros(1) hrewrites.intros(2) by blast
+
+lemma hreal_trans[trans]:
+ assumes a1: "r1 h\<leadsto>* r2" and a2: "r2 h\<leadsto>* r3"
+ shows "r1 h\<leadsto>* r3"
+ using a2 a1
+ apply(induct r2 r3 arbitrary: r1 rule: hrewrites.induct)
+ apply(auto)
+ done
+
+lemma hrewrites_seq_context:
+ shows "r1 h\<leadsto>* r2 \<Longrightarrow> RSEQ r1 r3 h\<leadsto>* RSEQ r2 r3"
+ apply(induct r1 r2 rule: hrewrites.induct)
+ apply simp
+ using hrewrite.intros(4) by blast
+
+lemma hrewrites_seq_context2:
+ shows "r1 h\<leadsto>* r2 \<Longrightarrow> RSEQ r0 r1 h\<leadsto>* RSEQ r0 r2"
+ apply(induct r1 r2 rule: hrewrites.induct)
+ apply simp
+ using hrewrite.intros(5) by blast
+
+
+lemma hrewrites_seq_contexts:
+ shows "\<lbrakk>r1 h\<leadsto>* r2; r3 h\<leadsto>* r4\<rbrakk> \<Longrightarrow> RSEQ r1 r3 h\<leadsto>* RSEQ r2 r4"
+ by (meson hreal_trans hrewrites_seq_context hrewrites_seq_context2)
+
+
+lemma simp_removes_duplicate1:
+ shows " a \<in> set rsa \<Longrightarrow> rsimp (RALTS (rsa @ [a])) = rsimp (RALTS (rsa))"
+and " rsimp (RALTS (a1 # rsa @ [a1])) = rsimp (RALTS (a1 # rsa))"
+ apply(induct rsa arbitrary: a1)
+ apply simp
+ apply simp
+ prefer 2
+ apply(case_tac "a = aa")
+ apply simp
+ apply simp
+ apply (metis Cons_eq_appendI Cons_eq_map_conv distinct_removes_duplicate_flts list.set_intros(2))
+ apply (metis append_Cons append_Nil distinct_removes_duplicate_flts list.set_intros(1) list.simps(8) list.simps(9))
+ by (metis (mono_tags, lifting) append_Cons distinct_removes_duplicate_flts list.set_intros(1) list.simps(8) list.simps(9) map_append rsimp.simps(2))
+
+lemma simp_removes_duplicate2:
+ shows "a \<in> set rsa \<Longrightarrow> rsimp (RALTS (rsa @ [a] @ rsb)) = rsimp (RALTS (rsa @ rsb))"
+ apply(induct rsb arbitrary: rsa)
+ apply simp
+ using distinct_removes_duplicate_flts apply auto[1]
+ by (metis append.assoc head_one_more_simp rsimp.simps(2) simp_flatten simp_removes_duplicate1(1))
+
+lemma simp_removes_duplicate3:
+ shows "a \<in> set rsa \<Longrightarrow> rsimp (RALTS (rsa @ a # rsb)) = rsimp (RALTS (rsa @ rsb))"
+ using simp_removes_duplicate2 by auto
+
+(*
+lemma distinct_removes_middle4:
+ shows "a \<in> set rsa \<Longrightarrow> rdistinct (rsa @ [a] @ rsb) rset = rdistinct (rsa @ rsb) rset"
+ using distinct_removes_middle(1) by fastforce
+*)
+
+(*
+lemma distinct_removes_middle_list:
+ shows "\<forall>a \<in> set x. a \<in> set rsa \<Longrightarrow> rdistinct (rsa @ x @ rsb) rset = rdistinct (rsa @ rsb) rset"
+ apply(induct x)
+ apply simp
+ by (simp add: distinct_removes_middle3)
+*)
+
+inductive frewrite:: "rrexp list \<Rightarrow> rrexp list \<Rightarrow> bool" ("_ \<leadsto>f _" [10, 10] 10)
+ where
+ "(RZERO # rs) \<leadsto>f rs"
+| "((RALTS rs) # rsa) \<leadsto>f (rs @ rsa)"
+| "rs1 \<leadsto>f rs2 \<Longrightarrow> (r # rs1) \<leadsto>f (r # rs2)"
+
+
+inductive
+ frewrites:: "rrexp list \<Rightarrow> rrexp list \<Rightarrow> bool" ("_ \<leadsto>f* _" [10, 10] 10)
+where
+ [intro, simp]:"rs \<leadsto>f* rs"
+| [intro]: "\<lbrakk>rs1 \<leadsto>f* rs2; rs2 \<leadsto>f rs3\<rbrakk> \<Longrightarrow> rs1 \<leadsto>f* rs3"
+
+inductive grewrite:: "rrexp list \<Rightarrow> rrexp list \<Rightarrow> bool" ("_ \<leadsto>g _" [10, 10] 10)
+ where
+ "(RZERO # rs) \<leadsto>g rs"
+| "((RALTS rs) # rsa) \<leadsto>g (rs @ rsa)"
+| "rs1 \<leadsto>g rs2 \<Longrightarrow> (r # rs1) \<leadsto>g (r # rs2)"
+| "rsa @ [a] @ rsb @ [a] @ rsc \<leadsto>g rsa @ [a] @ rsb @ rsc"
+
+lemma grewrite_variant1:
+ shows "a \<in> set rs1 \<Longrightarrow> rs1 @ a # rs \<leadsto>g rs1 @ rs"
+ apply (metis append.assoc append_Cons append_Nil grewrite.intros(4) split_list_first)
+ done
+
+
+inductive
+ grewrites:: "rrexp list \<Rightarrow> rrexp list \<Rightarrow> bool" ("_ \<leadsto>g* _" [10, 10] 10)
+where
+ [intro, simp]:"rs \<leadsto>g* rs"
+| [intro]: "\<lbrakk>rs1 \<leadsto>g* rs2; rs2 \<leadsto>g rs3\<rbrakk> \<Longrightarrow> rs1 \<leadsto>g* rs3"
+
+
+
+(*
+inductive
+ frewrites2:: "rrexp list \<Rightarrow> rrexp list \<Rightarrow> bool" ("_ <\<leadsto>f* _" [10, 10] 10)
+where
+ [intro]: "\<lbrakk>rs1 \<leadsto>f* rs2; rs2 \<leadsto>f* rs1\<rbrakk> \<Longrightarrow> rs1 <\<leadsto>f* rs2"
+*)
+
+lemma fr_in_rstar : "r1 \<leadsto>f r2 \<Longrightarrow> r1 \<leadsto>f* r2"
+ using frewrites.intros(1) frewrites.intros(2) by blast
+
+lemma freal_trans[trans]:
+ assumes a1: "r1 \<leadsto>f* r2" and a2: "r2 \<leadsto>f* r3"
+ shows "r1 \<leadsto>f* r3"
+ using a2 a1
+ apply(induct r2 r3 arbitrary: r1 rule: frewrites.induct)
+ apply(auto)
+ done
+
+
+lemma many_steps_later: "\<lbrakk>r1 \<leadsto>f r2; r2 \<leadsto>f* r3 \<rbrakk> \<Longrightarrow> r1 \<leadsto>f* r3"
+ by (meson fr_in_rstar freal_trans)
+
+
+lemma gr_in_rstar : "r1 \<leadsto>g r2 \<Longrightarrow> r1 \<leadsto>g* r2"
+ using grewrites.intros(1) grewrites.intros(2) by blast
+
+lemma greal_trans[trans]:
+ assumes a1: "r1 \<leadsto>g* r2" and a2: "r2 \<leadsto>g* r3"
+ shows "r1 \<leadsto>g* r3"
+ using a2 a1
+ apply(induct r2 r3 arbitrary: r1 rule: grewrites.induct)
+ apply(auto)
+ done
+
+
+lemma gmany_steps_later: "\<lbrakk>r1 \<leadsto>g r2; r2 \<leadsto>g* r3 \<rbrakk> \<Longrightarrow> r1 \<leadsto>g* r3"
+ by (meson gr_in_rstar greal_trans)
+
+lemma gstar_rdistinct_general:
+ shows "rs1 @ rs \<leadsto>g* rs1 @ (rdistinct rs (set rs1))"
+ apply(induct rs arbitrary: rs1)
+ apply simp
+ apply(case_tac " a \<in> set rs1")
+ apply simp
+ apply(subgoal_tac "rs1 @ a # rs \<leadsto>g rs1 @ rs")
+ using gmany_steps_later apply auto[1]
+ apply (metis append.assoc append_Cons append_Nil grewrite.intros(4) split_list_first)
+ apply simp
+ apply(drule_tac x = "rs1 @ [a]" in meta_spec)
+ by simp
+
+
+lemma gstar_rdistinct:
+ shows "rs \<leadsto>g* rdistinct rs {}"
+ apply(induct rs)
+ apply simp
+ by (metis append.left_neutral empty_set gstar_rdistinct_general)
+
+
+lemma grewrite_append:
+ shows "\<lbrakk> rsa \<leadsto>g rsb \<rbrakk> \<Longrightarrow> rs @ rsa \<leadsto>g rs @ rsb"
+ apply(induct rs)
+ apply simp+
+ using grewrite.intros(3) by blast
+
+
+
+lemma frewrites_cons:
+ shows "\<lbrakk> rsa \<leadsto>f* rsb \<rbrakk> \<Longrightarrow> r # rsa \<leadsto>f* r # rsb"
+ apply(induct rsa rsb rule: frewrites.induct)
+ apply simp
+ using frewrite.intros(3) by blast
+
+
+lemma grewrites_cons:
+ shows "\<lbrakk> rsa \<leadsto>g* rsb \<rbrakk> \<Longrightarrow> r # rsa \<leadsto>g* r # rsb"
+ apply(induct rsa rsb rule: grewrites.induct)
+ apply simp
+ using grewrite.intros(3) by blast
+
+
+lemma frewrites_append:
+ shows " \<lbrakk>rsa \<leadsto>f* rsb\<rbrakk> \<Longrightarrow> (rs @ rsa) \<leadsto>f* (rs @ rsb)"
+ apply(induct rs)
+ apply simp
+ by (simp add: frewrites_cons)
+
+lemma grewrites_append:
+ shows " \<lbrakk>rsa \<leadsto>g* rsb\<rbrakk> \<Longrightarrow> (rs @ rsa) \<leadsto>g* (rs @ rsb)"
+ apply(induct rs)
+ apply simp
+ by (simp add: grewrites_cons)
+
+
+lemma grewrites_concat:
+ shows "\<lbrakk>rs1 \<leadsto>g rs2; rsa \<leadsto>g* rsb \<rbrakk> \<Longrightarrow> (rs1 @ rsa) \<leadsto>g* (rs2 @ rsb)"
+ apply(induct rs1 rs2 rule: grewrite.induct)
+ apply(simp)
+ apply(subgoal_tac "(RZERO # rs @ rsa) \<leadsto>g (rs @ rsa)")
+ prefer 2
+ using grewrite.intros(1) apply blast
+ apply(subgoal_tac "(rs @ rsa) \<leadsto>g* (rs @ rsb)")
+ using gmany_steps_later apply blast
+ apply (simp add: grewrites_append)
+ apply (metis append.assoc append_Cons grewrite.intros(2) grewrites_append gmany_steps_later)
+ using grewrites_cons apply auto
+ apply(subgoal_tac "rsaa @ a # rsba @ a # rsc @ rsa \<leadsto>g* rsaa @ a # rsba @ a # rsc @ rsb")
+ using grewrite.intros(4) grewrites.intros(2) apply force
+ using grewrites_append by auto
+
+
+lemma grewritess_concat:
+ shows "\<lbrakk>rsa \<leadsto>g* rsb; rsc \<leadsto>g* rsd \<rbrakk> \<Longrightarrow> (rsa @ rsc) \<leadsto>g* (rsb @ rsd)"
+ apply(induct rsa rsb rule: grewrites.induct)
+ apply(case_tac rs)
+ apply simp
+ using grewrites_append apply blast
+ by (meson greal_trans grewrites.simps grewrites_concat)
+
+fun alt_set:: "rrexp \<Rightarrow> rrexp set"
+ where
+ "alt_set (RALTS rs) = set rs \<union> \<Union> (alt_set ` (set rs))"
+| "alt_set r = {r}"
+
+
+lemma grewrite_cases_middle:
+ shows "rs1 \<leadsto>g rs2 \<Longrightarrow>
+(\<exists>rsa rsb rsc. rs1 = (rsa @ [RALTS rsb] @ rsc) \<and> rs2 = (rsa @ rsb @ rsc)) \<or>
+(\<exists>rsa rsc. rs1 = rsa @ [RZERO] @ rsc \<and> rs2 = rsa @ rsc) \<or>
+(\<exists>rsa rsb rsc a. rs1 = rsa @ [a] @ rsb @ [a] @ rsc \<and> rs2 = rsa @ [a] @ rsb @ rsc)"
+ apply( induct rs1 rs2 rule: grewrite.induct)
+ apply simp
+ apply blast
+ apply (metis append_Cons append_Nil)
+ apply (metis append_Cons)
+ by blast
+
+
+lemma good_singleton:
+ shows "good a \<and> nonalt a \<Longrightarrow> rflts [a] = [a]"
+ using good.simps(1) k0b by blast
+
+
+
+
+
+
+
+lemma all_that_same_elem:
+ shows "\<lbrakk> a \<in> rset; rdistinct rs {a} = []\<rbrakk>
+ \<Longrightarrow> rdistinct (rs @ rsb) rset = rdistinct rsb rset"
+ apply(induct rs)
+ apply simp
+ apply(subgoal_tac "aa = a")
+ apply simp
+ by (metis empty_iff insert_iff list.discI rdistinct.simps(2))
+
+lemma distinct_early_app1:
+ shows "rset1 \<subseteq> rset \<Longrightarrow> rdistinct rs rset = rdistinct (rdistinct rs rset1) rset"
+ apply(induct rs arbitrary: rset rset1)
+ apply simp
+ apply simp
+ apply(case_tac "a \<in> rset1")
+ apply simp
+ apply(case_tac "a \<in> rset")
+ apply simp+
+
+ apply blast
+ apply(case_tac "a \<in> rset1")
+ apply simp+
+ apply(case_tac "a \<in> rset")
+ apply simp
+ apply (metis insert_subsetI)
+ apply simp
+ by (meson insert_mono)
+
+
+lemma distinct_early_app:
+ shows " rdistinct (rs @ rsb) rset = rdistinct (rdistinct rs {} @ rsb) rset"
+ apply(induct rsb)
+ apply simp
+ using distinct_early_app1 apply blast
+ by (metis distinct_early_app1 distinct_once_enough empty_subsetI)
+
+
+lemma distinct_eq_interesting1:
+ shows "a \<in> rset \<Longrightarrow> rdistinct (rs @ rsb) rset = rdistinct (rdistinct (a # rs) {} @ rsb) rset"
+ apply(subgoal_tac "rdistinct (rdistinct (a # rs) {} @ rsb) rset = rdistinct (rdistinct rs {} @ rsb) rset")
+ apply(simp only:)
+ using distinct_early_app apply blast
+ by (metis append_Cons distinct_early_app rdistinct.simps(2))
+
+
+
+lemma good_flatten_aux_aux1:
+ shows "\<lbrakk> size rs \<ge>2;
+\<forall>r \<in> set rs. good r \<and> r \<noteq> RZERO \<and> nonalt r; \<forall>r \<in> set rsb. good r \<and> r \<noteq> RZERO \<and> nonalt r \<rbrakk>
+ \<Longrightarrow> rdistinct (rs @ rsb) rset =
+ rdistinct (rflts [rsimp_ALTs (rdistinct rs {})] @ rsb) rset"
+ apply(induct rs arbitrary: rset)
+ apply simp
+ apply(case_tac "a \<in> rset")
+ apply simp
+ apply(case_tac "rdistinct rs {a}")
+ apply simp
+ apply(subst good_singleton)
+ apply force
+ apply simp
+ apply (meson all_that_same_elem)
+ apply(subgoal_tac "rflts [rsimp_ALTs (a # rdistinct rs {a})] = a # rdistinct rs {a} ")
+ prefer 2
+ using k0a rsimp_ALTs.simps(3) apply presburger
+ apply(simp only:)
+ apply(subgoal_tac "rdistinct (rs @ rsb) rset = rdistinct ((rdistinct (a # rs) {}) @ rsb) rset ")
+ apply (metis insert_absorb insert_is_Un insert_not_empty rdistinct.simps(2))
+ apply (meson distinct_eq_interesting1)
+ apply simp
+ apply(case_tac "rdistinct rs {a}")
+ prefer 2
+ apply(subgoal_tac "rsimp_ALTs (a # rdistinct rs {a}) = RALTS (a # rdistinct rs {a})")
+ apply(simp only:)
+ apply(subgoal_tac "a # rdistinct (rs @ rsb) (insert a rset) =
+ rdistinct (rflts [RALTS (a # rdistinct rs {a})] @ rsb) rset")
+ apply simp
+ apply (metis append_Cons distinct_early_app empty_iff insert_is_Un k0a rdistinct.simps(2))
+ using rsimp_ALTs.simps(3) apply presburger
+ by (metis Un_insert_left append_Cons distinct_early_app empty_iff good_singleton rdistinct.simps(2) rsimp_ALTs.simps(2) sup_bot_left)
+
+
+
+
+
+lemma good_flatten_aux_aux:
+ shows "\<lbrakk>\<exists>a aa lista list. rs = a # list \<and> list = aa # lista;
+\<forall>r \<in> set rs. good r \<and> r \<noteq> RZERO \<and> nonalt r; \<forall>r \<in> set rsb. good r \<and> r \<noteq> RZERO \<and> nonalt r \<rbrakk>
+ \<Longrightarrow> rdistinct (rs @ rsb) rset =
+ rdistinct (rflts [rsimp_ALTs (rdistinct rs {})] @ rsb) rset"
+ apply(erule exE)+
+ apply(subgoal_tac "size rs \<ge> 2")
+ apply (metis good_flatten_aux_aux1)
+ by (simp add: Suc_leI length_Cons less_add_Suc1)
+
+
+
+lemma good_flatten_aux:
+ shows " \<lbrakk>\<forall>r\<in>set rs. good r \<or> r = RZERO; \<forall>r\<in>set rsa . good r \<or> r = RZERO;
+ \<forall>r\<in>set rsb. good r \<or> r = RZERO;
+ rsimp (RALTS (rsa @ rs @ rsb)) = rsimp_ALTs (rdistinct (rflts (rsa @ rs @ rsb)) {});
+ rsimp (RALTS (rsa @ [RALTS rs] @ rsb)) =
+ rsimp_ALTs (rdistinct (rflts (rsa @ [rsimp (RALTS rs)] @ rsb)) {});
+ map rsimp rsa = rsa; map rsimp rsb = rsb; map rsimp rs = rs;
+ rdistinct (rflts rsa @ rflts rs @ rflts rsb) {} =
+ rdistinct (rflts rsa) {} @ rdistinct (rflts rs @ rflts rsb) (set (rflts rsa));
+ rdistinct (rflts rsa @ rflts [rsimp (RALTS rs)] @ rflts rsb) {} =
+ rdistinct (rflts rsa) {} @ rdistinct (rflts [rsimp (RALTS rs)] @ rflts rsb) (set (rflts rsa))\<rbrakk>
+ \<Longrightarrow> rdistinct (rflts rs @ rflts rsb) rset =
+ rdistinct (rflts [rsimp (RALTS rs)] @ rflts rsb) rset"
+ apply simp
+ apply(case_tac "rflts rs ")
+ apply simp
+ apply(case_tac "list")
+ apply simp
+ apply(case_tac "a \<in> rset")
+ apply simp
+ apply (metis append.left_neutral append_Cons equals0D k0b list.set_intros(1) nonalt_flts_rd qqq1 rdistinct.simps(2))
+ apply simp
+ apply (metis Un_insert_left append_Cons append_Nil ex_in_conv flts_single1 insertI1 list.simps(15) nonalt_flts_rd nonazero.elims(3) qqq1 rdistinct.simps(2) sup_bot_left)
+ apply(subgoal_tac "\<forall>r \<in> set (rflts rs). good r \<and> r \<noteq> RZERO \<and> nonalt r")
+ prefer 2
+ apply (metis Diff_empty flts3 nonalt_flts_rd qqq1 rdistinct_set_equality1)
+ apply(subgoal_tac "\<forall>r \<in> set (rflts rsb). good r \<and> r \<noteq> RZERO \<and> nonalt r")
+ prefer 2
+ apply (metis Diff_empty flts3 good.simps(1) nonalt_flts_rd rdistinct_set_equality1)
+ by (smt (verit, ccfv_threshold) good_flatten_aux_aux)
+
+
+
+
+lemma good_flatten_middle:
+ shows "\<lbrakk>\<forall>r \<in> set rs. good r \<or> r = RZERO; \<forall>r \<in> set rsa. good r \<or> r = RZERO; \<forall>r \<in> set rsb. good r \<or> r = RZERO\<rbrakk> \<Longrightarrow>
+rsimp (RALTS (rsa @ rs @ rsb)) = rsimp (RALTS (rsa @ [RALTS rs] @ rsb))"
+ apply(subgoal_tac "rsimp (RALTS (rsa @ rs @ rsb)) = rsimp_ALTs (rdistinct (rflts (map rsimp rsa @
+map rsimp rs @ map rsimp rsb)) {})")
+ prefer 2
+ apply simp
+ apply(simp only:)
+ apply(subgoal_tac "rsimp (RALTS (rsa @ [RALTS rs] @ rsb)) = rsimp_ALTs (rdistinct (rflts (map rsimp rsa @
+[rsimp (RALTS rs)] @ map rsimp rsb)) {})")
+ prefer 2
+ apply simp
+ apply(simp only:)
+ apply(subgoal_tac "map rsimp rsa = rsa")
+ prefer 2
+ apply (metis map_idI rsimp.simps(3) test)
+ apply(simp only:)
+ apply(subgoal_tac "map rsimp rsb = rsb")
+ prefer 2
+ apply (metis map_idI rsimp.simps(3) test)
+ apply(simp only:)
+ apply(subst k00)+
+ apply(subgoal_tac "map rsimp rs = rs")
+ apply(simp only:)
+ prefer 2
+ apply (metis map_idI rsimp.simps(3) test)
+ apply(subgoal_tac "rdistinct (rflts rsa @ rflts rs @ rflts rsb) {} =
+rdistinct (rflts rsa) {} @ rdistinct (rflts rs @ rflts rsb) (set (rflts rsa))")
+ apply(simp only:)
+ prefer 2
+ using rdistinct_concat_general apply blast
+ apply(subgoal_tac "rdistinct (rflts rsa @ rflts [rsimp (RALTS rs)] @ rflts rsb) {} =
+rdistinct (rflts rsa) {} @ rdistinct (rflts [rsimp (RALTS rs)] @ rflts rsb) (set (rflts rsa))")
+ apply(simp only:)
+ prefer 2
+ using rdistinct_concat_general apply blast
+ apply(subgoal_tac "rdistinct (rflts rs @ rflts rsb) (set (rflts rsa)) =
+ rdistinct (rflts [rsimp (RALTS rs)] @ rflts rsb) (set (rflts rsa))")
+ apply presburger
+ using good_flatten_aux by blast
+
+
+lemma simp_flatten3:
+ shows "rsimp (RALTS (rsa @ [RALTS rs] @ rsb)) = rsimp (RALTS (rsa @ rs @ rsb))"
+ apply(subgoal_tac "rsimp (RALTS (rsa @ [RALTS rs] @ rsb)) =
+ rsimp (RALTS (map rsimp rsa @ [rsimp (RALTS rs)] @ map rsimp rsb)) ")
+ prefer 2
+ apply (metis append.left_neutral append_Cons list.simps(9) map_append simp_flatten_aux0)
+ apply (simp only:)
+ apply(subgoal_tac "rsimp (RALTS (rsa @ rs @ rsb)) =
+rsimp (RALTS (map rsimp rsa @ map rsimp rs @ map rsimp rsb))")
+ prefer 2
+ apply (metis map_append simp_flatten_aux0)
+ apply(simp only:)
+ apply(subgoal_tac "rsimp (RALTS (map rsimp rsa @ map rsimp rs @ map rsimp rsb)) =
+ rsimp (RALTS (map rsimp rsa @ [RALTS (map rsimp rs)] @ map rsimp rsb))")
+
+ apply (metis (no_types, lifting) head_one_more_simp map_append simp_flatten_aux0)
+ apply(subgoal_tac "\<forall>r \<in> set (map rsimp rsa). good r \<or> r = RZERO")
+ apply(subgoal_tac "\<forall>r \<in> set (map rsimp rs). good r \<or> r = RZERO")
+ apply(subgoal_tac "\<forall>r \<in> set (map rsimp rsb). good r \<or> r = RZERO")
+
+ using good_flatten_middle apply presburger
+
+ apply (simp add: good1)
+ apply (simp add: good1)
+ apply (simp add: good1)
+
+ done
+
+
+
+
+
+lemma grewrite_equal_rsimp:
+ shows "rs1 \<leadsto>g rs2 \<Longrightarrow> rsimp (RALTS rs1) = rsimp (RALTS rs2)"
+ apply(frule grewrite_cases_middle)
+ apply(case_tac "(\<exists>rsa rsb rsc. rs1 = rsa @ [RALTS rsb] @ rsc \<and> rs2 = rsa @ rsb @ rsc)")
+ using simp_flatten3 apply auto[1]
+ apply(case_tac "(\<exists>rsa rsc. rs1 = rsa @ [RZERO] @ rsc \<and> rs2 = rsa @ rsc)")
+ apply (metis (mono_tags, opaque_lifting) append_Cons append_Nil list.set_intros(1) list.simps(9) rflts.simps(2) rsimp.simps(2) rsimp.simps(3) simp_removes_duplicate3)
+ by (smt (verit) append.assoc append_Cons append_Nil in_set_conv_decomp simp_removes_duplicate3)
+
+
+lemma grewrites_equal_rsimp:
+ shows "rs1 \<leadsto>g* rs2 \<Longrightarrow> rsimp (RALTS rs1) = rsimp (RALTS rs2)"
+ apply (induct rs1 rs2 rule: grewrites.induct)
+ apply simp
+ using grewrite_equal_rsimp by presburger
+
+
+
+lemma grewrites_last:
+ shows "r # [RALTS rs] \<leadsto>g* r # rs"
+ by (metis gr_in_rstar grewrite.intros(2) grewrite.intros(3) self_append_conv)
+
+lemma simp_flatten2:
+ shows "rsimp (RALTS (r # [RALTS rs])) = rsimp (RALTS (r # rs))"
+ using grewrites_equal_rsimp grewrites_last by blast
+
+
+lemma frewrites_alt:
+ shows "rs1 \<leadsto>f* rs2 \<Longrightarrow> (RALT r1 r2) # rs1 \<leadsto>f* r1 # r2 # rs2"
+ by (metis Cons_eq_appendI append_self_conv2 frewrite.intros(2) frewrites_cons many_steps_later)
+
+lemma early_late_der_frewrites:
+ shows "map (rder x) (rflts rs) \<leadsto>f* rflts (map (rder x) rs)"
+ apply(induct rs)
+ apply simp
+ apply(case_tac a)
+ apply simp+
+ using frewrite.intros(1) many_steps_later apply blast
+ apply(case_tac "x = x3")
+ apply simp
+ using frewrites_cons apply presburger
+ using frewrite.intros(1) many_steps_later apply fastforce
+ apply(case_tac "rnullable x41")
+ apply simp+
+ apply (simp add: frewrites_alt)
+ apply (simp add: frewrites_cons)
+ apply (simp add: frewrites_append)
+ apply (simp add: frewrites_cons)
+ apply (auto simp add: frewrites_cons)
+ using frewrite.intros(1) many_steps_later by blast
+
+
+lemma gstar0:
+ shows "rsa @ (rdistinct rs (set rsa)) \<leadsto>g* rsa @ (rdistinct rs (insert RZERO (set rsa)))"
+ apply(induct rs arbitrary: rsa)
+ apply simp
+ apply(case_tac "a = RZERO")
+ apply simp
+
+ using gr_in_rstar grewrite.intros(1) grewrites_append apply presburger
+ apply(case_tac "a \<in> set rsa")
+ apply simp+
+ apply(drule_tac x = "rsa @ [a]" in meta_spec)
+ by simp
+
+lemma grewrite_rdistinct_aux:
+ shows "rs @ rdistinct rsa rset \<leadsto>g* rs @ rdistinct rsa (rset \<union> set rs)"
+ apply(induct rsa arbitrary: rs rset)
+ apply simp
+ apply(case_tac " a \<in> rset")
+ apply simp
+ apply(case_tac "a \<in> set rs")
+ apply simp
+ apply (metis Un_insert_left Un_insert_right gmany_steps_later grewrite_variant1 insert_absorb)
+ apply simp
+ apply(drule_tac x = "rs @ [a]" in meta_spec)
+ by (metis Un_insert_left Un_insert_right append.assoc append.right_neutral append_Cons append_Nil insert_absorb2 list.simps(15) set_append)
+
+
+lemma flts_gstar:
+ shows "rs \<leadsto>g* rflts rs"
+ apply(induct rs)
+ apply simp
+ apply(case_tac "a = RZERO")
+ apply simp
+ using gmany_steps_later grewrite.intros(1) apply blast
+ apply(case_tac "\<exists>rsa. a = RALTS rsa")
+ apply(erule exE)
+ apply simp
+ apply (meson grewrite.intros(2) grewrites.simps grewrites_cons)
+ by (simp add: grewrites_cons rflts_def_idiot)
+
+lemma more_distinct1:
+ shows " \<lbrakk>\<And>rsb rset rset2.
+ rset2 \<subseteq> set rsb \<Longrightarrow> rsb @ rdistinct rs rset \<leadsto>g* rsb @ rdistinct rs (rset \<union> rset2);
+ rset2 \<subseteq> set rsb; a \<notin> rset; a \<in> rset2\<rbrakk>
+ \<Longrightarrow> rsb @ a # rdistinct rs (insert a rset) \<leadsto>g* rsb @ rdistinct rs (rset \<union> rset2)"
+ apply(subgoal_tac "rsb @ a # rdistinct rs (insert a rset) \<leadsto>g* rsb @ rdistinct rs (insert a rset)")
+ apply(subgoal_tac "rsb @ rdistinct rs (insert a rset) \<leadsto>g* rsb @ rdistinct rs (rset \<union> rset2)")
+ apply (meson greal_trans)
+ apply (metis Un_iff Un_insert_left insert_absorb)
+ by (simp add: gr_in_rstar grewrite_variant1 in_mono)
+
+
+
+
+
+lemma frewrite_rd_grewrites_aux:
+ shows " RALTS rs \<notin> set rsb \<Longrightarrow>
+ rsb @
+ RALTS rs #
+ rdistinct rsa
+ (insert (RALTS rs)
+ (set rsb)) \<leadsto>g* rflts rsb @
+ rdistinct rs (set rsb) @ rdistinct rsa (set rs \<union> set rsb \<union> {RALTS rs})"
+
+ apply simp
+ apply(subgoal_tac "rsb @
+ RALTS rs #
+ rdistinct rsa
+ (insert (RALTS rs)
+ (set rsb)) \<leadsto>g* rsb @
+ rs @
+ rdistinct rsa
+ (insert (RALTS rs)
+ (set rsb)) ")
+ apply(subgoal_tac " rsb @
+ rs @
+ rdistinct rsa
+ (insert (RALTS rs)
+ (set rsb)) \<leadsto>g*
+ rsb @
+ rdistinct rs (set rsb) @
+ rdistinct rsa
+ (insert (RALTS rs)
+ (set rsb)) ")
+ apply (smt (verit, ccfv_SIG) Un_insert_left flts_gstar greal_trans grewrite_rdistinct_aux grewritess_concat inf_sup_aci(5) rdistinct_concat_general rdistinct_set_equality set_append)
+ apply (metis append_assoc grewrites.intros(1) grewritess_concat gstar_rdistinct_general)
+ by (simp add: gr_in_rstar grewrite.intros(2) grewrites_append)
+
+
+
+
+lemma list_dlist_union:
+ shows "set rs \<subseteq> set rsb \<union> set (rdistinct rs (set rsb))"
+ by (metis rdistinct_concat_general rdistinct_set_equality set_append sup_ge2)
+
+lemma r_finite1:
+ shows "r = RALTS (r # rs) = False"
+ apply(induct r)
+ apply simp+
+ apply (metis list.set_intros(1))
+ apply blast
+ by simp
+
+
+
+lemma grewrite_singleton:
+ shows "[r] \<leadsto>g r # rs \<Longrightarrow> rs = []"
+ apply (induct "[r]" "r # rs" rule: grewrite.induct)
+ apply simp
+ apply (metis r_finite1)
+ using grewrite.simps apply blast
+ by simp
+
+
+
+lemma concat_rdistinct_equality1:
+ shows "rdistinct (rs @ rsa) rset = rdistinct rs rset @ rdistinct rsa (rset \<union> (set rs))"
+ apply(induct rs arbitrary: rsa rset)
+ apply simp
+ apply(case_tac "a \<in> rset")
+ apply simp
+ apply (simp add: insert_absorb)
+ by auto
+
+
+lemma grewrites_rev_append:
+ shows "rs1 \<leadsto>g* rs2 \<Longrightarrow> rs1 @ [x] \<leadsto>g* rs2 @ [x]"
+ using grewritess_concat by auto
+
+lemma grewrites_inclusion:
+ shows "set rs \<subseteq> set rs1 \<Longrightarrow> rs1 @ rs \<leadsto>g* rs1"
+ apply(induct rs arbitrary: rs1)
+ apply simp
+ by (meson gmany_steps_later grewrite_variant1 list.set_intros(1) set_subset_Cons subset_code(1))
+
+lemma distinct_keeps_last:
+ shows "\<lbrakk>x \<notin> rset; x \<notin> set xs \<rbrakk> \<Longrightarrow> rdistinct (xs @ [x]) rset = rdistinct xs rset @ [x]"
+ by (simp add: concat_rdistinct_equality1)
+
+lemma grewrites_shape2_aux:
+ shows " RALTS rs \<notin> set rsb \<Longrightarrow>
+ rsb @
+ rdistinct (rs @ rsa)
+ (set rsb) \<leadsto>g* rsb @
+ rdistinct rs (set rsb) @
+ rdistinct rsa (set rs \<union> set rsb \<union> {RALTS rs})"
+ apply(subgoal_tac " rdistinct (rs @ rsa) (set rsb) = rdistinct rs (set rsb) @ rdistinct rsa (set rs \<union> set rsb)")
+ apply (simp only:)
+ prefer 2
+ apply (simp add: Un_commute concat_rdistinct_equality1)
+ apply(induct rsa arbitrary: rs rsb rule: rev_induct)
+ apply simp
+ apply(case_tac "x \<in> set rs")
+ apply (simp add: distinct_removes_middle3)
+ apply(case_tac "x = RALTS rs")
+ apply simp
+ apply(case_tac "x \<in> set rsb")
+ apply simp
+ apply (simp add: concat_rdistinct_equality1)
+ apply (simp add: concat_rdistinct_equality1)
+ apply simp
+ apply(drule_tac x = "rs " in meta_spec)
+ apply(drule_tac x = rsb in meta_spec)
+ apply simp
+ apply(subgoal_tac " rsb @ rdistinct rs (set rsb) @ rdistinct xs (set rs \<union> set rsb) \<leadsto>g* rsb @ rdistinct rs (set rsb) @ rdistinct xs (insert (RALTS rs) (set rs \<union> set rsb))")
+ prefer 2
+ apply (simp add: concat_rdistinct_equality1)
+ apply(case_tac "x \<in> set xs")
+ apply simp
+ apply (simp add: distinct_removes_last)
+ apply(case_tac "x \<in> set rsb")
+ apply (smt (verit, ccfv_threshold) Un_iff append.right_neutral concat_rdistinct_equality1 insert_is_Un rdistinct.simps(2))
+ apply(subgoal_tac "rsb @ rdistinct rs (set rsb) @ rdistinct (xs @ [x]) (set rs \<union> set rsb) = rsb @ rdistinct rs (set rsb) @ rdistinct xs (set rs \<union> set rsb) @ [x]")
+ apply(simp only:)
+ apply(case_tac "x = RALTS rs")
+ apply(subgoal_tac "rsb @ rdistinct rs (set rsb) @ rdistinct xs (set rs \<union> set rsb) @ [x] \<leadsto>g* rsb @ rdistinct rs (set rsb) @ rdistinct xs (set rs \<union> set rsb) @ rs")
+ apply(subgoal_tac "rsb @ rdistinct rs (set rsb) @ rdistinct xs (set rs \<union> set rsb) @ rs \<leadsto>g* rsb @ rdistinct rs (set rsb) @ rdistinct xs (set rs \<union> set rsb) ")
+ apply (smt (verit, ccfv_SIG) Un_insert_left append.right_neutral concat_rdistinct_equality1 greal_trans insert_iff rdistinct.simps(2))
+ apply(subgoal_tac "set rs \<subseteq> set ( rsb @ rdistinct rs (set rsb) @ rdistinct xs (set rs \<union> set rsb))")
+ apply (metis append.assoc grewrites_inclusion)
+ apply (metis Un_upper1 append.assoc dual_order.trans list_dlist_union set_append)
+ apply (metis append_Nil2 gr_in_rstar grewrite.intros(2) grewrite_append)
+ apply(subgoal_tac " rsb @ rdistinct rs (set rsb) @ rdistinct (xs @ [x]) (insert (RALTS rs) (set rs \<union> set rsb)) = rsb @ rdistinct rs (set rsb) @ rdistinct (xs) (insert (RALTS rs) (set rs \<union> set rsb)) @ [x]")
+ apply(simp only:)
+ apply (metis append.assoc grewrites_rev_append)
+ apply (simp add: insert_absorb)
+ apply (simp add: distinct_keeps_last)+
+ done
+
+lemma grewrites_shape2:
+ shows " RALTS rs \<notin> set rsb \<Longrightarrow>
+ rsb @
+ rdistinct (rs @ rsa)
+ (set rsb) \<leadsto>g* rflts rsb @
+ rdistinct rs (set rsb) @
+ rdistinct rsa (set rs \<union> set rsb \<union> {RALTS rs})"
+ apply (meson flts_gstar greal_trans grewrites.simps grewrites_shape2_aux grewritess_concat)
+ done
+
+lemma rdistinct_add_acc:
+ shows "rset2 \<subseteq> set rsb \<Longrightarrow> rsb @ rdistinct rs rset \<leadsto>g* rsb @ rdistinct rs (rset \<union> rset2)"
+ apply(induct rs arbitrary: rsb rset rset2)
+ apply simp
+ apply (case_tac "a \<in> rset")
+ apply simp
+ apply(case_tac "a \<in> rset2")
+ apply simp
+ apply (simp add: more_distinct1)
+ apply simp
+ apply(drule_tac x = "rsb @ [a]" in meta_spec)
+ by (metis Un_insert_left append.assoc append_Cons append_Nil set_append sup.coboundedI1)
+
+
+lemma frewrite_fun1:
+ shows " RALTS rs \<in> set rsb \<Longrightarrow>
+ rsb @ rdistinct rsa (set rsb) \<leadsto>g* rflts rsb @ rdistinct rsa (set rsb \<union> set rs)"
+ apply(subgoal_tac "rsb @ rdistinct rsa (set rsb) \<leadsto>g* rflts rsb @ rdistinct rsa (set rsb)")
+ apply(subgoal_tac " set rs \<subseteq> set (rflts rsb)")
+ prefer 2
+ using spilled_alts_contained apply blast
+ apply(subgoal_tac "rflts rsb @ rdistinct rsa (set rsb) \<leadsto>g* rflts rsb @ rdistinct rsa (set rsb \<union> set rs)")
+ using greal_trans apply blast
+ using rdistinct_add_acc apply presburger
+ using flts_gstar grewritess_concat by auto
+
+lemma frewrite_rd_grewrites:
+ shows "rs1 \<leadsto>f rs2 \<Longrightarrow>
+\<exists>rs3. (rs @ (rdistinct rs1 (set rs)) \<leadsto>g* rs3) \<and> (rs @ (rdistinct rs2 (set rs)) \<leadsto>g* rs3) "
+ apply(induct rs1 rs2 arbitrary: rs rule: frewrite.induct)
+ apply(rule_tac x = "rsa @ (rdistinct rs ({RZERO} \<union> set rsa))" in exI)
+ apply(rule conjI)
+ apply(case_tac "RZERO \<in> set rsa")
+ apply simp+
+ using gstar0 apply fastforce
+ apply (simp add: gr_in_rstar grewrite.intros(1) grewrites_append)
+ apply (simp add: gstar0)
+ prefer 2
+ apply(case_tac "r \<in> set rs")
+ apply simp
+ apply(drule_tac x = "rs @ [r]" in meta_spec)
+ apply(erule exE)
+ apply(rule_tac x = "rs3" in exI)
+ apply simp
+ apply(case_tac "RALTS rs \<in> set rsb")
+ apply simp
+ apply(rule_tac x = "rflts rsb @ rdistinct rsa (set rsb \<union> set rs)" in exI)
+ apply(rule conjI)
+ using frewrite_fun1 apply force
+ apply (metis frewrite_fun1 rdistinct_concat sup_ge2)
+ apply(simp)
+ apply(rule_tac x =
+ "rflts rsb @
+ rdistinct rs (set rsb) @
+ rdistinct rsa (set rs \<union> set rsb \<union> {RALTS rs})" in exI)
+ apply(rule conjI)
+ prefer 2
+ using grewrites_shape2 apply force
+ using frewrite_rd_grewrites_aux by blast
+
+
+lemma frewrite_simpeq2:
+ shows "rs1 \<leadsto>f rs2 \<Longrightarrow> rsimp (RALTS (rdistinct rs1 {})) = rsimp (RALTS (rdistinct rs2 {}))"
+ apply(subgoal_tac "\<exists> rs3. (rdistinct rs1 {} \<leadsto>g* rs3) \<and> (rdistinct rs2 {} \<leadsto>g* rs3)")
+ using grewrites_equal_rsimp apply fastforce
+ by (metis append_self_conv2 frewrite_rd_grewrites list.set(1))
+
+
+
+
+(*a more refined notion of h\<leadsto>* is needed,
+this lemma fails when rs1 contains some RALTS rs where elements
+of rs appear in later parts of rs1, which will be picked up by rs2
+and deduplicated*)
+lemma frewrites_simpeq:
+ shows "rs1 \<leadsto>f* rs2 \<Longrightarrow>
+ rsimp (RALTS (rdistinct rs1 {})) = rsimp (RALTS ( rdistinct rs2 {})) "
+ apply(induct rs1 rs2 rule: frewrites.induct)
+ apply simp
+ using frewrite_simpeq2 by presburger
+
+
+lemma frewrite_single_step:
+ shows " rs2 \<leadsto>f rs3 \<Longrightarrow> rsimp (RALTS rs2) = rsimp (RALTS rs3)"
+ apply(induct rs2 rs3 rule: frewrite.induct)
+ apply simp
+ using simp_flatten apply blast
+ by (metis (no_types, opaque_lifting) list.simps(9) rsimp.simps(2) simp_flatten2)
+
+lemma grewrite_simpalts:
+ shows " rs2 \<leadsto>g rs3 \<Longrightarrow> rsimp (rsimp_ALTs rs2) = rsimp (rsimp_ALTs rs3)"
+ apply(induct rs2 rs3 rule : grewrite.induct)
+ using identity_wwo0 apply presburger
+ apply (metis frewrite.intros(1) frewrite_single_step identity_wwo0 rsimp_ALTs.simps(3) simp_flatten)
+ apply (smt (verit, ccfv_SIG) gmany_steps_later grewrites.intros(1) grewrites_cons grewrites_equal_rsimp identity_wwo0 rsimp_ALTs.simps(3))
+ apply simp
+ apply(subst rsimp_alts_equal)
+ apply(case_tac "rsa = [] \<and> rsb = [] \<and> rsc = []")
+ apply(subgoal_tac "rsa @ a # rsb @ rsc = [a]")
+ apply (simp only:)
+ apply (metis append_Nil frewrite.intros(1) frewrite_single_step identity_wwo0 rsimp_ALTs.simps(3) simp_removes_duplicate1(2))
+ apply simp
+ by (smt (verit, best) append.assoc append_Cons frewrite.intros(1) frewrite_single_step identity_wwo0 in_set_conv_decomp rsimp_ALTs.simps(3) simp_removes_duplicate3)
+
+
+lemma grewrites_simpalts:
+ shows " rs2 \<leadsto>g* rs3 \<Longrightarrow> rsimp (rsimp_ALTs rs2) = rsimp (rsimp_ALTs rs3)"
+ apply(induct rs2 rs3 rule: grewrites.induct)
+ apply simp
+ using grewrite_simpalts by presburger
+
+
+lemma simp_der_flts:
+ shows "rsimp (RALTS (rdistinct (map (rder x) (rflts rs)) {})) =
+ rsimp (RALTS (rdistinct (rflts (map (rder x) rs)) {}))"
+ apply(subgoal_tac "map (rder x) (rflts rs) \<leadsto>f* rflts (map (rder x) rs)")
+ using frewrites_simpeq apply presburger
+ using early_late_der_frewrites by auto
+
+
+lemma simp_der_pierce_flts_prelim:
+ shows "rsimp (rsimp_ALTs (rdistinct (map (rder x) (rflts rs)) {}))
+ = rsimp (rsimp_ALTs (rdistinct (rflts (map (rder x) rs)) {}))"
+ by (metis append.right_neutral grewrite.intros(2) grewrite_simpalts rsimp_ALTs.simps(2) simp_der_flts)
+
+
+lemma basic_regex_property1:
+ shows "rnullable r \<Longrightarrow> rsimp r \<noteq> RZERO"
+ apply(induct r rule: rsimp.induct)
+ apply(auto)
+ apply (metis idiot idiot2 rrexp.distinct(5))
+ by (metis der_simp_nullability rnullable.simps(1) rnullable.simps(4) rsimp.simps(2))
+
+
+lemma inside_simp_seq_nullable:
+ shows
+"\<And>r1 r2.
+ \<lbrakk>rsimp (rder x (rsimp r1)) = rsimp (rder x r1); rsimp (rder x (rsimp r2)) = rsimp (rder x r2);
+ rnullable r1\<rbrakk>
+ \<Longrightarrow> rsimp (rder x (rsimp_SEQ (rsimp r1) (rsimp r2))) =
+ rsimp_ALTs (rdistinct (rflts [rsimp_SEQ (rsimp (rder x r1)) (rsimp r2), rsimp (rder x r2)]) {})"
+ apply(case_tac "rsimp r1 = RONE")
+ apply(simp)
+ apply(subst basic_rsimp_SEQ_property1)
+ apply (simp add: idem_after_simp1)
+ apply(case_tac "rsimp r1 = RZERO")
+
+ using basic_regex_property1 apply blast
+ apply(case_tac "rsimp r2 = RZERO")
+
+ apply (simp add: basic_rsimp_SEQ_property3)
+ apply(subst idiot2)
+ apply simp+
+ apply(subgoal_tac "rnullable (rsimp r1)")
+ apply simp
+ using rsimp_idem apply presburger
+ using der_simp_nullability by presburger
+
+
+
+lemma grewrite_ralts:
+ shows "rs \<leadsto>g rs' \<Longrightarrow> RALTS rs h\<leadsto>* RALTS rs'"
+ by (smt (verit) grewrite_cases_middle hr_in_rstar hrewrite.intros(11) hrewrite.intros(7) hrewrite.intros(8))
+
+lemma grewrites_ralts:
+ shows "rs \<leadsto>g* rs' \<Longrightarrow> RALTS rs h\<leadsto>* RALTS rs'"
+ apply(induct rule: grewrites.induct)
+ apply simp
+ using grewrite_ralts hreal_trans by blast
+
+
+lemma distinct_grewrites_subgoal1:
+ shows "
+ \<lbrakk>rs1 \<leadsto>g* [a]; RALTS rs1 h\<leadsto>* a; [a] \<leadsto>g rs3\<rbrakk> \<Longrightarrow> RALTS rs1 h\<leadsto>* rsimp_ALTs rs3"
+ apply(subgoal_tac "RALTS rs1 h\<leadsto>* RALTS rs3")
+ apply (metis hrewrite.intros(10) hrewrite.intros(9) rs2 rsimp_ALTs.cases rsimp_ALTs.simps(1) rsimp_ALTs.simps(2) rsimp_ALTs.simps(3))
+ apply(subgoal_tac "rs1 \<leadsto>g* rs3")
+ using grewrites_ralts apply blast
+ using grewrites.intros(2) by presburger
+
+lemma grewrites_ralts_rsimpalts:
+ shows "rs \<leadsto>g* rs' \<Longrightarrow> RALTS rs h\<leadsto>* rsimp_ALTs rs' "
+ apply(induct rs rs' rule: grewrites.induct)
+ apply(case_tac rs)
+ using hrewrite.intros(9) apply force
+ apply(case_tac list)
+ apply simp
+ using hr_in_rstar hrewrite.intros(10) rsimp_ALTs.simps(2) apply presburger
+ apply simp
+ apply(case_tac rs2)
+ apply simp
+ apply (metis grewrite.intros(3) grewrite_singleton rsimp_ALTs.simps(1))
+ apply(case_tac list)
+ apply(simp)
+ using distinct_grewrites_subgoal1 apply blast
+ apply simp
+ apply(case_tac rs3)
+ apply simp
+ using grewrites_ralts hrewrite.intros(9) apply blast
+ by (metis (no_types, opaque_lifting) grewrite_ralts hr_in_rstar hreal_trans hrewrite.intros(10) neq_Nil_conv rsimp_ALTs.simps(2) rsimp_ALTs.simps(3))
+
+lemma hrewrites_alts:
+ shows " r h\<leadsto>* r' \<Longrightarrow> (RALTS (rs1 @ [r] @ rs2)) h\<leadsto>* (RALTS (rs1 @ [r'] @ rs2))"
+ apply(induct r r' rule: hrewrites.induct)
+ apply simp
+ using hrewrite.intros(6) by blast
+
+inductive
+ srewritescf:: "rrexp list \<Rightarrow> rrexp list \<Rightarrow> bool" (" _ scf\<leadsto>* _" [100, 100] 100)
+where
+ ss1: "[] scf\<leadsto>* []"
+| ss2: "\<lbrakk>r h\<leadsto>* r'; rs scf\<leadsto>* rs'\<rbrakk> \<Longrightarrow> (r#rs) scf\<leadsto>* (r'#rs')"
+
+
+lemma srewritescf_alt: "rs1 scf\<leadsto>* rs2 \<Longrightarrow> (RALTS (rs@rs1)) h\<leadsto>* (RALTS (rs@rs2))"
+
+ apply(induct rs1 rs2 arbitrary: rs rule: srewritescf.induct)
+ apply(rule rs1)
+ apply(drule_tac x = "rsa@[r']" in meta_spec)
+ apply simp
+ apply(rule hreal_trans)
+ prefer 2
+ apply(assumption)
+ apply(drule hrewrites_alts)
+ by auto
+
+
+corollary srewritescf_alt1:
+ assumes "rs1 scf\<leadsto>* rs2"
+ shows "RALTS rs1 h\<leadsto>* RALTS rs2"
+ using assms
+ by (metis append_Nil srewritescf_alt)
+
+
+
+
+lemma trivialrsimp_srewrites:
+ "\<lbrakk>\<And>x. x \<in> set rs \<Longrightarrow> x h\<leadsto>* f x \<rbrakk> \<Longrightarrow> rs scf\<leadsto>* (map f rs)"
+
+ apply(induction rs)
+ apply simp
+ apply(rule ss1)
+ by (metis insert_iff list.simps(15) list.simps(9) srewritescf.simps)
+
+lemma hrewrites_list:
+ shows
+" (\<And>xa. xa \<in> set x \<Longrightarrow> xa h\<leadsto>* rsimp xa) \<Longrightarrow> RALTS x h\<leadsto>* RALTS (map rsimp x)"
+ apply(induct x)
+ apply(simp)+
+ by (simp add: srewritescf_alt1 ss2 trivialrsimp_srewrites)
+(* apply(subgoal_tac "RALTS x h\<leadsto>* RALTS (map rsimp x)")*)
+
+
+lemma hrewrite_simpeq:
+ shows "r1 h\<leadsto> r2 \<Longrightarrow> rsimp r1 = rsimp r2"
+ apply(induct rule: hrewrite.induct)
+ apply simp+
+ apply (simp add: basic_rsimp_SEQ_property3)
+ apply (simp add: basic_rsimp_SEQ_property1)
+ using rsimp.simps(1) apply presburger
+ apply simp+
+ using flts_middle0 apply force
+
+
+ using simp_flatten3 apply presburger
+
+ apply simp+
+ apply (simp add: idem_after_simp1)
+ using grewrite.intros(4) grewrite_equal_rsimp by presburger
+
+lemma hrewrites_simpeq:
+ shows "r1 h\<leadsto>* r2 \<Longrightarrow> rsimp r1 = rsimp r2"
+ apply(induct rule: hrewrites.induct)
+ apply simp
+ apply(subgoal_tac "rsimp r2 = rsimp r3")
+ apply auto[1]
+ using hrewrite_simpeq by presburger
+
+
+
+lemma simp_hrewrites:
+ shows "r1 h\<leadsto>* rsimp r1"
+ apply(induct r1)
+ apply simp+
+ apply(case_tac "rsimp r11 = RONE")
+ apply simp
+ apply(subst basic_rsimp_SEQ_property1)
+ apply(subgoal_tac "RSEQ r11 r12 h\<leadsto>* RSEQ RONE r12")
+ using hreal_trans hrewrite.intros(3) apply blast
+ using hrewrites_seq_context apply presburger
+ apply(case_tac "rsimp r11 = RZERO")
+ apply simp
+ using hrewrite.intros(1) hrewrites_seq_context apply blast
+ apply(case_tac "rsimp r12 = RZERO")
+ apply simp
+ apply(subst basic_rsimp_SEQ_property3)
+ apply (meson hrewrite.intros(2) hrewrites.simps hrewrites_seq_context2)
+ apply(subst idiot2)
+ apply simp+
+ using hrewrites_seq_contexts apply presburger
+ apply simp
+ apply(subgoal_tac "RALTS x h\<leadsto>* RALTS (map rsimp x)")
+ apply(subgoal_tac "RALTS (map rsimp x) h\<leadsto>* rsimp_ALTs (rdistinct (rflts (map rsimp x)) {}) ")
+ using hreal_trans apply blast
+ apply (meson flts_gstar greal_trans grewrites_ralts_rsimpalts gstar_rdistinct)
+
+ apply (simp add: grewrites_ralts hrewrites_list)
+ by simp_all
+
+lemma interleave_aux1:
+ shows " RALT (RSEQ RZERO r1) r h\<leadsto>* r"
+ apply(subgoal_tac "RSEQ RZERO r1 h\<leadsto>* RZERO")
+ apply(subgoal_tac "RALT (RSEQ RZERO r1) r h\<leadsto>* RALT RZERO r")
+ apply (meson grewrite.intros(1) grewrite_ralts hreal_trans hrewrite.intros(10) hrewrites.simps)
+ using rs1 srewritescf_alt1 ss1 ss2 apply presburger
+ by (simp add: hr_in_rstar hrewrite.intros(1))
+
+
+
+lemma rnullable_hrewrite:
+ shows "r1 h\<leadsto> r2 \<Longrightarrow> rnullable r1 = rnullable r2"
+ apply(induct rule: hrewrite.induct)
+ apply simp+
+ apply blast
+ apply simp+
+ done
+
+
+lemma interleave1:
+ shows "r h\<leadsto> r' \<Longrightarrow> rder c r h\<leadsto>* rder c r'"
+ apply(induct r r' rule: hrewrite.induct)
+ apply (simp add: hr_in_rstar hrewrite.intros(1))
+ apply (metis (no_types, lifting) basic_rsimp_SEQ_property3 list.simps(8) list.simps(9) rder.simps(1) rder.simps(5) rdistinct.simps(1) rflts.simps(1) rflts.simps(2) rsimp.simps(1) rsimp.simps(2) rsimp.simps(3) rsimp_ALTs.simps(1) simp_hrewrites)
+ apply simp
+ apply(subst interleave_aux1)
+ apply simp
+ apply(case_tac "rnullable r1")
+ apply simp
+
+ apply (simp add: hrewrites_seq_context rnullable_hrewrite srewritescf_alt1 ss1 ss2)
+
+ apply (simp add: hrewrites_seq_context rnullable_hrewrite)
+ apply(case_tac "rnullable r1")
+ apply simp
+
+ using hr_in_rstar hrewrites_seq_context2 srewritescf_alt1 ss1 ss2 apply presburger
+ apply simp
+ using hr_in_rstar hrewrites_seq_context2 apply blast
+ apply simp
+
+ using hrewrites_alts apply auto[1]
+ apply simp
+ using grewrite.intros(1) grewrite_append grewrite_ralts apply auto[1]
+ apply simp
+ apply (simp add: grewrite.intros(2) grewrite_append grewrite_ralts)
+ apply (simp add: hr_in_rstar hrewrite.intros(9))
+ apply (simp add: hr_in_rstar hrewrite.intros(10))
+ apply simp
+ using hrewrite.intros(11) by auto
+
+lemma interleave_star1:
+ shows "r h\<leadsto>* r' \<Longrightarrow> rder c r h\<leadsto>* rder c r'"
+ apply(induct rule : hrewrites.induct)
+ apply simp
+ by (meson hreal_trans interleave1)
+
+
+
+lemma inside_simp_removal:
+ shows " rsimp (rder x (rsimp r)) = rsimp (rder x r)"
+ apply(induct r)
+ apply simp+
+ apply(case_tac "rnullable r1")
+ apply simp
+
+ using inside_simp_seq_nullable apply blast
+ apply simp
+ apply (smt (verit, del_insts) idiot2 basic_rsimp_SEQ_property3 der_simp_nullability rder.simps(1) rder.simps(5) rnullable.simps(2) rsimp.simps(1) rsimp_SEQ.simps(1) rsimp_idem)
+ apply(subgoal_tac "rder x (RALTS xa) h\<leadsto>* rder x (rsimp (RALTS xa))")
+ using hrewrites_simpeq apply presburger
+ using interleave_star1 simp_hrewrites apply presburger
+ by simp_all
+
+
+
+
+lemma rders_simp_same_simpders:
+ shows "s \<noteq> [] \<Longrightarrow> rders_simp r s = rsimp (rders r s)"
+ apply(induct s rule: rev_induct)
+ apply simp
+ apply(case_tac "xs = []")
+ apply simp
+ apply(simp add: rders_append rders_simp_append)
+ using inside_simp_removal by blast
+
+
+
+
+lemma distinct_der:
+ shows "rsimp (rsimp_ALTs (map (rder x) (rdistinct rs {}))) =
+ rsimp (rsimp_ALTs (rdistinct (map (rder x) rs) {}))"
+ by (metis grewrites_simpalts gstar_rdistinct inside_simp_removal rder_rsimp_ALTs_commute)
+
+
+
+
+
+lemma rders_simp_lambda:
+ shows " rsimp \<circ> rder x \<circ> (\<lambda>r. rders_simp r xs) = (\<lambda>r. rders_simp r (xs @ [x]))"
+ using rders_simp_append by auto
+
+lemma rders_simp_nonempty_simped:
+ shows "xs \<noteq> [] \<Longrightarrow> rsimp \<circ> (\<lambda>r. rders_simp r xs) = (\<lambda>r. rders_simp r xs)"
+ using rders_simp_same_simpders rsimp_idem by auto
+
+lemma repeated_altssimp:
+ shows "\<forall>r \<in> set rs. rsimp r = r \<Longrightarrow> rsimp (rsimp_ALTs (rdistinct (rflts rs) {})) =
+ rsimp_ALTs (rdistinct (rflts rs) {})"
+ by (metis map_idI rsimp.simps(2) rsimp_idem)
+
+
+
+lemma alts_closed_form:
+ shows "rsimp (rders_simp (RALTS rs) s) = rsimp (RALTS (map (\<lambda>r. rders_simp r s) rs))"
+ apply(induct s rule: rev_induct)
+ apply simp
+ apply simp
+ apply(subst rders_simp_append)
+ apply(subgoal_tac " rsimp (rders_simp (rders_simp (RALTS rs) xs) [x]) =
+ rsimp(rders_simp (rsimp_ALTs (rdistinct (rflts (map (rsimp \<circ> (\<lambda>r. rders_simp r xs)) rs)) {})) [x])")
+ prefer 2
+ apply (metis inside_simp_removal rders_simp_one_char)
+ apply(simp only: )
+ apply(subst rders_simp_one_char)
+ apply(subst rsimp_idem)
+ apply(subgoal_tac "rsimp (rder x (rsimp_ALTs (rdistinct (rflts (map (rsimp \<circ> (\<lambda>r. rders_simp r xs)) rs)) {}))) =
+ rsimp ((rsimp_ALTs (map (rder x) (rdistinct (rflts (map (rsimp \<circ> (\<lambda>r. rders_simp r xs)) rs)) {})))) ")
+ prefer 2
+ using rder_rsimp_ALTs_commute apply presburger
+ apply(simp only:)
+ apply(subgoal_tac "rsimp (rsimp_ALTs (map (rder x) (rdistinct (rflts (map (rsimp \<circ> (\<lambda>r. rders_simp r xs)) rs)) {})))
+= rsimp (rsimp_ALTs (rdistinct (map (rder x) (rflts (map (rsimp \<circ> (\<lambda>r. rders_simp r xs)) rs))) {}))")
+ prefer 2
+
+ using distinct_der apply presburger
+ apply(simp only:)
+ apply(subgoal_tac " rsimp (rsimp_ALTs (rdistinct (map (rder x) (rflts (map (rsimp \<circ> (\<lambda>r. rders_simp r xs)) rs))) {})) =
+ rsimp (rsimp_ALTs (rdistinct ( (rflts (map (rder x) (map (rsimp \<circ> (\<lambda>r. rders_simp r xs)) rs)))) {}))")
+ apply(simp only:)
+ apply(subgoal_tac " rsimp (rsimp_ALTs (rdistinct (rflts (map (rder x) (map (rsimp \<circ> (\<lambda>r. rders_simp r xs)) rs))) {})) =
+ rsimp (rsimp_ALTs (rdistinct (rflts ( (map (rsimp \<circ> (rder x) \<circ> (\<lambda>r. rders_simp r xs)) rs))) {}))")
+ apply(simp only:)
+ apply(subst rders_simp_lambda)
+ apply(subst rders_simp_nonempty_simped)
+ apply simp
+ apply(subgoal_tac "\<forall>r \<in> set (map (\<lambda>r. rders_simp r (xs @ [x])) rs). rsimp r = r")
+ prefer 2
+ apply (simp add: rders_simp_same_simpders rsimp_idem)
+ apply(subst repeated_altssimp)
+ apply simp
+ apply fastforce
+ apply (metis inside_simp_removal list.map_comp rder.simps(4) rsimp.simps(2) rsimp_idem)
+ using simp_der_pierce_flts_prelim by blast
+
+
+lemma alts_closed_form_variant:
+ shows "s \<noteq> [] \<Longrightarrow> rders_simp (RALTS rs) s = rsimp (RALTS (map (\<lambda>r. rders_simp r s) rs))"
+ by (metis alts_closed_form comp_apply rders_simp_nonempty_simped)
+
+
+lemma rsimp_seq_equal1:
+ shows "rsimp_SEQ (rsimp r1) (rsimp r2) = rsimp_ALTs (rdistinct (rflts [rsimp_SEQ (rsimp r1) (rsimp r2)]) {})"
+ by (metis idem_after_simp1 rsimp.simps(1))
+
+
+fun sflat_aux :: "rrexp \<Rightarrow> rrexp list " where
+ "sflat_aux (RALTS (r # rs)) = sflat_aux r @ rs"
+| "sflat_aux (RALTS []) = []"
+| "sflat_aux r = [r]"
+
+
+fun sflat :: "rrexp \<Rightarrow> rrexp" where
+ "sflat (RALTS (r # [])) = r"
+| "sflat (RALTS (r # rs)) = RALTS (sflat_aux r @ rs)"
+| "sflat r = r"
+
+inductive created_by_seq:: "rrexp \<Rightarrow> bool" where
+ "created_by_seq (RSEQ r1 r2) "
+| "created_by_seq r1 \<Longrightarrow> created_by_seq (RALT r1 r2)"
+
+lemma seq_ders_shape1:
+ shows "\<forall>r1 r2. \<exists>r3 r4. (rders (RSEQ r1 r2) s) = RSEQ r3 r4 \<or> (rders (RSEQ r1 r2) s) = RALT r3 r4"
+ apply(induct s rule: rev_induct)
+ apply auto[1]
+ apply(rule allI)+
+ apply(subst rders_append)+
+ apply(subgoal_tac " \<exists>r3 r4. rders (RSEQ r1 r2) xs = RSEQ r3 r4 \<or> rders (RSEQ r1 r2) xs = RALT r3 r4 ")
+ apply(erule exE)+
+ apply(erule disjE)
+ apply simp+
+ done
+
+lemma created_by_seq_der:
+ shows "created_by_seq r \<Longrightarrow> created_by_seq (rder c r)"
+ apply(induct r)
+ apply simp+
+
+ using created_by_seq.cases apply blast
+ apply(auto)
+ apply (meson created_by_seq.cases rrexp.distinct(23) rrexp.distinct(25))
+ using created_by_seq.simps apply blast
+ apply (meson created_by_seq.simps)
+ using created_by_seq.intros(1) apply blast
+ apply (metis (no_types, lifting) created_by_seq.simps k0a list.set_intros(1) list.simps(8) list.simps(9) rrexp.distinct(31))
+ apply (simp add: created_by_seq.intros(1))
+ using created_by_seq.simps apply blast
+ by (simp add: created_by_seq.intros(1))
+
+lemma createdbyseq_left_creatable:
+ shows "created_by_seq (RALT r1 r2) \<Longrightarrow> created_by_seq r1"
+ using created_by_seq.cases by blast
+
+
+
+lemma recursively_derseq:
+ shows " created_by_seq (rders (RSEQ r1 r2) s)"
+ apply(induct s rule: rev_induct)
+ apply simp
+ using created_by_seq.intros(1) apply force
+ apply(subgoal_tac "created_by_seq (rders (RSEQ r1 r2) (xs @ [x]))")
+ apply blast
+ apply(subst rders_append)
+ apply(subgoal_tac "\<exists>r3 r4. rders (RSEQ r1 r2) xs = RSEQ r3 r4 \<or>
+ rders (RSEQ r1 r2) xs = RALT r3 r4")
+ prefer 2
+ using seq_ders_shape1 apply presburger
+ apply(erule exE)+
+ apply(erule disjE)
+ apply(subgoal_tac "created_by_seq (rders (RSEQ r3 r4) [x])")
+ apply presburger
+ apply simp
+ using created_by_seq.intros(1) created_by_seq.intros(2) apply presburger
+ apply simp
+ apply(subgoal_tac "created_by_seq r3")
+ prefer 2
+ using createdbyseq_left_creatable apply blast
+ using created_by_seq.intros(2) created_by_seq_der by blast
+
+
+lemma recursively_derseq1:
+ shows "r = rders (RSEQ r1 r2) s \<Longrightarrow> created_by_seq r"
+ using recursively_derseq by blast
+
+
+lemma sfau_head:
+ shows " created_by_seq r \<Longrightarrow> \<exists>ra rb rs. sflat_aux r = RSEQ ra rb # rs"
+ apply(induction r rule: created_by_seq.induct)
+ apply simp
+ by fastforce
+
+
+lemma vsuf_prop1:
+ shows "vsuf (xs @ [x]) r = (if (rnullable (rders r xs))
+ then [x] # (map (\<lambda>s. s @ [x]) (vsuf xs r) )
+ else (map (\<lambda>s. s @ [x]) (vsuf xs r)) )
+ "
+ apply(induct xs arbitrary: r)
+ apply simp
+ apply(case_tac "rnullable r")
+ apply simp
+ apply simp
+ done
+
+fun breakHead :: "rrexp list \<Rightarrow> rrexp list" where
+ "breakHead [] = [] "
+| "breakHead (RALT r1 r2 # rs) = r1 # r2 # rs"
+| "breakHead (r # rs) = r # rs"
+
+
+lemma sfau_idem_der:
+ shows "created_by_seq r \<Longrightarrow> sflat_aux (rder c r) = breakHead (map (rder c) (sflat_aux r))"
+ apply(induct rule: created_by_seq.induct)
+ apply simp+
+ using sfau_head by fastforce
+
+lemma vsuf_compose1:
+ shows " \<not> rnullable (rders r1 xs)
+ \<Longrightarrow> map (rder x \<circ> rders r2) (vsuf xs r1) = map (rders r2) (vsuf (xs @ [x]) r1)"
+ apply(subst vsuf_prop1)
+ apply simp
+ by (simp add: rders_append)
+
+
+
+
+lemma seq_sfau0:
+ shows "sflat_aux (rders (RSEQ r1 r2) s) = (RSEQ (rders r1 s) r2) #
+ (map (rders r2) (vsuf s r1)) "
+ apply(induct s rule: rev_induct)
+ apply simp
+ apply(subst rders_append)+
+ apply(subgoal_tac "created_by_seq (rders (RSEQ r1 r2) xs)")
+ prefer 2
+ using recursively_derseq1 apply blast
+ apply simp
+ apply(subst sfau_idem_der)
+
+ apply blast
+ apply(case_tac "rnullable (rders r1 xs)")
+ apply simp
+ apply(subst vsuf_prop1)
+ apply simp
+ apply (simp add: rders_append)
+ apply simp
+ using vsuf_compose1 by blast
+
+
+
+
+
+
+
+
+
+thm sflat.elims
+
+
+
+
+
+lemma sflat_rsimpeq:
+ shows "created_by_seq r1 \<Longrightarrow> sflat_aux r1 = rs \<Longrightarrow> rsimp r1 = rsimp (RALTS rs)"
+ apply(induct r1 arbitrary: rs rule: created_by_seq.induct)
+ apply simp
+ using rsimp_seq_equal1 apply force
+ by (metis head_one_more_simp rsimp.simps(2) sflat_aux.simps(1) simp_flatten)
+
+
+
+lemma seq_closed_form_general:
+ shows "rsimp (rders (RSEQ r1 r2) s) =
+rsimp ( (RALTS ( (RSEQ (rders r1 s) r2 # (map (rders r2) (vsuf s r1))))))"
+ apply(case_tac "s \<noteq> []")
+ apply(subgoal_tac "created_by_seq (rders (RSEQ r1 r2) s)")
+ apply(subgoal_tac "sflat_aux (rders (RSEQ r1 r2) s) = RSEQ (rders r1 s) r2 # (map (rders r2) (vsuf s r1))")
+ using sflat_rsimpeq apply blast
+ apply (simp add: seq_sfau0)
+ using recursively_derseq1 apply blast
+ apply simp
+ by (metis idem_after_simp1 rsimp.simps(1))
+
+lemma seq_closed_form_aux1a:
+ shows "rsimp (RALTS (RSEQ (rders r1 s) r2 # rs)) =
+ rsimp (RALTS (RSEQ (rders_simp r1 s) r2 # rs))"
+ by (metis head_one_more_simp rders.simps(1) rders_simp.simps(1) rders_simp_same_simpders rsimp.simps(1) rsimp_idem simp_flatten_aux0)
+
+
+lemma seq_closed_form_aux1:
+ shows "rsimp (RALTS (RSEQ (rders r1 s) r2 # (map (rders r2) (vsuf s r1)))) =
+ rsimp (RALTS (RSEQ (rders_simp r1 s) r2 # (map (rders r2) (vsuf s r1))))"
+ by (smt (verit, best) list.simps(9) rders.simps(1) rders_simp.simps(1) rders_simp_same_simpders rsimp.simps(1) rsimp.simps(2) rsimp_idem)
+
+lemma add_simp_to_rest:
+ shows "rsimp (RALTS (r # rs)) = rsimp (RALTS (r # map rsimp rs))"
+ by (metis append_Nil2 grewrite.intros(2) grewrite_simpalts head_one_more_simp list.simps(9) rsimp_ALTs.simps(2) spawn_simp_rsimpalts)
+
+lemma rsimp_compose_der2:
+ shows "\<forall>s \<in> set ss. s \<noteq> [] \<Longrightarrow> map rsimp (map (rders r) ss) = map (\<lambda>s. (rders_simp r s)) ss"
+ by (simp add: rders_simp_same_simpders)
+
+lemma vsuf_nonempty:
+ shows "\<forall>s \<in> set ( vsuf s1 r). s \<noteq> []"
+ apply(induct s1 arbitrary: r)
+ apply simp
+ apply simp
+ done
+
+
+
+lemma seq_closed_form_aux2:
+ shows "s \<noteq> [] \<Longrightarrow> rsimp ( (RALTS ( (RSEQ (rders_simp r1 s) r2 # (map (rders r2) (vsuf s r1)))))) =
+ rsimp ( (RALTS ( (RSEQ (rders_simp r1 s) r2 # (map (rders_simp r2) (vsuf s r1))))))"
+
+ by (metis add_simp_to_rest rsimp_compose_der2 vsuf_nonempty)
+
+
+lemma seq_closed_form:
+ shows "rsimp (rders_simp (RSEQ r1 r2) s) =
+ rsimp (RALTS ((RSEQ (rders_simp r1 s) r2) # (map (rders_simp r2) (vsuf s r1))))"
+proof (cases s)
+ case Nil
+ then show ?thesis
+ by (simp add: rsimp_seq_equal1[symmetric])
+next
+ case (Cons a list)
+ have "rsimp (rders_simp (RSEQ r1 r2) s) = rsimp (rsimp (rders (RSEQ r1 r2) s))"
+ using local.Cons by (subst rders_simp_same_simpders)(simp_all)
+ also have "... = rsimp (rders (RSEQ r1 r2) s)"
+ by (simp add: rsimp_idem)
+ also have "... = rsimp (RALTS (RSEQ (rders r1 s) r2 # map (rders r2) (vsuf s r1)))"
+ using seq_closed_form_general by blast
+ also have "... = rsimp (RALTS (RSEQ (rders_simp r1 s) r2 # map (rders r2) (vsuf s r1)))"
+ by (simp only: seq_closed_form_aux1)
+ also have "... = rsimp (RALTS (RSEQ (rders_simp r1 s) r2 # map (rders_simp r2) (vsuf s r1)))"
+ using local.Cons by (subst seq_closed_form_aux2)(simp_all)
+ finally show ?thesis .
+qed
+
+lemma q: "s \<noteq> [] \<Longrightarrow> rders_simp (RSEQ r1 r2) s = rsimp (rders_simp (RSEQ r1 r2) s)"
+ using rders_simp_same_simpders rsimp_idem by presburger
+
+
+lemma seq_closed_form_variant:
+ assumes "s \<noteq> []"
+ shows "rders_simp (RSEQ r1 r2) s =
+ rsimp (RALTS (RSEQ (rders_simp r1 s) r2 # (map (rders_simp r2) (vsuf s r1))))"
+ using assms q seq_closed_form by force
+
+
+fun hflat_aux :: "rrexp \<Rightarrow> rrexp list" where
+ "hflat_aux (RALT r1 r2) = hflat_aux r1 @ hflat_aux r2"
+| "hflat_aux r = [r]"
+
+
+fun hflat :: "rrexp \<Rightarrow> rrexp" where
+ "hflat (RALT r1 r2) = RALTS ((hflat_aux r1) @ (hflat_aux r2))"
+| "hflat r = r"
+
+inductive created_by_star :: "rrexp \<Rightarrow> bool" where
+ "created_by_star (RSEQ ra (RSTAR rb))"
+| "\<lbrakk>created_by_star r1; created_by_star r2\<rbrakk> \<Longrightarrow> created_by_star (RALT r1 r2)"
+
+fun hElem :: "rrexp \<Rightarrow> rrexp list" where
+ "hElem (RALT r1 r2) = (hElem r1 ) @ (hElem r2)"
+| "hElem r = [r]"
+
+
+lemma cbs_ders_cbs:
+ shows "created_by_star r \<Longrightarrow> created_by_star (rder c r)"
+ apply(induct r rule: created_by_star.induct)
+ apply simp
+ using created_by_star.intros(1) created_by_star.intros(2) apply auto[1]
+ by (metis (mono_tags, lifting) created_by_star.simps list.simps(8) list.simps(9) rder.simps(4))
+
+lemma star_ders_cbs:
+ shows "created_by_star (rders (RSEQ r1 (RSTAR r2)) s)"
+ apply(induct s rule: rev_induct)
+ apply simp
+ apply (simp add: created_by_star.intros(1))
+ apply(subst rders_append)
+ apply simp
+ using cbs_ders_cbs by auto
+
+
+
+lemma hfau_pushin:
+ shows "created_by_star r \<Longrightarrow> hflat_aux (rder c r) = concat (map hElem (map (rder c) (hflat_aux r)))"
+ apply(induct r rule: created_by_star.induct)
+ apply simp
+ apply(subgoal_tac "created_by_star (rder c r1)")
+ prefer 2
+ apply(subgoal_tac "created_by_star (rder c r2)")
+ using cbs_ders_cbs apply blast
+ using cbs_ders_cbs apply auto[1]
+ apply simp
+ done
+
+lemma stupdate_induct1:
+ shows " concat (map (hElem \<circ> (rder x \<circ> (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0)))) Ss) =
+ map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0)) (star_update x r0 Ss)"
+ apply(induct Ss)
+ apply simp+
+ by (simp add: rders_append)
+
+
+
+lemma stupdates_join_general:
+ shows "concat (map hElem (map (rder x) (map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0)) (star_updates xs r0 Ss)))) =
+ map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0)) (star_updates (xs @ [x]) r0 Ss)"
+ apply(induct xs arbitrary: Ss)
+ apply (simp)
+ prefer 2
+ apply auto[1]
+ using stupdate_induct1 by blast
+
+lemma star_hfau_induct:
+ shows "hflat_aux (rders (RSEQ (rder c r0) (RSTAR r0)) s) =
+ map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0)) (star_updates s r0 [[c]])"
+ apply(induct s rule: rev_induct)
+ apply simp
+ apply(subst rders_append)+
+ apply simp
+ apply(subst stupdates_append)
+ apply(subgoal_tac "created_by_star (rders (RSEQ (rder c r0) (RSTAR r0)) xs)")
+ prefer 2
+ apply (simp add: star_ders_cbs)
+ apply(subst hfau_pushin)
+ apply simp
+ apply(subgoal_tac "concat (map hElem (map (rder x) (hflat_aux (rders (RSEQ (rder c r0) (RSTAR r0)) xs)))) =
+ concat (map hElem (map (rder x) ( map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0)) (star_updates xs r0 [[c]])))) ")
+ apply(simp only:)
+ prefer 2
+ apply presburger
+ apply(subst stupdates_append[symmetric])
+ using stupdates_join_general by blast
+
+
+
+lemma starders_hfau_also1:
+ shows "hflat_aux (rders (RSTAR r) (c # xs)) = map (\<lambda>s1. RSEQ (rders r s1) (RSTAR r)) (star_updates xs r [[c]])"
+ using star_hfau_induct by force
+
+lemma hflat_aux_grewrites:
+ shows "a # rs \<leadsto>g* hflat_aux a @ rs"
+ apply(induct a arbitrary: rs)
+ apply simp+
+ apply(case_tac x)
+ apply simp
+ apply(case_tac list)
+
+ apply (metis append.right_neutral append_Cons append_eq_append_conv2 grewrites.simps hflat_aux.simps(7) same_append_eq)
+ apply(case_tac lista)
+ apply simp
+ apply (metis (no_types, lifting) append_Cons append_eq_append_conv2 gmany_steps_later greal_trans grewrite.intros(2) grewrites_append self_append_conv)
+ apply simp
+ by simp_all
+
+
+
+
+lemma cbs_hfau_rsimpeq1:
+ shows "rsimp (RALT a b) = rsimp (RALTS ((hflat_aux a) @ (hflat_aux b)))"
+ apply(subgoal_tac "[a, b] \<leadsto>g* hflat_aux a @ hflat_aux b")
+ using grewrites_equal_rsimp apply presburger
+ by (metis append.right_neutral greal_trans grewrites_cons hflat_aux_grewrites)
+
+
+lemma hfau_rsimpeq2:
+ shows "created_by_star r \<Longrightarrow> rsimp r = rsimp ( (RALTS (hflat_aux r)))"
+ apply(induct r)
+ apply simp+
+
+ apply (metis rsimp_seq_equal1)
+ prefer 2
+ apply simp
+ apply(case_tac x)
+ apply simp
+ apply(case_tac "list")
+ apply simp
+
+ apply (metis idem_after_simp1)
+ apply(case_tac "lista")
+ prefer 2
+ apply (metis hflat_aux.simps(8) idem_after_simp1 list.simps(8) list.simps(9) rsimp.simps(2))
+ apply(subgoal_tac "rsimp (RALT a aa) = rsimp (RALTS (hflat_aux (RALT a aa)))")
+ apply simp
+ apply(subgoal_tac "rsimp (RALT a aa) = rsimp (RALTS (hflat_aux a @ hflat_aux aa))")
+ using hflat_aux.simps(1) apply presburger
+ apply simp
+ using cbs_hfau_rsimpeq1 apply(fastforce)
+ by simp
+
+
+lemma star_closed_form1:
+ shows "rsimp (rders (RSTAR r0) (c#s)) =
+rsimp ( ( RALTS ( (map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0) ) (star_updates s r0 [[c]]) ) )))"
+ using hfau_rsimpeq2 rder.simps(6) rders.simps(2) star_ders_cbs starders_hfau_also1 by presburger
+
+lemma star_closed_form2:
+ shows "rsimp (rders_simp (RSTAR r0) (c#s)) =
+rsimp ( ( RALTS ( (map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0) ) (star_updates s r0 [[c]]) ) )))"
+ by (metis list.distinct(1) rders_simp_same_simpders rsimp_idem star_closed_form1)
+
+lemma star_closed_form3:
+ shows "rsimp (rders_simp (RSTAR r0) (c#s)) = (rders_simp (RSTAR r0) (c#s))"
+ by (metis list.distinct(1) rders_simp_same_simpders star_closed_form1 star_closed_form2)
+
+lemma star_closed_form4:
+ shows " (rders_simp (RSTAR r0) (c#s)) =
+rsimp ( ( RALTS ( (map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0) ) (star_updates s r0 [[c]]) ) )))"
+ using star_closed_form2 star_closed_form3 by presburger
+
+lemma star_closed_form5:
+ shows " rsimp ( ( RALTS ( (map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0) ) Ss )))) =
+ rsimp ( ( RALTS ( (map (\<lambda>s1. rsimp (RSEQ (rders r0 s1) (RSTAR r0)) ) Ss ))))"
+ by (metis (mono_tags, lifting) list.map_comp map_eq_conv o_apply rsimp.simps(2) rsimp_idem)
+
+lemma star_closed_form6_hrewrites:
+ shows "
+ (map (\<lambda>s1. (RSEQ (rsimp (rders r0 s1)) (RSTAR r0)) ) Ss )
+ scf\<leadsto>*
+(map (\<lambda>s1. rsimp (RSEQ (rders r0 s1) (RSTAR r0)) ) Ss )"
+ apply(induct Ss)
+ apply simp
+ apply (simp add: ss1)
+ by (metis (no_types, lifting) list.simps(9) rsimp.simps(1) rsimp_idem simp_hrewrites ss2)
+
+lemma star_closed_form6:
+ shows " rsimp ( ( RALTS ( (map (\<lambda>s1. rsimp (RSEQ (rders r0 s1) (RSTAR r0)) ) Ss )))) =
+ rsimp ( ( RALTS ( (map (\<lambda>s1. (RSEQ (rsimp (rders r0 s1)) (RSTAR r0)) ) Ss ))))"
+ apply(subgoal_tac " map (\<lambda>s1. (RSEQ (rsimp (rders r0 s1)) (RSTAR r0)) ) Ss scf\<leadsto>*
+ map (\<lambda>s1. rsimp (RSEQ (rders r0 s1) (RSTAR r0)) ) Ss ")
+ using hrewrites_simpeq srewritescf_alt1 apply fastforce
+ using star_closed_form6_hrewrites by blast
+
+
+
+
+lemma stupdate_nonempty:
+ shows "\<forall>s \<in> set Ss. s \<noteq> [] \<Longrightarrow> \<forall>s \<in> set (star_update c r Ss). s \<noteq> []"
+ apply(induct Ss)
+ apply simp
+ apply(case_tac "rnullable (rders r a)")
+ apply simp+
+ done
+
+
+lemma stupdates_nonempty:
+ shows "\<forall>s \<in> set Ss. s\<noteq> [] \<Longrightarrow> \<forall>s \<in> set (star_updates s r Ss). s \<noteq> []"
+ apply(induct s arbitrary: Ss)
+ apply simp
+ apply simp
+ using stupdate_nonempty by presburger
+
+
+lemma star_closed_form8:
+ shows
+"rsimp ( ( RALTS ( (map (\<lambda>s1. RSEQ (rsimp (rders r0 s1)) (RSTAR r0) ) (star_updates s r0 [[c]]) ) ))) =
+ rsimp ( ( RALTS ( (map (\<lambda>s1. RSEQ ( (rders_simp r0 s1)) (RSTAR r0) ) (star_updates s r0 [[c]]) ) )))"
+ by (smt (verit, ccfv_SIG) list.simps(8) map_eq_conv rders__onechar rders_simp_same_simpders set_ConsD stupdates_nonempty)
+
+
+lemma star_closed_form:
+ shows "rders_simp (RSTAR r0) (c#s) =
+rsimp ( RALTS ( (map (\<lambda>s1. RSEQ (rders_simp r0 s1) (RSTAR r0) ) (star_updates s r0 [[c]]) ) ))"
+ apply(case_tac s)
+ apply simp
+ apply (metis idem_after_simp1 rsimp.simps(1) rsimp.simps(6) rsimp_idem)
+ using star_closed_form4 star_closed_form5 star_closed_form6 star_closed_form8 by presburger
+
+
+
+
+fun nupdate :: "char \<Rightarrow> rrexp \<Rightarrow> (string * nat) option list \<Rightarrow> (string * nat) option list" where
+ "nupdate c r [] = []"
+| "nupdate c r (Some (s, Suc n) # Ss) = (if (rnullable (rders r s))
+ then Some (s@[c], Suc n) # Some ([c], n) # (nupdate c r Ss)
+ else Some ((s@[c]), Suc n) # (nupdate c r Ss)
+ )"
+| "nupdate c r (Some (s, 0) # Ss) = (if (rnullable (rders r s))
+ then Some (s@[c], 0) # None # (nupdate c r Ss)
+ else Some ((s@[c]), 0) # (nupdate c r Ss)
+ ) "
+| "nupdate c r (None # Ss) = (None # nupdate c r Ss)"
+
+
+fun nupdates :: "char list \<Rightarrow> rrexp \<Rightarrow> (string * nat) option list \<Rightarrow> (string * nat) option list"
+ where
+ "nupdates [] r Ss = Ss"
+| "nupdates (c # cs) r Ss = nupdates cs r (nupdate c r Ss)"
+
+fun ntset :: "rrexp \<Rightarrow> nat \<Rightarrow> string \<Rightarrow> (string * nat) option list" where
+ "ntset r (Suc n) (c # cs) = nupdates cs r [Some ([c], n)]"
+| "ntset r 0 _ = [None]"
+| "ntset r _ [] = []"
+
+inductive created_by_ntimes :: "rrexp \<Rightarrow> bool" where
+ "created_by_ntimes RZERO"
+| "created_by_ntimes (RSEQ ra (RNTIMES rb n))"
+| "\<lbrakk>created_by_ntimes r1; created_by_ntimes r2\<rbrakk> \<Longrightarrow> created_by_ntimes (RALT r1 r2)"
+| "\<lbrakk>created_by_ntimes r \<rbrakk> \<Longrightarrow> created_by_ntimes (RALT r RZERO)"
+
+fun highest_power_aux :: "(string * nat) option list \<Rightarrow> nat \<Rightarrow> nat" where
+ "highest_power_aux [] n = n"
+| "highest_power_aux (None # rs) n = highest_power_aux rs n"
+| "highest_power_aux (Some (s, n) # rs) m = highest_power_aux rs (max n m)"
+
+fun hpower :: "(string * nat) option list \<Rightarrow> nat" where
+ "hpower rs = highest_power_aux rs 0"
+
+
+lemma nupdate_mono:
+ shows " (highest_power_aux (nupdate c r optlist) m) \<le> (highest_power_aux optlist m)"
+ apply(induct optlist arbitrary: m)
+ apply simp
+ apply(case_tac a)
+ apply simp
+ apply(case_tac aa)
+ apply(case_tac b)
+ apply simp+
+ done
+
+lemma nupdate_mono1:
+ shows "hpower (nupdate c r optlist) \<le> hpower optlist"
+ by (simp add: nupdate_mono)
+
+
+
+lemma cbn_ders_cbn:
+ shows "created_by_ntimes r \<Longrightarrow> created_by_ntimes (rder c r)"
+ apply(induct r rule: created_by_ntimes.induct)
+ apply simp
+
+ using created_by_ntimes.intros(1) created_by_ntimes.intros(2) created_by_ntimes.intros(3) apply presburger
+
+ apply (metis created_by_ntimes.simps rder.simps(5) rder.simps(7))
+ using created_by_star.intros(1) created_by_star.intros(2) apply auto[1]
+ using created_by_ntimes.intros(1) created_by_ntimes.intros(3) apply auto[1]
+ by (metis (mono_tags, lifting) created_by_ntimes.simps list.simps(8) list.simps(9) rder.simps(1) rder.simps(4))
+
+lemma ntimes_ders_cbn:
+ shows "created_by_ntimes (rders (RSEQ r' (RNTIMES r n)) s)"
+ apply(induct s rule: rev_induct)
+ apply simp
+ apply (simp add: created_by_ntimes.intros(2))
+ apply(subst rders_append)
+ using cbn_ders_cbn by auto
+
+lemma always0:
+ shows "rders RZERO s = RZERO"
+ apply(induct s)
+ by simp+
+
+lemma ntimes_ders_cbn1:
+ shows "created_by_ntimes (rders (RNTIMES r n) (c#s))"
+ apply(case_tac n)
+ apply simp
+ using always0 created_by_ntimes.intros(1) apply auto[1]
+ by (simp add: ntimes_ders_cbn)
+
+
+lemma ntimes_hfau_pushin:
+ shows "created_by_ntimes r \<Longrightarrow> hflat_aux (rder c r) = concat (map hflat_aux (map (rder c) (hflat_aux r)))"
+ apply(induct r rule: created_by_ntimes.induct)
+ apply simp+
+ done
+
+
+abbreviation
+ "opterm r SN \<equiv> case SN of
+ Some (s, n) \<Rightarrow> RSEQ (rders r s) (RNTIMES r n)
+ | None \<Rightarrow> RZERO
+
+
+"
+
+fun nonempty_string :: "(string * nat) option \<Rightarrow> bool" where
+ "nonempty_string None = True"
+| "nonempty_string (Some ([], n)) = False"
+| "nonempty_string (Some (c#s, n)) = True"
+
+
+lemma nupdate_nonempty:
+ shows "\<lbrakk>\<forall>opt \<in> set Ss. nonempty_string opt \<rbrakk> \<Longrightarrow> \<forall>opt \<in> set (nupdate c r Ss). nonempty_string opt"
+ apply(induct c r Ss rule: nupdate.induct)
+ apply(auto)
+ apply (metis Nil_is_append_conv neq_Nil_conv nonempty_string.simps(3))
+ by (metis Nil_is_append_conv neq_Nil_conv nonempty_string.simps(3))
+
+
+
+lemma nupdates_nonempty:
+ shows "\<lbrakk>\<forall>opt \<in> set Ss. nonempty_string opt \<rbrakk> \<Longrightarrow> \<forall>opt \<in> set (nupdates s r Ss). nonempty_string opt"
+ apply(induct s arbitrary: Ss)
+ apply simp
+ apply simp
+ using nupdate_nonempty by presburger
+
+lemma nullability1: shows "rnullable (rders r s) = rnullable (rders_simp r s)"
+ by (metis der_simp_nullability rders.simps(1) rders_simp.simps(1) rders_simp_same_simpders)
+
+lemma nupdate_induct1:
+ shows
+ "concat (map (hflat_aux \<circ> (rder c \<circ> (opterm r))) sl ) =
+ map (opterm r) (nupdate c r sl)"
+ apply(induct sl)
+ apply simp
+ apply(simp add: rders_append)
+ apply(case_tac "a")
+ apply simp+
+ apply(case_tac "aa")
+ apply(case_tac "b")
+ apply(case_tac "rnullable (rders r ab)")
+ apply(subgoal_tac "rnullable (rders_simp r ab)")
+ apply simp
+ using rders.simps(1) rders.simps(2) rders_append apply presburger
+ using nullability1 apply blast
+ apply simp
+ using rders.simps(1) rders.simps(2) rders_append apply presburger
+ apply simp
+ using rders.simps(1) rders.simps(2) rders_append by presburger
+
+
+lemma nupdates_join_general:
+ shows "concat (map hflat_aux (map (rder x) (map (opterm r) (nupdates xs r Ss)) )) =
+ map (opterm r) (nupdates (xs @ [x]) r Ss)"
+ apply(induct xs arbitrary: Ss)
+ apply (simp)
+ prefer 2
+ apply auto[1]
+ using nupdate_induct1 by blast
+
+
+lemma nupdates_join_general1:
+ shows "concat (map (hflat_aux \<circ> (rder x) \<circ> (opterm r)) (nupdates xs r Ss)) =
+ map (opterm r) (nupdates (xs @ [x]) r Ss)"
+ by (metis list.map_comp nupdates_join_general)
+
+lemma nupdates_append: shows
+"nupdates (s @ [c]) r Ss = nupdate c r (nupdates s r Ss)"
+ apply(induct s arbitrary: Ss)
+ apply simp
+ apply simp
+ done
+
+lemma nupdates_mono:
+ shows "highest_power_aux (nupdates s r optlist) m \<le> highest_power_aux optlist m"
+ apply(induct s rule: rev_induct)
+ apply simp
+ apply(subst nupdates_append)
+ by (meson le_trans nupdate_mono)
+
+lemma nupdates_mono1:
+ shows "hpower (nupdates s r optlist) \<le> hpower optlist"
+ by (simp add: nupdates_mono)
+
+
+(*"\<forall>r \<in> set (nupdates s r [Some ([c], n)]). r = None \<or>( \<exists>s' m. r = Some (s', m) \<and> m \<le> n)"*)
+lemma nupdates_mono2:
+ shows "hpower (nupdates s r [Some ([c], n)]) \<le> n"
+ by (metis highest_power_aux.simps(1) highest_power_aux.simps(3) hpower.simps max_nat.right_neutral nupdates_mono1)
+
+lemma hpow_arg_mono:
+ shows "m \<ge> n \<Longrightarrow> highest_power_aux rs m \<ge> highest_power_aux rs n"
+ apply(induct rs arbitrary: m n)
+ apply simp
+ apply(case_tac a)
+ apply simp
+ apply(case_tac aa)
+ apply simp
+ done
+
+
+lemma hpow_increase:
+ shows "highest_power_aux (a # rs') m \<ge> highest_power_aux rs' m"
+ apply(case_tac a)
+ apply simp
+ apply simp
+ apply(case_tac aa)
+ apply(case_tac b)
+ apply simp+
+ apply(case_tac "Suc nat > m")
+ using hpow_arg_mono max.cobounded2 apply blast
+ using hpow_arg_mono max.cobounded2 by blast
+
+lemma hpow_append:
+ shows "highest_power_aux (rsa @ rsb) m = highest_power_aux rsb (highest_power_aux rsa m)"
+ apply (induct rsa arbitrary: rsb m)
+ apply simp
+ apply simp
+ apply(case_tac a)
+ apply simp
+ apply(case_tac aa)
+ apply simp
+ done
+
+lemma hpow_aux_mono:
+ shows "highest_power_aux (rsa @ rsb) m \<ge> highest_power_aux rsb m"
+ apply(induct rsa arbitrary: rsb rule: rev_induct)
+ apply simp
+ apply simp
+ using hpow_increase order.trans by blast
+
+
+
+
+lemma hpow_mono:
+ shows "hpower (rsa @ rsb) \<le> n \<Longrightarrow> hpower rsb \<le> n"
+ apply(induct rsb arbitrary: rsa)
+ apply simp
+ apply(subgoal_tac "hpower rsb \<le> n")
+ apply simp
+ apply (metis dual_order.trans hpow_aux_mono)
+ by (metis hpow_append hpow_increase hpower.simps nat_le_iff_add trans_le_add1)
+
+
+lemma hpower_rs_elems_aux:
+ shows "highest_power_aux rs k \<le> n \<Longrightarrow> \<forall>r\<in>set rs. r = None \<or> (\<exists>s' m. r = Some (s', m) \<and> m \<le> n)"
+apply(induct rs k arbitrary: n rule: highest_power_aux.induct)
+ apply(auto)
+ by (metis dual_order.trans highest_power_aux.simps(1) hpow_append hpow_aux_mono linorder_le_cases max.absorb1 max.absorb2)
+
+
+lemma hpower_rs_elems:
+ shows "hpower rs \<le> n \<Longrightarrow> \<forall>r \<in> set rs. r = None \<or>( \<exists>s' m. r = Some (s', m) \<and> m \<le> n)"
+ by (simp add: hpower_rs_elems_aux)
+
+lemma nupdates_elems_leqn:
+ shows "\<forall>r \<in> set (nupdates s r [Some ([c], n)]). r = None \<or>( \<exists>s' m. r = Some (s', m) \<and> m \<le> n)"
+ by (meson hpower_rs_elems nupdates_mono2)
+
+lemma ntimes_hfau_induct:
+ shows "hflat_aux (rders (RSEQ (rder c r) (RNTIMES r n)) s) =
+ map (opterm r) (nupdates s r [Some ([c], n)])"
+ apply(induct s rule: rev_induct)
+ apply simp
+ apply(subst rders_append)+
+ apply simp
+ apply(subst nupdates_append)
+ apply(subgoal_tac "created_by_ntimes (rders (RSEQ (rder c r) (RNTIMES r n)) xs)")
+ prefer 2
+ apply (simp add: ntimes_ders_cbn)
+ apply(subst ntimes_hfau_pushin)
+ apply simp
+ apply(subgoal_tac "concat (map hflat_aux (map (rder x) (hflat_aux (rders (RSEQ (rder c r) (RNTIMES r n)) xs)))) =
+ concat (map hflat_aux (map (rder x) ( map (opterm r) (nupdates xs r [Some ([c], n)])))) ")
+ apply(simp only:)
+ prefer 2
+ apply presburger
+ apply(subst nupdates_append[symmetric])
+ using nupdates_join_general by blast
+
+
+(*nupdates s r [Some ([c], n)]*)
+lemma ntimes_ders_hfau_also1:
+ shows "hflat_aux (rders (RNTIMES r (Suc n)) (c # xs)) = map (opterm r) (nupdates xs r [Some ([c], n)])"
+ using ntimes_hfau_induct by force
+
+
+
+lemma hfau_rsimpeq2_ntimes:
+ shows "created_by_ntimes r \<Longrightarrow> rsimp r = rsimp ( (RALTS (hflat_aux r)))"
+ apply(induct r)
+ apply simp+
+
+ apply (metis rsimp_seq_equal1)
+ prefer 2
+ apply simp
+ apply(case_tac x)
+ apply simp
+ apply(case_tac "list")
+ apply simp
+
+ apply (metis idem_after_simp1)
+ apply(case_tac "lista")
+ prefer 2
+ apply (metis hflat_aux.simps(8) idem_after_simp1 list.simps(8) list.simps(9) rsimp.simps(2))
+ apply(subgoal_tac "rsimp (RALT a aa) = rsimp (RALTS (hflat_aux (RALT a aa)))")
+ apply simp
+ apply(subgoal_tac "rsimp (RALT a aa) = rsimp (RALTS (hflat_aux a @ hflat_aux aa))")
+ using hflat_aux.simps(1) apply presburger
+ apply simp
+ using cbs_hfau_rsimpeq1 apply(fastforce)
+ by simp
+
+
+lemma ntimes_closed_form1:
+ shows "rsimp (rders (RNTIMES r (Suc n)) (c#s)) =
+rsimp ( ( RALTS ( map (opterm r) (nupdates s r [Some ([c], n)]) )))"
+ apply(subgoal_tac "created_by_ntimes (rders (RNTIMES r (Suc n)) (c#s))")
+ apply(subst hfau_rsimpeq2_ntimes)
+ apply linarith
+ using ntimes_ders_hfau_also1 apply auto[1]
+ using ntimes_ders_cbn1 by blast
+
+
+lemma ntimes_closed_form2:
+ shows "rsimp (rders_simp (RNTIMES r (Suc n)) (c#s) ) =
+rsimp ( ( RALTS ( (map (opterm r ) (nupdates s r [Some ([c], n)]) ) )))"
+ by (metis list.distinct(1) ntimes_closed_form1 rders_simp_same_simpders rsimp_idem)
+
+
+lemma ntimes_closed_form3:
+ shows "rsimp (rders_simp (RNTIMES r n) (c#s)) = (rders_simp (RNTIMES r n) (c#s))"
+ by (metis list.distinct(1) rders_simp_same_simpders rsimp_idem)
+
+
+lemma ntimes_closed_form4:
+ shows " (rders_simp (RNTIMES r (Suc n)) (c#s)) =
+rsimp ( ( RALTS ( (map (opterm r ) (nupdates s r [Some ([c], n)]) ) )))"
+ using ntimes_closed_form2 ntimes_closed_form3
+ by metis
+
+
+
+
+lemma ntimes_closed_form5:
+ shows " rsimp ( RALTS (map (\<lambda>s1. RSEQ (rders r0 s1) (RNTIMES r n) ) Ss)) =
+ rsimp ( RALTS (map (\<lambda>s1. rsimp (RSEQ (rders r0 s1) (RNTIMES r n)) ) Ss))"
+ by (smt (verit, ccfv_SIG) list.map_comp map_eq_conv o_apply simp_flatten_aux0)
+
+
+
+lemma ntimes_closed_form6_hrewrites:
+ shows "
+(map (\<lambda>s1. (RSEQ (rsimp (rders r0 s1)) (RNTIMES r0 n)) ) Ss )
+ scf\<leadsto>*
+(map (\<lambda>s1. rsimp (RSEQ (rders r0 s1) (RNTIMES r0 n)) ) Ss )"
+ apply(induct Ss)
+ apply simp
+ apply (simp add: ss1)
+ by (metis (no_types, lifting) list.simps(9) rsimp.simps(1) rsimp_idem simp_hrewrites ss2)
+
+
+
+lemma ntimes_closed_form6:
+ shows " rsimp ( ( RALTS ( (map (\<lambda>s1. rsimp (RSEQ (rders r0 s1) (RNTIMES r0 n)) ) Ss )))) =
+ rsimp ( ( RALTS ( (map (\<lambda>s1. (RSEQ (rsimp (rders r0 s1)) (RNTIMES r0 n)) ) Ss ))))"
+ apply(subgoal_tac " map (\<lambda>s1. (RSEQ (rsimp (rders r0 s1)) (RNTIMES r0 n)) ) Ss scf\<leadsto>*
+ map (\<lambda>s1. rsimp (RSEQ (rders r0 s1) (RNTIMES r0 n)) ) Ss ")
+ using hrewrites_simpeq srewritescf_alt1 apply fastforce
+ using ntimes_closed_form6_hrewrites by blast
+
+abbreviation
+ "optermsimp r SN \<equiv> case SN of
+ Some (s, n) \<Rightarrow> RSEQ (rders_simp r s) (RNTIMES r n)
+ | None \<Rightarrow> RZERO
+
+
+"
+
+abbreviation
+ "optermOsimp r SN \<equiv> case SN of
+ Some (s, n) \<Rightarrow> rsimp (RSEQ (rders r s) (RNTIMES r n))
+ | None \<Rightarrow> RZERO
+
+
+"
+
+abbreviation
+ "optermosimp r SN \<equiv> case SN of
+ Some (s, n) \<Rightarrow> RSEQ (rsimp (rders r s)) (RNTIMES r n)
+ | None \<Rightarrow> RZERO
+"
+
+lemma ntimes_closed_form51:
+ shows "rsimp (RALTS (map (opterm r) (nupdates s r [Some ([c], n)]))) =
+ rsimp (RALTS (map (rsimp \<circ> (opterm r)) (nupdates s r [Some ([c], n)])))"
+ by (metis map_map simp_flatten_aux0)
+
+
+
+lemma osimp_Osimp:
+ shows " nonempty_string sn \<Longrightarrow> optermosimp r sn = optermsimp r sn"
+ apply(induct rule: nonempty_string.induct)
+ apply force
+ apply auto[1]
+ apply simp
+ by (metis list.distinct(1) rders.simps(2) rders_simp.simps(2) rders_simp_same_simpders)
+
+
+
+lemma osimp_Osimp_list:
+ shows "\<forall>sn \<in> set snlist. nonempty_string sn \<Longrightarrow> map (optermosimp r) snlist = map (optermsimp r) snlist"
+ by (simp add: osimp_Osimp)
+
+
+lemma ntimes_closed_form8:
+ shows
+"rsimp (RALTS (map (optermosimp r) (nupdates s r [Some ([c], n)]))) =
+ rsimp (RALTS (map (optermsimp r) (nupdates s r [Some ([c], n)])))"
+ apply(subgoal_tac "\<forall>opt \<in> set (nupdates s r [Some ([c], n)]). nonempty_string opt")
+ using osimp_Osimp_list apply presburger
+ by (metis list.distinct(1) list.set_cases nonempty_string.simps(3) nupdates_nonempty set_ConsD)
+
+
+
+lemma ntimes_closed_form9aux:
+ shows "\<forall>snopt \<in> set (nupdates s r [Some ([c], n)]). nonempty_string snopt"
+ by (metis list.distinct(1) list.set_cases nonempty_string.simps(3) nupdates_nonempty set_ConsD)
+
+lemma ntimes_closed_form9aux1:
+ shows "\<forall>snopt \<in> set snlist. nonempty_string snopt \<Longrightarrow>
+rsimp (RALTS (map (optermosimp r) snlist)) =
+rsimp (RALTS (map (optermOsimp r) snlist))"
+ apply(induct snlist)
+ apply simp+
+ apply(case_tac "a")
+ apply simp+
+ by (smt (z3) case_prod_conv idem_after_simp1 map_eq_conv nonempty_string.elims(2) o_apply option.simps(4) option.simps(5) rsimp.simps(1) rsimp.simps(7) rsimp_idem)
+
+
+
+
+lemma ntimes_closed_form9:
+ shows
+"rsimp (RALTS (map (optermosimp r) (nupdates s r [Some ([c], n)]))) =
+ rsimp (RALTS (map (optermOsimp r) (nupdates s r [Some ([c], n)])))"
+ using ntimes_closed_form9aux ntimes_closed_form9aux1 by presburger
+
+
+lemma ntimes_closed_form10rewrites_aux:
+ shows " map (rsimp \<circ> (opterm r)) optlist scf\<leadsto>*
+ map (optermOsimp r) optlist"
+ apply(induct optlist)
+ apply simp
+ apply (simp add: ss1)
+ apply simp
+ apply(case_tac a)
+ using ss2 apply fastforce
+ using ss2 by force
+
+
+lemma ntimes_closed_form10rewrites:
+ shows " map (rsimp \<circ> (opterm r)) (nupdates s r [Some ([c], n)]) scf\<leadsto>*
+ map (optermOsimp r) (nupdates s r [Some ([c], n)])"
+ using ntimes_closed_form10rewrites_aux by blast
+
+lemma ntimes_closed_form10:
+ shows "rsimp (RALTS (map (rsimp \<circ> (opterm r)) (nupdates s r [Some ([c], n)]))) =
+ rsimp (RALTS (map (optermOsimp r) (nupdates s r [Some ([c], n)])))"
+ by (smt (verit, best) case_prod_conv hpower_rs_elems map_eq_conv nupdates_mono2 o_apply option.case(2) option.simps(4) rsimp.simps(3))
+
+
+lemma rders_simp_cons:
+ shows "rders_simp r (c # s) = rders_simp (rsimp (rder c r)) s"
+ by simp
+
+lemma rder_ntimes:
+ shows "rder c (RNTIMES r (Suc n)) = RSEQ (rder c r) (RNTIMES r n)"
+ by simp
+
+
+lemma ntimes_closed_form:
+ shows "rders_simp (RNTIMES r0 (Suc n)) (c#s) =
+rsimp ( RALTS ( (map (optermsimp r0 ) (nupdates s r0 [Some ([c], n)]) ) ))"
+ apply (subst rders_simp_cons)
+ apply(subst rder_ntimes)
+ using ntimes_closed_form10 ntimes_closed_form4 ntimes_closed_form51 ntimes_closed_form8 ntimes_closed_form9 by force
+
+
+
+
+
+
+(*
+lemma ntimes_closed_form:
+ assumes "s \<noteq> []"
+ shows "rders_simp (RNTIMES r (Suc n)) s =
+rsimp ( RALTS ( map
+ (\<lambda> optSN. case optSN of
+ Some (s, n) \<Rightarrow> RSEQ (rders_simp r s) (RNTIMES r n)
+ | None \<Rightarrow> RZERO
+ )
+ (ntset r n s)
+ )
+ )"
+
+*)
+
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys4/posix/ClosedFormsBounds.thy Mon Aug 29 23:16:28 2022 +0100
@@ -0,0 +1,691 @@
+
+theory ClosedFormsBounds
+ imports "GeneralRegexBound" "ClosedForms"
+begin
+lemma alts_ders_lambda_shape_ders:
+ shows "\<forall>r \<in> set (map (\<lambda>r. rders_simp r ( s)) rs ). \<exists>r1 \<in> set rs. r = rders_simp r1 s"
+ by (simp add: image_iff)
+
+lemma rlist_bound:
+ assumes "\<forall>r \<in> set rs. rsize r \<le> N"
+ shows "rsizes rs \<le> N * (length rs)"
+ using assms
+ apply(induct rs)
+ apply simp
+ by simp
+
+lemma alts_closed_form_bounded:
+ assumes "\<forall>r \<in> set rs. \<forall>s. rsize (rders_simp r s) \<le> N"
+ shows "rsize (rders_simp (RALTS rs) s) \<le> max (Suc (N * (length rs))) (rsize (RALTS rs))"
+proof (cases s)
+ case Nil
+ then show "rsize (rders_simp (RALTS rs) s) \<le> max (Suc (N * length rs)) (rsize (RALTS rs))"
+ by simp
+next
+ case (Cons a s)
+
+ from assms have "\<forall>r \<in> set (map (\<lambda>r. rders_simp r (a # s)) rs ). rsize r \<le> N"
+ by (metis alts_ders_lambda_shape_ders)
+ then have a: "rsizes (map (\<lambda>r. rders_simp r (a # s)) rs ) \<le> N * (length rs)"
+ by (metis length_map rlist_bound)
+
+ have "rsize (rders_simp (RALTS rs) (a # s))
+ = rsize (rsimp (RALTS (map (\<lambda>r. rders_simp r (a # s)) rs)))"
+ by (metis alts_closed_form_variant list.distinct(1))
+ also have "... \<le> rsize (RALTS (map (\<lambda>r. rders_simp r (a # s)) rs))"
+ using rsimp_mono by blast
+ also have "... = Suc (rsizes (map (\<lambda>r. rders_simp r (a # s)) rs))"
+ by simp
+ also have "... \<le> Suc (N * (length rs))"
+ using a by blast
+ finally have "rsize (rders_simp (RALTS rs) (a # s)) \<le> max (Suc (N * length rs)) (rsize (RALTS rs))"
+ by auto
+ then show ?thesis using local.Cons by simp
+qed
+
+lemma alts_simp_ineq_unfold:
+ shows "rsize (rsimp (RALTS rs)) \<le> Suc (rsizes (rdistinct (rflts (map rsimp rs)) {}))"
+ using rsimp_aalts_smaller by auto
+
+
+lemma rdistinct_mono_list:
+ shows "rsizes (rdistinct (x5 @ rs) rset) \<le> rsizes x5 + rsizes (rdistinct rs ((set x5 ) \<union> rset))"
+ apply(induct x5 arbitrary: rs rset)
+ apply simp
+ apply(case_tac "a \<in> rset")
+ apply simp
+ apply (simp add: add.assoc insert_absorb trans_le_add2)
+ apply simp
+ by (metis Un_insert_right)
+
+
+lemma flts_size_reduction_alts:
+ assumes a: "\<And>noalts_set alts_set corr_set.
+ (\<forall>r\<in>noalts_set. \<forall>xs. r \<noteq> RALTS xs) \<and>
+ (\<forall>a\<in>alts_set. \<exists>xs. a = RALTS xs \<and> set xs \<subseteq> corr_set) \<Longrightarrow>
+ Suc (rsizes (rdistinct (rflts rs) (noalts_set \<union> corr_set)))
+ \<le> Suc (rsizes (rdistinct rs (insert RZERO (noalts_set \<union> alts_set))))"
+ and b: "\<forall>r\<in>noalts_set. \<forall>xs. r \<noteq> RALTS xs"
+ and c: "\<forall>a\<in>alts_set. \<exists>xs. a = RALTS xs \<and> set xs \<subseteq> corr_set"
+ and d: "a = RALTS x5"
+ shows "rsizes (rdistinct (rflts (a # rs)) (noalts_set \<union> corr_set))
+ \<le> rsizes (rdistinct (a # rs) (insert RZERO (noalts_set \<union> alts_set)))"
+
+ apply(case_tac "a \<in> alts_set")
+ using a b c d
+ apply simp
+ apply(subgoal_tac "set x5 \<subseteq> corr_set")
+ apply(subst rdistinct_concat)
+ apply auto[1]
+ apply presburger
+ apply fastforce
+ using a b c d
+ apply (subgoal_tac "a \<notin> noalts_set")
+ prefer 2
+ apply blast
+ apply simp
+ apply(subgoal_tac "rsizes (rdistinct (x5 @ rflts rs) (noalts_set \<union> corr_set))
+ \<le> rsizes x5 + rsizes (rdistinct (rflts rs) ((set x5) \<union> (noalts_set \<union> corr_set)))")
+ prefer 2
+ using rdistinct_mono_list apply presburger
+ apply(subgoal_tac "insert (RALTS x5) (noalts_set \<union> alts_set) = noalts_set \<union> (insert (RALTS x5) alts_set)")
+ apply(simp only:)
+ apply(subgoal_tac "rsizes x5 + rsizes (rdistinct (rflts rs) (noalts_set \<union> (corr_set \<union> (set x5)))) \<le>
+ rsizes x5 + rsizes (rdistinct rs (insert RZERO (noalts_set \<union> insert (RALTS x5) alts_set)))")
+
+ apply (simp add: Un_left_commute inf_sup_aci(5))
+ apply(subgoal_tac "rsizes (rdistinct (rflts rs) (noalts_set \<union> (corr_set \<union> set x5))) \<le>
+ rsizes (rdistinct rs (insert RZERO (noalts_set \<union> insert (RALTS x5) alts_set)))")
+ apply linarith
+ apply(subgoal_tac "\<forall>r \<in> insert (RALTS x5) alts_set. \<exists>xs1.( r = RALTS xs1 \<and> set xs1 \<subseteq> corr_set \<union> set x5)")
+ apply presburger
+ apply (meson insert_iff sup.cobounded2 sup.coboundedI1)
+ by blast
+
+
+lemma flts_vs_nflts1:
+ assumes "\<forall>r \<in> noalts_set. \<forall>xs. r \<noteq> RALTS xs"
+ and "\<forall>a \<in> alts_set. (\<exists>xs. a = RALTS xs \<and> set xs \<subseteq> corr_set)"
+ shows "rsizes (rdistinct (rflts rs) (noalts_set \<union> corr_set))
+ \<le> rsizes (rdistinct rs (insert RZERO (noalts_set \<union> alts_set)))"
+ using assms
+ apply(induct rs arbitrary: noalts_set alts_set corr_set)
+ apply simp
+ apply(case_tac a)
+ apply(case_tac "RZERO \<in> noalts_set")
+ apply simp
+ apply(subgoal_tac "RZERO \<notin> alts_set")
+ apply simp
+ apply fastforce
+ apply(case_tac "RONE \<in> noalts_set")
+ apply simp
+ apply(subgoal_tac "RONE \<notin> alts_set")
+ prefer 2
+ apply fastforce
+ apply(case_tac "RONE \<in> corr_set")
+ apply(subgoal_tac "rflts (a # rs) = RONE # rflts rs")
+ apply(simp only:)
+ apply(subgoal_tac "rdistinct (RONE # rflts rs) (noalts_set \<union> corr_set) =
+ rdistinct (rflts rs) (noalts_set \<union> corr_set)")
+ apply(simp only:)
+ apply(subgoal_tac "rdistinct (RONE # rs) (insert RZERO (noalts_set \<union> alts_set)) =
+ RONE # (rdistinct rs (insert RONE (insert RZERO (noalts_set \<union> alts_set)))) ")
+ apply(simp only:)
+ apply(subgoal_tac "rdistinct (rflts rs) (noalts_set \<union> corr_set) =
+ rdistinct (rflts rs) (insert RONE (noalts_set \<union> corr_set))")
+ apply (simp only:)
+ apply(subgoal_tac "insert RONE (noalts_set \<union> corr_set) = (insert RONE noalts_set) \<union> corr_set")
+ apply(simp only:)
+ apply(subgoal_tac "insert RONE (insert RZERO (noalts_set \<union> alts_set)) =
+ insert RZERO ((insert RONE noalts_set) \<union> alts_set)")
+ apply(simp only:)
+ apply(subgoal_tac "rsizes (rdistinct rs (insert RZERO (insert RONE noalts_set \<union> alts_set)))
+ \<le> rsizes (RONE # rdistinct rs (insert RZERO (insert RONE noalts_set \<union> alts_set)))")
+ apply (smt (verit, ccfv_threshold) dual_order.trans insertE rrexp.distinct(17))
+ apply (metis (no_types, opaque_lifting) le_add_same_cancel2 list.simps(9) sum_list.Cons zero_le)
+ apply fastforce
+ apply fastforce
+ apply (metis Un_iff insert_absorb)
+ apply (metis UnE insertE insert_is_Un rdistinct.simps(2) rrexp.distinct(1))
+ apply (meson UnCI rdistinct.simps(2))
+ using rflts.simps(4) apply presburger
+ apply simp
+ apply(subgoal_tac "insert RONE (noalts_set \<union> corr_set) = (insert RONE noalts_set) \<union> corr_set")
+ apply(simp only:)
+ apply (metis Un_insert_left insertE rrexp.distinct(17))
+ apply fastforce
+ apply(case_tac "a \<in> noalts_set")
+ apply simp
+ apply(subgoal_tac "a \<notin> alts_set")
+ prefer 2
+ apply blast
+ apply(case_tac "a \<in> corr_set")
+ apply(subgoal_tac "noalts_set \<union> corr_set = insert a ( noalts_set \<union> corr_set)")
+ prefer 2
+ apply fastforce
+ apply(simp only:)
+ apply(subgoal_tac "rsizes (rdistinct (a # rs) (insert RZERO ((insert a noalts_set) \<union> alts_set))) \<le>
+ rsizes (rdistinct (a # rs) (insert RZERO (noalts_set \<union> alts_set)))")
+
+ apply(subgoal_tac "rsizes (rdistinct (rflts (a # rs)) ((insert a noalts_set) \<union> corr_set)) \<le>
+ rsizes (rdistinct (a # rs) (insert RZERO ((insert a noalts_set) \<union> alts_set)))")
+ apply fastforce
+ apply simp
+ apply(subgoal_tac "(insert a (noalts_set \<union> alts_set)) = (insert a noalts_set) \<union> alts_set")
+ apply(simp only:)
+ apply(subgoal_tac "noalts_set \<union> corr_set = (insert a noalts_set) \<union> corr_set")
+ apply(simp only:)
+ apply (metis insertE nonalt.simps(1) nonalt.simps(4))
+ apply blast
+
+ apply fastforce
+ apply force
+ apply simp
+ apply (metis Un_insert_left insertE nonalt.simps(1) nonalt.simps(4))
+ apply(case_tac "a \<in> noalts_set")
+ apply simp
+ apply(subgoal_tac "a \<notin> alts_set")
+ prefer 2
+ apply blast
+ apply(case_tac "a \<in> corr_set")
+ apply(subgoal_tac "noalts_set \<union> corr_set = insert a ( noalts_set \<union> corr_set)")
+ prefer 2
+ apply fastforce
+ apply(simp only:)
+ apply(subgoal_tac "rsizes (rdistinct (a # rs) (insert RZERO ((insert a noalts_set) \<union> alts_set))) \<le>
+ rsizes (rdistinct (a # rs) (insert RZERO (noalts_set \<union> alts_set)))")
+
+ apply(subgoal_tac "rsizes (rdistinct (rflts (a # rs)) ((insert a noalts_set) \<union> corr_set)) \<le>
+ rsizes (rdistinct (a # rs) (insert RZERO ((insert a noalts_set) \<union> alts_set)))")
+ apply fastforce
+ apply simp
+ apply(subgoal_tac "(insert a (noalts_set \<union> alts_set)) = (insert a noalts_set) \<union> alts_set")
+ apply(simp only:)
+ apply(subgoal_tac "noalts_set \<union> corr_set = (insert a noalts_set) \<union> corr_set")
+ apply(simp only:)
+
+ apply (metis insertE rrexp.distinct(31))
+ apply blast
+ apply fastforce
+ apply force
+ apply simp
+
+ apply (metis Un_insert_left insertE rrexp.distinct(31))
+
+ using Suc_le_mono flts_size_reduction_alts apply presburger
+ apply(case_tac "a \<in> noalts_set")
+ apply simp
+ apply(subgoal_tac "a \<notin> alts_set")
+ prefer 2
+ apply blast
+ apply(case_tac "a \<in> corr_set")
+ apply(subgoal_tac "noalts_set \<union> corr_set = insert a ( noalts_set \<union> corr_set)")
+ prefer 2
+ apply fastforce
+ apply(simp only:)
+ apply(subgoal_tac "rsizes (rdistinct (a # rs) (insert RZERO ((insert a noalts_set) \<union> alts_set))) \<le>
+ rsizes (rdistinct (a # rs) (insert RZERO (noalts_set \<union> alts_set)))")
+
+ apply(subgoal_tac "rsizes (rdistinct (rflts (a # rs)) ((insert a noalts_set) \<union> corr_set)) \<le>
+ rsizes (rdistinct (a # rs) (insert RZERO ((insert a noalts_set) \<union> alts_set)))")
+ apply fastforce
+ apply simp
+ apply(subgoal_tac "(insert a (noalts_set \<union> alts_set)) = (insert a noalts_set) \<union> alts_set")
+ apply(simp only:)
+ apply(subgoal_tac "noalts_set \<union> corr_set = (insert a noalts_set) \<union> corr_set")
+ apply(simp only:)
+ apply (metis insertE rrexp.distinct(37))
+
+ apply blast
+
+ apply fastforce
+ apply force
+ apply simp
+ apply (metis Un_insert_left insert_iff rrexp.distinct(37))
+ apply(case_tac "a \<in> noalts_set")
+ apply simp
+ apply(subgoal_tac "a \<notin> alts_set")
+ prefer 2
+ apply blast
+ apply(case_tac "a \<in> corr_set")
+ apply(subgoal_tac "noalts_set \<union> corr_set = insert a ( noalts_set \<union> corr_set)")
+ prefer 2
+ apply fastforce
+ apply(simp only:)
+ apply(subgoal_tac "rsizes (rdistinct (a # rs) (insert RZERO ((insert a noalts_set) \<union> alts_set))) \<le>
+ rsizes (rdistinct (a # rs) (insert RZERO (noalts_set \<union> alts_set)))")
+
+ apply(subgoal_tac "rsizes (rdistinct (rflts (a # rs)) ((insert a noalts_set) \<union> corr_set)) \<le>
+ rsizes (rdistinct (a # rs) (insert RZERO ((insert a noalts_set) \<union> alts_set)))")
+ apply fastforce
+ apply simp
+ apply(subgoal_tac "(insert a (noalts_set \<union> alts_set)) = (insert a noalts_set) \<union> alts_set")
+ apply(simp only:)
+ apply(subgoal_tac "noalts_set \<union> corr_set = (insert a noalts_set) \<union> corr_set")
+ apply(simp only:)
+ apply (metis insertE nonalt.simps(1) nonalt.simps(7))
+ apply blast
+ apply blast
+ apply force
+ apply(auto)
+ by (metis Un_insert_left insert_iff rrexp.distinct(39))
+
+
+lemma flts_vs_nflts:
+ assumes "\<forall>r \<in> noalts_set. \<forall>xs. r \<noteq> RALTS xs"
+ and "\<forall>a \<in> alts_set. (\<exists>xs. a = RALTS xs \<and> set xs \<subseteq> corr_set)"
+ shows "rsizes (rdistinct (rflts rs) (noalts_set \<union> corr_set))
+ \<le> rsizes (rdistinct rs (insert RZERO (noalts_set \<union> alts_set)))"
+ by (simp add: assms flts_vs_nflts1)
+
+lemma distinct_simp_ineq_general:
+ assumes "rsimp ` no_simp = has_simp" "finite no_simp"
+ shows "rsizes (rdistinct (map rsimp rs) has_simp) \<le> rsizes (rdistinct rs no_simp)"
+ using assms
+ apply(induct rs no_simp arbitrary: has_simp rule: rdistinct.induct)
+ apply simp
+ apply(auto)
+ using add_le_mono rsimp_mono by presburger
+
+lemma larger_acc_smaller_distinct_res0:
+ assumes "ss \<subseteq> SS"
+ shows "rsizes (rdistinct rs SS) \<le> rsizes (rdistinct rs ss)"
+ using assms
+ apply(induct rs arbitrary: ss SS)
+ apply simp
+ by (metis distinct_early_app1 rdistinct_smaller)
+
+lemma without_flts_ineq:
+ shows "rsizes (rdistinct (rflts rs) {}) \<le> rsizes (rdistinct rs {})"
+proof -
+ have "rsizes (rdistinct (rflts rs) {}) \<le> rsizes (rdistinct rs (insert RZERO {}))"
+ by (metis empty_iff flts_vs_nflts sup_bot_left)
+ also have "... \<le> rsizes (rdistinct rs {})"
+ by (simp add: larger_acc_smaller_distinct_res0)
+ finally show ?thesis
+ by blast
+qed
+
+
+lemma distinct_simp_ineq:
+ shows "rsizes (rdistinct (map rsimp rs) {}) \<le> rsizes (rdistinct rs {})"
+ using distinct_simp_ineq_general by blast
+
+
+lemma alts_simp_control:
+ shows "rsize (rsimp (RALTS rs)) \<le> Suc (rsizes (rdistinct rs {}))"
+proof -
+ have "rsize (rsimp (RALTS rs)) \<le> Suc (rsizes (rdistinct (rflts (map rsimp rs)) {}))"
+ using alts_simp_ineq_unfold by auto
+ moreover have "\<dots> \<le> Suc (rsizes (rdistinct (map rsimp rs) {}))"
+ using without_flts_ineq by blast
+ ultimately show "rsize (rsimp (RALTS rs)) \<le> Suc (rsizes (rdistinct rs {}))"
+ by (meson Suc_le_mono distinct_simp_ineq le_trans)
+qed
+
+
+lemma larger_acc_smaller_distinct_res:
+ shows "rsizes (rdistinct rs (insert a ss)) \<le> rsizes (rdistinct rs ss)"
+ by (simp add: larger_acc_smaller_distinct_res0 subset_insertI)
+
+lemma triangle_inequality_distinct:
+ shows "rsizes (rdistinct (a # rs) ss) \<le> rsize a + rsizes (rdistinct rs ss)"
+ apply(case_tac "a \<in> ss")
+ apply simp
+ by (simp add: larger_acc_smaller_distinct_res)
+
+
+lemma distinct_list_size_len_bounded:
+ assumes "\<forall>r \<in> set rs. rsize r \<le> N" "length rs \<le> lrs"
+ shows "rsizes rs \<le> lrs * N "
+ using assms
+ by (metis rlist_bound dual_order.trans mult.commute mult_le_mono1)
+
+
+
+lemma rdistinct_same_set:
+ shows "r \<in> set rs \<longleftrightarrow> r \<in> set (rdistinct rs {})"
+ apply(induct rs)
+ apply simp
+ by (metis rdistinct_set_equality)
+
+(* distinct_list_rexp_up_to_certain_size_bouded_by_set_enumerating_up_to_that_size *)
+lemma distinct_list_rexp_upto:
+ assumes "\<forall>r\<in> set rs. (rsize r) \<le> N"
+ shows "rsizes (rdistinct rs {}) \<le> (card (sizeNregex N)) * N"
+
+ apply(subgoal_tac "distinct (rdistinct rs {})")
+ prefer 2
+ using rdistinct_does_the_job apply blast
+ apply(subgoal_tac "length (rdistinct rs {}) \<le> card (sizeNregex N)")
+ apply(rule distinct_list_size_len_bounded)
+ using assms
+ apply (meson rdistinct_same_set)
+ apply blast
+ apply(subgoal_tac "\<forall>r \<in> set (rdistinct rs {}). rsize r \<le> N")
+ prefer 2
+ using assms
+ apply (meson rdistinct_same_set)
+ apply(subgoal_tac "length (rdistinct rs {}) = card (set (rdistinct rs {}))")
+ prefer 2
+ apply (simp add: distinct_card)
+ apply(simp)
+ by (metis card_mono finite_size_n mem_Collect_eq sizeNregex_def subsetI)
+
+
+lemma star_control_bounded:
+ assumes "\<forall>s. rsize (rders_simp r s) \<le> N"
+ shows "rsizes (rdistinct (map (\<lambda>s1. RSEQ (rders_simp r s1) (RSTAR r)) (star_updates s r [[c]])) {})
+ \<le> (card (sizeNregex (Suc (N + rsize (RSTAR r))))) * (Suc (N + rsize (RSTAR r)))"
+ by (smt (verit) add_Suc_shift add_mono_thms_linordered_semiring(3) assms distinct_list_rexp_upto image_iff list.set_map plus_nat.simps(2) rsize.simps(5))
+
+
+lemma star_closed_form_bounded:
+ assumes "\<forall>s. rsize (rders_simp r s) \<le> N"
+ shows "rsize (rders_simp (RSTAR r) s) \<le>
+ max ((Suc (card (sizeNregex (Suc (N + rsize (RSTAR r))))) * (Suc (N + rsize (RSTAR r))))) (rsize (RSTAR r))"
+proof(cases s)
+ case Nil
+ then show "rsize (rders_simp (RSTAR r) s)
+ \<le> max (Suc (card (sizeNregex (Suc (N + rsize (RSTAR r))))) * Suc (N + rsize (RSTAR r))) (rsize (RSTAR r))"
+ by simp
+next
+ case (Cons a list)
+ then have "rsize (rders_simp (RSTAR r) s) =
+ rsize (rsimp (RALTS ((map (\<lambda>s1. RSEQ (rders_simp r s1) (RSTAR r)) (star_updates list r [[a]])))))"
+ using star_closed_form by fastforce
+ also have "... \<le> Suc (rsizes (rdistinct (map (\<lambda>s1. RSEQ (rders_simp r s1) (RSTAR r)) (star_updates list r [[a]])) {}))"
+ using alts_simp_control by blast
+ also have "... \<le> Suc (card (sizeNregex (Suc (N + rsize (RSTAR r))))) * (Suc (N + rsize (RSTAR r)))"
+ using star_control_bounded[OF assms] by (metis add_mono le_add1 mult_Suc plus_1_eq_Suc)
+ also have "... \<le> max (Suc (card (sizeNregex (Suc (N + rsize (RSTAR r))))) * Suc (N + rsize (RSTAR r))) (rsize (RSTAR r))"
+ by simp
+ finally show ?thesis by simp
+qed
+
+
+thm ntimes_closed_form
+
+thm rsize.simps
+
+lemma nupdates_snoc:
+ shows " (nupdates (xs @ [x]) r optlist) = nupdate x r (nupdates xs r optlist)"
+ by (simp add: nupdates_append)
+
+lemma nupdate_elems:
+ shows "\<forall>opt \<in> set (nupdate c r optlist). opt = None \<or> (\<exists>s n. opt = Some (s, n))"
+ using nonempty_string.cases by auto
+
+lemma nupdates_elems:
+ shows "\<forall>opt \<in> set (nupdates s r optlist). opt = None \<or> (\<exists>s n. opt = Some (s, n))"
+ by (meson nonempty_string.cases)
+
+
+lemma opterm_optlist_result_shape:
+ shows "\<forall>r' \<in> set (map (optermsimp r) optlist). r' = RZERO \<or> (\<exists>s m. r' = RSEQ (rders_simp r s) (RNTIMES r m))"
+ apply(induct optlist)
+ apply simp
+ apply(case_tac a)
+ apply simp+
+ by fastforce
+
+
+lemma opterm_optlist_result_shape2:
+ shows "\<And>optlist. \<forall>r' \<in> set (map (optermsimp r) optlist). r' = RZERO \<or> (\<exists>s m. r' = RSEQ (rders_simp r s) (RNTIMES r m))"
+ using opterm_optlist_result_shape by presburger
+
+
+lemma nupdate_n_leq_n:
+ shows "\<forall>r \<in> set (nupdate c' r [Some ([c], n)]). r = None \<or>( \<exists>s' m. r = Some (s', m) \<and> m \<le> n)"
+ apply(case_tac n)
+ apply simp
+ apply simp
+ done
+(*
+lemma nupdate_induct_leqn:
+ shows "\<lbrakk>\<forall>opt \<in> set optlist. opt = None \<or> (\<exists>s' m. opt = Some(s', m) \<and> m \<le> n) \<rbrakk> \<Longrightarrow>
+ \<forall>opt \<in> set (nupdate c' r optlist). opt = None \<or> (\<exists>s' m. opt = Some (s', m) \<and> m \<le> n)"
+ apply (case_tac optlist)
+ apply simp
+ apply(case_tac a)
+ apply simp
+ sledgehammer
+*)
+
+
+lemma nupdates_n_leq_n:
+ shows "\<forall>r \<in> set (nupdates s r [Some ([c], n)]). r = None \<or>( \<exists>s' m. r = Some (s', m) \<and> m \<le> n)"
+ apply(induct s rule: rev_induct)
+ apply simp
+ apply(subst nupdates_append)
+ by (metis nupdates_elems_leqn nupdates_snoc)
+
+
+
+lemma ntimes_closed_form_list_elem_shape:
+ shows "\<forall>r' \<in> set (map (optermsimp r) (nupdates s r [Some ([c], n)])).
+r' = RZERO \<or> (\<exists>s' m. r' = RSEQ (rders_simp r s') (RNTIMES r m) \<and> m \<le> n)"
+ apply(insert opterm_optlist_result_shape2)
+ apply(case_tac s)
+ apply(auto)
+ apply (metis rders_simp_one_char)
+ by (metis case_prod_conv nupdates.simps(2) nupdates_n_leq_n option.simps(4) option.simps(5))
+
+
+lemma ntimes_trivial1:
+ shows "rsize RZERO \<le> N + rsize (RNTIMES r n)"
+ by simp
+
+
+lemma ntimes_trivial20:
+ shows "m \<le> n \<Longrightarrow> rsize (RNTIMES r m) \<le> rsize (RNTIMES r n)"
+ by simp
+
+
+lemma ntimes_trivial2:
+ assumes "\<forall>s. rsize (rders_simp r s) \<le> N"
+ shows " r' = RSEQ (rders_simp r s1) (RNTIMES r m) \<and> m \<le> n
+ \<Longrightarrow> rsize r' \<le> Suc (N + rsize (RNTIMES r n))"
+ apply simp
+ by (simp add: add_mono_thms_linordered_semiring(1) assms)
+
+lemma ntimes_closed_form_list_elem_bounded:
+ assumes "\<forall>s. rsize (rders_simp r s) \<le> N"
+ shows "\<forall>r' \<in> set (map (optermsimp r) (nupdates s r [Some ([c], n)])). rsize r' \<le> Suc (N + rsize (RNTIMES r n))"
+ apply(rule ballI)
+ apply(subgoal_tac "r' = RZERO \<or> (\<exists>s' m. r' = RSEQ (rders_simp r s') (RNTIMES r m) \<and> m \<le> n)")
+ prefer 2
+ using ntimes_closed_form_list_elem_shape apply blast
+ apply(case_tac "r' = RZERO")
+ using le_SucI ntimes_trivial1 apply presburger
+ apply(subgoal_tac "\<exists>s1 m. r' = RSEQ (rders_simp r s1) (RNTIMES r m) \<and> m \<le> n")
+ apply(erule exE)+
+ using assms ntimes_trivial2 apply presburger
+ by blast
+
+
+lemma P_holds_after_distinct:
+ assumes "\<forall>r \<in> set rs. P r"
+ shows "\<forall>r \<in> set (rdistinct rs rset). P r"
+ by (simp add: assms rdistinct_set_equality1)
+
+
+
+lemma ntimes_control_bounded:
+ assumes "\<forall>s. rsize (rders_simp r s) \<le> N"
+ shows "rsizes (rdistinct (map (optermsimp r) (nupdates s r [Some ([c], n)])) {})
+ \<le> (card (sizeNregex (Suc (N + rsize (RNTIMES r n))))) * (Suc (N + rsize (RNTIMES r n)))"
+ apply(subgoal_tac "\<forall>r' \<in> set (rdistinct (map (optermsimp r) (nupdates s r [Some ([c], n)])) {}).
+ rsize r' \<le> Suc (N + rsize (RNTIMES r n))")
+ apply (meson distinct_list_rexp_upto rdistinct_same_set)
+ apply(subgoal_tac "\<forall>r' \<in> set (map (optermsimp r) (nupdates s r [Some ([c], n)])). rsize r' \<le> Suc (N + rsize (RNTIMES r n))")
+ apply (simp add: rdistinct_set_equality)
+ by (metis assms nat_le_linear not_less_eq_eq ntimes_closed_form_list_elem_bounded)
+
+
+
+lemma ntimes_closed_form_bounded0:
+ assumes "\<forall>s. rsize (rders_simp r s) \<le> N"
+ shows " (rders_simp (RNTIMES r 0) s) = RZERO \<or> (rders_simp (RNTIMES r 0) s) = RNTIMES r 0
+ "
+ apply(induct s)
+ apply simp
+ by (metis always0 list.simps(3) rder.simps(7) rders.simps(2) rders_simp_same_simpders rsimp.simps(3))
+
+lemma ntimes_closed_form_bounded1:
+ assumes "\<forall>s. rsize (rders_simp r s) \<le> N"
+ shows " rsize (rders_simp (RNTIMES r 0) s) \<le> max (rsize RZERO) (rsize (RNTIMES r 0))"
+
+ by (metis assms max.cobounded1 max.cobounded2 ntimes_closed_form_bounded0)
+
+lemma self_smaller_than_bound:
+ shows "\<forall>s. rsize (rders_simp r s) \<le> N \<Longrightarrow> rsize r \<le> N"
+ apply(drule_tac x = "[]" in spec)
+ apply simp
+ done
+
+lemma ntimes_closed_form_bounded_nil_aux:
+ shows "max (rsize RZERO) (rsize (RNTIMES r 0)) = 1 + rsize r"
+ by auto
+
+lemma ntimes_closed_form_bounded_nil:
+ assumes "\<forall>s. rsize (rders_simp r s) \<le> N"
+ shows " rsize (rders_simp (RNTIMES r 0) s) \<le> 1 + rsize r"
+ using assms ntimes_closed_form_bounded1 by auto
+
+lemma ntimes_ineq1:
+ shows "(rsize (RNTIMES r n)) \<ge> 1 + rsize r"
+ by simp
+
+lemma ntimes_ineq2:
+ shows "1 + rsize r \<le>
+max ((Suc (card (sizeNregex (Suc (N + rsize (RNTIMES r n))))) * (Suc (N + rsize (RNTIMES r n))))) (rsize (RNTIMES r n))"
+ by (meson le_max_iff_disj ntimes_ineq1)
+
+lemma ntimes_closed_form_bounded:
+ assumes "\<forall>s. rsize (rders_simp r s) \<le> N"
+ shows "rsize (rders_simp (RNTIMES r (Suc n)) s) \<le>
+ max ((Suc (card (sizeNregex (Suc (N + rsize (RNTIMES r n))))) * (Suc (N + rsize (RNTIMES r n))))) (rsize (RNTIMES r n))"
+proof(cases s)
+ case Nil
+ then show "rsize (rders_simp (RNTIMES r (Suc n)) s)
+ \<le> max (Suc (card (sizeNregex (Suc (N + rsize (RNTIMES r n))))) * Suc (N + rsize (RNTIMES r n))) (rsize (RNTIMES r n))"
+ by simp
+next
+ case (Cons a list)
+
+ then have "rsize (rders_simp (RNTIMES r (Suc n)) s) =
+ rsize (rsimp (RALTS ((map (optermsimp r) (nupdates list r [Some ([a], n)])))))"
+ using ntimes_closed_form by fastforce
+ also have "... \<le> Suc (rsizes (rdistinct ((map (optermsimp r) (nupdates list r [Some ([a], n)]))) {}))"
+ using alts_simp_control by blast
+ also have "... \<le> Suc (card (sizeNregex (Suc (N + rsize (RNTIMES r n))))) * (Suc (N + rsize (RNTIMES r n)))"
+ using ntimes_control_bounded[OF assms]
+ by (metis add_mono le_add1 mult_Suc plus_1_eq_Suc)
+ also have "... \<le> max (Suc (card (sizeNregex (Suc (N + rsize (RNTIMES r n))))) * Suc (N + rsize (RNTIMES r n))) (rsize (RNTIMES r n))"
+ by simp
+ finally show ?thesis by simp
+qed
+
+
+lemma ntimes_closed_form_boundedA:
+ assumes "\<forall>s. rsize (rders_simp r s) \<le> N"
+ shows "\<exists>N'. \<forall>s. rsize (rders_simp (RNTIMES r n) s) \<le> N'"
+ apply(case_tac n)
+ using assms ntimes_closed_form_bounded_nil apply blast
+ using assms ntimes_closed_form_bounded by blast
+
+
+lemma star_closed_form_nonempty_bounded:
+ assumes "\<forall>s. rsize (rders_simp r s) \<le> N" and "s \<noteq> []"
+ shows "rsize (rders_simp (RSTAR r) s) \<le>
+ ((Suc (card (sizeNregex (Suc (N + rsize (RSTAR r))))) * (Suc (N + rsize (RSTAR r))))) "
+proof(cases s)
+ case Nil
+ then show ?thesis
+ using local.Nil by fastforce
+next
+ case (Cons a list)
+ then have "rsize (rders_simp (RSTAR r) s) =
+ rsize (rsimp (RALTS ((map (\<lambda>s1. RSEQ (rders_simp r s1) (RSTAR r)) (star_updates list r [[a]])))))"
+ using star_closed_form by fastforce
+ also have "... \<le> Suc (rsizes (rdistinct (map (\<lambda>s1. RSEQ (rders_simp r s1) (RSTAR r)) (star_updates list r [[a]])) {}))"
+ using alts_simp_control by blast
+ also have "... \<le> Suc (card (sizeNregex (Suc (N + rsize (RSTAR r))))) * (Suc (N + rsize (RSTAR r)))"
+ by (smt (z3) add_mono_thms_linordered_semiring(1) assms(1) le_add1 map_eq_conv mult_Suc plus_1_eq_Suc star_control_bounded)
+ also have "... \<le> max (Suc (card (sizeNregex (Suc (N + rsize (RSTAR r))))) * Suc (N + rsize (RSTAR r))) (rsize (RSTAR r))"
+ by simp
+ finally show ?thesis by simp
+qed
+
+
+
+lemma seq_estimate_bounded:
+ assumes "\<forall>s. rsize (rders_simp r1 s) \<le> N1"
+ and "\<forall>s. rsize (rders_simp r2 s) \<le> N2"
+ shows
+ "rsizes (rdistinct (RSEQ (rders_simp r1 s) r2 # map (rders_simp r2) (vsuf s r1)) {})
+ \<le> (Suc (N1 + (rsize r2)) + (N2 * card (sizeNregex N2)))"
+proof -
+ have a: "rsizes (rdistinct (map (rders_simp r2) (vsuf s r1)) {}) \<le> N2 * card (sizeNregex N2)"
+ by (metis assms(2) distinct_list_rexp_upto ex_map_conv mult.commute)
+
+ have "rsizes (rdistinct (RSEQ (rders_simp r1 s) r2 # map (rders_simp r2) (vsuf s r1)) {}) \<le>
+ rsize (RSEQ (rders_simp r1 s) r2) + rsizes (rdistinct (map (rders_simp r2) (vsuf s r1)) {})"
+ using triangle_inequality_distinct by blast
+ also have "... \<le> rsize (RSEQ (rders_simp r1 s) r2) + N2 * card (sizeNregex N2)"
+ by (simp add: a)
+ also have "... \<le> Suc (N1 + (rsize r2) + N2 * card (sizeNregex N2))"
+ by (simp add: assms(1))
+ finally show ?thesis
+ by force
+qed
+
+
+lemma seq_closed_form_bounded2:
+ assumes "\<forall>s. rsize (rders_simp r1 s) \<le> N1"
+ and "\<forall>s. rsize (rders_simp r2 s) \<le> N2"
+shows "rsize (rders_simp (RSEQ r1 r2) s)
+ \<le> max (2 + N1 + (rsize r2) + (N2 * card (sizeNregex N2))) (rsize (RSEQ r1 r2))"
+proof(cases s)
+ case Nil
+ then show "rsize (rders_simp (RSEQ r1 r2) s)
+ \<le> max (2 + N1 + (rsize r2) + (N2 * card (sizeNregex N2))) (rsize (RSEQ r1 r2))"
+ by simp
+next
+ case (Cons a list)
+ then have "rsize (rders_simp (RSEQ r1 r2) s) =
+ rsize (rsimp (RALTS ((RSEQ (rders_simp r1 s) r2) # (map (rders_simp r2) (vsuf s r1)))))"
+ using seq_closed_form_variant by (metis list.distinct(1))
+ also have "... \<le> Suc (rsizes (rdistinct (RSEQ (rders_simp r1 s) r2 # map (rders_simp r2) (vsuf s r1)) {}))"
+ using alts_simp_control by blast
+ also have "... \<le> 2 + N1 + (rsize r2) + (N2 * card (sizeNregex N2))"
+ using seq_estimate_bounded[OF assms] by auto
+ ultimately show "rsize (rders_simp (RSEQ r1 r2) s)
+ \<le> max (2 + N1 + (rsize r2) + N2 * card (sizeNregex N2)) (rsize (RSEQ r1 r2))"
+ by auto
+qed
+
+lemma rders_simp_bounded:
+ shows "\<exists>N. \<forall>s. rsize (rders_simp r s) \<le> N"
+ apply(induct r)
+ apply(rule_tac x = "Suc 0 " in exI)
+ using three_easy_cases0 apply force
+ using three_easy_cases1 apply blast
+ using three_easy_casesC apply blast
+ apply(erule exE)+
+ apply(rule exI)
+ apply(rule allI)
+ apply(rule seq_closed_form_bounded2)
+ apply(assumption)
+ apply(assumption)
+ apply (metis alts_closed_form_bounded size_list_estimation')
+ using star_closed_form_bounded apply blast
+ using ntimes_closed_form_boundedA by blast
+
+
+unused_thms
+export_code rders_simp rsimp rder in Scala module_name Example
+
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys4/posix/FBound.thy Mon Aug 29 23:16:28 2022 +0100
@@ -0,0 +1,315 @@
+
+theory FBound
+ imports "BlexerSimp" "ClosedFormsBounds"
+begin
+
+fun distinctBy :: "'a list \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b set \<Rightarrow> 'a list"
+ where
+ "distinctBy [] f acc = []"
+| "distinctBy (x#xs) f acc =
+ (if (f x) \<in> acc then distinctBy xs f acc
+ else x # (distinctBy xs f ({f x} \<union> acc)))"
+
+fun rerase :: "arexp \<Rightarrow> rrexp"
+where
+ "rerase AZERO = RZERO"
+| "rerase (AONE _) = RONE"
+| "rerase (ACHAR _ c) = RCHAR c"
+| "rerase (AALTs bs rs) = RALTS (map rerase rs)"
+| "rerase (ASEQ _ r1 r2) = RSEQ (rerase r1) (rerase r2)"
+| "rerase (ASTAR _ r) = RSTAR (rerase r)"
+| "rerase (ANTIMES _ r n) = RNTIMES (rerase r) n"
+
+lemma eq1_rerase:
+ shows "x ~1 y \<longleftrightarrow> (rerase x) = (rerase y)"
+ apply(induct x y rule: eq1.induct)
+ apply(auto)
+ done
+
+
+lemma distinctBy_distinctWith:
+ shows "distinctBy xs f (f ` acc) = distinctWith xs (\<lambda>x y. f x = f y) acc"
+ apply(induct xs arbitrary: acc)
+ apply(auto)
+ by (metis image_insert)
+
+lemma distinctBy_distinctWith2:
+ shows "distinctBy xs rerase {} = distinctWith xs eq1 {}"
+ apply(subst distinctBy_distinctWith[of _ _ "{}", simplified])
+ using eq1_rerase by presburger
+
+lemma asize_rsize:
+ shows "rsize (rerase r) = asize r"
+ apply(induct r rule: rerase.induct)
+ apply(auto)
+ apply (metis (mono_tags, lifting) comp_apply map_eq_conv)
+ done
+
+lemma rerase_fuse:
+ shows "rerase (fuse bs r) = rerase r"
+ apply(induct r)
+ apply simp+
+ done
+
+lemma rerase_bsimp_ASEQ:
+ shows "rerase (bsimp_ASEQ x1 a1 a2) = rsimp_SEQ (rerase a1) (rerase a2)"
+ apply(induct x1 a1 a2 rule: bsimp_ASEQ.induct)
+ apply(auto)
+ done
+
+lemma rerase_bsimp_AALTs:
+ shows "rerase (bsimp_AALTs bs rs) = rsimp_ALTs (map rerase rs)"
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(auto simp add: rerase_fuse)
+ done
+
+fun anonalt :: "arexp \<Rightarrow> bool"
+ where
+ "anonalt (AALTs bs2 rs) = False"
+| "anonalt r = True"
+
+
+fun agood :: "arexp \<Rightarrow> bool" where
+ "agood AZERO = False"
+| "agood (AONE cs) = True"
+| "agood (ACHAR cs c) = True"
+| "agood (AALTs cs []) = False"
+| "agood (AALTs cs [r]) = False"
+| "agood (AALTs cs (r1#r2#rs)) = (distinct (map rerase (r1 # r2 # rs)) \<and>(\<forall>r' \<in> set (r1#r2#rs). agood r' \<and> anonalt r'))"
+| "agood (ASEQ _ AZERO _) = False"
+| "agood (ASEQ _ (AONE _) _) = False"
+| "agood (ASEQ _ _ AZERO) = False"
+| "agood (ASEQ cs r1 r2) = (agood r1 \<and> agood r2)"
+| "agood (ASTAR cs r) = True"
+
+
+fun anonnested :: "arexp \<Rightarrow> bool"
+ where
+ "anonnested (AALTs bs2 []) = True"
+| "anonnested (AALTs bs2 ((AALTs bs1 rs1) # rs2)) = False"
+| "anonnested (AALTs bs2 (r # rs2)) = anonnested (AALTs bs2 rs2)"
+| "anonnested r = True"
+
+
+lemma asize0:
+ shows "0 < asize r"
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma rnullable:
+ shows "rnullable (rerase r) = bnullable r"
+ apply(induct r rule: rerase.induct)
+ apply(auto)
+ done
+
+lemma rder_bder_rerase:
+ shows "rder c (rerase r ) = rerase (bder c r)"
+ apply (induct r)
+ apply (auto)
+ using rerase_fuse apply presburger
+ using rnullable apply blast
+ using rnullable by blast
+
+lemma rerase_map_bsimp:
+ assumes "\<And> r. r \<in> set rs \<Longrightarrow> rerase (bsimp r) = (rsimp \<circ> rerase) r"
+ shows "map rerase (map bsimp rs) = map (rsimp \<circ> rerase) rs"
+ using assms
+ apply(induct rs)
+ by simp_all
+
+
+lemma rerase_flts:
+ shows "map rerase (flts rs) = rflts (map rerase rs)"
+ apply(induct rs rule: flts.induct)
+ apply(auto simp add: rerase_fuse)
+ done
+
+lemma rerase_dB:
+ shows "map rerase (distinctBy rs rerase acc) = rdistinct (map rerase rs) acc"
+ apply(induct rs arbitrary: acc)
+ apply simp+
+ done
+
+lemma rerase_earlier_later_same:
+ assumes " \<And>r. r \<in> set rs \<Longrightarrow> rerase (bsimp r) = rsimp (rerase r)"
+ shows " (map rerase (distinctBy (flts (map bsimp rs)) rerase {})) =
+ (rdistinct (rflts (map (rsimp \<circ> rerase) rs)) {})"
+ apply(subst rerase_dB)
+ apply(subst rerase_flts)
+ apply(subst rerase_map_bsimp)
+ apply auto
+ using assms
+ apply simp
+ done
+
+lemma bsimp_rerase:
+ shows "rerase (bsimp a) = rsimp (rerase a)"
+ apply(induct a rule: bsimp.induct)
+ apply(auto)
+ using rerase_bsimp_ASEQ apply presburger
+ using distinctBy_distinctWith2 rerase_bsimp_AALTs rerase_earlier_later_same by fastforce
+
+lemma rders_simp_size:
+ shows "rders_simp (rerase r) s = rerase (bders_simp r s)"
+ apply(induct s rule: rev_induct)
+ apply simp
+ by (simp add: bders_simp_append rder_bder_rerase rders_simp_append bsimp_rerase)
+
+
+corollary aders_simp_finiteness:
+ assumes "\<exists>N. \<forall>s. rsize (rders_simp (rerase r) s) \<le> N"
+ shows " \<exists>N. \<forall>s. asize (bders_simp r s) \<le> N"
+proof -
+ from assms obtain N where "\<forall>s. rsize (rders_simp (rerase r) s) \<le> N"
+ by blast
+ then have "\<forall>s. rsize (rerase (bders_simp r s)) \<le> N"
+ by (simp add: rders_simp_size)
+ then have "\<forall>s. asize (bders_simp r s) \<le> N"
+ by (simp add: asize_rsize)
+ then show "\<exists>N. \<forall>s. asize (bders_simp r s) \<le> N" by blast
+qed
+
+theorem annotated_size_bound:
+ shows "\<exists>N. \<forall>s. asize (bders_simp r s) \<le> N"
+ apply(insert aders_simp_finiteness)
+ by (simp add: rders_simp_bounded)
+
+definition bitcode_agnostic :: "(arexp \<Rightarrow> arexp ) \<Rightarrow> bool"
+ where " bitcode_agnostic f = (\<forall>a1 a2. rerase a1 = rerase a2 \<longrightarrow> rerase (f a1) = rerase (f a2)) "
+
+lemma bitcode_agnostic_bsimp:
+ shows "bitcode_agnostic bsimp"
+ by (simp add: bitcode_agnostic_def bsimp_rerase)
+
+thm bsimp_rerase
+
+lemma cant1:
+ shows "\<lbrakk> bsimp a = b; rerase a = rerase b; a = ASEQ bs r1 r2 \<rbrakk> \<Longrightarrow>
+ \<exists>bs' r1' r2'. b = ASEQ bs' r1' r2' \<and> rerase r1' = rerase r1 \<and> rerase r2' = rerase r2"
+ sorry
+
+
+
+(*"part is less than whole" thm for rrexp, since rrexp is always finite*)
+lemma rrexp_finite1:
+ shows "\<lbrakk> bsimp_ASEQ bs1 (bsimp ra1) (bsimp ra2) = ASEQ bs2 rb1 rb2; ra1 ~1 rb1; ra2 ~1 rb2 \<rbrakk> \<Longrightarrow> rerase ra1 = rerase (bsimp ra1) "
+ apply(case_tac ra1 )
+ apply simp+
+ apply(case_tac rb1)
+ apply simp+
+
+ sorry
+
+lemma unsure_unchanging:
+ assumes "bsimp a = bsimp b"
+and "a ~1 b"
+shows "a = b"
+ using assms
+ apply(induct rule: eq1.induct)
+ apply simp+
+ oops
+
+lemma eq1rerase:
+ shows "rerase r1 = rerase r2 \<longleftrightarrow> r1 ~1 r2"
+ using eq1_rerase by presburger
+
+thm contrapos_pp
+
+lemma r_part_neq_whole:
+ shows "RSEQ r1 r2 \<noteq> r2"
+ apply simp
+ done
+
+lemma r_part_neq_whole2:
+ shows "RSEQ r1 r2 \<noteq> rsimp r2"
+ by (metis good.simps(7) good.simps(8) good1 good_SEQ r_part_neq_whole rrexp.distinct(5) rsimp.simps(3) test)
+
+
+
+lemma arexpfiniteaux1:
+ shows "rerase (bsimp_ASEQ x41 (bsimp x42) (bsimp x43)) = RSEQ (rerase x42) (rerase x43) \<Longrightarrow> \<forall>bs. bsimp x42 \<noteq> AONE bs"
+ apply(erule contrapos_pp)
+ apply simp
+ apply(erule exE)
+ apply simp
+ by (metis bsimp_rerase r_part_neq_whole2 rerase_fuse)
+
+lemma arexpfiniteaux2:
+ shows "rerase (bsimp_ASEQ x41 (bsimp x42) (bsimp x43)) = RSEQ (rerase x42) (rerase x43) \<Longrightarrow> bsimp x42 \<noteq> AZERO "
+ apply(erule contrapos_pp)
+ apply simp
+ done
+
+lemma arexpfiniteaux3:
+ shows "rerase (bsimp_ASEQ x41 (bsimp x42) (bsimp x43)) = RSEQ (rerase x42) (rerase x43) \<Longrightarrow> bsimp x43 \<noteq> AZERO "
+ apply(erule contrapos_pp)
+ apply simp
+ done
+
+
+lemma arexp_finite1:
+ shows "rerase (bsimp b) = rerase b \<Longrightarrow> bsimp b = b"
+ apply(induct b)
+ apply simp+
+ apply(case_tac "bsimp b2 = AZERO")
+ apply simp
+ apply (case_tac "bsimp b1 = AZERO")
+ apply simp
+ apply(case_tac "\<exists>bs. bsimp b1 = AONE bs")
+ using arexpfiniteaux1 apply blast
+ apply simp
+ apply(subgoal_tac "bsimp_ASEQ x1 (bsimp b1) (bsimp b2) = ASEQ x1 (bsimp b1) (bsimp b2)")
+ apply simp
+ using bsimp_ASEQ1 apply presburger
+ apply simp
+
+ sorry
+
+lemma bitcodes_unchanging2:
+ assumes "bsimp a = b"
+and "a ~1 b"
+shows "a = b"
+ using assms
+ apply(induct rule: eq1.induct)
+ apply simp
+ apply simp
+ apply simp
+
+ apply auto
+
+ sorry
+
+
+
+lemma bitcodes_unchanging:
+ shows "\<lbrakk>bsimp a = b; rerase a = rerase b \<rbrakk> \<Longrightarrow> a = b"
+ apply(induction a arbitrary: b)
+ apply simp+
+ apply(case_tac "\<exists>bs. bsimp a1 = AONE bs")
+ apply(erule exE)
+ apply simp
+ prefer 2
+ apply(case_tac "bsimp a1 = AZERO")
+ apply simp
+ apply simp
+ apply (metis BlexerSimp.bsimp_ASEQ0 bsimp_ASEQ1 rerase.simps(1) rerase.simps(5) rrexp.distinct(5) rrexp.inject(2))
+
+ sorry
+
+
+lemma bagnostic_shows_bsimp_idem:
+ assumes "bitcode_agnostic bsimp"
+and "rerase (bsimp a) = rsimp (rerase a)"
+and "rsimp r = rsimp (rsimp r)"
+shows "bsimp a = bsimp (bsimp a)"
+
+ oops
+
+theorem bsimp_idem:
+ shows "bsimp (bsimp a) = bsimp a"
+ using bitcodes_unchanging bsimp_rerase rsimp_idem by auto
+
+unused_thms
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys4/posix/GeneralRegexBound.thy Mon Aug 29 23:16:28 2022 +0100
@@ -0,0 +1,239 @@
+theory GeneralRegexBound
+ imports "BasicIdentities"
+begin
+
+lemma size_geq1:
+ shows "rsize r \<ge> 1"
+ by (induct r) auto
+
+definition RSEQ_set where
+ "RSEQ_set A n \<equiv> {RSEQ r1 r2 | r1 r2. r1 \<in> A \<and> r2 \<in> A \<and> rsize r1 + rsize r2 \<le> n}"
+
+definition RSEQ_set_cartesian where
+ "RSEQ_set_cartesian A = {RSEQ r1 r2 | r1 r2. r1 \<in> A \<and> r2 \<in> A}"
+
+definition RALT_set where
+ "RALT_set A n \<equiv> {RALTS rs | rs. set rs \<subseteq> A \<and> rsizes rs \<le> n}"
+
+definition RALTs_set where
+ "RALTs_set A n \<equiv> {RALTS rs | rs. \<forall>r \<in> set rs. r \<in> A \<and> rsizes rs \<le> n}"
+
+definition RNTIMES_set where
+ "RNTIMES_set A n \<equiv> {RNTIMES r m | m r. r \<in> A \<and> rsize r + m \<le> n}"
+
+
+definition
+ "sizeNregex N \<equiv> {r. rsize r \<le> N}"
+
+
+lemma sizenregex_induct1:
+ "sizeNregex (Suc n) = (({RZERO, RONE} \<union> {RCHAR c| c. True})
+ \<union> (RSTAR ` sizeNregex n)
+ \<union> (RSEQ_set (sizeNregex n) n)
+ \<union> (RALTs_set (sizeNregex n) n))
+ \<union> (RNTIMES_set (sizeNregex n) n)"
+ apply(auto)
+ apply(case_tac x)
+ apply(auto simp add: RSEQ_set_def)
+ using sizeNregex_def apply force
+ using sizeNregex_def apply auto[1]
+ apply (simp add: sizeNregex_def)
+ apply (simp add: sizeNregex_def)
+ apply (simp add: RALTs_set_def)
+ apply (metis imageI list.set_map member_le_sum_list order_trans)
+ apply (simp add: sizeNregex_def)
+ apply (simp add: sizeNregex_def)
+ apply (simp add: RNTIMES_set_def)
+ apply (simp add: sizeNregex_def)
+ using sizeNregex_def apply force
+ apply (simp add: sizeNregex_def)
+ apply (simp add: sizeNregex_def)
+ apply (simp add: sizeNregex_def)
+ apply (simp add: RALTs_set_def)
+ apply(simp add: sizeNregex_def)
+ apply(auto)
+ using ex_in_conv apply fastforce
+ apply (simp add: RNTIMES_set_def)
+ apply(simp add: sizeNregex_def)
+ by force
+
+
+lemma s4:
+ "RSEQ_set A n \<subseteq> RSEQ_set_cartesian A"
+ using RSEQ_set_cartesian_def RSEQ_set_def by fastforce
+
+lemma s5:
+ assumes "finite A"
+ shows "finite (RSEQ_set_cartesian A)"
+ using assms
+ apply(subgoal_tac "RSEQ_set_cartesian A = (\<lambda>(x1, x2). RSEQ x1 x2) ` (A \<times> A)")
+ apply simp
+ unfolding RSEQ_set_cartesian_def
+ apply(auto)
+ done
+
+
+definition RALTs_set_length
+ where
+ "RALTs_set_length A n l \<equiv> {RALTS rs | rs. \<forall>r \<in> set rs. r \<in> A \<and> rsizes rs \<le> n \<and> length rs \<le> l}"
+
+
+definition RALTs_set_length2
+ where
+ "RALTs_set_length2 A l \<equiv> {RALTS rs | rs. \<forall>r \<in> set rs. r \<in> A \<and> length rs \<le> l}"
+
+definition set_length2
+ where
+ "set_length2 A l \<equiv> {rs. \<forall>r \<in> set rs. r \<in> A \<and> length rs \<le> l}"
+
+
+lemma r000:
+ shows "RALTs_set_length A n l \<subseteq> RALTs_set_length2 A l"
+ apply(auto simp add: RALTs_set_length2_def RALTs_set_length_def)
+ done
+
+
+lemma r02:
+ shows "set_length2 A 0 \<subseteq> {[]}"
+ apply(auto simp add: set_length2_def)
+ apply(case_tac x)
+ apply(auto)
+ done
+
+lemma r03:
+ shows "set_length2 A (Suc n) \<subseteq>
+ {[]} \<union> (\<lambda>(h, t). h # t) ` (A \<times> (set_length2 A n))"
+ apply(auto simp add: set_length2_def)
+ apply(case_tac x)
+ apply(auto)
+ done
+
+lemma r1:
+ assumes "finite A"
+ shows "finite (set_length2 A n)"
+ using assms
+ apply(induct n)
+ apply(rule finite_subset)
+ apply(rule r02)
+ apply(simp)
+ apply(rule finite_subset)
+ apply(rule r03)
+ apply(simp)
+ done
+
+lemma size_sum_more_than_len:
+ shows "rsizes rs \<ge> length rs"
+ apply(induct rs)
+ apply simp
+ apply simp
+ apply(subgoal_tac "rsize a \<ge> 1")
+ apply linarith
+ using size_geq1 by auto
+
+
+lemma sum_list_len:
+ shows "rsizes rs \<le> n \<Longrightarrow> length rs \<le> n"
+ by (meson order.trans size_sum_more_than_len)
+
+
+lemma t2:
+ shows "RALTs_set A n \<subseteq> RALTs_set_length A n n"
+ unfolding RALTs_set_length_def RALTs_set_def
+ apply(auto)
+ using sum_list_len by blast
+
+lemma s8_aux:
+ assumes "finite A"
+ shows "finite (RALTs_set_length A n n)"
+proof -
+ have "finite A" by fact
+ then have "finite (set_length2 A n)"
+ by (simp add: r1)
+ moreover have "(RALTS ` (set_length2 A n)) = RALTs_set_length2 A n"
+ unfolding RALTs_set_length2_def set_length2_def
+ by (auto)
+ ultimately have "finite (RALTs_set_length2 A n)"
+ by (metis finite_imageI)
+ then show ?thesis
+ by (metis infinite_super r000)
+qed
+
+lemma char_finite:
+ shows "finite {RCHAR c |c. True}"
+ apply simp
+ apply(subgoal_tac "finite (RCHAR ` (UNIV::char set))")
+ prefer 2
+ apply simp
+ by (simp add: full_SetCompr_eq)
+
+thm RNTIMES_set_def
+
+lemma s9_aux0:
+ shows "RNTIMES_set (insert r A) n \<subseteq> RNTIMES_set A n \<union> (\<Union> i \<in> {..n}. {RNTIMES r i})"
+apply(auto simp add: RNTIMES_set_def)
+ done
+
+lemma s9_aux:
+ assumes "finite A"
+ shows "finite (RNTIMES_set A n)"
+ using assms
+ apply(induct A arbitrary: n)
+ apply(auto simp add: RNTIMES_set_def)[1]
+ apply(subgoal_tac "finite (RNTIMES_set F n \<union> (\<Union> i \<in> {..n}. {RNTIMES x i}))")
+ apply (metis finite_subset s9_aux0)
+ by blast
+
+lemma finite_size_n:
+ shows "finite (sizeNregex n)"
+ apply(induct n)
+ apply(simp add: sizeNregex_def)
+ apply (metis (mono_tags, lifting) not_finite_existsD not_one_le_zero size_geq1)
+ apply(subst sizenregex_induct1)
+ apply(simp only: finite_Un)
+ apply(rule conjI)+
+ apply(simp)
+
+ using char_finite apply blast
+ apply(simp)
+ apply(rule finite_subset)
+ apply(rule s4)
+ apply(rule s5)
+ apply(simp)
+ apply(rule finite_subset)
+ apply(rule t2)
+ apply(rule s8_aux)
+ apply(simp)
+ by (simp add: s9_aux)
+
+lemma three_easy_cases0:
+ shows "rsize (rders_simp RZERO s) \<le> Suc 0"
+ apply(induct s)
+ apply simp
+ apply simp
+ done
+
+
+lemma three_easy_cases1:
+ shows "rsize (rders_simp RONE s) \<le> Suc 0"
+ apply(induct s)
+ apply simp
+ apply simp
+ using three_easy_cases0 by auto
+
+
+lemma three_easy_casesC:
+ shows "rsize (rders_simp (RCHAR c) s) \<le> Suc 0"
+ apply(induct s)
+ apply simp
+ apply simp
+ apply(case_tac " a = c")
+ using three_easy_cases1 apply blast
+ apply simp
+ using three_easy_cases0 by force
+
+
+unused_thms
+
+
+end
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys4/posix/Lexer.thy Mon Aug 29 23:16:28 2022 +0100
@@ -0,0 +1,496 @@
+
+theory Lexer
+ imports PosixSpec
+begin
+
+section \<open>The Lexer Functions by Sulzmann and Lu (without simplification)\<close>
+
+fun
+ mkeps :: "rexp \<Rightarrow> val"
+where
+ "mkeps(ONE) = Void"
+| "mkeps(SEQ r1 r2) = Seq (mkeps r1) (mkeps r2)"
+| "mkeps(ALT r1 r2) = (if nullable(r1) then Left (mkeps r1) else Right (mkeps r2))"
+| "mkeps(STAR r) = Stars []"
+| "mkeps(NTIMES r n) = Stars (replicate n (mkeps r))"
+
+fun injval :: "rexp \<Rightarrow> char \<Rightarrow> val \<Rightarrow> val"
+where
+ "injval (CH d) c Void = Char d"
+| "injval (ALT r1 r2) c (Left v1) = Left(injval r1 c v1)"
+| "injval (ALT r1 r2) c (Right v2) = Right(injval r2 c v2)"
+| "injval (SEQ r1 r2) c (Seq v1 v2) = Seq (injval r1 c v1) v2"
+| "injval (SEQ r1 r2) c (Left (Seq v1 v2)) = Seq (injval r1 c v1) v2"
+| "injval (SEQ r1 r2) c (Right v2) = Seq (mkeps r1) (injval r2 c v2)"
+| "injval (STAR r) c (Seq v (Stars vs)) = Stars ((injval r c v) # vs)"
+| "injval (NTIMES r n) c (Seq v (Stars vs)) = Stars ((injval r c v) # vs)"
+
+fun
+ lexer :: "rexp \<Rightarrow> string \<Rightarrow> val option"
+where
+ "lexer r [] = (if nullable r then Some(mkeps r) else None)"
+| "lexer r (c#s) = (case (lexer (der c r) s) of
+ None \<Rightarrow> None
+ | Some(v) \<Rightarrow> Some(injval r c v))"
+
+
+
+section \<open>Mkeps, Injval Properties\<close>
+
+lemma mkeps_flat:
+ assumes "nullable(r)"
+ shows "flat (mkeps r) = []"
+using assms
+ by (induct rule: mkeps.induct) (auto)
+
+lemma Prf_NTimes_empty:
+ assumes "\<forall>v \<in> set vs. \<Turnstile> v : r \<and> flat v = []"
+ and "length vs = n"
+ shows "\<Turnstile> Stars vs : NTIMES r n"
+ using assms
+ by (metis Prf.intros(7) empty_iff eq_Nil_appendI list.set(1))
+
+
+lemma mkeps_nullable:
+ assumes "nullable(r)"
+ shows "\<Turnstile> mkeps r : r"
+using assms
+ apply (induct rule: mkeps.induct)
+ apply(auto intro: Prf.intros split: if_splits)
+ apply (metis Prf.intros(7) append_is_Nil_conv empty_iff list.set(1) list.size(3))
+ apply(rule Prf_NTimes_empty)
+ apply(auto simp add: mkeps_flat)
+ done
+
+lemma Prf_injval_flat:
+ assumes "\<Turnstile> v : der c r"
+ shows "flat (injval r c v) = c # (flat v)"
+using assms
+apply(induct c r arbitrary: v rule: der.induct)
+apply(auto elim!: Prf_elims intro: mkeps_flat split: if_splits)
+done
+
+lemma Prf_injval:
+ assumes "\<Turnstile> v : der c r"
+ shows "\<Turnstile> (injval r c v) : r"
+using assms
+apply(induct r arbitrary: c v rule: rexp.induct)
+apply(auto intro!: Prf.intros mkeps_nullable elim!: Prf_elims split: if_splits)
+(* Star *)
+apply(simp add: Prf_injval_flat)
+(* NTimes *)
+ apply(case_tac x2)
+ apply(simp)
+ apply(simp)
+ apply(subst append.simps(2)[symmetric])
+ apply(rule Prf.intros)
+ apply(auto simp add: Prf_injval_flat)
+ done
+
+
+text \<open>Mkeps and injval produce, or preserve, Posix values.\<close>
+lemma mkepsPosixSeq_pf2:
+ shows " \<And>x1 x2 s v. \<lbrakk>\<And>s v. s \<in> der c x1 \<rightarrow> v \<Longrightarrow> (c # s) \<in> x1 \<rightarrow> injval x1 c v;
+ \<And>s v. s \<in> der c x2 \<rightarrow> v \<Longrightarrow> (c # s) \<in> x2 \<rightarrow> injval x2 c v;
+ s \<in> der c (SEQ x1 x2) \<rightarrow> v\<rbrakk> \<Longrightarrow> (c # s) \<in> (SEQ x1 x2) \<rightarrow> (injval (SEQ x1 x2) c v) "
+ apply(case_tac "v ")
+
+ apply (metis Posix1a Posix_elims(4) Prf_elims(2) der.simps(5) val.distinct(3) val.distinct(5) val.distinct(7))
+
+ apply (metis Posix1a Posix_elims(4) Prf_elims(2) der.simps(5) val.distinct(11) val.distinct(13) val.distinct(15))
+ sorry
+
+lemma Posix_mkeps:
+ assumes "nullable r"
+ shows "[] \<in> r \<rightarrow> mkeps r"
+using assms
+apply(induct r rule: nullable.induct)
+apply(auto intro: Posix.intros simp add: nullable_correctness Sequ_def)
+apply(subst append.simps(1)[symmetric])
+apply(rule Posix.intros)
+apply(auto)
+by (simp add: Posix_NTIMES2 pow_empty_iff)
+
+lemma Posix_injval:
+ assumes "s \<in> (der c r) \<rightarrow> v"
+ shows "(c # s) \<in> r \<rightarrow> (injval r c v)"
+using assms
+proof(induct r arbitrary: s v rule: rexp.induct)
+ case ZERO
+ have "s \<in> der c ZERO \<rightarrow> v" by fact
+ then have "s \<in> ZERO \<rightarrow> v" by simp
+ then have "False" by cases
+ then show "(c # s) \<in> ZERO \<rightarrow> (injval ZERO c v)" by simp
+next
+ case ONE
+ have "s \<in> der c ONE \<rightarrow> v" by fact
+ then have "s \<in> ZERO \<rightarrow> v" by simp
+ then have "False" by cases
+ then show "(c # s) \<in> ONE \<rightarrow> (injval ONE c v)" by simp
+next
+ case (CH d)
+ consider (eq) "c = d" | (ineq) "c \<noteq> d" by blast
+ then show "(c # s) \<in> (CH d) \<rightarrow> (injval (CH d) c v)"
+ proof (cases)
+ case eq
+ have "s \<in> der c (CH d) \<rightarrow> v" by fact
+ then have "s \<in> ONE \<rightarrow> v" using eq by simp
+ then have eqs: "s = [] \<and> v = Void" by cases simp
+ show "(c # s) \<in> CH d \<rightarrow> injval (CH d) c v" using eq eqs
+ by (auto intro: Posix.intros)
+ next
+ case ineq
+ have "s \<in> der c (CH d) \<rightarrow> v" by fact
+ then have "s \<in> ZERO \<rightarrow> v" using ineq by simp
+ then have "False" by cases
+ then show "(c # s) \<in> CH d \<rightarrow> injval (CH d) c v" by simp
+ qed
+next
+ case (ALT r1 r2)
+ have IH1: "\<And>s v. s \<in> der c r1 \<rightarrow> v \<Longrightarrow> (c # s) \<in> r1 \<rightarrow> injval r1 c v" by fact
+ have IH2: "\<And>s v. s \<in> der c r2 \<rightarrow> v \<Longrightarrow> (c # s) \<in> r2 \<rightarrow> injval r2 c v" by fact
+ have "s \<in> der c (ALT r1 r2) \<rightarrow> v" by fact
+ then have "s \<in> ALT (der c r1) (der c r2) \<rightarrow> v" by simp
+ then consider (left) v' where "v = Left v'" "s \<in> der c r1 \<rightarrow> v'"
+ | (right) v' where "v = Right v'" "s \<notin> L (der c r1)" "s \<in> der c r2 \<rightarrow> v'"
+ by cases auto
+ then show "(c # s) \<in> ALT r1 r2 \<rightarrow> injval (ALT r1 r2) c v"
+ proof (cases)
+ case left
+ have "s \<in> der c r1 \<rightarrow> v'" by fact
+ then have "(c # s) \<in> r1 \<rightarrow> injval r1 c v'" using IH1 by simp
+ then have "(c # s) \<in> ALT r1 r2 \<rightarrow> injval (ALT r1 r2) c (Left v')" by (auto intro: Posix.intros)
+ then show "(c # s) \<in> ALT r1 r2 \<rightarrow> injval (ALT r1 r2) c v" using left by simp
+ next
+ case right
+ have "s \<notin> L (der c r1)" by fact
+ then have "c # s \<notin> L r1" by (simp add: der_correctness Der_def)
+ moreover
+ have "s \<in> der c r2 \<rightarrow> v'" by fact
+ then have "(c # s) \<in> r2 \<rightarrow> injval r2 c v'" using IH2 by simp
+ ultimately have "(c # s) \<in> ALT r1 r2 \<rightarrow> injval (ALT r1 r2) c (Right v')"
+ by (auto intro: Posix.intros)
+ then show "(c # s) \<in> ALT r1 r2 \<rightarrow> injval (ALT r1 r2) c v" using right by simp
+ qed
+next
+ case (SEQ r1 r2)
+ have IH1: "\<And>s v. s \<in> der c r1 \<rightarrow> v \<Longrightarrow> (c # s) \<in> r1 \<rightarrow> injval r1 c v" by fact
+ have IH2: "\<And>s v. s \<in> der c r2 \<rightarrow> v \<Longrightarrow> (c # s) \<in> r2 \<rightarrow> injval r2 c v" by fact
+ have "s \<in> der c (SEQ r1 r2) \<rightarrow> v" by fact
+ then consider
+ (left_nullable) v1 v2 s1 s2 where
+ "v = Left (Seq v1 v2)" "s = s1 @ s2"
+ "s1 \<in> der c r1 \<rightarrow> v1" "s2 \<in> r2 \<rightarrow> v2" "nullable r1"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r1) \<and> s\<^sub>4 \<in> L r2)"
+ | (right_nullable) v1 s1 s2 where
+ "v = Right v1" "s = s1 @ s2"
+ "s \<in> der c r2 \<rightarrow> v1" "nullable r1" "s1 @ s2 \<notin> L (SEQ (der c r1) r2)"
+ | (not_nullable) v1 v2 s1 s2 where
+ "v = Seq v1 v2" "s = s1 @ s2"
+ "s1 \<in> der c r1 \<rightarrow> v1" "s2 \<in> r2 \<rightarrow> v2" "\<not>nullable r1"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r1) \<and> s\<^sub>4 \<in> L r2)"
+ by (force split: if_splits elim!: Posix_elims simp add: Sequ_def der_correctness Der_def)
+ then show "(c # s) \<in> SEQ r1 r2 \<rightarrow> injval (SEQ r1 r2) c v"
+ proof (cases)
+ case left_nullable
+ have "s1 \<in> der c r1 \<rightarrow> v1" by fact
+ then have "(c # s1) \<in> r1 \<rightarrow> injval r1 c v1" using IH1 by simp
+ moreover
+ have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r1) \<and> s\<^sub>4 \<in> L r2)" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (c # s1) @ s\<^sub>3 \<in> L r1 \<and> s\<^sub>4 \<in> L r2)" by (simp add: der_correctness Der_def)
+ ultimately have "((c # s1) @ s2) \<in> SEQ r1 r2 \<rightarrow> Seq (injval r1 c v1) v2" using left_nullable by (rule_tac Posix.intros)
+ then show "(c # s) \<in> SEQ r1 r2 \<rightarrow> injval (SEQ r1 r2) c v" using left_nullable by simp
+ next
+ case right_nullable
+ have "nullable r1" by fact
+ then have "[] \<in> r1 \<rightarrow> (mkeps r1)" by (rule Posix_mkeps)
+ moreover
+ have "s \<in> der c r2 \<rightarrow> v1" by fact
+ then have "(c # s) \<in> r2 \<rightarrow> (injval r2 c v1)" using IH2 by simp
+ moreover
+ have "s1 @ s2 \<notin> L (SEQ (der c r1) r2)" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = c # s \<and> [] @ s\<^sub>3 \<in> L r1 \<and> s\<^sub>4 \<in> L r2)" using right_nullable
+ by(auto simp add: der_correctness Der_def append_eq_Cons_conv Sequ_def)
+ ultimately have "([] @ (c # s)) \<in> SEQ r1 r2 \<rightarrow> Seq (mkeps r1) (injval r2 c v1)"
+ by(rule Posix.intros)
+ then show "(c # s) \<in> SEQ r1 r2 \<rightarrow> injval (SEQ r1 r2) c v" using right_nullable by simp
+ next
+ case not_nullable
+ have "s1 \<in> der c r1 \<rightarrow> v1" by fact
+ then have "(c # s1) \<in> r1 \<rightarrow> injval r1 c v1" using IH1 by simp
+ moreover
+ have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r1) \<and> s\<^sub>4 \<in> L r2)" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (c # s1) @ s\<^sub>3 \<in> L r1 \<and> s\<^sub>4 \<in> L r2)" by (simp add: der_correctness Der_def)
+ ultimately have "((c # s1) @ s2) \<in> SEQ r1 r2 \<rightarrow> Seq (injval r1 c v1) v2" using not_nullable
+ by (rule_tac Posix.intros) (simp_all)
+ then show "(c # s) \<in> SEQ r1 r2 \<rightarrow> injval (SEQ r1 r2) c v" using not_nullable by simp
+ qed
+next
+ case (STAR r)
+ have IH: "\<And>s v. s \<in> der c r \<rightarrow> v \<Longrightarrow> (c # s) \<in> r \<rightarrow> injval r c v" by fact
+ have "s \<in> der c (STAR r) \<rightarrow> v" by fact
+ then consider
+ (cons) v1 vs s1 s2 where
+ "v = Seq v1 (Stars vs)" "s = s1 @ s2"
+ "s1 \<in> der c r \<rightarrow> v1" "s2 \<in> (STAR r) \<rightarrow> (Stars vs)"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (STAR r))"
+ apply(auto elim!: Posix_elims(1-5) simp add: der_correctness Der_def intro: Posix.intros)
+ apply(rotate_tac 3)
+ apply(erule_tac Posix_elims(6))
+ apply (simp add: Posix.intros(6))
+ using Posix.intros(7) by blast
+ then show "(c # s) \<in> STAR r \<rightarrow> injval (STAR r) c v"
+ proof (cases)
+ case cons
+ have "s1 \<in> der c r \<rightarrow> v1" by fact
+ then have "(c # s1) \<in> r \<rightarrow> injval r c v1" using IH by simp
+ moreover
+ have "s2 \<in> STAR r \<rightarrow> Stars vs" by fact
+ moreover
+ have "(c # s1) \<in> r \<rightarrow> injval r c v1" by fact
+ then have "flat (injval r c v1) = (c # s1)" by (rule Posix1)
+ then have "flat (injval r c v1) \<noteq> []" by simp
+ moreover
+ have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (STAR r))" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (c # s1) @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))"
+ by (simp add: der_correctness Der_def)
+ ultimately
+ have "((c # s1) @ s2) \<in> STAR r \<rightarrow> Stars (injval r c v1 # vs)" by (rule Posix.intros)
+ then show "(c # s) \<in> STAR r \<rightarrow> injval (STAR r) c v" using cons by(simp)
+ qed
+next
+ case (NTIMES r n)
+ have IH: "\<And>s v. s \<in> der c r \<rightarrow> v \<Longrightarrow> (c # s) \<in> r \<rightarrow> injval r c v" by fact
+ have "s \<in> der c (NTIMES r n) \<rightarrow> v" by fact
+ then consider
+ (cons) v1 vs s1 s2 where
+ "v = Seq v1 (Stars vs)" "s = s1 @ s2"
+ "s1 \<in> der c r \<rightarrow> v1" "s2 \<in> (NTIMES r (n - 1)) \<rightarrow> (Stars vs)" "0 < n"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (NTIMES r (n - 1)))"
+
+ apply(auto elim: Posix_elims simp add: der_correctness Der_def intro: Posix.intros split: if_splits)
+ apply(erule Posix_elims)
+ apply(simp)
+ apply(subgoal_tac "\<exists>vss. v2 = Stars vss")
+ apply(clarify)
+ apply(drule_tac x="vss" in meta_spec)
+ apply(drule_tac x="s1" in meta_spec)
+ apply(drule_tac x="s2" in meta_spec)
+ apply(simp add: der_correctness Der_def)
+ apply(erule Posix_elims)
+ apply(auto)
+ done
+ then show "(c # s) \<in> (NTIMES r n) \<rightarrow> injval (NTIMES r n) c v"
+ proof (cases)
+ case cons
+ have "s1 \<in> der c r \<rightarrow> v1" by fact
+ then have "(c # s1) \<in> r \<rightarrow> injval r c v1" using IH by simp
+ moreover
+ have "s2 \<in> (NTIMES r (n - 1)) \<rightarrow> Stars vs" by fact
+ moreover
+ have "(c # s1) \<in> r \<rightarrow> injval r c v1" by fact
+ then have "flat (injval r c v1) = (c # s1)" by (rule Posix1)
+ then have "flat (injval r c v1) \<noteq> []" by simp
+ moreover
+ have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (NTIMES r (n - 1)))" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (c # s1) @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (NTIMES r (n - 1)))"
+ by (simp add: der_correctness Der_def)
+ ultimately
+ have "((c # s1) @ s2) \<in> NTIMES r n \<rightarrow> Stars (injval r c v1 # vs)"
+ apply (rule_tac Posix.intros)
+ apply(simp_all)
+ apply(case_tac n)
+ apply(simp)
+ using Posix_elims(1) NTIMES.prems apply auto[1]
+ apply(simp)
+ done
+ then show "(c # s) \<in> NTIMES r n \<rightarrow> injval (NTIMES r n) c v" using cons by(simp)
+ qed
+
+qed
+
+
+section \<open>Lexer Correctness\<close>
+
+
+lemma lexer_correct_None:
+ shows "s \<notin> L r \<longleftrightarrow> lexer r s = None"
+ apply(induct s arbitrary: r)
+ apply(simp)
+ apply(simp add: nullable_correctness)
+ apply(simp)
+ apply(drule_tac x="der a r" in meta_spec)
+ apply(auto)
+ apply(auto simp add: der_correctness Der_def)
+done
+
+lemma lexer_correct_Some:
+ shows "s \<in> L r \<longleftrightarrow> (\<exists>v. lexer r s = Some(v) \<and> s \<in> r \<rightarrow> v)"
+ apply(induct s arbitrary : r)
+ apply(simp only: lexer.simps)
+ apply(simp)
+ apply(simp add: nullable_correctness Posix_mkeps)
+ apply(drule_tac x="der a r" in meta_spec)
+ apply(simp (no_asm_use) add: der_correctness Der_def del: lexer.simps)
+ apply(simp del: lexer.simps)
+ apply(simp only: lexer.simps)
+ apply(case_tac "lexer (der a r) s = None")
+ apply(auto)[1]
+ apply(simp)
+ apply(erule exE)
+ apply(simp)
+ apply(rule iffI)
+ apply(simp add: Posix_injval)
+ apply(simp add: Posix1(1))
+done
+
+lemma lexer_correctness:
+ shows "(lexer r s = Some v) \<longleftrightarrow> s \<in> r \<rightarrow> v"
+ and "(lexer r s = None) \<longleftrightarrow> \<not>(\<exists>v. s \<in> r \<rightarrow> v)"
+using Posix1(1) Posix_determ lexer_correct_None lexer_correct_Some apply fastforce
+using Posix1(1) lexer_correct_None lexer_correct_Some by blast
+
+
+subsection {* A slight reformulation of the lexer algorithm using stacked functions*}
+
+fun flex :: "rexp \<Rightarrow> (val \<Rightarrow> val) => string \<Rightarrow> (val \<Rightarrow> val)"
+ where
+ "flex r f [] = f"
+| "flex r f (c#s) = flex (der c r) (\<lambda>v. f (injval r c v)) s"
+
+lemma flex_fun_apply:
+ shows "g (flex r f s v) = flex r (g o f) s v"
+ apply(induct s arbitrary: g f r v)
+ apply(simp_all add: comp_def)
+ by meson
+
+lemma flex_fun_apply2:
+ shows "g (flex r id s v) = flex r g s v"
+ by (simp add: flex_fun_apply)
+
+
+lemma flex_append:
+ shows "flex r f (s1 @ s2) = flex (ders s1 r) (flex r f s1) s2"
+ apply(induct s1 arbitrary: s2 r f)
+ apply(simp_all)
+ done
+
+lemma lexer_flex:
+ shows "lexer r s = (if nullable (ders s r)
+ then Some(flex r id s (mkeps (ders s r))) else None)"
+ apply(induct s arbitrary: r)
+ apply(simp_all add: flex_fun_apply)
+ done
+
+lemma Posix_flex:
+ assumes "s2 \<in> (ders s1 r) \<rightarrow> v"
+ shows "(s1 @ s2) \<in> r \<rightarrow> flex r id s1 v"
+ using assms
+ apply(induct s1 arbitrary: r v s2)
+ apply(simp)
+ apply(simp)
+ apply(drule_tac x="der a r" in meta_spec)
+ apply(drule_tac x="v" in meta_spec)
+ apply(drule_tac x="s2" in meta_spec)
+ apply(simp)
+ using Posix_injval
+ apply(drule_tac Posix_injval)
+ apply(subst (asm) (5) flex_fun_apply)
+ apply(simp)
+ done
+
+lemma injval_inj:
+ assumes "\<Turnstile> a : (der c r)" "\<Turnstile> v : (der c r)" "injval r c a = injval r c v"
+ shows "a = v"
+ using assms
+ apply(induct r arbitrary: a c v)
+ apply(auto)
+ using Prf_elims(1) apply blast
+ using Prf_elims(1) apply blast
+ apply(case_tac "c = x")
+ apply(auto)
+ using Prf_elims(4) apply auto[1]
+ using Prf_elims(1) apply blast
+ prefer 2
+ apply (smt Prf_elims(3) injval.simps(2) injval.simps(3) val.distinct(25) val.inject(3) val.inject(4))
+ apply(case_tac "nullable r1")
+ apply(auto)
+ apply(erule Prf_elims)
+ apply(erule Prf_elims)
+ apply(erule Prf_elims)
+ apply(erule Prf_elims)
+ apply(auto)
+ apply (metis Prf_injval_flat list.distinct(1) mkeps_flat)
+ apply(erule Prf_elims)
+ apply(erule Prf_elims)
+ apply(auto)
+ using Prf_injval_flat mkeps_flat apply fastforce
+ apply(erule Prf_elims)
+ apply(erule Prf_elims)
+ apply(auto)
+ apply(erule Prf_elims)
+ apply(erule Prf_elims)
+ apply(auto)
+ apply (smt Prf_elims(6) injval.simps(7) list.inject val.inject(5))
+ apply (smt Prf_elims(6) injval.simps(7) list.inject val.inject(5))
+ by (smt (verit, best) Prf_elims(1) Prf_elims(2) Prf_elims(7) injval.simps(8) list.inject val.simps(5))
+
+
+
+lemma uu:
+ assumes "(c # s) \<in> r \<rightarrow> injval r c v" "\<Turnstile> v : (der c r)"
+ shows "s \<in> der c r \<rightarrow> v"
+ using assms
+ apply -
+ apply(subgoal_tac "lexer r (c # s) = Some (injval r c v)")
+ prefer 2
+ using lexer_correctness(1) apply blast
+ apply(simp add: )
+ apply(case_tac "lexer (der c r) s")
+ apply(simp)
+ apply(simp)
+ apply(case_tac "s \<in> der c r \<rightarrow> a")
+ prefer 2
+ apply (simp add: lexer_correctness(1))
+ apply(subgoal_tac "\<Turnstile> a : (der c r)")
+ prefer 2
+ using Posix1a apply blast
+ using injval_inj by blast
+
+
+lemma Posix_flex2:
+ assumes "(s1 @ s2) \<in> r \<rightarrow> flex r id s1 v" "\<Turnstile> v : ders s1 r"
+ shows "s2 \<in> (ders s1 r) \<rightarrow> v"
+ using assms
+ apply(induct s1 arbitrary: r v s2 rule: rev_induct)
+ apply(simp)
+ apply(simp)
+ apply(drule_tac x="r" in meta_spec)
+ apply(drule_tac x="injval (ders xs r) x v" in meta_spec)
+ apply(drule_tac x="x#s2" in meta_spec)
+ apply(simp add: flex_append ders_append)
+ using Prf_injval uu by blast
+
+lemma Posix_flex3:
+ assumes "s1 \<in> r \<rightarrow> flex r id s1 v" "\<Turnstile> v : ders s1 r"
+ shows "[] \<in> (ders s1 r) \<rightarrow> v"
+ using assms
+ by (simp add: Posix_flex2)
+
+lemma flex_injval:
+ shows "flex (der a r) (injval r a) s v = injval r a (flex (der a r) id s v)"
+ by (simp add: flex_fun_apply)
+
+lemma Prf_flex:
+ assumes "\<Turnstile> v : ders s r"
+ shows "\<Turnstile> flex r id s v : r"
+ using assms
+ apply(induct s arbitrary: v r)
+ apply(simp)
+ apply(simp)
+ by (simp add: Prf_injval flex_injval)
+
+
+unused_thms
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys4/posix/LexerSimp.thy Mon Aug 29 23:16:28 2022 +0100
@@ -0,0 +1,246 @@
+theory LexerSimp
+ imports "Lexer"
+begin
+
+section {* Lexer including some simplifications *}
+
+
+fun F_RIGHT where
+ "F_RIGHT f v = Right (f v)"
+
+fun F_LEFT where
+ "F_LEFT f v = Left (f v)"
+
+fun F_ALT where
+ "F_ALT f\<^sub>1 f\<^sub>2 (Right v) = Right (f\<^sub>2 v)"
+| "F_ALT f\<^sub>1 f\<^sub>2 (Left v) = Left (f\<^sub>1 v)"
+| "F_ALT f1 f2 v = v"
+
+
+fun F_SEQ1 where
+ "F_SEQ1 f\<^sub>1 f\<^sub>2 v = Seq (f\<^sub>1 Void) (f\<^sub>2 v)"
+
+fun F_SEQ2 where
+ "F_SEQ2 f\<^sub>1 f\<^sub>2 v = Seq (f\<^sub>1 v) (f\<^sub>2 Void)"
+
+fun F_SEQ where
+ "F_SEQ f\<^sub>1 f\<^sub>2 (Seq v\<^sub>1 v\<^sub>2) = Seq (f\<^sub>1 v\<^sub>1) (f\<^sub>2 v\<^sub>2)"
+| "F_SEQ f1 f2 v = v"
+
+fun simp_ALT where
+ "simp_ALT (ZERO, f\<^sub>1) (r\<^sub>2, f\<^sub>2) = (r\<^sub>2, F_RIGHT f\<^sub>2)"
+| "simp_ALT (r\<^sub>1, f\<^sub>1) (ZERO, f\<^sub>2) = (r\<^sub>1, F_LEFT f\<^sub>1)"
+| "simp_ALT (r\<^sub>1, f\<^sub>1) (r\<^sub>2, f\<^sub>2) = (ALT r\<^sub>1 r\<^sub>2, F_ALT f\<^sub>1 f\<^sub>2)"
+
+
+fun simp_SEQ where
+ "simp_SEQ (ONE, f\<^sub>1) (r\<^sub>2, f\<^sub>2) = (r\<^sub>2, F_SEQ1 f\<^sub>1 f\<^sub>2)"
+| "simp_SEQ (r\<^sub>1, f\<^sub>1) (ONE, f\<^sub>2) = (r\<^sub>1, F_SEQ2 f\<^sub>1 f\<^sub>2)"
+| "simp_SEQ (ZERO, f\<^sub>1) (r\<^sub>2, f\<^sub>2) = (ZERO, undefined)"
+| "simp_SEQ (r\<^sub>1, f\<^sub>1) (ZERO, f\<^sub>2) = (ZERO, undefined)"
+| "simp_SEQ (r\<^sub>1, f\<^sub>1) (r\<^sub>2, f\<^sub>2) = (SEQ r\<^sub>1 r\<^sub>2, F_SEQ f\<^sub>1 f\<^sub>2)"
+
+lemma simp_SEQ_simps[simp]:
+ "simp_SEQ p1 p2 = (if (fst p1 = ONE) then (fst p2, F_SEQ1 (snd p1) (snd p2))
+ else (if (fst p2 = ONE) then (fst p1, F_SEQ2 (snd p1) (snd p2))
+ else (if (fst p1 = ZERO) then (ZERO, undefined)
+ else (if (fst p2 = ZERO) then (ZERO, undefined)
+ else (SEQ (fst p1) (fst p2), F_SEQ (snd p1) (snd p2))))))"
+by (induct p1 p2 rule: simp_SEQ.induct) (auto)
+
+lemma simp_ALT_simps[simp]:
+ "simp_ALT p1 p2 = (if (fst p1 = ZERO) then (fst p2, F_RIGHT (snd p2))
+ else (if (fst p2 = ZERO) then (fst p1, F_LEFT (snd p1))
+ else (ALT (fst p1) (fst p2), F_ALT (snd p1) (snd p2))))"
+by (induct p1 p2 rule: simp_ALT.induct) (auto)
+
+fun
+ simp :: "rexp \<Rightarrow> rexp * (val \<Rightarrow> val)"
+where
+ "simp (ALT r1 r2) = simp_ALT (simp r1) (simp r2)"
+| "simp (SEQ r1 r2) = simp_SEQ (simp r1) (simp r2)"
+| "simp r = (r, id)"
+
+fun
+ slexer :: "rexp \<Rightarrow> string \<Rightarrow> val option"
+where
+ "slexer r [] = (if nullable r then Some(mkeps r) else None)"
+| "slexer r (c#s) = (let (rs, fr) = simp (der c r) in
+ (case (slexer rs s) of
+ None \<Rightarrow> None
+ | Some(v) \<Rightarrow> Some(injval r c (fr v))))"
+
+
+lemma slexer_better_simp:
+ "slexer r (c#s) = (case (slexer (fst (simp (der c r))) s) of
+ None \<Rightarrow> None
+ | Some(v) \<Rightarrow> Some(injval r c ((snd (simp (der c r))) v)))"
+by (auto split: prod.split option.split)
+
+
+lemma L_fst_simp:
+ shows "L(r) = L(fst (simp r))"
+by (induct r) (auto)
+
+lemma Posix_simp:
+ assumes "s \<in> (fst (simp r)) \<rightarrow> v"
+ shows "s \<in> r \<rightarrow> ((snd (simp r)) v)"
+using assms
+proof(induct r arbitrary: s v rule: rexp.induct)
+ case (ALT r1 r2 s v)
+ have IH1: "\<And>s v. s \<in> fst (simp r1) \<rightarrow> v \<Longrightarrow> s \<in> r1 \<rightarrow> snd (simp r1) v" by fact
+ have IH2: "\<And>s v. s \<in> fst (simp r2) \<rightarrow> v \<Longrightarrow> s \<in> r2 \<rightarrow> snd (simp r2) v" by fact
+ have as: "s \<in> fst (simp (ALT r1 r2)) \<rightarrow> v" by fact
+ consider (ZERO_ZERO) "fst (simp r1) = ZERO" "fst (simp r2) = ZERO"
+ | (ZERO_NZERO) "fst (simp r1) = ZERO" "fst (simp r2) \<noteq> ZERO"
+ | (NZERO_ZERO) "fst (simp r1) \<noteq> ZERO" "fst (simp r2) = ZERO"
+ | (NZERO_NZERO) "fst (simp r1) \<noteq> ZERO" "fst (simp r2) \<noteq> ZERO" by auto
+ then show "s \<in> ALT r1 r2 \<rightarrow> snd (simp (ALT r1 r2)) v"
+ proof(cases)
+ case (ZERO_ZERO)
+ with as have "s \<in> ZERO \<rightarrow> v" by simp
+ then show "s \<in> ALT r1 r2 \<rightarrow> snd (simp (ALT r1 r2)) v" by (rule Posix_elims(1))
+ next
+ case (ZERO_NZERO)
+ with as have "s \<in> fst (simp r2) \<rightarrow> v" by simp
+ with IH2 have "s \<in> r2 \<rightarrow> snd (simp r2) v" by simp
+ moreover
+ from ZERO_NZERO have "fst (simp r1) = ZERO" by simp
+ then have "L (fst (simp r1)) = {}" by simp
+ then have "L r1 = {}" using L_fst_simp by simp
+ then have "s \<notin> L r1" by simp
+ ultimately have "s \<in> ALT r1 r2 \<rightarrow> Right (snd (simp r2) v)" by (rule Posix_ALT2)
+ then show "s \<in> ALT r1 r2 \<rightarrow> snd (simp (ALT r1 r2)) v"
+ using ZERO_NZERO by simp
+ next
+ case (NZERO_ZERO)
+ with as have "s \<in> fst (simp r1) \<rightarrow> v" by simp
+ with IH1 have "s \<in> r1 \<rightarrow> snd (simp r1) v" by simp
+ then have "s \<in> ALT r1 r2 \<rightarrow> Left (snd (simp r1) v)" by (rule Posix_ALT1)
+ then show "s \<in> ALT r1 r2 \<rightarrow> snd (simp (ALT r1 r2)) v" using NZERO_ZERO by simp
+ next
+ case (NZERO_NZERO)
+ with as have "s \<in> ALT (fst (simp r1)) (fst (simp r2)) \<rightarrow> v" by simp
+ then consider (Left) v1 where "v = Left v1" "s \<in> (fst (simp r1)) \<rightarrow> v1"
+ | (Right) v2 where "v = Right v2" "s \<in> (fst (simp r2)) \<rightarrow> v2" "s \<notin> L (fst (simp r1))"
+ by (erule_tac Posix_elims(4))
+ then show "s \<in> ALT r1 r2 \<rightarrow> snd (simp (ALT r1 r2)) v"
+ proof(cases)
+ case (Left)
+ then have "v = Left v1" "s \<in> r1 \<rightarrow> (snd (simp r1) v1)" using IH1 by simp_all
+ then show "s \<in> ALT r1 r2 \<rightarrow> snd (simp (ALT r1 r2)) v" using NZERO_NZERO
+ by (simp_all add: Posix_ALT1)
+ next
+ case (Right)
+ then have "v = Right v2" "s \<in> r2 \<rightarrow> (snd (simp r2) v2)" "s \<notin> L r1" using IH2 L_fst_simp by simp_all
+ then show "s \<in> ALT r1 r2 \<rightarrow> snd (simp (ALT r1 r2)) v" using NZERO_NZERO
+ by (simp_all add: Posix_ALT2)
+ qed
+ qed
+next
+ case (SEQ r1 r2 s v)
+ have IH1: "\<And>s v. s \<in> fst (simp r1) \<rightarrow> v \<Longrightarrow> s \<in> r1 \<rightarrow> snd (simp r1) v" by fact
+ have IH2: "\<And>s v. s \<in> fst (simp r2) \<rightarrow> v \<Longrightarrow> s \<in> r2 \<rightarrow> snd (simp r2) v" by fact
+ have as: "s \<in> fst (simp (SEQ r1 r2)) \<rightarrow> v" by fact
+ consider (ONE_ONE) "fst (simp r1) = ONE" "fst (simp r2) = ONE"
+ | (ONE_NONE) "fst (simp r1) = ONE" "fst (simp r2) \<noteq> ONE"
+ | (NONE_ONE) "fst (simp r1) \<noteq> ONE" "fst (simp r2) = ONE"
+ | (NONE_NONE) "fst (simp r1) \<noteq> ONE" "fst (simp r2) \<noteq> ONE"
+ by auto
+ then show "s \<in> SEQ r1 r2 \<rightarrow> snd (simp (SEQ r1 r2)) v"
+ proof(cases)
+ case (ONE_ONE)
+ with as have b: "s \<in> ONE \<rightarrow> v" by simp
+ from b have "s \<in> r1 \<rightarrow> snd (simp r1) v" using IH1 ONE_ONE by simp
+ moreover
+ from b have c: "s = []" "v = Void" using Posix_elims(2) by auto
+ moreover
+ have "[] \<in> ONE \<rightarrow> Void" by (simp add: Posix_ONE)
+ then have "[] \<in> fst (simp r2) \<rightarrow> Void" using ONE_ONE by simp
+ then have "[] \<in> r2 \<rightarrow> snd (simp r2) Void" using IH2 by simp
+ ultimately have "([] @ []) \<in> SEQ r1 r2 \<rightarrow> Seq (snd (simp r1) Void) (snd (simp r2) Void)"
+ using Posix_SEQ by blast
+ then show "s \<in> SEQ r1 r2 \<rightarrow> snd (simp (SEQ r1 r2)) v" using c ONE_ONE by simp
+ next
+ case (ONE_NONE)
+ with as have b: "s \<in> fst (simp r2) \<rightarrow> v" by simp
+ from b have "s \<in> r2 \<rightarrow> snd (simp r2) v" using IH2 ONE_NONE by simp
+ moreover
+ have "[] \<in> ONE \<rightarrow> Void" by (simp add: Posix_ONE)
+ then have "[] \<in> fst (simp r1) \<rightarrow> Void" using ONE_NONE by simp
+ then have "[] \<in> r1 \<rightarrow> snd (simp r1) Void" using IH1 by simp
+ moreover
+ from ONE_NONE(1) have "L (fst (simp r1)) = {[]}" by simp
+ then have "L r1 = {[]}" by (simp add: L_fst_simp[symmetric])
+ ultimately have "([] @ s) \<in> SEQ r1 r2 \<rightarrow> Seq (snd (simp r1) Void) (snd (simp r2) v)"
+ by(rule_tac Posix_SEQ) auto
+ then show "s \<in> SEQ r1 r2 \<rightarrow> snd (simp (SEQ r1 r2)) v" using ONE_NONE by simp
+ next
+ case (NONE_ONE)
+ with as have "s \<in> fst (simp r1) \<rightarrow> v" by simp
+ with IH1 have "s \<in> r1 \<rightarrow> snd (simp r1) v" by simp
+ moreover
+ have "[] \<in> ONE \<rightarrow> Void" by (simp add: Posix_ONE)
+ then have "[] \<in> fst (simp r2) \<rightarrow> Void" using NONE_ONE by simp
+ then have "[] \<in> r2 \<rightarrow> snd (simp r2) Void" using IH2 by simp
+ ultimately have "(s @ []) \<in> SEQ r1 r2 \<rightarrow> Seq (snd (simp r1) v) (snd (simp r2) Void)"
+ by(rule_tac Posix_SEQ) auto
+ then show "s \<in> SEQ r1 r2 \<rightarrow> snd (simp (SEQ r1 r2)) v" using NONE_ONE by simp
+ next
+ case (NONE_NONE)
+ from as have 00: "fst (simp r1) \<noteq> ZERO" "fst (simp r2) \<noteq> ZERO"
+ apply(auto)
+ apply(smt Posix_elims(1) fst_conv)
+ by (smt NONE_NONE(2) Posix_elims(1) fstI)
+ with NONE_NONE as have "s \<in> SEQ (fst (simp r1)) (fst (simp r2)) \<rightarrow> v" by simp
+ then obtain s1 s2 v1 v2 where eqs: "s = s1 @ s2" "v = Seq v1 v2"
+ "s1 \<in> (fst (simp r1)) \<rightarrow> v1" "s2 \<in> (fst (simp r2)) \<rightarrow> v2"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r1 \<and> s\<^sub>4 \<in> L r2)"
+ by (erule_tac Posix_elims(5)) (auto simp add: L_fst_simp[symmetric])
+ then have "s1 \<in> r1 \<rightarrow> (snd (simp r1) v1)" "s2 \<in> r2 \<rightarrow> (snd (simp r2) v2)"
+ using IH1 IH2 by auto
+ then show "s \<in> SEQ r1 r2 \<rightarrow> snd (simp (SEQ r1 r2)) v" using eqs NONE_NONE 00
+ by(auto intro: Posix_SEQ)
+ qed
+qed (simp_all)
+
+
+lemma slexer_correctness:
+ shows "slexer r s = lexer r s"
+proof(induct s arbitrary: r)
+ case Nil
+ show "slexer r [] = lexer r []" by simp
+next
+ case (Cons c s r)
+ have IH: "\<And>r. slexer r s = lexer r s" by fact
+ show "slexer r (c # s) = lexer r (c # s)"
+ proof (cases "s \<in> L (der c r)")
+ case True
+ assume a1: "s \<in> L (der c r)"
+ then obtain v1 where a2: "lexer (der c r) s = Some v1" "s \<in> der c r \<rightarrow> v1"
+ using lexer_correct_Some by auto
+ from a1 have "s \<in> L (fst (simp (der c r)))" using L_fst_simp[symmetric] by simp
+ then obtain v2 where a3: "lexer (fst (simp (der c r))) s = Some v2" "s \<in> (fst (simp (der c r))) \<rightarrow> v2"
+ using lexer_correct_Some by auto
+ then have a4: "slexer (fst (simp (der c r))) s = Some v2" using IH by simp
+ from a3(2) have "s \<in> der c r \<rightarrow> (snd (simp (der c r))) v2" using Posix_simp by simp
+ with a2(2) have "v1 = (snd (simp (der c r))) v2" using Posix_determ by simp
+ with a2(1) a4 show "slexer r (c # s) = lexer r (c # s)" by (auto split: prod.split)
+ next
+ case False
+ assume b1: "s \<notin> L (der c r)"
+ then have "lexer (der c r) s = None" using lexer_correct_None by simp
+ moreover
+ from b1 have "s \<notin> L (fst (simp (der c r)))" using L_fst_simp[symmetric] by simp
+ then have "lexer (fst (simp (der c r))) s = None" using lexer_correct_None by simp
+ then have "slexer (fst (simp (der c r))) s = None" using IH by simp
+ ultimately show "slexer r (c # s) = lexer r (c # s)"
+ by (simp del: slexer.simps add: slexer_better_simp)
+ qed
+ qed
+
+
+unused_thms
+
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys4/posix/PosixSpec.thy Mon Aug 29 23:16:28 2022 +0100
@@ -0,0 +1,626 @@
+
+theory PosixSpec
+ imports RegLangs
+begin
+
+section \<open>"Plain" Values\<close>
+
+datatype val =
+ Void
+| Char char
+| Seq val val
+| Right val
+| Left val
+| Stars "val list"
+
+
+section \<open>The string behind a value\<close>
+
+fun
+ flat :: "val \<Rightarrow> string"
+where
+ "flat (Void) = []"
+| "flat (Char c) = [c]"
+| "flat (Left v) = flat v"
+| "flat (Right v) = flat v"
+| "flat (Seq v1 v2) = (flat v1) @ (flat v2)"
+| "flat (Stars []) = []"
+| "flat (Stars (v#vs)) = (flat v) @ (flat (Stars vs))"
+
+abbreviation
+ "flats vs \<equiv> concat (map flat vs)"
+
+lemma flat_Stars [simp]:
+ "flat (Stars vs) = flats vs"
+by (induct vs) (auto)
+
+
+section \<open>Lexical Values\<close>
+
+inductive
+ Prf :: "val \<Rightarrow> rexp \<Rightarrow> bool" ("\<Turnstile> _ : _" [100, 100] 100)
+where
+ "\<lbrakk>\<Turnstile> v1 : r1; \<Turnstile> v2 : r2\<rbrakk> \<Longrightarrow> \<Turnstile> Seq v1 v2 : SEQ r1 r2"
+| "\<Turnstile> v1 : r1 \<Longrightarrow> \<Turnstile> Left v1 : ALT r1 r2"
+| "\<Turnstile> v2 : r2 \<Longrightarrow> \<Turnstile> Right v2 : ALT r1 r2"
+| "\<Turnstile> Void : ONE"
+| "\<Turnstile> Char c : CH c"
+| "\<forall>v \<in> set vs. \<Turnstile> v : r \<and> flat v \<noteq> [] \<Longrightarrow> \<Turnstile> Stars vs : STAR r"
+| "\<lbrakk>\<forall>v \<in> set vs1. \<Turnstile> v : r \<and> flat v \<noteq> [];
+ \<forall>v \<in> set vs2. \<Turnstile> v : r \<and> flat v = [];
+ length (vs1 @ vs2) = n\<rbrakk> \<Longrightarrow> \<Turnstile> Stars (vs1 @ vs2) : NTIMES r n"
+
+inductive_cases Prf_elims:
+ "\<Turnstile> v : ZERO"
+ "\<Turnstile> v : SEQ r1 r2"
+ "\<Turnstile> v : ALT r1 r2"
+ "\<Turnstile> v : ONE"
+ "\<Turnstile> v : CH c"
+ "\<Turnstile> vs : STAR r"
+ "\<Turnstile> vs : NTIMES r n"
+
+lemma Prf_Stars_appendE:
+ assumes "\<Turnstile> Stars (vs1 @ vs2) : STAR r"
+ shows "\<Turnstile> Stars vs1 : STAR r \<and> \<Turnstile> Stars vs2 : STAR r"
+using assms
+by (auto intro: Prf.intros elim!: Prf_elims)
+
+lemma Pow_cstring:
+ fixes A::"string set"
+ assumes "s \<in> A ^^ n"
+ shows "\<exists>ss1 ss2. concat (ss1 @ ss2) = s \<and> length (ss1 @ ss2) = n \<and>
+ (\<forall>s \<in> set ss1. s \<in> A \<and> s \<noteq> []) \<and> (\<forall>s \<in> set ss2. s \<in> A \<and> s = [])"
+using assms
+apply(induct n arbitrary: s)
+ apply(auto)[1]
+ apply(auto simp add: Sequ_def)
+ apply(drule_tac x="s2" in meta_spec)
+ apply(simp)
+apply(erule exE)+
+ apply(clarify)
+apply(case_tac "s1 = []")
+apply(simp)
+apply(rule_tac x="ss1" in exI)
+apply(rule_tac x="s1 # ss2" in exI)
+apply(simp)
+apply(rule_tac x="s1 # ss1" in exI)
+apply(rule_tac x="ss2" in exI)
+ apply(simp)
+ done
+
+lemma flats_Prf_value:
+ assumes "\<forall>s\<in>set ss. \<exists>v. s = flat v \<and> \<Turnstile> v : r"
+ shows "\<exists>vs. flats vs = concat ss \<and> (\<forall>v\<in>set vs. \<Turnstile> v : r \<and> flat v \<noteq> [])"
+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
+
+lemma Aux:
+ assumes "\<forall>s\<in>set ss. s = []"
+ shows "concat ss = []"
+using assms
+by (induct ss) (auto)
+
+lemma flats_cval:
+ assumes "\<forall>s\<in>set ss. \<exists>v. s = flat v \<and> \<Turnstile> v : r"
+ shows "\<exists>vs1 vs2. flats (vs1 @ vs2) = concat ss \<and> length (vs1 @ vs2) = length ss \<and>
+ (\<forall>v\<in>set vs1. \<Turnstile> v : r \<and> flat v \<noteq> []) \<and>
+ (\<forall>v\<in>set vs2. \<Turnstile> v : r \<and> flat v = [])"
+using assms
+apply(induct ss rule: rev_induct)
+apply(rule_tac x="[]" in exI)+
+apply(simp)
+apply(simp)
+apply(clarify)
+apply(case_tac "flat v = []")
+apply(rule_tac x="vs1" in exI)
+apply(rule_tac x="v#vs2" in exI)
+apply(simp)
+apply(rule_tac x="vs1 @ [v]" in exI)
+apply(rule_tac x="vs2" in exI)
+apply(simp)
+by (simp add: Aux)
+
+lemma pow_Prf:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> flat v \<in> A"
+ shows "flats vs \<in> A ^^ (length vs)"
+ using assms
+ by (induct vs) (auto)
+
+lemma L_flat_Prf1:
+ assumes "\<Turnstile> v : r"
+ shows "flat v \<in> L r"
+ using assms
+ apply (induct v r rule: Prf.induct)
+ apply(auto simp add: Sequ_def Star_concat lang_pow_add)
+ by (metis pow_Prf)
+
+lemma L_flat_Prf2:
+ assumes "s \<in> L r"
+ shows "\<exists>v. \<Turnstile> v : r \<and> flat v = s"
+using assms
+proof(induct r arbitrary: s)
+ case (STAR r s)
+ have IH: "\<And>s. s \<in> L r \<Longrightarrow> \<exists>v. \<Turnstile> v : r \<and> flat v = s" by fact
+ have "s \<in> L (STAR r)" by fact
+ then obtain ss where "concat ss = s" "\<forall>s \<in> set ss. s \<in> L r \<and> s \<noteq> []"
+ using Star_split by auto
+ then obtain vs where "flats vs = s" "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> flat v \<noteq> []"
+ using IH flats_Prf_value by metis
+ then show "\<exists>v. \<Turnstile> v : STAR r \<and> flat v = s"
+ using Prf.intros(6) flat_Stars by blast
+next
+ case (SEQ r1 r2 s)
+ then show "\<exists>v. \<Turnstile> v : SEQ r1 r2 \<and> flat v = s"
+ unfolding Sequ_def L.simps by (fastforce intro: Prf.intros)
+next
+ case (ALT r1 r2 s)
+ then show "\<exists>v. \<Turnstile> v : ALT r1 r2 \<and> flat v = s"
+ unfolding L.simps by (fastforce intro: Prf.intros)
+next
+ case (NTIMES r n)
+ have IH: "\<And>s. s \<in> L r \<Longrightarrow> \<exists>v. \<Turnstile> v : r \<and> flat v = s" by fact
+ have "s \<in> L (NTIMES r n)" by fact
+ then obtain ss1 ss2 where "concat (ss1 @ ss2) = s" "length (ss1 @ ss2) = n"
+ "\<forall>s \<in> set ss1. s \<in> L r \<and> s \<noteq> []" "\<forall>s \<in> set ss2. s \<in> L r \<and> s = []"
+ using Pow_cstring by force
+ then obtain vs1 vs2 where "flats (vs1 @ vs2) = s" "length (vs1 @ vs2) = n"
+ "\<forall>v\<in>set vs1. \<Turnstile> v : r \<and> flat v \<noteq> []" "\<forall>v\<in>set vs2. \<Turnstile> v : r \<and> flat v = []"
+ using IH flats_cval
+ apply -
+ apply(drule_tac x="ss1 @ ss2" in meta_spec)
+ apply(drule_tac x="r" in meta_spec)
+ apply(drule meta_mp)
+ apply(simp)
+ apply (metis Un_iff)
+ apply(clarify)
+ apply(drule_tac x="vs1" in meta_spec)
+ apply(drule_tac x="vs2" in meta_spec)
+ apply(simp)
+ done
+ then show "\<exists>v. \<Turnstile> v : NTIMES r n \<and> flat v = s"
+ using Prf.intros(7) flat_Stars by blast
+qed (auto intro: Prf.intros)
+
+
+lemma L_flat_Prf:
+ shows "L(r) = {flat v | v. \<Turnstile> v : r}"
+using L_flat_Prf1 L_flat_Prf2 by blast
+
+
+
+section \<open>Sets of Lexical Values\<close>
+
+text \<open>
+ Shows that lexical values are finite for a given regex and string.
+\<close>
+
+definition
+ LV :: "rexp \<Rightarrow> string \<Rightarrow> val set"
+where "LV r s \<equiv> {v. \<Turnstile> v : r \<and> flat v = s}"
+
+lemma LV_simps:
+ shows "LV ZERO s = {}"
+ and "LV ONE s = (if s = [] then {Void} else {})"
+ and "LV (CH c) s = (if s = [c] then {Char c} else {})"
+ and "LV (ALT r1 r2) s = Left ` LV r1 s \<union> Right ` LV r2 s"
+ and "LV (NTIMES r 0) s = (if s = [] then {Stars []} else {})"
+unfolding LV_def
+ apply (auto intro: Prf.intros elim: Prf.cases)
+ by (metis Prf.intros(7) append.right_neutral empty_iff list.set(1) list.size(3))
+
+
+abbreviation
+ "Prefixes s \<equiv> {s'. prefix s' s}"
+
+abbreviation
+ "Suffixes s \<equiv> {s'. suffix s' s}"
+
+abbreviation
+ "SSuffixes s \<equiv> {s'. strict_suffix s' s}"
+
+lemma Suffixes_cons [simp]:
+ shows "Suffixes (c # s) = Suffixes s \<union> {c # s}"
+by (auto simp add: suffix_def Cons_eq_append_conv)
+
+
+lemma finite_Suffixes:
+ shows "finite (Suffixes s)"
+by (induct s) (simp_all)
+
+lemma finite_SSuffixes:
+ shows "finite (SSuffixes s)"
+proof -
+ have "SSuffixes s \<subseteq> Suffixes s"
+ unfolding strict_suffix_def suffix_def by auto
+ then show "finite (SSuffixes s)"
+ using finite_Suffixes finite_subset by blast
+qed
+
+lemma finite_Prefixes:
+ shows "finite (Prefixes s)"
+proof -
+ have "finite (Suffixes (rev s))"
+ by (rule finite_Suffixes)
+ then have "finite (rev ` Suffixes (rev s))" by simp
+ moreover
+ have "rev ` (Suffixes (rev s)) = Prefixes s"
+ unfolding suffix_def prefix_def image_def
+ by (auto)(metis rev_append rev_rev_ident)+
+ ultimately show "finite (Prefixes s)" by simp
+qed
+
+definition
+ "Stars_Append Vs1 Vs2 \<equiv> {Stars (vs1 @ vs2) | vs1 vs2. Stars vs1 \<in> Vs1 \<and> Stars vs2 \<in> Vs2}"
+
+lemma finite_Stars_Append:
+ assumes "finite Vs1" "finite Vs2"
+ shows "finite (Stars_Append Vs1 Vs2)"
+ using assms
+proof -
+ define UVs1 where "UVs1 \<equiv> Stars -` Vs1"
+ define UVs2 where "UVs2 \<equiv> Stars -` Vs2"
+ from assms have "finite UVs1" "finite UVs2"
+ unfolding UVs1_def UVs2_def
+ by(simp_all add: finite_vimageI inj_on_def)
+ then have "finite ((\<lambda>(vs1, vs2). Stars (vs1 @ vs2)) ` (UVs1 \<times> UVs2))"
+ by simp
+ moreover
+ have "Stars_Append Vs1 Vs2 = (\<lambda>(vs1, vs2). Stars (vs1 @ vs2)) ` (UVs1 \<times> UVs2)"
+ unfolding Stars_Append_def UVs1_def UVs2_def by auto
+ ultimately show "finite (Stars_Append Vs1 Vs2)"
+ by simp
+qed
+
+lemma LV_NTIMES_subset:
+ "LV (NTIMES r n) s \<subseteq> Stars_Append (LV (STAR r) s) (\<Union>i\<le>n. LV (NTIMES r i) [])"
+apply(auto simp add: LV_def)
+apply(auto elim!: Prf_elims)
+ apply(auto simp add: Stars_Append_def)
+ apply(rule_tac x="vs1" in exI)
+ apply(rule_tac x="vs2" in exI)
+ apply(auto)
+ using Prf.intros(6) apply(auto)
+ apply(rule_tac x="length vs2" in bexI)
+ thm Prf.intros
+ apply(subst append.simps(1)[symmetric])
+ apply(rule Prf.intros)
+ apply(auto)[1]
+ apply(auto)[1]
+ apply(simp)
+ apply(simp)
+ done
+
+lemma LV_NTIMES_Suc_empty:
+ shows "LV (NTIMES r (Suc n)) [] =
+ (\<lambda>(v, vs). Stars (v#vs)) ` (LV r [] \<times> (Stars -` (LV (NTIMES r n) [])))"
+unfolding LV_def
+apply(auto elim!: Prf_elims simp add: image_def)
+apply(case_tac vs1)
+apply(auto)
+apply(case_tac vs2)
+apply(auto)
+apply(subst append.simps(1)[symmetric])
+apply(rule Prf.intros)
+apply(auto)
+apply(subst append.simps(1)[symmetric])
+apply(rule Prf.intros)
+apply(auto)
+ done
+
+lemma LV_STAR_finite:
+ assumes "\<forall>s. finite (LV r s)"
+ shows "finite (LV (STAR r) s)"
+proof(induct s rule: length_induct)
+ fix s::"char list"
+ assume "\<forall>s'. length s' < length s \<longrightarrow> finite (LV (STAR r) s')"
+ then have IH: "\<forall>s' \<in> SSuffixes s. finite (LV (STAR r) s')"
+ by (force simp add: strict_suffix_def suffix_def)
+ define f where "f \<equiv> \<lambda>(v, vs). Stars (v # vs)"
+ define S1 where "S1 \<equiv> \<Union>s' \<in> Prefixes s. LV r s'"
+ define S2 where "S2 \<equiv> \<Union>s2 \<in> SSuffixes s. Stars -` (LV (STAR r) s2)"
+ have "finite S1" using assms
+ unfolding S1_def by (simp_all add: finite_Prefixes)
+ moreover
+ with IH have "finite S2" unfolding S2_def
+ by (auto simp add: finite_SSuffixes inj_on_def finite_vimageI)
+ ultimately
+ have "finite ({Stars []} \<union> f ` (S1 \<times> S2))" by simp
+ moreover
+ have "LV (STAR r) s \<subseteq> {Stars []} \<union> f ` (S1 \<times> S2)"
+ unfolding S1_def S2_def f_def
+ unfolding LV_def image_def prefix_def strict_suffix_def
+ apply(auto)
+ apply(case_tac x)
+ apply(auto elim: Prf_elims)
+ apply(erule Prf_elims)
+ apply(auto)
+ apply(case_tac vs)
+ apply(auto intro: Prf.intros)
+ apply(rule exI)
+ apply(rule conjI)
+ apply(rule_tac x="flat a" in exI)
+ apply(rule conjI)
+ apply(rule_tac x="flats list" in exI)
+ apply(simp)
+ apply(blast)
+ apply(simp add: suffix_def)
+ using Prf.intros(6) by blast
+ ultimately
+ show "finite (LV (STAR r) s)" by (simp add: finite_subset)
+qed
+
+lemma finite_NTimes_empty:
+ assumes "\<And>s. finite (LV r s)"
+ shows "finite (LV (NTIMES r n) [])"
+ using assms
+ apply(induct n)
+ apply(auto simp add: LV_simps)
+ apply(subst LV_NTIMES_Suc_empty)
+ apply(rule finite_imageI)
+ apply(rule finite_cartesian_product)
+ using assms apply simp
+ apply(rule finite_vimageI)
+ apply(simp)
+ apply(simp add: inj_on_def)
+ done
+
+
+lemma LV_finite:
+ shows "finite (LV r s)"
+proof(induct r arbitrary: s)
+ case (ZERO s)
+ show "finite (LV ZERO s)" by (simp add: LV_simps)
+next
+ case (ONE s)
+ show "finite (LV ONE s)" by (simp add: LV_simps)
+next
+ case (CH c s)
+ show "finite (LV (CH c) s)" by (simp add: LV_simps)
+next
+ case (ALT r1 r2 s)
+ then show "finite (LV (ALT r1 r2) s)" by (simp add: LV_simps)
+next
+ case (SEQ r1 r2 s)
+ define f where "f \<equiv> \<lambda>(v1, v2). Seq v1 v2"
+ define S1 where "S1 \<equiv> \<Union>s' \<in> Prefixes s. LV r1 s'"
+ define S2 where "S2 \<equiv> \<Union>s' \<in> Suffixes s. LV r2 s'"
+ have IHs: "\<And>s. finite (LV r1 s)" "\<And>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 "LV (SEQ r1 r2) s \<subseteq> f ` (S1 \<times> S2)"
+ unfolding f_def S1_def S2_def
+ unfolding LV_def image_def prefix_def suffix_def
+ apply (auto elim!: Prf_elims)
+ by (metis (mono_tags, lifting) mem_Collect_eq)
+ ultimately
+ show "finite (LV (SEQ r1 r2) s)"
+ by (simp add: finite_subset)
+next
+ case (STAR r s)
+ then show "finite (LV (STAR r) s)" by (simp add: LV_STAR_finite)
+next
+ case (NTIMES r n s)
+ have "\<And>s. finite (LV r s)" by fact
+ then have "finite (Stars_Append (LV (STAR r) s) (\<Union>i\<le>n. LV (NTIMES r i) []))"
+ apply(rule_tac finite_Stars_Append)
+ apply (simp add: LV_STAR_finite)
+ using finite_NTimes_empty by blast
+ then show "finite (LV (NTIMES r n) s)"
+ by (metis LV_NTIMES_subset finite_subset)
+qed
+
+
+
+section \<open>Our inductive POSIX Definition\<close>
+
+inductive
+ Posix :: "string \<Rightarrow> rexp \<Rightarrow> val \<Rightarrow> bool" ("_ \<in> _ \<rightarrow> _" [100, 100, 100] 100)
+where
+ Posix_ONE: "[] \<in> ONE \<rightarrow> Void"
+| Posix_CH: "[c] \<in> (CH c) \<rightarrow> (Char c)"
+| Posix_ALT1: "s \<in> r1 \<rightarrow> v \<Longrightarrow> s \<in> (ALT r1 r2) \<rightarrow> (Left v)"
+| Posix_ALT2: "\<lbrakk>s \<in> r2 \<rightarrow> v; s \<notin> L(r1)\<rbrakk> \<Longrightarrow> s \<in> (ALT r1 r2) \<rightarrow> (Right v)"
+| Posix_SEQ: "\<lbrakk>s1 \<in> r1 \<rightarrow> v1; s2 \<in> r2 \<rightarrow> v2;
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r1 \<and> s\<^sub>4 \<in> L r2)\<rbrakk> \<Longrightarrow>
+ (s1 @ s2) \<in> (SEQ r1 r2) \<rightarrow> (Seq v1 v2)"
+| Posix_STAR1: "\<lbrakk>s1 \<in> r \<rightarrow> v; s2 \<in> STAR r \<rightarrow> Stars vs; flat v \<noteq> [];
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))\<rbrakk>
+ \<Longrightarrow> (s1 @ s2) \<in> STAR r \<rightarrow> Stars (v # vs)"
+| Posix_STAR2: "[] \<in> STAR r \<rightarrow> Stars []"
+| Posix_NTIMES1: "\<lbrakk>s1 \<in> r \<rightarrow> v; s2 \<in> NTIMES r (n - 1) \<rightarrow> Stars vs; flat v \<noteq> []; 0 < n;
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r \<and> s\<^sub>4 \<in> L (NTIMES r (n - 1)))\<rbrakk>
+ \<Longrightarrow> (s1 @ s2) \<in> NTIMES r n \<rightarrow> Stars (v # vs)"
+| Posix_NTIMES2: "\<lbrakk>\<forall>v \<in> set vs. [] \<in> r \<rightarrow> v; length vs = n\<rbrakk>
+ \<Longrightarrow> [] \<in> NTIMES r n \<rightarrow> Stars vs"
+
+inductive_cases Posix_elims:
+ "s \<in> ZERO \<rightarrow> v"
+ "s \<in> ONE \<rightarrow> v"
+ "s \<in> CH c \<rightarrow> v"
+ "s \<in> ALT r1 r2 \<rightarrow> v"
+ "s \<in> SEQ r1 r2 \<rightarrow> v"
+ "s \<in> STAR r \<rightarrow> v"
+ "s \<in> NTIMES r n \<rightarrow> v"
+
+
+lemma Posix1:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "s \<in> L r" "flat v = s"
+using assms
+ apply(induct s r v rule: Posix.induct)
+ apply(auto simp add: pow_empty_iff)
+ apply (metis Suc_pred concI lang_pow.simps(2))
+ by (meson ex_in_conv set_empty)
+
+
+
+lemma Posix1a:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "\<Turnstile> v : r"
+using assms
+ apply(induct s r v rule: Posix.induct)
+ apply(auto intro: Prf.intros)
+ apply (metis Prf.intros(6) Prf_elims(6) set_ConsD val.inject(5))
+ prefer 2
+ apply (metis Posix1(2) Prf.intros(7) append_Nil empty_iff list.set(1))
+ apply(erule Prf_elims)
+ apply(auto)
+ apply(subst append.simps(2)[symmetric])
+ apply(rule Prf.intros)
+ apply(auto)
+ done
+
+text \<open>
+ For a give value and string, our Posix definition
+ determines a unique value.
+\<close>
+
+lemma List_eq_zipI:
+ assumes "list_all2 (\<lambda>v1 v2. v1 = v2) vs1 vs2"
+ and "length vs1 = length vs2"
+ shows "vs1 = vs2"
+ using assms
+ apply(induct vs1 vs2 rule: list_all2_induct)
+ apply(auto)
+ done
+
+lemma Posix_determ:
+ assumes "s \<in> r \<rightarrow> v1" "s \<in> r \<rightarrow> v2"
+ shows "v1 = v2"
+using assms
+proof (induct s r v1 arbitrary: v2 rule: Posix.induct)
+ case (Posix_ONE v2)
+ have "[] \<in> ONE \<rightarrow> v2" by fact
+ then show "Void = v2" by cases auto
+next
+ case (Posix_CH c v2)
+ have "[c] \<in> CH c \<rightarrow> v2" by fact
+ then show "Char c = v2" by cases auto
+next
+ case (Posix_ALT1 s r1 v r2 v2)
+ have "s \<in> ALT r1 r2 \<rightarrow> v2" by fact
+ moreover
+ have "s \<in> r1 \<rightarrow> v" by fact
+ then have "s \<in> L r1" by (simp add: Posix1)
+ ultimately obtain v' where eq: "v2 = Left v'" "s \<in> r1 \<rightarrow> v'" by cases auto
+ moreover
+ have IH: "\<And>v2. s \<in> r1 \<rightarrow> v2 \<Longrightarrow> v = v2" by fact
+ ultimately have "v = v'" by simp
+ then show "Left v = v2" using eq by simp
+next
+ case (Posix_ALT2 s r2 v r1 v2)
+ have "s \<in> ALT r1 r2 \<rightarrow> v2" by fact
+ moreover
+ have "s \<notin> L r1" by fact
+ ultimately obtain v' where eq: "v2 = Right v'" "s \<in> r2 \<rightarrow> v'"
+ by cases (auto simp add: Posix1)
+ moreover
+ have IH: "\<And>v2. s \<in> r2 \<rightarrow> v2 \<Longrightarrow> v = v2" by fact
+ ultimately have "v = v'" by simp
+ then show "Right v = v2" using eq by simp
+next
+ case (Posix_SEQ s1 r1 v1 s2 r2 v2 v')
+ have "(s1 @ s2) \<in> SEQ r1 r2 \<rightarrow> v'"
+ "s1 \<in> r1 \<rightarrow> v1" "s2 \<in> r2 \<rightarrow> v2"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r1 \<and> s\<^sub>4 \<in> L r2)" by fact+
+ then obtain v1' v2' where "v' = Seq v1' v2'" "s1 \<in> r1 \<rightarrow> v1'" "s2 \<in> r2 \<rightarrow> v2'"
+ apply(cases) apply (auto simp add: append_eq_append_conv2)
+ using Posix1(1) by fastforce+
+ moreover
+ have IHs: "\<And>v1'. s1 \<in> r1 \<rightarrow> v1' \<Longrightarrow> v1 = v1'"
+ "\<And>v2'. s2 \<in> r2 \<rightarrow> v2' \<Longrightarrow> v2 = v2'" by fact+
+ ultimately show "Seq v1 v2 = v'" by simp
+next
+ case (Posix_STAR1 s1 r v s2 vs v2)
+ have "(s1 @ s2) \<in> STAR r \<rightarrow> v2"
+ "s1 \<in> r \<rightarrow> v" "s2 \<in> STAR r \<rightarrow> Stars vs" "flat v \<noteq> []"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))" by fact+
+ then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \<in> r \<rightarrow> v'" "s2 \<in> (STAR r) \<rightarrow> (Stars vs')"
+ apply(cases) apply (auto simp add: append_eq_append_conv2)
+ using Posix1(1) apply fastforce
+ apply (metis Posix1(1) Posix_STAR1.hyps(6) append_Nil append_Nil2)
+ using Posix1(2) by blast
+ moreover
+ have IHs: "\<And>v2. s1 \<in> r \<rightarrow> v2 \<Longrightarrow> v = v2"
+ "\<And>v2. s2 \<in> STAR r \<rightarrow> v2 \<Longrightarrow> Stars vs = v2" by fact+
+ ultimately show "Stars (v # vs) = v2" by auto
+next
+ case (Posix_STAR2 r v2)
+ have "[] \<in> STAR r \<rightarrow> v2" by fact
+ then show "Stars [] = v2" by cases (auto simp add: Posix1)
+next
+ case (Posix_NTIMES2 vs r n v2)
+ then show "Stars vs = v2"
+ apply(erule_tac Posix_elims)
+ apply(auto)
+ apply (simp add: Posix1(2))
+ apply(rule List_eq_zipI)
+ apply(auto simp add: list_all2_iff)
+ by (meson in_set_zipE)
+next
+ case (Posix_NTIMES1 s1 r v s2 n vs)
+ have "(s1 @ s2) \<in> NTIMES r n \<rightarrow> v2"
+ "s1 \<in> r \<rightarrow> v" "s2 \<in> NTIMES r (n - 1) \<rightarrow> Stars vs" "flat v \<noteq> []"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (NTIMES r (n - 1 )))" by fact+
+ then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \<in> r \<rightarrow> v'" "s2 \<in> (NTIMES r (n - 1)) \<rightarrow> (Stars vs')"
+ apply(cases) apply (auto simp add: append_eq_append_conv2)
+ using Posix1(1) apply fastforce
+ apply (metis One_nat_def Posix1(1) Posix_NTIMES1.hyps(7) append.right_neutral append_self_conv2)
+ using Posix1(2) by blast
+ moreover
+ have IHs: "\<And>v2. s1 \<in> r \<rightarrow> v2 \<Longrightarrow> v = v2"
+ "\<And>v2. s2 \<in> NTIMES r (n - 1) \<rightarrow> v2 \<Longrightarrow> Stars vs = v2" by fact+
+ ultimately show "Stars (v # vs) = v2" by auto
+qed
+
+
+text \<open>
+ Our POSIX values are lexical values.
+\<close>
+
+lemma Posix_LV:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "v \<in> LV r s"
+ using assms unfolding LV_def
+ apply(induct rule: Posix.induct)
+ apply(auto simp add: intro!: Prf.intros elim!: Prf_elims Posix1a)
+ apply (smt (verit, best) One_nat_def Posix1a Posix_NTIMES1 L.simps(7))
+ using Posix1a Posix_NTIMES2 by blast
+
+
+lemma longer_string_nonempty_suff:
+ shows "s3 @ s4 = s1 @ s2 \<and> length s3 > length s1 \<Longrightarrow> (\<exists>s5. s3 = s1 @ s5 \<and> s5 \<noteq> [])"
+ sorry
+
+
+lemma equivalent_concat_condition_aux:
+ shows "(\<exists>s3 s4. s3 @ s4 = s1 @ s2 \<and> length s3 > length s1\<and> s3 \<in> L r1 \<and> s4 \<in> L r2 ) \<Longrightarrow> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r1 \<and> s\<^sub>4 \<in> L r2)"
+ apply(erule exE)+
+ apply(subgoal_tac "\<exists>s5. s3 = s1 @ s5\<and> s5 \<noteq> [] ")
+ apply(erule exE)
+ apply auto[1]
+ using longer_string_nonempty_suff by blast
+
+lemma equivalent_concat_condition:
+ shows " \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r1 \<and> s\<^sub>4 \<in> L r2) \<Longrightarrow> \<not>(\<exists>s3 s4. s3 @ s4 = s1 @ s2 \<and> length s3 > length s1\<and> s3 \<in> L r1 \<and> s4 \<in> L r2 )"
+ by (meson equivalent_concat_condition_aux)
+
+lemma seqPOSIX_altdef:
+ shows "\<lbrakk>s1 \<in> r1 \<rightarrow> v1; s2 \<in> r2 \<rightarrow> v2;
+ \<not>(\<exists>s3 s4. s3 @ s4 = s1 @ s2 \<and> length s3 > length s1\<and> s3 \<in> L r1 \<and> s4 \<in> L r2 )\<rbrakk> \<Longrightarrow>
+ (s1 @ s2) \<in> (SEQ r1 r2) \<rightarrow> (Seq v1 v2)"
+ by (metis Posix_SEQ append.assoc length_append length_greater_0_conv less_add_same_cancel1)
+
+
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys4/posix/RegLangs.thy Mon Aug 29 23:16:28 2022 +0100
@@ -0,0 +1,262 @@
+theory RegLangs
+ imports Main "HOL-Library.Sublist"
+begin
+
+section \<open>Sequential Composition of Languages\<close>
+
+definition
+ Sequ :: "string set \<Rightarrow> string set \<Rightarrow> string set" ("_ ;; _" [100,100] 100)
+where
+ "A ;; B = {s1 @ s2 | s1 s2. s1 \<in> A \<and> s2 \<in> B}"
+
+text \<open>Two Simple Properties about Sequential Composition\<close>
+
+lemma Sequ_empty_string [simp]:
+ shows "A ;; {[]} = A"
+ and "{[]} ;; A = A"
+by (simp_all add: Sequ_def)
+
+lemma Sequ_empty [simp]:
+ shows "A ;; {} = {}"
+ and "{} ;; A = {}"
+ by (simp_all add: Sequ_def)
+
+lemma concI[simp,intro]: "u : A \<Longrightarrow> v : B \<Longrightarrow> u@v : A ;; B"
+by (auto simp add: Sequ_def)
+
+lemma concE[elim]:
+assumes "w \<in> A ;; B"
+obtains u v where "u \<in> A" "v \<in> B" "w = u@v"
+using assms by (auto simp: Sequ_def)
+
+lemma concI_if_Nil2: "[] \<in> B \<Longrightarrow> xs : A \<Longrightarrow> xs \<in> A ;; B"
+by (metis append_Nil2 concI)
+
+lemma conc_assoc: "(A ;; B) ;; C = A ;; (B ;; C)"
+by (auto elim!: concE) (simp only: append_assoc[symmetric] concI)
+
+
+text \<open>Language power operations\<close>
+
+overloading lang_pow == "compow :: nat \<Rightarrow> string set \<Rightarrow> string set"
+begin
+ primrec lang_pow :: "nat \<Rightarrow> string set \<Rightarrow> string set" where
+ "lang_pow 0 A = {[]}" |
+ "lang_pow (Suc n) A = A ;; (lang_pow n A)"
+end
+
+
+lemma conc_pow_comm:
+ shows "A ;; (A ^^ n) = (A ^^ n) ;; A"
+by (induct n) (simp_all add: conc_assoc[symmetric])
+
+lemma lang_pow_add: "A ^^ (n + m) = (A ^^ n) ;; (A ^^ m)"
+ by (induct n) (auto simp: conc_assoc)
+
+lemma lang_empty:
+ fixes A::"string set"
+ shows "A ^^ 0 = {[]}"
+ by simp
+
+section \<open>Semantic Derivative (Left Quotient) of Languages\<close>
+
+definition
+ Der :: "char \<Rightarrow> string set \<Rightarrow> string set"
+where
+ "Der c A \<equiv> {s. c # s \<in> A}"
+
+definition
+ Ders :: "string \<Rightarrow> string set \<Rightarrow> string set"
+where
+ "Ders s A \<equiv> {s'. s @ s' \<in> A}"
+
+lemma Der_null [simp]:
+ shows "Der c {} = {}"
+unfolding Der_def
+by auto
+
+lemma Der_empty [simp]:
+ shows "Der c {[]} = {}"
+unfolding Der_def
+by auto
+
+lemma Der_char [simp]:
+ shows "Der c {[d]} = (if c = d then {[]} else {})"
+unfolding Der_def
+by auto
+
+lemma Der_union [simp]:
+ shows "Der c (A \<union> B) = Der c A \<union> Der c B"
+unfolding Der_def
+by auto
+
+lemma Der_Sequ [simp]:
+ shows "Der c (A ;; B) = (Der c A) ;; B \<union> (if [] \<in> A then Der c B else {})"
+unfolding Der_def Sequ_def
+by (auto simp add: Cons_eq_append_conv)
+
+
+section \<open>Kleene Star for Languages\<close>
+
+inductive_set
+ Star :: "string set \<Rightarrow> string set" ("_\<star>" [101] 102)
+ for A :: "string set"
+where
+ start[intro]: "[] \<in> A\<star>"
+| step[intro]: "\<lbrakk>s1 \<in> A; s2 \<in> A\<star>\<rbrakk> \<Longrightarrow> s1 @ s2 \<in> A\<star>"
+
+(* Arden's lemma *)
+
+lemma Star_cases:
+ shows "A\<star> = {[]} \<union> A ;; A\<star>"
+unfolding Sequ_def
+by (auto) (metis Star.simps)
+
+lemma Star_decomp:
+ assumes "c # x \<in> A\<star>"
+ shows "\<exists>s1 s2. x = s1 @ s2 \<and> c # s1 \<in> A \<and> s2 \<in> A\<star>"
+using assms
+by (induct x\<equiv>"c # x" rule: Star.induct)
+ (auto simp add: append_eq_Cons_conv)
+
+lemma Star_Der_Sequ:
+ shows "Der c (A\<star>) \<subseteq> (Der c A) ;; A\<star>"
+unfolding Der_def Sequ_def
+by(auto simp add: Star_decomp)
+
+lemma Der_inter[simp]: "Der a (A \<inter> B) = Der a A \<inter> Der a B"
+ and Der_compl[simp]: "Der a (-A) = - Der a A"
+ and Der_Union[simp]: "Der a (Union M) = Union(Der a ` M)"
+ and Der_UN[simp]: "Der a (UN x:I. S x) = (UN x:I. Der a (S x))"
+by (auto simp: Der_def)
+
+lemma Der_star[simp]:
+ shows "Der c (A\<star>) = (Der c A) ;; A\<star>"
+proof -
+ have "Der c (A\<star>) = Der c ({[]} \<union> A ;; A\<star>)"
+ by (simp only: Star_cases[symmetric])
+ also have "... = Der c (A ;; A\<star>)"
+ by (simp only: Der_union Der_empty) (simp)
+ also have "... = (Der c A) ;; A\<star> \<union> (if [] \<in> A then Der c (A\<star>) else {})"
+ by simp
+ also have "... = (Der c A) ;; A\<star>"
+ using Star_Der_Sequ by auto
+ finally show "Der c (A\<star>) = (Der c A) ;; A\<star>" .
+qed
+
+lemma Der_pow[simp]:
+ shows "Der c (A ^^ n) = (if n = 0 then {} else (Der c A) ;; (A ^^ (n - 1)))"
+ apply(induct n arbitrary: A)
+ apply(auto simp add: Cons_eq_append_conv)
+ by (metis Suc_pred concI_if_Nil2 conc_assoc conc_pow_comm lang_pow.simps(2))
+
+
+lemma Star_concat:
+ assumes "\<forall>s \<in> set ss. s \<in> A"
+ shows "concat ss \<in> A\<star>"
+using assms by (induct ss) (auto)
+
+lemma Star_split:
+ assumes "s \<in> A\<star>"
+ shows "\<exists>ss. concat ss = s \<and> (\<forall>s \<in> set ss. s \<in> A \<and> s \<noteq> [])"
+using assms
+ apply(induct rule: Star.induct)
+ using concat.simps(1) apply fastforce
+ apply(clarify)
+ by (metis append_Nil concat.simps(2) set_ConsD)
+
+
+
+
+section \<open>Regular Expressions\<close>
+
+datatype rexp =
+ ZERO
+| ONE
+| CH char
+| SEQ rexp rexp
+| ALT rexp rexp
+| STAR rexp
+| NTIMES rexp nat
+
+section \<open>Semantics of Regular Expressions\<close>
+
+fun
+ L :: "rexp \<Rightarrow> string set"
+where
+ "L (ZERO) = {}"
+| "L (ONE) = {[]}"
+| "L (CH 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>"
+| "L (NTIMES r n) = (L r) ^^ n"
+
+section \<open>Nullable, Derivatives\<close>
+
+fun
+ nullable :: "rexp \<Rightarrow> bool"
+where
+ "nullable (ZERO) = False"
+| "nullable (ONE) = True"
+| "nullable (CH c) = False"
+| "nullable (ALT r1 r2) = (nullable r1 \<or> nullable r2)"
+| "nullable (SEQ r1 r2) = (nullable r1 \<and> nullable r2)"
+| "nullable (STAR r) = True"
+| "nullable (NTIMES r n) = (if n = 0 then True else nullable r)"
+
+fun
+ der :: "char \<Rightarrow> rexp \<Rightarrow> rexp"
+where
+ "der c (ZERO) = ZERO"
+| "der c (ONE) = ZERO"
+| "der c (CH d) = (if c = d then ONE else ZERO)"
+| "der c (ALT r1 r2) = ALT (der c r1) (der c r2)"
+| "der c (SEQ r1 r2) =
+ (if nullable r1
+ then ALT (SEQ (der c r1) r2) (der c r2)
+ else SEQ (der c r1) r2)"
+| "der c (STAR r) = SEQ (der c r) (STAR r)"
+| "der c (NTIMES r n) = (if n = 0 then ZERO else SEQ (der c r) (NTIMES r (n - 1)))"
+
+
+fun
+ ders :: "string \<Rightarrow> rexp \<Rightarrow> rexp"
+where
+ "ders [] r = r"
+| "ders (c # s) r = ders s (der c r)"
+
+
+lemma pow_empty_iff:
+ shows "[] \<in> (L r) ^^ n \<longleftrightarrow> (if n = 0 then True else [] \<in> (L r))"
+ by (induct n) (auto simp add: Sequ_def)
+
+lemma nullable_correctness:
+ shows "nullable r \<longleftrightarrow> [] \<in> (L r)"
+ by (induct r) (auto simp add: Sequ_def pow_empty_iff)
+
+lemma der_correctness:
+ shows "L (der c r) = Der c (L r)"
+ apply (induct r)
+ apply(auto simp add: nullable_correctness Sequ_def)
+ using Der_def apply force
+ using Der_def apply auto[1]
+ apply (smt (verit, ccfv_SIG) Der_def append_eq_Cons_conv mem_Collect_eq)
+ using Der_def apply force
+ using Der_Sequ Sequ_def by auto
+
+lemma ders_correctness:
+ shows "L (ders s r) = Ders s (L r)"
+ by (induct s arbitrary: r)
+ (simp_all add: Ders_def der_correctness Der_def)
+
+lemma ders_append:
+ shows "ders (s1 @ s2) r = ders s2 (ders s1 r)"
+ by (induct s1 arbitrary: s2 r) (auto)
+
+lemma ders_snoc:
+ shows "ders (s @ [c]) r = der c (ders s r)"
+ by (simp add: ders_append)
+
+
+end
\ No newline at end of file