diff -r ca4e9eb8d576 -r 7c89d3f6923e thys/Sulzmann.thy --- a/thys/Sulzmann.thy Tue Jun 27 08:59:11 2017 +0100 +++ b/thys/Sulzmann.thy Tue Jun 27 13:15:55 2017 +0100 @@ -1,1865 +1,11 @@ theory Sulzmann - imports "Lexer" "~~/src/HOL/Library/Multiset" + imports "Positions" begin section {* Sulzmann's "Ordering" of Values *} -fun - size :: "val \ nat" -where - "size (Void) = 0" -| "size (Char c) = 0" -| "size (Left v) = 1 + size v" -| "size (Right v) = 1 + size v" -| "size (Seq v1 v2) = 1 + (size v1) + (size v2)" -| "size (Stars []) = 0" -| "size (Stars (v#vs)) = 1 + (size v) + (size (Stars vs))" - -lemma Star_size [simp]: - "\n < length vs; 0 < length vs\ \ size (nth vs n) < size (Stars vs)" -apply(induct vs arbitrary: n) -apply(simp) -apply(auto) -by (metis One_nat_def Suc_pred less_Suc0 less_Suc_eq list.size(3) not_add_less1 not_less_eq nth_Cons' trans_less_add2) - -lemma Star_size0 [simp]: - "0 < length vs \ 0 < size (Stars vs)" -apply(induct vs) -apply(auto) -done - - -fun - at :: "val \ nat list \ val" -where - "at v [] = v" -| "at (Left v) (0#ps)= at v ps" -| "at (Right v) (Suc 0#ps)= at v ps" -| "at (Seq v1 v2) (0#ps)= at v1 ps" -| "at (Seq v1 v2) (Suc 0#ps)= at v2 ps" -| "at (Stars vs) (n#ps)= at (nth vs n) ps" - -fun - ato :: "val \ nat list \ val option" -where - "ato v [] = Some v" -| "ato (Left v) (0#ps)= ato v ps" -| "ato (Right v) (Suc 0#ps)= ato v ps" -| "ato (Seq v1 v2) (0#ps)= ato v1 ps" -| "ato (Seq v1 v2) (Suc 0#ps)= ato v2 ps" -| "ato (Stars vs) (n#ps)= (if (n < length vs) then ato (nth vs n) ps else None)" -| "ato v p = None" - -fun Pos :: "val \ (nat list) set" -where - "Pos (Void) = {[]}" -| "Pos (Char c) = {[]}" -| "Pos (Left v) = {[]} \ {0#ps | ps. ps \ Pos v}" -| "Pos (Right v) = {[]} \ {1#ps | ps. ps \ Pos v}" -| "Pos (Seq v1 v2) = {[]} \ {0#ps | ps. ps \ Pos v1} \ {1#ps | ps. ps \ Pos v2}" -| "Pos (Stars []) = {[]}" -| "Pos (Stars (v#vs)) = {[]} \ {0#ps | ps. ps \ Pos v} \ {(Suc n)#ps | n ps. n#ps \ Pos (Stars vs)}" - -lemma Pos_empty: - shows "[] \ Pos v" -apply(induct v rule: Pos.induct) -apply(auto) -done - -lemma Pos_finite_aux: - assumes "\v \ set vs. finite (Pos v)" - shows "finite (Pos (Stars vs))" -using assms -apply(induct vs) -apply(simp) -apply(simp) -apply(subgoal_tac "finite (Pos (Stars vs) - {[]})") -apply(rule_tac f="\l. Suc (hd l) # tl l" in finite_surj) -apply(assumption) -back -apply(auto simp add: image_def) -apply(rule_tac x="n#ps" in bexI) -apply(simp) -apply(simp) -done - -lemma Pos_finite: - shows "finite (Pos v)" -apply(induct v rule: val.induct) -apply(auto) -apply(simp add: Pos_finite_aux) -done - - -lemma ato_test: - assumes "p \ Pos v" - shows "\v'. ato v p = Some v'" -using assms -apply(induct v arbitrary: p rule: Pos.induct) -apply(auto) -apply force -by (metis ato.simps(6) option.distinct(1)) - -definition pflat :: "val \ nat list => string option" -where - "pflat v p \ (if p \ Pos v then Some (flat (at v p)) else None)" - -fun intlen :: "'a list \ int" -where - "intlen [] = 0" -| "intlen (x#xs) = 1 + intlen xs" - -lemma inlen_bigger: - shows "0 \ intlen xs" -apply(induct xs) -apply(auto) -done - -lemma intlen_append: - shows "intlen (xs @ ys) = intlen xs + intlen ys" -apply(induct xs arbitrary: ys) -apply(auto) -done - -lemma intlen_length: - assumes "length xs < length ys" - shows "intlen xs < intlen ys" -using assms -apply(induct xs arbitrary: ys) -apply(auto) -apply(case_tac ys) -apply(simp_all) -apply (smt inlen_bigger) -by (smt Suc_lessE intlen.simps(2) length_Suc_conv) - - -definition pflat_len :: "val \ nat list => int" -where - "pflat_len v p \ (if p \ Pos v then intlen (flat (at v p)) else -1)" - -lemma pflat_len_simps: - shows "pflat_len (Seq v1 v2) (0#p) = pflat_len v1 p" - and "pflat_len (Seq v1 v2) (Suc 0#p) = pflat_len v2 p" - and "pflat_len (Left v) (0#p) = pflat_len v p" - and "pflat_len (Left v) (Suc 0#p) = -1" - and "pflat_len (Right v) (Suc 0#p) = pflat_len v p" - and "pflat_len (Right v) (0#p) = -1" - and "pflat_len v [] = intlen (flat v)" -apply(auto simp add: pflat_len_def Pos_empty) -done - -lemma pflat_len_Stars_simps: - assumes "n < length vs" - shows "pflat_len (Stars vs) (n#p) = pflat_len (vs!n) p" -using assms -apply(induct vs arbitrary: n p) -apply(simp) -apply(simp) -apply(simp add: pflat_len_def) -apply(auto)[1] -apply (metis at.simps(6)) -apply (metis Suc_less_eq Suc_pred) -by (metis diff_Suc_1 less_Suc_eq_0_disj nth_Cons') - - -lemma pflat_len_Stars_simps2: - shows "pflat_len (Stars (v#vs)) (Suc n # p) = pflat_len (Stars vs) (n#p)" - and "pflat_len (Stars (v#vs)) (0 # p) = pflat_len v p" -using assms -apply(simp_all add: pflat_len_def) -done - -lemma Two_to_Three_aux: - assumes "p \ Pos v1 \ Pos v2" "pflat_len v1 p = pflat_len v2 p" - shows "p \ Pos v1 \ Pos v2" -using assms -apply(simp add: pflat_len_def) -apply(auto split: if_splits) -apply (smt inlen_bigger)+ -done - -lemma Two_to_Three: - assumes "\p \ Pos v1 \ Pos v2. pflat v1 p = pflat v2 p" - shows "Pos v1 = Pos v2" -using assms -by (metis Un_iff option.distinct(1) pflat_def subsetI subset_antisym) - -lemma Two_to_Three_orig: - assumes "\p \ Pos v1 \ Pos v2. pflat_len v1 p = pflat_len v2 p" - shows "Pos v1 = Pos v2" -using assms -by (metis Un_iff inlen_bigger neg_0_le_iff_le not_one_le_zero pflat_len_def subsetI subset_antisym) - -lemma set_eq1: - assumes "insert [] A = insert [] B" "[] \ A" "[] \ B" - shows "A = B" -using assms -by (simp add: insert_ident) - -lemma set_eq2: - assumes "A \ B = A \ C" - and "A \ B = {}" "A \ C = {}" - shows "B = C" -using assms -using Un_Int_distrib sup_bot.left_neutral sup_commute by blast - - - -lemma Three_to_One: - assumes "\ v1 : r" "\ v2 : r" - and "Pos v1 = Pos v2" - shows "v1 = v2" -using assms -apply(induct v1 arbitrary: r v2 rule: Pos.induct) -apply(erule Prf.cases) -apply(simp_all) -apply(erule Prf.cases) -apply(simp_all) -apply(erule Prf.cases) -apply(simp_all) -apply(erule Prf.cases) -apply(simp_all) -apply(erule Prf.cases) -apply(simp_all) -apply(erule Prf.cases) -apply(simp_all) -apply(clarify) -apply(simp add: insert_ident) -apply(drule_tac x="r1a" in meta_spec) -apply(drule_tac x="v1a" in meta_spec) -apply(simp) -apply(drule_tac meta_mp) -thm subset_antisym -apply(rule subset_antisym) -apply(auto)[3] -apply(clarify) -apply(simp add: insert_ident) -using Pos_empty apply blast -apply(erule Prf.cases) -apply(simp_all) -apply(erule Prf.cases) -apply(simp_all) -apply(clarify) -apply(simp add: insert_ident) -using Pos_empty apply blast -apply(simp add: insert_ident) -apply(drule_tac x="r2a" in meta_spec) -apply(drule_tac x="v2b" in meta_spec) -apply(simp) -apply(drule_tac meta_mp) -apply(rule subset_antisym) -apply(auto)[3] -apply(erule Prf.cases) -apply(simp_all) -apply(erule Prf.cases) -apply(simp_all) -apply(simp add: insert_ident) -apply(clarify) -apply(drule_tac x="r1a" in meta_spec) -apply(drule_tac x="r2a" in meta_spec) -apply(drule_tac x="v1b" in meta_spec) -apply(drule_tac x="v2c" in meta_spec) -apply(simp) -apply(drule_tac meta_mp) -apply(rule subset_antisym) -apply(rule subsetI) -apply(subgoal_tac "0 # x \ {0 # ps |ps. ps \ Pos v1a}") -prefer 2 -apply(auto)[1] -apply(subgoal_tac "0 # x \ {0 # ps |ps. ps \ Pos v1b} \ {Suc 0 # ps |ps. ps \ Pos v2c}") -prefer 2 -apply (metis (no_types, lifting) Un_iff) -apply(simp) -apply(rule subsetI) -apply(subgoal_tac "0 # x \ {0 # ps |ps. ps \ Pos v1b}") -prefer 2 -apply(auto)[1] -apply(subgoal_tac "0 # x \ {0 # ps |ps. ps \ Pos v1a} \ {Suc 0 # ps |ps. ps \ Pos v2b}") -prefer 2 -apply (metis (no_types, lifting) Un_iff) -apply(simp (no_asm_use)) -apply(simp) -apply(drule_tac meta_mp) -apply(rule subset_antisym) -apply(rule subsetI) -apply(subgoal_tac "Suc 0 # x \ {Suc 0 # ps |ps. ps \ Pos v2b}") -prefer 2 -apply(auto)[1] -apply(subgoal_tac "Suc 0 # x \ {0 # ps |ps. ps \ Pos v1b} \ {Suc 0 # ps |ps. ps \ Pos v2c}") -prefer 2 -apply (metis (no_types, lifting) Un_iff) -apply(simp) -apply(rule subsetI) -apply(subgoal_tac "Suc 0 # x \ {Suc 0 # ps |ps. ps \ Pos v2c}") -prefer 2 -apply(auto)[1] -apply(subgoal_tac "Suc 0 # x \ {0 # ps |ps. ps \ Pos v1b} \ {Suc 0 # ps |ps. ps \ Pos v2b}") -prefer 2 -apply (metis (no_types, lifting) Un_iff) -apply(simp (no_asm_use)) -apply(simp) -apply(erule Prf.cases) -apply(simp_all) -apply(erule Prf.cases) -apply(simp_all) -apply(auto)[1] -using Pos_empty apply fastforce -apply(erule Prf.cases) -apply(simp_all) -apply(erule Prf.cases) -apply(simp_all) -apply(auto)[1] -using Pos_empty apply fastforce -apply(clarify) -apply(simp add: insert_ident) -apply(drule_tac x="rb" in meta_spec) -apply(drule_tac x="STAR rb" in meta_spec) -apply(drule_tac x="vb" in meta_spec) -apply(drule_tac x="Stars vsb" in meta_spec) -apply(simp) -apply(drule_tac meta_mp) -apply(rule subset_antisym) -apply(rule subsetI) -apply(subgoal_tac "0 # x \ {0 # ps |ps. ps \ Pos va}") -prefer 2 -apply(auto)[1] -apply(subgoal_tac "0 # x \ {0 # ps |ps. ps \ Pos vb} \ {Suc n # ps |n ps. n # ps \ Pos (Stars vsb)}") -prefer 2 -apply (metis (no_types, lifting) Un_iff) -apply(simp) -apply(rule subsetI) -apply(subgoal_tac "0 # x \ {0 # ps |ps. ps \ Pos vb}") -prefer 2 -apply(auto)[1] -apply(subgoal_tac "0 # x \ {0 # ps |ps. ps \ Pos va} \ {Suc n # ps |n ps. n # ps \ Pos (Stars vsa)}") -prefer 2 -apply (metis (no_types, lifting) Un_iff) -apply(simp (no_asm_use)) -apply(simp) -apply(drule_tac meta_mp) -apply(rule subset_antisym) -apply(rule subsetI) -apply(case_tac vsa) -apply(simp) -apply (simp add: Pos_empty) -apply(simp) -apply(clarify) -apply(erule disjE) -apply (simp add: Pos_empty) -apply(erule disjE) -apply(clarify) -apply(subgoal_tac - "Suc 0 # ps \ {Suc n # ps |n ps. n = 0 \ ps \ Pos a \ (\na. n = Suc na \ na # ps \ Pos (Stars list))}") -prefer 2 -apply blast -apply(subgoal_tac "Suc 0 # ps \ {0 # ps |ps. ps \ Pos vb} \ {Suc n # ps |n ps. n # ps \ Pos (Stars vsb)}") -prefer 2 -apply (metis (no_types, lifting) Un_iff) -apply(simp) -apply(clarify) -apply(subgoal_tac - "Suc (Suc n) # ps \ {Suc n # ps |n ps. n = 0 \ ps \ Pos a \ (\na. n = Suc na \ na # ps \ Pos (Stars list))}") -prefer 2 -apply blast -apply(subgoal_tac "Suc (Suc n) # ps \ {0 # ps |ps. ps \ Pos vb} \ {Suc n # ps |n ps. n # ps \ Pos (Stars vsb)}") -prefer 2 -apply (metis (no_types, lifting) Un_iff) -apply(simp) -apply(rule subsetI) -apply(case_tac vsb) -apply(simp) -apply (simp add: Pos_empty) -apply(simp) -apply(clarify) -apply(erule disjE) -apply (simp add: Pos_empty) -apply(erule disjE) -apply(clarify) -apply(subgoal_tac - "Suc 0 # ps \ {Suc n # ps |n ps. n = 0 \ ps \ Pos a \ (\na. n = Suc na \ na # ps \ Pos (Stars list))}") -prefer 2 -apply(simp) -apply(subgoal_tac "Suc 0 # ps \ {Suc n # ps |n ps. n # ps \ Pos (Stars vsa)}") -apply blast -using list.inject apply blast -apply(clarify) -apply(subgoal_tac - "Suc (Suc n) # ps \ {Suc n # ps |n ps. n = 0 \ ps \ Pos a \ (\na. n = Suc na \ na # ps \ Pos (Stars list))}") -prefer 2 -apply(simp) -apply(subgoal_tac "Suc (Suc n) # ps \ {0 # ps |ps. ps \ Pos vb} \ {Suc n # ps |n ps. n # ps \ Pos (Stars vsa)}") -prefer 2 -apply (metis (no_types, lifting) Un_iff) -apply(simp (no_asm_use)) -apply(simp) -done - -definition prefix_list:: "'a list \ 'a list \ bool" ("_ \pre _") -where - "ps1 \pre ps2 \ (\ps'. ps1 @ps' = ps2)" - -definition sprefix_list:: "'a list \ 'a list \ bool" ("_ \spre _") -where - "ps1 \spre ps2 \ (ps1 \pre ps2 \ ps1 \ ps2)" - -inductive lex_lists :: "nat list \ nat list \ bool" ("_ \lex _") -where - "[] \lex p#ps" -| "ps1 \lex ps2 \ (p#ps1) \lex (p#ps2)" -| "p1 < p2 \ (p1#ps1) \lex (p2#ps2)" - -lemma lex_irrfl: - fixes ps1 ps2 :: "nat list" - assumes "ps1 \lex ps2" - shows "ps1 \ ps2" -using assms -apply(induct rule: lex_lists.induct) -apply(auto) -done - -lemma lex_append: - assumes "ps2 \ []" - shows "ps \lex ps @ ps2" -using assms -apply(induct ps) -apply(auto intro: lex_lists.intros) -apply(case_tac ps2) -apply(simp) -apply(simp) -apply(auto intro: lex_lists.intros) -done - -lemma lexordp_simps [simp]: - fixes xs ys :: "nat list" - shows "[] \lex ys = (ys \ [])" - and "xs \lex [] = False" - and "(x # xs) \lex (y # ys) \ (x < y \ (\ y < x \ xs \lex ys))" -apply - -apply (metis lex_append lex_lists.simps list.simps(3)) -using lex_lists.cases apply blast -using lex_lists.cases lex_lists.intros(2) lex_lists.intros(3) not_less_iff_gr_or_eq by fastforce - -lemma lex_append_cancel [simp]: - fixes ps ps1 ps2 :: "nat list" - shows "ps @ ps1 \lex ps @ ps2 \ ps1 \lex ps2" -apply(induct ps) -apply(auto) -done - -lemma lex_trans: - fixes ps1 ps2 ps3 :: "nat list" - assumes "ps1 \lex ps2" "ps2 \lex ps3" - shows "ps1 \lex ps3" -using assms -apply(induct arbitrary: ps3 rule: lex_lists.induct) -apply(erule lex_lists.cases) -apply(simp_all) -apply(rotate_tac 2) -apply(erule lex_lists.cases) -apply(simp_all) -apply(erule lex_lists.cases) -apply(simp_all) -done - -lemma trichotomous_aux: - fixes p q :: "nat list" - assumes "p \lex q" "p \ q" - shows "\(q \lex p)" -using assms -apply(induct rule: lex_lists.induct) -apply(auto) -done - -lemma trichotomous_aux2: - fixes p q :: "nat list" - assumes "p \lex q" "q \lex p" - shows "False" -using assms -apply(induct rule: lex_lists.induct) -apply(auto) -done - -lemma trichotomous: - fixes p q :: "nat list" - shows "p = q \ p \lex q \ q \lex p" -apply(induct p arbitrary: q) -apply(auto) -apply(case_tac q) -apply(auto) -done - -definition dpos :: "val \ val \ nat list \ bool" - where - "dpos v1 v2 p \ (p \ Pos v1 \ Pos v2) \ (p \ Pos v1 \ Pos v2)" - -definition - "DPos v1 v2 \ {p. dpos v1 v2 p}" - -lemma outside_lemma: - assumes "p \ Pos v1 \ Pos v2" - shows "pflat_len v1 p = pflat_len v2 p" -using assms -apply(auto simp add: pflat_len_def) -done - -lemma dpos_lemma_aux: - assumes "p \ Pos v1 \ Pos v2" - and "pflat_len v1 p = pflat_len v2 p" - shows "p \ Pos v1 \ Pos v2" -using assms -apply(auto simp add: pflat_len_def) -apply (smt inlen_bigger) -apply (smt inlen_bigger) -done - -lemma dpos_lemma: - assumes "p \ Pos v1 \ Pos v2" - and "pflat_len v1 p = pflat_len v2 p" - shows "\dpos v1 v2 p" -using assms -apply(auto simp add: dpos_def dpos_lemma_aux) -using dpos_lemma_aux apply auto[1] -using dpos_lemma_aux apply auto[1] -done - -lemma dpos_lemma2: - assumes "p \ Pos v1 \ Pos v2" - and "dpos v1 v2 p" - shows "pflat_len v1 p \ pflat_len v2 p" -using assms -using dpos_lemma by blast - -lemma DPos_lemma: - assumes "p \ DPos v1 v2" - shows "pflat_len v1 p \ pflat_len v2 p" -using assms -unfolding DPos_def -apply(auto simp add: pflat_len_def dpos_def) -apply (smt inlen_bigger) -by (smt inlen_bigger) - - -definition val_ord:: "val \ nat list \ val \ bool" ("_ \val _ _") -where - "v1 \val p v2 \ (p \ Pos v1 \ pflat_len v1 p > pflat_len v2 p \ - (\q \ Pos v1 \ Pos v2. q \lex p \ pflat_len v1 q = pflat_len v2 q))" - - -definition val_ord_ex:: "val \ val \ bool" ("_ :\val _") -where - "v1 :\val v2 \ (\p. v1 \val p v2)" - -definition val_ord_ex1:: "val \ val \ bool" ("_ :\val _") -where - "v1 :\val v2 \ v1 :\val v2 \ v1 = v2" - -lemma val_ord_shorterI: - assumes "length (flat v') < length (flat v)" - shows "v :\val v'" -using assms(1) -apply(subst val_ord_ex_def) -apply(rule_tac x="[]" in exI) -apply(subst val_ord_def) -apply(rule conjI) -apply (simp add: Pos_empty) -apply(rule conjI) -apply(simp add: pflat_len_simps) -apply (simp add: intlen_length) -apply(simp) -done - -lemma val_ord_spre: - assumes "(flat v') \spre (flat v)" - shows "v :\val v'" -using assms(1) -apply(rule_tac val_ord_shorterI) -apply(simp add: sprefix_list_def prefix_list_def) -apply(auto) -apply(case_tac ps') -apply(auto) -by (metis append_eq_conv_conj drop_all le_less_linear neq_Nil_conv) - - -lemma val_ord_ALTI: - assumes "v \val p v'" "flat v = flat v'" - shows "(Left v) \val (0#p) (Left v')" -using assms(1) -apply(subst (asm) val_ord_def) -apply(erule conjE) -apply(subst val_ord_def) -apply(rule conjI) -apply(simp) -apply(rule conjI) -apply(simp add: pflat_len_simps) -apply(rule ballI) -apply(rule impI) -apply(simp only: Pos.simps) -apply(auto)[1] -using assms(2) -apply(simp add: pflat_len_simps) -apply(auto simp add: pflat_len_simps)[2] -done - -lemma val_ord_ALTI2: - assumes "v \val p v'" "flat v = flat v'" - shows "(Right v) \val (1#p) (Right v')" -using assms(1) -apply(subst (asm) val_ord_def) -apply(erule conjE) -apply(subst val_ord_def) -apply(rule conjI) -apply(simp) -apply(rule conjI) -apply(simp add: pflat_len_simps) -apply(rule ballI) -apply(rule impI) -apply(simp only: Pos.simps) -apply(auto)[1] -using assms(2) -apply(simp add: pflat_len_simps) -apply(auto simp add: pflat_len_simps)[2] -done - -lemma val_ord_ALTE: - assumes "(Left v1) \val (p # ps) (Left v2)" - shows "p = 0 \ v1 \val ps v2" -using assms(1) -apply(simp add: val_ord_def) -apply(auto simp add: pflat_len_simps) -apply (metis (no_types, hide_lams) assms lex_lists.intros(2) outside_lemma pflat_len_simps(3) val_ord_def) -by (metis (no_types, hide_lams) assms lex_lists.intros(2) outside_lemma pflat_len_simps(3) val_ord_def) - -lemma val_ord_ALTE2: - assumes "(Right v1) \val (p # ps) (Right v2)" - shows "p = 1 \ v1 \val ps v2" -using assms(1) -apply(simp add: val_ord_def) -apply(auto simp add: pflat_len_simps) -apply (metis (no_types, hide_lams) assms lex_lists.intros(2) outside_lemma pflat_len_simps(5) val_ord_def) -by (metis (no_types, hide_lams) assms lex_lists.intros(2) outside_lemma pflat_len_simps(5) val_ord_def) - -lemma val_ord_STARI: - assumes "v1 \val p v2" "flat (Stars (v1#vs1)) = flat (Stars (v2#vs2))" - shows "(Stars (v1#vs1)) \val (0#p) (Stars (v2#vs2))" -using assms(1) -apply(subst (asm) val_ord_def) -apply(erule conjE) -apply(subst val_ord_def) -apply(rule conjI) -apply(simp) -apply(rule conjI) -apply(subst pflat_len_Stars_simps) -apply(simp) -apply(subst pflat_len_Stars_simps) -apply(simp) -apply(simp) -apply(rule ballI) -apply(rule impI) -apply(simp) -apply(auto) -using assms(2) -apply(simp add: pflat_len_simps) -apply(auto simp add: pflat_len_Stars_simps) -done - -lemma val_ord_STARI2: - assumes "(Stars vs1) \val n#p (Stars vs2)" "flat (Stars vs1) = flat (Stars vs2)" - shows "(Stars (v#vs1)) \val (Suc n#p) (Stars (v#vs2))" -using assms(1) -apply(subst (asm) val_ord_def) -apply(erule conjE)+ -apply(subst val_ord_def) -apply(rule conjI) -apply(simp) -apply(rule conjI) -apply(case_tac vs1) -apply(simp) -apply(simp) -apply(auto)[1] -apply(case_tac vs2) -apply(simp) -apply (simp add: pflat_len_def) -apply(simp) -apply(auto)[1] -apply (simp add: pflat_len_Stars_simps) -using pflat_len_def apply auto[1] -apply(rule ballI) -apply(rule impI) -apply(simp) -using assms(2) -apply(auto) -apply (simp add: pflat_len_simps(7)) -apply (simp add: pflat_len_Stars_simps) -using assms(2) -apply(auto simp add: pflat_len_def)[1] -apply force -apply force -apply(auto simp add: pflat_len_def)[1] -apply force -apply force -apply(auto simp add: pflat_len_def)[1] -apply(auto simp add: pflat_len_def)[1] -apply force -apply force -apply(auto simp add: pflat_len_def)[1] -apply force -apply force -done - - -lemma val_ord_SEQI: - assumes "v1 \val p v1'" "flat (Seq v1 v2) = flat (Seq v1' v2')" - shows "(Seq v1 v2) \val (0#p) (Seq v1' v2')" -using assms(1) -apply(subst (asm) val_ord_def) -apply(erule conjE) -apply(subst val_ord_def) -apply(rule conjI) -apply(simp) -apply(rule conjI) -apply(simp add: pflat_len_simps) -apply(rule ballI) -apply(rule impI) -apply(simp only: Pos.simps) -apply(auto)[1] -apply(simp add: pflat_len_simps) -using assms(2) -apply(simp) -apply(auto simp add: pflat_len_simps)[2] -done - - -lemma val_ord_SEQI2: - assumes "v2 \val p v2'" "flat v2 = flat v2'" - shows "(Seq v v2) \val (1#p) (Seq v v2')" -using assms(1) -apply(subst (asm) val_ord_def) -apply(erule conjE)+ -apply(subst val_ord_def) -apply(rule conjI) -apply(simp) -apply(rule conjI) -apply(simp add: pflat_len_simps) -apply(rule ballI) -apply(rule impI) -apply(simp only: Pos.simps) -apply(auto) -apply(auto simp add: pflat_len_def intlen_append) -apply(auto simp add: assms(2)) -done - -lemma val_ord_SEQE_0: - assumes "(Seq v1 v2) \val 0#p (Seq v1' v2')" - shows "v1 \val p v1'" -using assms(1) -apply(simp add: val_ord_def val_ord_ex_def) -apply(auto)[1] -apply(simp add: pflat_len_simps) -apply(simp add: val_ord_def pflat_len_def) -apply(auto)[1] -apply(drule_tac x="0#q" in bspec) -apply(simp) -apply(simp) -apply(drule_tac x="0#q" in bspec) -apply(simp) -apply(simp) -apply(drule_tac x="0#q" in bspec) -apply(simp) -apply(simp) -apply(simp add: val_ord_def pflat_len_def) -apply(auto)[1] -done - -lemma val_ord_SEQE_1: - assumes "(Seq v1 v2) \val (Suc 0)#p (Seq v1' v2')" - shows "v2 \val p v2'" -using assms(1) -apply(simp add: val_ord_def pflat_len_def) -apply(auto)[1] -apply(drule_tac x="1#q" in bspec) -apply(simp) -apply(simp) -apply(drule_tac x="1#q" in bspec) -apply(simp) -apply(simp) -apply(drule_tac x="1#q" in bspec) -apply(simp) -apply(auto)[1] -apply(drule_tac x="1#q" in bspec) -apply(simp) -apply(auto) -apply(simp add: intlen_append) -apply force -apply(simp add: intlen_append) -apply force -apply(simp add: intlen_append) -apply force -apply(simp add: intlen_append) -apply force -done - -lemma val_ord_SEQE_2: - assumes "(Seq v1 v2) \val (Suc 0)#p (Seq v1' v2')" - and "\ v1 : r" "\ v1' : r" - shows "v1 = v1'" -proof - - have "\q \ Pos v1 \ Pos v1'. 0 # q \lex 1#p \ pflat_len v1 q = pflat_len v1' q" - using assms(1) - apply(simp add: val_ord_def) - apply(rule ballI) - apply(clarify) - apply(drule_tac x="0#q" in bspec) - apply(auto)[1] - apply(simp add: pflat_len_simps) - done - then have "Pos v1 = Pos v1'" - apply(rule_tac Two_to_Three_orig) - apply(rule ballI) - apply(drule_tac x="pa" in bspec) - apply(simp) - apply(simp) - done - then show "v1 = v1'" - apply(rule_tac Three_to_One) - apply(rule assms) - apply(rule assms) - apply(simp) - done -qed - -lemma val_ord_SEQ: - assumes "(Seq v1 v2) :\val (Seq v1' v2')" - and "flat (Seq v1 v2) = flat (Seq v1' v2')" - and "\ v1 : r" "\ v1' : r" - shows "(v1 :\val v1') \ (v1 = v1' \ (v2 :\val v2'))" -using assms(1) -apply(subst (asm) val_ord_ex_def) -apply(erule exE) -apply(simp only: val_ord_def) -apply(simp) -apply(erule conjE)+ -apply(erule disjE) -prefer 2 -apply(erule disjE) -apply(erule exE) -apply(rule disjI1) -apply(simp) -apply(subst val_ord_ex_def) -apply(rule_tac x="ps" in exI) -apply(rule val_ord_SEQE_0) -apply(simp add: val_ord_def) -apply(erule exE) -apply(rule disjI2) -apply(rule conjI) -thm val_ord_SEQE_1 -apply(rule_tac val_ord_SEQE_2) -apply(auto simp add: val_ord_def)[3] -apply(rule assms(3)) -apply(rule assms(4)) -apply(subst val_ord_ex_def) -apply(rule_tac x="ps" in exI) -apply(rule_tac val_ord_SEQE_1) -apply(auto simp add: val_ord_def)[1] -apply(simp) -using assms(2) -apply(simp add: pflat_len_simps) -done - - -lemma val_ord_ex_trans: - assumes "v1 :\val v2" "v2 :\val v3" - shows "v1 :\val v3" -using assms -unfolding val_ord_ex_def -apply(clarify) -apply(subgoal_tac "p = pa \ p \lex pa \ pa \lex p") -prefer 2 -apply(rule trichotomous) -apply(erule disjE) -apply(simp) -apply(rule_tac x="pa" in exI) -apply(subst val_ord_def) -apply(rule conjI) -apply(simp add: val_ord_def) -apply(auto)[1] -apply(simp add: val_ord_def) -apply(simp add: val_ord_def) -apply(auto)[1] -using outside_lemma apply blast -apply(simp add: val_ord_def) -apply(auto)[1] -using outside_lemma apply force -apply auto[1] -apply(simp add: val_ord_def) -apply(auto)[1] -apply (metis (no_types, hide_lams) lex_trans outside_lemma) -apply(simp add: val_ord_def) -apply(auto)[1] -by (metis IntE Two_to_Three_aux UnCI lex_trans outside_lemma) - - -definition fdpos :: "val \ val \ nat list \ bool" -where - "fdpos v1 v2 p \ ({q. q \lex p} \ DPos v1 v2 = {})" - - -lemma pos_append: - assumes "p @ q \ Pos v" - shows "q \ Pos (at v p)" -using assms -apply(induct arbitrary: p q rule: Pos.induct) -apply(simp_all) -apply(auto)[1] -apply(simp add: append_eq_Cons_conv) -apply(auto)[1] -apply(auto)[1] -apply(simp add: append_eq_Cons_conv) -apply(auto)[1] -apply(auto)[1] -apply(simp add: append_eq_Cons_conv) -apply(auto)[1] -apply(simp add: append_eq_Cons_conv) -apply(auto)[1] -apply(auto)[1] -apply(simp add: append_eq_Cons_conv) -apply(auto)[1] -apply(simp add: append_eq_Cons_conv) -apply(auto)[1] -by (metis append_Cons at.simps(6)) - - -lemma Pos_pre: - assumes "p \ Pos v" "q \pre p" - shows "q \ Pos v" -using assms -apply(induct v arbitrary: p q rule: Pos.induct) -apply(simp_all add: prefix_list_def) -apply (meson append_eq_Cons_conv append_is_Nil_conv) -apply (meson append_eq_Cons_conv append_is_Nil_conv) -apply (metis (no_types, lifting) Cons_eq_append_conv append_is_Nil_conv) -apply(auto) -apply (meson append_eq_Cons_conv) -apply(simp add: append_eq_Cons_conv) -apply(auto) -done - -lemma lex_lists_order: - assumes "q' \lex q" "\(q' \pre q)" - shows "\(q \lex q')" -using assms -apply(induct rule: lex_lists.induct) -apply(simp add: prefix_list_def) -apply(auto) -using trichotomous_aux2 by auto - -lemma lex_appendL: - assumes "q \lex p" - shows "q \lex p @ q'" -using assms -apply(induct arbitrary: q' rule: lex_lists.induct) -apply(auto) -done - - -inductive - CPrf :: "val \ rexp \ bool" ("\ _ : _" [100, 100] 100) -where - "\\ v1 : r1; \ v2 : r2\ \ \ Seq v1 v2 : SEQ r1 r2" -| "\ v1 : r1 \ \ Left v1 : ALT r1 r2" -| "\ v2 : r2 \ \ Right v2 : ALT r1 r2" -| "\ Void : ONE" -| "\ Char c : CHAR c" -| "\ Stars [] : STAR r" -| "\\ v : r; flat v \ []; \ Stars vs : STAR r\ \ \ Stars (v # vs) : STAR r" - -lemma Prf_CPrf: - assumes "\ v : r" - shows "\ v : r" -using assms -apply(induct) -apply(auto intro: Prf.intros) -done - -definition - "CPT r s = {v. flat v = s \ \ v : r}" - -definition - "CPTpre r s = {v. \s'. flat v @ s' = s \ \ v : r}" - -lemma CPT_CPTpre_subset: - shows "CPT r s \ CPTpre r s" -apply(auto simp add: CPT_def CPTpre_def) -done - - -lemma CPTpre_subsets: - "CPTpre ZERO s = {}" - "CPTpre ONE s \ {Void}" - "CPTpre (CHAR c) s \ {Char c}" - "CPTpre (ALT r1 r2) s \ Left ` CPTpre r1 s \ Right ` CPTpre r2 s" - "CPTpre (SEQ r1 r2) s \ {Seq v1 v2 | v1 v2. v1 \ CPTpre r1 s \ v2 \ CPTpre r2 (drop (length (flat v1)) s)}" - "CPTpre (STAR r) s \ {Stars []} \ - {Stars (v#vs) | v vs. v \ CPTpre r s \ flat v \ [] \ Stars vs \ CPTpre (STAR r) (drop (length (flat v)) s)}" - "CPTpre (STAR r) [] = {Stars []}" -apply(auto simp add: CPTpre_def) -apply(erule CPrf.cases) -apply(simp_all) -apply(erule CPrf.cases) -apply(simp_all) -apply(erule CPrf.cases) -apply(simp_all) -apply(erule CPrf.cases) -apply(simp_all) -apply(erule CPrf.cases) -apply(simp_all) -apply(erule CPrf.cases) -apply(simp_all) -apply(erule CPrf.cases) -apply(simp_all) -apply(rule CPrf.intros) -done - - -lemma CPTpre_simps: - shows "CPTpre ONE s = {Void}" - and "CPTpre (CHAR c) (d#s) = (if c = d then {Char c} else {})" - and "CPTpre (ALT r1 r2) s = Left ` CPTpre r1 s \ Right ` CPTpre r2 s" - and "CPTpre (SEQ r1 r2) s = - {Seq v1 v2 | v1 v2. v1 \ CPTpre r1 s \ v2 \ CPTpre r2 (drop (length (flat v1)) s)}" -apply - -apply(rule subset_antisym) -apply(rule CPTpre_subsets) -apply(auto simp add: CPTpre_def intro: "CPrf.intros")[1] -apply(case_tac "c = d") -apply(simp) -apply(rule subset_antisym) -apply(rule CPTpre_subsets) -apply(auto simp add: CPTpre_def intro: CPrf.intros)[1] -apply(simp) -apply(auto simp add: CPTpre_def intro: CPrf.intros)[1] -apply(erule CPrf.cases) -apply(simp_all) -apply(rule subset_antisym) -apply(rule CPTpre_subsets) -apply(auto simp add: CPTpre_def intro: CPrf.intros)[1] -apply(rule subset_antisym) -apply(rule CPTpre_subsets) -apply(auto simp add: CPTpre_def intro: CPrf.intros)[1] -done - -lemma CPT_simps: - shows "CPT ONE s = (if s = [] then {Void} else {})" - and "CPT (CHAR c) [d] = (if c = d then {Char c} else {})" - and "CPT (ALT r1 r2) s = Left ` CPT r1 s \ Right ` CPT r2 s" - and "CPT (SEQ r1 r2) s = - {Seq v1 v2 | v1 v2 s1 s2. s1 @ s2 = s \ v1 \ CPT r1 s1 \ v2 \ CPT r2 s2}" -apply - -apply(rule subset_antisym) -apply(auto simp add: CPT_def)[1] -apply(erule CPrf.cases) -apply(simp_all)[7] -apply(erule CPrf.cases) -apply(simp_all)[7] -apply(auto simp add: CPT_def intro: CPrf.intros)[1] -apply(auto simp add: CPT_def intro: CPrf.intros)[1] -apply(erule CPrf.cases) -apply(simp_all)[7] -apply(erule CPrf.cases) -apply(simp_all)[7] -apply(auto simp add: CPT_def image_def intro: CPrf.intros)[1] -apply(erule CPrf.cases) -apply(simp_all)[7] -apply(clarify) -apply blast -apply(auto simp add: CPT_def image_def intro: CPrf.intros)[1] -apply(erule CPrf.cases) -apply(simp_all)[7] -done - -lemma CPTpre_SEQ: - assumes "v \ CPTpre (SEQ r1 r2) s" - shows "\s'. flat v = s' \ (s' \pre s) \ s' \ L (SEQ r1 r2)" -using assms -apply(simp add: CPTpre_simps) -apply(auto simp add: CPTpre_def) -apply (simp add: prefix_list_def) -by (metis L.simps(4) L_flat_Prf1 Prf.intros(1) Prf_CPrf flat.simps(5)) - -lemma Cond_prefix: - assumes "\s\<^sub>3. s1 @ s\<^sub>3 \ L r1 \ s\<^sub>3 = [] \ (\s\<^sub>4. s1 @ s\<^sub>3 @ s\<^sub>4 \pre s1 @ s2 \ s\<^sub>4 \ L r2)" - and "t1 \ L r1" "t2 \ L r2" "t1 @ t2 \pre s1 @ s2" - shows "t1 \pre s1" -using assms -apply(auto simp add: Sequ_def prefix_list_def append_eq_append_conv2) -done - - - -lemma test: - assumes "finite A" - shows "finite {vs. Stars vs \ A}" -using assms -apply(induct A) -apply(simp) -apply(auto) -apply(case_tac x) -apply(simp_all) -done - -lemma CPTpre_STAR_finite: - assumes "\s. finite (CPTpre r s)" - shows "finite (CPTpre (STAR r) s)" -apply(induct s rule: length_induct) -apply(case_tac xs) -apply(simp) -apply(simp add: CPTpre_subsets) -apply(rule finite_subset) -apply(rule CPTpre_subsets) -apply(simp) -apply(rule_tac B="(\(v, vs). Stars (v#vs)) ` {(v, vs). v \ CPTpre r (a#list) \ flat v \ [] \ Stars vs \ CPTpre (STAR r) (drop (length (flat v)) (a#list))}" in finite_subset) -apply(auto)[1] -apply(rule finite_imageI) -apply(simp add: Collect_case_prod_Sigma) -apply(rule finite_SigmaI) -apply(rule assms) -apply(case_tac "flat v = []") -apply(simp) -apply(drule_tac x="drop (length (flat v)) (a # list)" in spec) -apply(simp) -apply(auto)[1] -apply(rule test) -apply(simp) -done - -lemma CPTpre_finite: - shows "finite (CPTpre r s)" -apply(induct r arbitrary: s) -apply(simp add: CPTpre_subsets) -apply(rule finite_subset) -apply(rule CPTpre_subsets) -apply(simp) -apply(rule finite_subset) -apply(rule CPTpre_subsets) -apply(simp) -sorry - - -lemma CPT_finite: - shows "finite (CPT r s)" -apply(rule finite_subset) -apply(rule CPT_CPTpre_subset) -apply(rule CPTpre_finite) -done - -lemma Posix_CPT: - assumes "s \ r \ v" - shows "v \ CPT r s" -using assms -apply(induct rule: Posix.induct) -apply(simp add: CPT_def) -apply(rule CPrf.intros) -apply(simp add: CPT_def) -apply(rule CPrf.intros) -apply(simp add: CPT_def) -apply(rule CPrf.intros) -apply(simp) -apply(simp add: CPT_def) -apply(rule CPrf.intros) -apply(simp) -apply(simp add: CPT_def) -apply(rule CPrf.intros) -apply(simp) -apply(simp) -apply(simp add: CPT_def) -apply(rule CPrf.intros) -apply(simp) -apply(simp) -apply(simp) -apply(simp add: CPT_def) -apply(rule CPrf.intros) -done - -lemma Posix_val_ord: - assumes "s \ r \ v1" "v2 \ CPTpre r s" - shows "v1 :\val v2" -using assms -apply(induct arbitrary: v2 rule: Posix.induct) -apply(simp add: CPTpre_def) -apply(clarify) -apply(erule CPrf.cases) -apply(simp_all) -apply(simp add: val_ord_ex1_def) -apply(simp add: CPTpre_def) -apply(clarify) -apply(erule CPrf.cases) -apply(simp_all) -apply(simp add: val_ord_ex1_def) -(* ALT1 *) -prefer 3 -(* SEQ case *) -apply(subst (asm) (3) CPTpre_def) -apply(clarify) -apply(erule CPrf.cases) -apply(simp_all) -apply(case_tac "s' = []") -apply(simp) -prefer 2 -apply(simp add: val_ord_ex1_def) -apply(clarify) -apply(simp) -apply(simp add: val_ord_ex_def) -apply(simp (no_asm) add: val_ord_def) -apply(rule_tac x="[]" in exI) -apply(simp add: pflat_len_simps) -apply(rule intlen_length) -apply (metis Posix1(2) append_assoc append_eq_conv_conj drop_eq_Nil not_le) -apply(subgoal_tac "length (flat v1a) \ length s1") -prefer 2 -apply (metis L_flat_Prf1 Prf_CPrf append_eq_append_conv_if append_take_drop_id drop_eq_Nil) -apply(subst (asm) append_eq_append_conv_if) -apply(simp) -apply(clarify) -apply(drule_tac x="v1a" in meta_spec) -apply(drule meta_mp) -apply(auto simp add: CPTpre_def)[1] -using append_eq_conv_conj apply blast -apply(subst (asm) (2)val_ord_ex1_def) -apply(erule disjE) -apply(subst (asm) val_ord_ex_def) -apply(erule exE) -apply(subst val_ord_ex1_def) -apply(rule disjI1) -apply(subst val_ord_ex_def) -apply(rule_tac x="0#p" in exI) -apply(rule val_ord_SEQI) -apply(simp) -apply(simp) -apply (metis Posix1(2) append_assoc append_take_drop_id) -apply(simp) -apply(drule_tac x="v2b" in meta_spec) -apply(drule meta_mp) -apply(auto simp add: CPTpre_def)[1] -apply (simp add: Posix1(2)) -apply(subst (asm) val_ord_ex1_def) -apply(erule disjE) -apply(subst (asm) val_ord_ex_def) -apply(erule exE) -apply(subst val_ord_ex1_def) -apply(rule disjI1) -apply(subst val_ord_ex_def) -apply(rule_tac x="1#p" in exI) -apply(rule val_ord_SEQI2) -apply(simp) -apply (simp add: Posix1(2)) -apply(subst val_ord_ex1_def) -apply(simp) -(* ALT *) -apply(subst (asm) (2) CPTpre_def) -apply(clarify) -apply(erule CPrf.cases) -apply(simp_all) -apply(clarify) -apply(case_tac "s' = []") -apply(simp) -apply(drule_tac x="v1" in meta_spec) -apply(drule meta_mp) -apply(auto simp add: CPTpre_def)[1] -apply(subst (asm) val_ord_ex1_def) -apply(erule disjE) -apply(subst (asm) val_ord_ex_def) -apply(erule exE) -apply(subst val_ord_ex1_def) -apply(rule disjI1) -apply(subst val_ord_ex_def) -apply(rule_tac x="0#p" in exI) -apply(rule val_ord_ALTI) -apply(simp) -using Posix1(2) apply blast -using val_ord_ex1_def apply blast -apply(subst val_ord_ex1_def) -apply(rule disjI1) -apply (simp add: Posix1(2) val_ord_shorterI) -apply(subst val_ord_ex1_def) -apply(rule disjI1) -apply(case_tac "s' = []") -apply(simp) -apply(subst val_ord_ex_def) -apply(rule_tac x="[0]" in exI) -apply(subst val_ord_def) -apply(rule conjI) -apply(simp add: Pos_empty) -apply(rule conjI) -apply(simp add: pflat_len_simps) -apply (smt inlen_bigger) -apply(simp) -apply(rule conjI) -apply(simp add: pflat_len_simps) -using Posix1(2) apply auto[1] -apply(rule ballI) -apply(rule impI) -apply(case_tac "q = []") -using Posix1(2) apply auto[1] -apply(auto)[1] -apply(rule val_ord_shorterI) -apply(simp) -apply (simp add: Posix1(2)) -(* ALT RIGHT *) -apply(subst (asm) (2) CPTpre_def) -apply(clarify) -apply(erule CPrf.cases) -apply(simp_all) -apply(clarify) -apply(case_tac "s' = []") -apply(simp) -apply (simp add: L_flat_Prf1 Prf_CPrf) -apply(subst val_ord_ex1_def) -apply(rule disjI1) -apply(rule val_ord_shorterI) -apply(simp) -apply (simp add: Posix1(2)) -apply(case_tac "s' = []") -apply(simp) -apply(drule_tac x="v2a" in meta_spec) -apply(drule meta_mp) -apply(auto simp add: CPTpre_def)[1] -apply(subst (asm) val_ord_ex1_def) -apply(erule disjE) -apply(subst (asm) val_ord_ex_def) -apply(erule exE) -apply(subst val_ord_ex1_def) -apply(rule disjI1) -apply(subst val_ord_ex_def) -apply(rule_tac x="1#p" in exI) -apply(rule val_ord_ALTI2) -apply(simp) -using Posix1(2) apply blast -apply (simp add: val_ord_ex1_def) -apply(subst val_ord_ex1_def) -apply(rule disjI1) -apply(rule val_ord_shorterI) -apply(simp) -apply (simp add: Posix1(2)) -(* STAR empty case *) -prefer 2 -apply(subst (asm) CPTpre_def) -apply(clarify) -apply(erule CPrf.cases) -apply(simp_all) -apply(clarify) -apply (simp add: val_ord_ex1_def) -(* STAR non-empty case *) -apply(subst (asm) (3) CPTpre_def) -apply(clarify) -apply(erule CPrf.cases) -apply(simp_all) -apply(clarify) -apply (simp add: val_ord_ex1_def) -apply(rule val_ord_shorterI) -apply(simp) -apply(case_tac "s' = []") -apply(simp) -prefer 2 -apply (simp add: val_ord_ex1_def) -apply(rule disjI1) -apply(rule val_ord_shorterI) -apply(simp) -apply (metis Posix1(2) append_assoc append_eq_conv_conj drop_all flat.simps(7) flat_Stars length_append not_less) -apply(drule_tac x="va" in meta_spec) -apply(drule meta_mp) -apply(auto simp add: CPTpre_def)[1] -apply (smt L.simps(6) L_flat_Prf1 Prf_CPrf append_eq_append_conv2 flat_Stars self_append_conv) -apply (subst (asm) (2) val_ord_ex1_def) -apply(erule disjE) -prefer 2 -apply(simp) -apply(drule_tac x="Stars vsa" in meta_spec) -apply(drule meta_mp) -apply(auto simp add: CPTpre_def)[1] -apply (simp add: Posix1(2)) -apply (subst (asm) val_ord_ex1_def) -apply(erule disjE) -apply (subst (asm) val_ord_ex_def) -apply(erule exE) -apply (subst val_ord_ex1_def) -apply(rule disjI1) -apply (subst val_ord_ex_def) -apply(case_tac p) -apply(simp) -apply (metis Posix1(2) flat_Stars not_less_iff_gr_or_eq pflat_len_simps(7) same_append_eq val_ord_def) -using Posix1(2) val_ord_STARI2 apply fastforce -apply(simp add: val_ord_ex1_def) -apply (subst (asm) val_ord_ex_def) -apply(erule exE) -apply (subst val_ord_ex1_def) -apply(rule disjI1) -apply (subst val_ord_ex_def) -by (metis Posix1(2) flat.simps(7) flat_Stars val_ord_STARI) - -lemma Posix_val_ord_stronger: - assumes "s \ r \ v1" "v2 \ CPT r s" - shows "v1 :\val v2" -using assms -apply(rule_tac Posix_val_ord) -apply(assumption) -apply(simp add: CPTpre_def CPT_def) -done - - -lemma STAR_val_ord: - assumes "Stars (v1 # vs1) \val (Suc p # ps) Stars (v2 # vs2)" "flat v1 = flat v2" - shows "(Stars vs1) \val (p # ps) (Stars vs2)" -using assms(1,2) -apply - -apply(simp(no_asm) add: val_ord_def) -apply(rule conjI) -apply(simp add: val_ord_def) -apply(rule conjI) -apply(simp add: val_ord_def) -apply(auto simp add: pflat_len_simps pflat_len_Stars_simps2)[1] -apply(rule ballI) -apply(rule impI) -apply(simp add: val_ord_def pflat_len_simps pflat_len_Stars_simps2 intlen_append) -apply(clarify) -apply(case_tac q) -apply(simp add: val_ord_def pflat_len_simps pflat_len_Stars_simps2 intlen_append) -apply(clarify) -apply(erule disjE) -prefer 2 -apply(drule_tac x="Suc a # list" in bspec) -apply(simp) -apply(drule mp) -apply(simp) -apply(simp add: val_ord_def pflat_len_simps pflat_len_Stars_simps2 intlen_append) -apply(drule_tac x="Suc a # list" in bspec) -apply(simp) -apply(drule mp) -apply(simp) -apply(simp add: val_ord_def pflat_len_simps pflat_len_Stars_simps2 intlen_append) -done - - -lemma Posix_val_ord_reverse: - assumes "s \ r \ v1" - shows "\(\v2 \ CPT r s. v2 :\val v1)" -using assms -by (metis Posix_val_ord_stronger less_irrefl val_ord_def - val_ord_ex1_def val_ord_ex_def val_ord_ex_trans) - -thm Posix.intros(6) - -inductive Prop :: "rexp \ val list \ bool" -where - "Prop r []" -| "\Prop r vs; - \ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = concat (map flat vs) \ flat v @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (STAR r))\ - \ Prop r (v # vs)" - -lemma STAR_val_ord_ex: - assumes "Stars (v # vs1) :\val Stars (v # vs2)" - shows "Stars vs1 :\val Stars vs2" -using assms -apply(subst (asm) val_ord_ex_def) -apply(erule exE) -apply(case_tac p) -apply(simp) -apply(simp add: val_ord_def pflat_len_simps intlen_append) -apply(subst val_ord_ex_def) -apply(rule_tac x="[]" in exI) -apply(simp add: val_ord_def pflat_len_simps Pos_empty) -apply(simp) -apply(case_tac a) -apply(clarify) -prefer 2 -using STAR_val_ord val_ord_ex_def apply blast -apply(auto simp add: pflat_len_Stars_simps2 val_ord_def pflat_len_def)[1] -done - -lemma STAR_val_ord_exI: - assumes "Stars vs1 :\val Stars vs2" "flat (Stars vs1) = flat (Stars vs2)" - shows "Stars (vs @ vs1) :\val Stars (vs @ vs2)" -using assms -apply(induct vs) -apply(simp) -apply(simp) -apply(simp add: val_ord_ex_def) -apply(erule exE) -apply(case_tac p) -apply(simp) -apply(rule_tac x="[]" in exI) -apply(simp add: val_ord_def) -apply(auto simp add: pflat_len_simps intlen_append)[1] -apply(simp) -apply(rule_tac x="Suc aa#list" in exI) -apply(rule val_ord_STARI2) -apply(simp) -apply(simp) -done - -lemma STAR_val_ord_ex_append: - assumes "Stars (vs @ vs1) :\val Stars (vs @ vs2)" - shows "Stars vs1 :\val Stars vs2" -using assms -apply(induct vs) -apply(simp) -apply(simp) -apply(drule STAR_val_ord_ex) -apply(simp) -done - -lemma STAR_val_ord_ex_append_eq: - assumes "flat (Stars vs1) = flat (Stars vs2)" - shows "Stars (vs @ vs1) :\val Stars (vs @ vs2) \ Stars vs1 :\val Stars vs2" -using assms -apply(rule_tac iffI) -apply(erule STAR_val_ord_ex_append) -apply(rule STAR_val_ord_exI) -apply(auto) -done - -lemma Posix_STARI: - assumes "\v \ set vs. flat v \ [] \ (flat v) \ r \ v" "Prop r vs" - shows "flat (Stars vs) \ STAR r \ Stars vs" -using assms -apply(induct vs arbitrary: r) -apply(simp) -apply(rule Posix.intros) -apply(simp) -apply(rule Posix.intros) -apply(simp) -apply(auto)[1] -apply(erule Prop.cases) -apply(simp) -apply(simp) -apply(simp) -apply(erule Prop.cases) -apply(simp) -apply(auto)[1] -done - -lemma CPrf_stars: - assumes "\ Stars vs : STAR r" - shows "\v \ set vs. flat v \ [] \ \ v : r" -using assms -apply(induct vs) -apply(auto) -apply(erule CPrf.cases) -apply(simp_all) -apply(erule CPrf.cases) -apply(simp_all) -apply(erule CPrf.cases) -apply(simp_all) -apply(erule CPrf.cases) -apply(simp_all) -done - -definition PT :: "rexp \ string \ val set" -where "PT r s \ {v. flat v = s \ \ v : r}" - -lemma exists: - assumes "s \ (L r)\" - shows "\vs. concat (map flat vs) = s \ \ Stars vs : STAR r" -using assms -apply(drule_tac Star_string) -apply(auto) -by (metis L_flat_Prf2 Prf_Stars Star_val) - - -lemma val_ord_Posix_Stars: - assumes "(Stars vs) \ CPT (STAR r) (flat (Stars vs))" "\v \ set vs. flat v \ r \ v" - and "\(\vs2 \ PT (STAR r) (flat (Stars vs)). vs2 :\val (Stars vs))" - shows "(flat (Stars vs)) \ (STAR r) \ Stars vs" -using assms -apply(induct vs) -apply(simp) -apply(rule Posix.intros) -apply(simp (no_asm)) -apply(rule Posix.intros) -apply(auto)[1] -apply(auto simp add: CPT_def PT_def)[1] -defer -apply(simp) -apply(drule meta_mp) -apply(auto simp add: CPT_def PT_def)[1] -apply(erule CPrf.cases) -apply(simp_all) -apply(drule meta_mp) -apply(auto simp add: CPT_def PT_def)[1] -apply(erule Prf.cases) -apply(simp_all) -apply (metis CPrf_stars Cons_eq_map_conv Posix_CPT Posix_STAR2 Posix_val_ord_reverse list.exhaust list.set_intros(2) map_idI val.distinct(25)) -apply(clarify) -apply(drule_tac x="Stars (a#v#vsa)" in spec) -apply(simp) -apply(drule mp) -apply (meson CPrf_stars Prf.intros(7) Prf_CPrf list.set_intros(1)) -apply(subst (asm) (2) val_ord_ex_def) -apply(simp) -apply (metis flat.simps(7) flat_Stars intlen.cases not_less_iff_gr_or_eq pflat_len_simps(7) val_ord_STARI2 val_ord_def val_ord_ex_def) -apply(auto simp add: CPT_def PT_def)[1] -using CPrf_stars apply auto[1] -apply(auto)[1] -apply(auto simp add: CPT_def PT_def)[1] -apply(subgoal_tac "\vA. flat vA = flat a @ s\<^sub>3 \ \ vA : r") -prefer 2 -apply (meson L_flat_Prf2) -apply(subgoal_tac "\vB. flat (Stars vB) = s\<^sub>4 \ \ (Stars vB) : (STAR r)") -apply(clarify) -apply(drule_tac x="Stars (vA # vB)" in spec) -apply(simp) -apply(drule mp) -using Prf.intros(7) apply blast -apply(subst (asm) (2) val_ord_ex_def) -apply(simp) -prefer 2 -apply(simp) -using exists apply blast -prefer 2 -apply(drule meta_mp) -apply(erule CPrf.cases) -apply(simp_all) -apply(drule meta_mp) -apply(auto)[1] -prefer 2 -apply(simp) -apply(erule CPrf.cases) -apply(simp_all) -apply(clarify) -apply(rotate_tac 3) -apply(erule Prf.cases) -apply(simp_all) -apply (metis CPrf_stars intlen.cases less_irrefl list.set_intros(1) val_ord_def val_ord_ex_def) -apply(drule_tac x="Stars (v#va#vsb)" in spec) -apply(drule mp) -apply (simp add: Posix1a Prf.intros(7)) -apply(simp) -apply(subst (asm) (2) val_ord_ex_def) -apply(simp) -apply (metis flat.simps(7) flat_Stars intlen.cases not_less_iff_gr_or_eq pflat_len_simps(7) val_ord_STARI2 val_ord_def val_ord_ex_def) -proof - - fix a :: val and vsa :: "val list" and s\<^sub>3 :: "char list" and vA :: val and vB :: "val list" - assume a1: "s\<^sub>3 \ []" - assume a2: "s\<^sub>3 @ concat (map flat vB) = concat (map flat vsa)" - assume a3: "flat vA = flat a @ s\<^sub>3" - assume a4: "\p. \ Stars (vA # vB) \val p Stars (a # vsa)" - have f5: "\n cs. drop n (cs::char list) = [] \ n < length cs" - by (meson drop_eq_Nil not_less) - have f6: "\ length (flat vA) \ length (flat a)" - using a3 a1 by simp - have "flat (Stars (a # vsa)) = flat (Stars (vA # vB))" - using a3 a2 by simp - then show False - using f6 f5 a4 by (metis (full_types) drop_eq_Nil val_ord_STARI val_ord_ex_def val_ord_shorterI) -qed - -lemma Prf_Stars_append: - assumes "\ Stars vs1 : STAR r" "\ Stars vs2 : STAR r" - shows "\ Stars (vs1 @ vs2) : STAR r" -using assms -apply(induct vs1 arbitrary: vs2) -apply(auto intro: Prf.intros) -apply(erule Prf.cases) -apply(simp_all) -apply(auto intro: Prf.intros) -done - -lemma CPrf_Stars_appendE: - assumes "\ Stars (vs1 @ vs2) : STAR r" - shows "\ Stars vs1 : STAR r \ \ Stars vs2 : STAR r" -using assms -apply(induct vs1 arbitrary: vs2) -apply(auto intro: CPrf.intros)[1] -apply(erule CPrf.cases) -apply(simp_all) -apply(auto intro: CPrf.intros) -done - -lemma val_ord_Posix: - assumes "v1 \ CPT r s" "\(\v2 \ PT r s. v2 :\val v1)" - shows "s \ r \ v1" -using assms -apply(induct r arbitrary: s v1) -apply(auto simp add: CPT_def PT_def)[1] -apply(erule CPrf.cases) -apply(simp_all) -(* ONE *) -apply(auto simp add: CPT_def)[1] -apply(erule CPrf.cases) -apply(simp_all) -apply(rule Posix.intros) -(* CHAR *) -apply(auto simp add: CPT_def)[1] -apply(erule CPrf.cases) -apply(simp_all) -apply(rule Posix.intros) -prefer 2 -(* ALT *) -apply(auto simp add: CPT_def PT_def)[1] -apply(erule CPrf.cases) -apply(simp_all) -apply(rule Posix.intros) -apply(drule_tac x="flat v1a" in meta_spec) -apply(drule_tac x="v1a" in meta_spec) -apply(drule meta_mp) -apply(simp) -apply(drule meta_mp) -apply(auto)[1] -apply(drule_tac x="Left v2" in spec) -apply(simp) -apply(drule mp) -apply(rule Prf.intros) -apply(simp) -apply (meson val_ord_ALTI val_ord_ex_def) -apply(assumption) -(* ALT Right *) -apply(auto simp add: CPT_def)[1] -apply(rule Posix.intros) -apply(rotate_tac 1) -apply(drule_tac x="flat v2" in meta_spec) -apply(drule_tac x="v2" in meta_spec) -apply(drule meta_mp) -apply(simp) -apply(drule meta_mp) -apply(auto)[1] -apply(drule_tac x="Right v2a" in spec) -apply(simp) -apply(drule mp) -apply(rule Prf.intros) -apply(simp) -apply(subst (asm) (2) val_ord_ex_def) -apply(erule exE) -apply(drule val_ord_ALTI2) -apply(assumption) -apply(auto simp add: val_ord_ex_def)[1] -apply(assumption) -apply(auto)[1] -apply(subgoal_tac "\v2'. flat v2' = flat v2 \ \ v2' : r1a") -apply(clarify) -apply(drule_tac x="Left v2'" in spec) -apply(simp) -apply(drule mp) -apply(rule Prf.intros) -apply(assumption) -apply(simp add: val_ord_ex_def) -apply(subst (asm) (3) val_ord_def) -apply(simp) -apply(simp add: pflat_len_simps) -apply(drule_tac x="[0]" in spec) -apply(simp add: pflat_len_simps Pos_empty) -apply(drule mp) -apply (smt inlen_bigger) -apply(erule disjE) -apply blast -apply auto[1] -apply (meson L_flat_Prf2) -(* SEQ *) -apply(auto simp add: CPT_def)[1] -apply(erule CPrf.cases) -apply(simp_all) -apply(rule Posix.intros) -apply(drule_tac x="flat v1a" in meta_spec) -apply(drule_tac x="v1a" in meta_spec) -apply(drule meta_mp) -apply(simp) -apply(drule meta_mp) -apply(auto)[1] -apply(auto simp add: PT_def)[1] -apply(drule_tac x="Seq v2a v2" in spec) -apply(simp) -apply(drule mp) -apply (simp add: Prf.intros(1) Prf_CPrf) -using val_ord_SEQI val_ord_ex_def apply fastforce -apply(assumption) -apply(rotate_tac 1) -apply(drule_tac x="flat v2" in meta_spec) -apply(drule_tac x="v2" in meta_spec) -apply(simp) -apply(auto)[1] -apply(drule meta_mp) -apply(auto)[1] -apply(auto simp add: PT_def)[1] -apply(drule_tac x="Seq v1a v2a" in spec) -apply(simp) -apply(drule mp) -apply (simp add: Prf.intros(1) Prf_CPrf) -apply (meson val_ord_SEQI2 val_ord_ex_def) -apply(assumption) -(* SEQ side condition *) -apply(auto simp add: PT_def) -apply(subgoal_tac "\vA. flat vA = flat v1a @ s\<^sub>3 \ \ vA : r1a") -prefer 2 -apply (meson L_flat_Prf2) -apply(subgoal_tac "\vB. flat vB = s\<^sub>4 \ \ vB : r2a") -prefer 2 -apply (meson L_flat_Prf2) -apply(clarify) -apply(drule_tac x="Seq vA vB" in spec) -apply(simp) -apply(drule mp) -apply (simp add: Prf.intros(1)) -apply(subst (asm) (3) val_ord_ex_def) -apply (metis append_Nil2 append_assoc append_eq_conv_conj flat.simps(5) length_append not_add_less1 not_less_iff_gr_or_eq val_ord_SEQI val_ord_ex_def val_ord_shorterI) -(* STAR *) -apply(auto simp add: CPT_def)[1] -apply(erule CPrf.cases) -apply(simp_all)[6] -using Posix_STAR2 apply blast -apply(clarify) -apply(rule val_ord_Posix_Stars) -apply(auto simp add: CPT_def)[1] -apply (simp add: CPrf.intros(7)) -apply(auto)[1] -apply(drule_tac x="flat v" in meta_spec) -apply(drule_tac x="v" in meta_spec) -apply(simp) -apply(drule meta_mp) -apply(auto)[1] -apply(drule_tac x="Stars (v2#vs)" in spec) -apply(simp) -apply(drule mp) -using Prf.intros(7) Prf_CPrf apply blast -apply(subst (asm) (2) val_ord_ex_def) -apply(simp) -using val_ord_STARI val_ord_ex_def apply fastforce -apply(assumption) -apply(drule_tac x="flat va" in meta_spec) -apply(drule_tac x="va" in meta_spec) -apply(simp) -apply(drule meta_mp) -using CPrf_stars apply blast -apply(drule meta_mp) -apply(auto)[1] -apply(subgoal_tac "\pre post. vs = pre @ [va] @ post") -prefer 2 -apply (metis append_Cons append_Nil in_set_conv_decomp_first) -apply(clarify) -apply(drule_tac x="Stars (v#(pre @ [v2] @ post))" in spec) -apply(simp) -apply(drule mp) -apply(rule Prf.intros) -apply (simp add: Prf_CPrf) -apply(rule Prf_Stars_append) -apply(drule CPrf_Stars_appendE) -apply(auto simp add: Prf_CPrf)[1] -apply (metis CPrf_Stars_appendE CPrf_stars Prf_CPrf Prf_Stars list.set_intros(2) set_ConsD) -apply(subgoal_tac "\ Stars ([v] @ pre @ v2 # post) :\val Stars ([v] @ pre @ va # post)") -apply(subst (asm) STAR_val_ord_ex_append_eq) -apply(simp) -apply(subst (asm) STAR_val_ord_ex_append_eq) -apply(simp) -prefer 2 -apply(simp) -prefer 2 -apply(simp) -apply(simp add: val_ord_ex_def) -apply(erule exE) -apply(rotate_tac 6) -apply(drule_tac x="0#p" in spec) -apply (simp add: val_ord_STARI) -apply(auto simp add: PT_def) -done - inductive ValOrd :: "val \ rexp \ val \ bool" ("_ \_ _" [100, 100, 100] 100) where C2: "v1 \r1 v1' \ (Seq v1 v2) \(SEQ r1 r2) (Seq v1' v2')" @@ -1926,123 +72,25 @@ lemma Posix_CPT2: - assumes "v1 \r v2" "flat v2 \pre flat v1" + assumes "v1 \r v2" "flat v2 \pre s" "flat v1 \pre s" shows "v1 :\val v2" using assms -apply(induct v1 r v2 arbitrary: rule: ValOrd.induct) -prefer 3 -apply(simp) -apply(auto simp add: prefix_sprefix)[1] -apply(rule val_ord_spre) -apply(simp) -prefer 3 -apply(simp) -apply(auto simp add: prefix_sprefix)[1] -apply(auto simp add: val_ord_ex_def)[1] -apply(rule_tac x="[0]" in exI) -apply(auto simp add: val_ord_def Pos_empty pflat_len_simps)[1] -apply (smt inlen_bigger) -apply(rule val_ord_spre) -apply(simp) -prefer 3 -apply(simp) -apply(auto simp add: prefix_sprefix)[1] -using val_ord_ALTI2 val_ord_ex_def apply fastforce -apply(rule val_ord_spre) -apply(simp) +apply(induct v1 r v2 arbitrary: s rule: ValOrd.induct) prefer 3 apply(simp) -apply(auto simp add: prefix_sprefix)[1] -using val_ord_ALTI val_ord_ex_def apply fastforce -apply(rule val_ord_spre) -apply(simp) -(* SEQ case *) -apply(simp) -apply(auto simp add: prefix_sprefix)[1] -apply(auto simp add: append_eq_append_conv2)[1] -apply(case_tac "us = []") -apply(simp) -apply(auto simp add: val_ord_ex1_def)[1] -apply (metis flat.simps(5) val_ord_SEQI val_ord_ex_def) -apply(simp) -prefer 2 -apply(case_tac "us = []") +apply(rule val_ord_shorterI) apply(simp) -apply (metis flat.simps(5) val_ord_SEQI val_ord_ex_def) -apply(drule meta_mp) -apply(rule disjI2) -apply (metis append_self_conv prefix_list_def sprefix_list_def) -apply(auto simp add: val_ord_ex_def)[1] -apply (metis append_assoc flat.simps(5) val_ord_SEQI) - -apply(sugoal_ tac "") -thm val_ord_SEQI -apply(rule val_ord_SEQI) -thm val_ord_SEQI -prefer 2 -apply(case_tac "us -apply(case_tac "v1 = v1'") -apply(simp) - -apply(auto simp add: val_ord_ex1_def)[1] -apply(auto simp add: val_ord_ex_def)[1] -apply(rule_tac x="[0]" in exI) - -prefer 2 -apply(rule val_ord_spre) -apply(simp) -prefer 3 -apply(simp) -using val_ord_ex1_def val_ord_spre apply auto[1] - -apply(erule disjE) -prefer 2 -apply(subst val_ord_ex1_def) -apply(rule disjI1) -apply(rule val_ord_spre) -apply(simp) +apply(subst (asm) (3) prefix_list_def) +apply(subst (asm) (3) prefix_list_def) +apply(clarify) apply(simp) apply(simp add: append_eq_append_conv2) apply(auto)[1] -apply(case_tac "us = []") +apply(drule_tac x="flat v1' @ flat v2' @ usa" in meta_spec) +apply(simp add: prefix_list_def) +apply(rule val_ord_SeqI1) apply(simp) -apply(drule meta_mp) -apply(auto simp add: prefix_sprefix)[1] -apply(subst (asm) val_ord_ex1_def) -apply(erule disjE) -apply(subst val_ord_ex1_def) -apply(rule disjI1) -apply (metis flat.simps(5) val_ord_SEQI val_ord_ex_def) -apply(clarify) -prefer 2 -apply(subgoal_tac "flat v1' \spre flat v1") -prefer 2 -apply (simp add: prefix_list_def sprefix_list_def) -apply(drule val_ord_spre) -apply(auto)[1] -apply(rule val_ord_sprefixI) -apply(erule ValOrd.cases) -apply(simp_all) -apply(erule ValOrd.cases) -apply(simp_all) -apply(erule ValOrd.cases) -apply(simp_all) -apply(erule ValOrd.cases) -apply(simp_all) -apply(clarify) -(* HERE *) apply(simp) -apply(subst val_ord_ex_def) -apply(simp) -apply(drule_tac x="v2a" in meta_spec) -apply(rotate_tac 5) -apply(drule_tac x="v2'" in meta_spec) -apply(rule_tac x="0#p" in exI) -apply(rule val_ord_SEQI) - -apply(drule_tac r="r1a" in val_ord_SEQ) -apply(simp) -apply(auto)[1] lemma Posix_CPT: