# HG changeset patch # User Christian Sternagel # Date 1346203676 -32400 # Node ID 154f25a162e335cc434116a7e20ef0e622910f0b # Parent 88fe93ae61cf202489a5be53ccf83c7fce3d1907 renamed theory List_Prefix into Sublist (since it is not only about prefixes) diff -r 88fe93ae61cf -r 154f25a162e3 src/HOL/Codatatype/BNF_Library.thy --- a/src/HOL/Codatatype/BNF_Library.thy Mon Sep 03 11:30:29 2012 +0200 +++ b/src/HOL/Codatatype/BNF_Library.thy Wed Aug 29 10:27:56 2012 +0900 @@ -8,7 +8,7 @@ header {* Library for Bounded Natural Functors *} theory BNF_Library -imports "../Ordinals_and_Cardinals/Cardinal_Arithmetic" "~~/src/HOL/Library/List_Prefix" +imports "../Ordinals_and_Cardinals/Cardinal_Arithmetic" "~~/src/HOL/Library/Sublist" Equiv_Relations_More begin @@ -634,7 +634,7 @@ shows "PROP P x y" by (rule `(\x y. PROP P x y)`) -(*Extended List_Prefix*) +(*Extended Sublist*) definition prefCl where "prefCl Kl = (\ kl1 kl2. kl1 \ kl2 \ kl2 \ Kl \ kl1 \ Kl)" diff -r 88fe93ae61cf -r 154f25a162e3 src/HOL/Codegenerator_Test/Candidates.thy --- a/src/HOL/Codegenerator_Test/Candidates.thy Mon Sep 03 11:30:29 2012 +0200 +++ b/src/HOL/Codegenerator_Test/Candidates.thy Wed Aug 29 10:27:56 2012 +0900 @@ -7,7 +7,7 @@ imports Complex_Main Library - "~~/src/HOL/Library/List_Prefix" + "~~/src/HOL/Library/Sublist" "~~/src/HOL/Number_Theory/Primes" "~~/src/HOL/ex/Records" begin diff -r 88fe93ae61cf -r 154f25a162e3 src/HOL/Library/List_Prefix.thy --- a/src/HOL/Library/List_Prefix.thy Mon Sep 03 11:30:29 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,382 +0,0 @@ -(* Title: HOL/Library/List_Prefix.thy - Author: Tobias Nipkow and Markus Wenzel, TU Muenchen -*) - -header {* List prefixes and postfixes *} - -theory List_Prefix -imports List Main -begin - -subsection {* Prefix order on lists *} - -instantiation list :: (type) "{order, bot}" -begin - -definition - prefix_def: "xs \ ys \ (\zs. ys = xs @ zs)" - -definition - strict_prefix_def: "xs < ys \ xs \ ys \ xs \ (ys::'a list)" - -definition - "bot = []" - -instance proof -qed (auto simp add: prefix_def strict_prefix_def bot_list_def) - -end - -lemma prefixI [intro?]: "ys = xs @ zs ==> xs \ ys" - unfolding prefix_def by blast - -lemma prefixE [elim?]: - assumes "xs \ ys" - obtains zs where "ys = xs @ zs" - using assms unfolding prefix_def by blast - -lemma strict_prefixI' [intro?]: "ys = xs @ z # zs ==> xs < ys" - unfolding strict_prefix_def prefix_def by blast - -lemma strict_prefixE' [elim?]: - assumes "xs < ys" - obtains z zs where "ys = xs @ z # zs" -proof - - from `xs < ys` obtain us where "ys = xs @ us" and "xs \ ys" - unfolding strict_prefix_def prefix_def by blast - with that show ?thesis by (auto simp add: neq_Nil_conv) -qed - -lemma strict_prefixI [intro?]: "xs \ ys ==> xs \ ys ==> xs < (ys::'a list)" - unfolding strict_prefix_def by blast - -lemma strict_prefixE [elim?]: - fixes xs ys :: "'a list" - assumes "xs < ys" - obtains "xs \ ys" and "xs \ ys" - using assms unfolding strict_prefix_def by blast - - -subsection {* Basic properties of prefixes *} - -theorem Nil_prefix [iff]: "[] \ xs" - by (simp add: prefix_def) - -theorem prefix_Nil [simp]: "(xs \ []) = (xs = [])" - by (induct xs) (simp_all add: prefix_def) - -lemma prefix_snoc [simp]: "(xs \ ys @ [y]) = (xs = ys @ [y] \ xs \ ys)" -proof - assume "xs \ ys @ [y]" - then obtain zs where zs: "ys @ [y] = xs @ zs" .. - show "xs = ys @ [y] \ xs \ ys" - by (metis append_Nil2 butlast_append butlast_snoc prefixI zs) -next - assume "xs = ys @ [y] \ xs \ ys" - then show "xs \ ys @ [y]" - by (metis order_eq_iff order_trans prefixI) -qed - -lemma Cons_prefix_Cons [simp]: "(x # xs \ y # ys) = (x = y \ xs \ ys)" - by (auto simp add: prefix_def) - -lemma less_eq_list_code [code]: - "([]\'a\{equal, ord} list) \ xs \ True" - "(x\'a\{equal, ord}) # xs \ [] \ False" - "(x\'a\{equal, ord}) # xs \ y # ys \ x = y \ xs \ ys" - by simp_all - -lemma same_prefix_prefix [simp]: "(xs @ ys \ xs @ zs) = (ys \ zs)" - by (induct xs) simp_all - -lemma same_prefix_nil [iff]: "(xs @ ys \ xs) = (ys = [])" - by (metis append_Nil2 append_self_conv order_eq_iff prefixI) - -lemma prefix_prefix [simp]: "xs \ ys ==> xs \ ys @ zs" - by (metis order_le_less_trans prefixI strict_prefixE strict_prefixI) - -lemma append_prefixD: "xs @ ys \ zs \ xs \ zs" - by (auto simp add: prefix_def) - -theorem prefix_Cons: "(xs \ y # ys) = (xs = [] \ (\zs. xs = y # zs \ zs \ ys))" - by (cases xs) (auto simp add: prefix_def) - -theorem prefix_append: - "(xs \ ys @ zs) = (xs \ ys \ (\us. xs = ys @ us \ us \ zs))" - apply (induct zs rule: rev_induct) - apply force - apply (simp del: append_assoc add: append_assoc [symmetric]) - apply (metis append_eq_appendI) - done - -lemma append_one_prefix: - "xs \ ys ==> length xs < length ys ==> xs @ [ys ! length xs] \ ys" - unfolding prefix_def - by (metis Cons_eq_appendI append_eq_appendI append_eq_conv_conj - eq_Nil_appendI nth_drop') - -theorem prefix_length_le: "xs \ ys ==> length xs \ length ys" - by (auto simp add: prefix_def) - -lemma prefix_same_cases: - "(xs\<^isub>1::'a list) \ ys \ xs\<^isub>2 \ ys \ xs\<^isub>1 \ xs\<^isub>2 \ xs\<^isub>2 \ xs\<^isub>1" - unfolding prefix_def by (metis append_eq_append_conv2) - -lemma set_mono_prefix: "xs \ ys \ set xs \ set ys" - by (auto simp add: prefix_def) - -lemma take_is_prefix: "take n xs \ xs" - unfolding prefix_def by (metis append_take_drop_id) - -lemma map_prefixI: "xs \ ys \ map f xs \ map f ys" - by (auto simp: prefix_def) - -lemma prefix_length_less: "xs < ys \ length xs < length ys" - by (auto simp: strict_prefix_def prefix_def) - -lemma strict_prefix_simps [simp, code]: - "xs < [] \ False" - "[] < x # xs \ True" - "x # xs < y # ys \ x = y \ xs < ys" - by (simp_all add: strict_prefix_def cong: conj_cong) - -lemma take_strict_prefix: "xs < ys \ take n xs < ys" - apply (induct n arbitrary: xs ys) - apply (case_tac ys, simp_all)[1] - apply (metis order_less_trans strict_prefixI take_is_prefix) - done - -lemma not_prefix_cases: - assumes pfx: "\ ps \ ls" - obtains - (c1) "ps \ []" and "ls = []" - | (c2) a as x xs where "ps = a#as" and "ls = x#xs" and "x = a" and "\ as \ xs" - | (c3) a as x xs where "ps = a#as" and "ls = x#xs" and "x \ a" -proof (cases ps) - case Nil then show ?thesis using pfx by simp -next - case (Cons a as) - note c = `ps = a#as` - show ?thesis - proof (cases ls) - case Nil then show ?thesis by (metis append_Nil2 pfx c1 same_prefix_nil) - next - case (Cons x xs) - show ?thesis - proof (cases "x = a") - case True - have "\ as \ xs" using pfx c Cons True by simp - with c Cons True show ?thesis by (rule c2) - next - case False - with c Cons show ?thesis by (rule c3) - qed - qed -qed - -lemma not_prefix_induct [consumes 1, case_names Nil Neq Eq]: - assumes np: "\ ps \ ls" - and base: "\x xs. P (x#xs) []" - and r1: "\x xs y ys. x \ y \ P (x#xs) (y#ys)" - and r2: "\x xs y ys. \ x = y; \ xs \ ys; P xs ys \ \ P (x#xs) (y#ys)" - shows "P ps ls" using np -proof (induct ls arbitrary: ps) - case Nil then show ?case - by (auto simp: neq_Nil_conv elim!: not_prefix_cases intro!: base) -next - case (Cons y ys) - then have npfx: "\ ps \ (y # ys)" by simp - then obtain x xs where pv: "ps = x # xs" - by (rule not_prefix_cases) auto - show ?case by (metis Cons.hyps Cons_prefix_Cons npfx pv r1 r2) -qed - - -subsection {* Parallel lists *} - -definition - parallel :: "'a list => 'a list => bool" (infixl "\" 50) where - "(xs \ ys) = (\ xs \ ys \ \ ys \ xs)" - -lemma parallelI [intro]: "\ xs \ ys ==> \ ys \ xs ==> xs \ ys" - unfolding parallel_def by blast - -lemma parallelE [elim]: - assumes "xs \ ys" - obtains "\ xs \ ys \ \ ys \ xs" - using assms unfolding parallel_def by blast - -theorem prefix_cases: - obtains "xs \ ys" | "ys < xs" | "xs \ ys" - unfolding parallel_def strict_prefix_def by blast - -theorem parallel_decomp: - "xs \ ys ==> \as b bs c cs. b \ c \ xs = as @ b # bs \ ys = as @ c # cs" -proof (induct xs rule: rev_induct) - case Nil - then have False by auto - then show ?case .. -next - case (snoc x xs) - show ?case - proof (rule prefix_cases) - assume le: "xs \ ys" - then obtain ys' where ys: "ys = xs @ ys'" .. - show ?thesis - proof (cases ys') - assume "ys' = []" - then show ?thesis by (metis append_Nil2 parallelE prefixI snoc.prems ys) - next - fix c cs assume ys': "ys' = c # cs" - then show ?thesis - by (metis Cons_eq_appendI eq_Nil_appendI parallelE prefixI - same_prefix_prefix snoc.prems ys) - qed - next - assume "ys < xs" then have "ys \ xs @ [x]" by (simp add: strict_prefix_def) - with snoc have False by blast - then show ?thesis .. - next - assume "xs \ ys" - with snoc obtain as b bs c cs where neq: "(b::'a) \ c" - and xs: "xs = as @ b # bs" and ys: "ys = as @ c # cs" - by blast - from xs have "xs @ [x] = as @ b # (bs @ [x])" by simp - with neq ys show ?thesis by blast - qed -qed - -lemma parallel_append: "a \ b \ a @ c \ b @ d" - apply (rule parallelI) - apply (erule parallelE, erule conjE, - induct rule: not_prefix_induct, simp+)+ - done - -lemma parallel_appendI: "xs \ ys \ x = xs @ xs' \ y = ys @ ys' \ x \ y" - by (simp add: parallel_append) - -lemma parallel_commute: "a \ b \ b \ a" - unfolding parallel_def by auto - - -subsection {* Postfix order on lists *} - -definition - postfix :: "'a list => 'a list => bool" ("(_/ >>= _)" [51, 50] 50) where - "(xs >>= ys) = (\zs. xs = zs @ ys)" - -lemma postfixI [intro?]: "xs = zs @ ys ==> xs >>= ys" - unfolding postfix_def by blast - -lemma postfixE [elim?]: - assumes "xs >>= ys" - obtains zs where "xs = zs @ ys" - using assms unfolding postfix_def by blast - -lemma postfix_refl [iff]: "xs >>= xs" - by (auto simp add: postfix_def) -lemma postfix_trans: "\xs >>= ys; ys >>= zs\ \ xs >>= zs" - by (auto simp add: postfix_def) -lemma postfix_antisym: "\xs >>= ys; ys >>= xs\ \ xs = ys" - by (auto simp add: postfix_def) - -lemma Nil_postfix [iff]: "xs >>= []" - by (simp add: postfix_def) -lemma postfix_Nil [simp]: "([] >>= xs) = (xs = [])" - by (auto simp add: postfix_def) - -lemma postfix_ConsI: "xs >>= ys \ x#xs >>= ys" - by (auto simp add: postfix_def) -lemma postfix_ConsD: "xs >>= y#ys \ xs >>= ys" - by (auto simp add: postfix_def) - -lemma postfix_appendI: "xs >>= ys \ zs @ xs >>= ys" - by (auto simp add: postfix_def) -lemma postfix_appendD: "xs >>= zs @ ys \ xs >>= ys" - by (auto simp add: postfix_def) - -lemma postfix_is_subset: "xs >>= ys ==> set ys \ set xs" -proof - - assume "xs >>= ys" - then obtain zs where "xs = zs @ ys" .. - then show ?thesis by (induct zs) auto -qed - -lemma postfix_ConsD2: "x#xs >>= y#ys ==> xs >>= ys" -proof - - assume "x#xs >>= y#ys" - then obtain zs where "x#xs = zs @ y#ys" .. - then show ?thesis - by (induct zs) (auto intro!: postfix_appendI postfix_ConsI) -qed - -lemma postfix_to_prefix [code]: "xs >>= ys \ rev ys \ rev xs" -proof - assume "xs >>= ys" - then obtain zs where "xs = zs @ ys" .. - then have "rev xs = rev ys @ rev zs" by simp - then show "rev ys <= rev xs" .. -next - assume "rev ys <= rev xs" - then obtain zs where "rev xs = rev ys @ zs" .. - then have "rev (rev xs) = rev zs @ rev (rev ys)" by simp - then have "xs = rev zs @ ys" by simp - then show "xs >>= ys" .. -qed - -lemma distinct_postfix: "distinct xs \ xs >>= ys \ distinct ys" - by (clarsimp elim!: postfixE) - -lemma postfix_map: "xs >>= ys \ map f xs >>= map f ys" - by (auto elim!: postfixE intro: postfixI) - -lemma postfix_drop: "as >>= drop n as" - unfolding postfix_def - apply (rule exI [where x = "take n as"]) - apply simp - done - -lemma postfix_take: "xs >>= ys \ xs = take (length xs - length ys) xs @ ys" - by (clarsimp elim!: postfixE) - -lemma parallelD1: "x \ y \ \ x \ y" - by blast - -lemma parallelD2: "x \ y \ \ y \ x" - by blast - -lemma parallel_Nil1 [simp]: "\ x \ []" - unfolding parallel_def by simp - -lemma parallel_Nil2 [simp]: "\ [] \ x" - unfolding parallel_def by simp - -lemma Cons_parallelI1: "a \ b \ a # as \ b # bs" - by auto - -lemma Cons_parallelI2: "\ a = b; as \ bs \ \ a # as \ b # bs" - by (metis Cons_prefix_Cons parallelE parallelI) - -lemma not_equal_is_parallel: - assumes neq: "xs \ ys" - and len: "length xs = length ys" - shows "xs \ ys" - using len neq -proof (induct rule: list_induct2) - case Nil - then show ?case by simp -next - case (Cons a as b bs) - have ih: "as \ bs \ as \ bs" by fact - show ?case - proof (cases "a = b") - case True - then have "as \ bs" using Cons by simp - then show ?thesis by (rule Cons_parallelI2 [OF True ih]) - next - case False - then show ?thesis by (rule Cons_parallelI1) - qed -qed - -end diff -r 88fe93ae61cf -r 154f25a162e3 src/HOL/Library/Sublist.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Library/Sublist.thy Wed Aug 29 10:27:56 2012 +0900 @@ -0,0 +1,382 @@ +(* Title: HOL/Library/Sublist.thy + Author: Tobias Nipkow and Markus Wenzel, TU Muenchen +*) + +header {* List prefixes and postfixes *} + +theory Sublist +imports List Main +begin + +subsection {* Prefix order on lists *} + +instantiation list :: (type) "{order, bot}" +begin + +definition + prefix_def: "xs \ ys \ (\zs. ys = xs @ zs)" + +definition + strict_prefix_def: "xs < ys \ xs \ ys \ xs \ (ys::'a list)" + +definition + "bot = []" + +instance proof +qed (auto simp add: prefix_def strict_prefix_def bot_list_def) + +end + +lemma prefixI [intro?]: "ys = xs @ zs ==> xs \ ys" + unfolding prefix_def by blast + +lemma prefixE [elim?]: + assumes "xs \ ys" + obtains zs where "ys = xs @ zs" + using assms unfolding prefix_def by blast + +lemma strict_prefixI' [intro?]: "ys = xs @ z # zs ==> xs < ys" + unfolding strict_prefix_def prefix_def by blast + +lemma strict_prefixE' [elim?]: + assumes "xs < ys" + obtains z zs where "ys = xs @ z # zs" +proof - + from `xs < ys` obtain us where "ys = xs @ us" and "xs \ ys" + unfolding strict_prefix_def prefix_def by blast + with that show ?thesis by (auto simp add: neq_Nil_conv) +qed + +lemma strict_prefixI [intro?]: "xs \ ys ==> xs \ ys ==> xs < (ys::'a list)" + unfolding strict_prefix_def by blast + +lemma strict_prefixE [elim?]: + fixes xs ys :: "'a list" + assumes "xs < ys" + obtains "xs \ ys" and "xs \ ys" + using assms unfolding strict_prefix_def by blast + + +subsection {* Basic properties of prefixes *} + +theorem Nil_prefix [iff]: "[] \ xs" + by (simp add: prefix_def) + +theorem prefix_Nil [simp]: "(xs \ []) = (xs = [])" + by (induct xs) (simp_all add: prefix_def) + +lemma prefix_snoc [simp]: "(xs \ ys @ [y]) = (xs = ys @ [y] \ xs \ ys)" +proof + assume "xs \ ys @ [y]" + then obtain zs where zs: "ys @ [y] = xs @ zs" .. + show "xs = ys @ [y] \ xs \ ys" + by (metis append_Nil2 butlast_append butlast_snoc prefixI zs) +next + assume "xs = ys @ [y] \ xs \ ys" + then show "xs \ ys @ [y]" + by (metis order_eq_iff order_trans prefixI) +qed + +lemma Cons_prefix_Cons [simp]: "(x # xs \ y # ys) = (x = y \ xs \ ys)" + by (auto simp add: prefix_def) + +lemma less_eq_list_code [code]: + "([]\'a\{equal, ord} list) \ xs \ True" + "(x\'a\{equal, ord}) # xs \ [] \ False" + "(x\'a\{equal, ord}) # xs \ y # ys \ x = y \ xs \ ys" + by simp_all + +lemma same_prefix_prefix [simp]: "(xs @ ys \ xs @ zs) = (ys \ zs)" + by (induct xs) simp_all + +lemma same_prefix_nil [iff]: "(xs @ ys \ xs) = (ys = [])" + by (metis append_Nil2 append_self_conv order_eq_iff prefixI) + +lemma prefix_prefix [simp]: "xs \ ys ==> xs \ ys @ zs" + by (metis order_le_less_trans prefixI strict_prefixE strict_prefixI) + +lemma append_prefixD: "xs @ ys \ zs \ xs \ zs" + by (auto simp add: prefix_def) + +theorem prefix_Cons: "(xs \ y # ys) = (xs = [] \ (\zs. xs = y # zs \ zs \ ys))" + by (cases xs) (auto simp add: prefix_def) + +theorem prefix_append: + "(xs \ ys @ zs) = (xs \ ys \ (\us. xs = ys @ us \ us \ zs))" + apply (induct zs rule: rev_induct) + apply force + apply (simp del: append_assoc add: append_assoc [symmetric]) + apply (metis append_eq_appendI) + done + +lemma append_one_prefix: + "xs \ ys ==> length xs < length ys ==> xs @ [ys ! length xs] \ ys" + unfolding prefix_def + by (metis Cons_eq_appendI append_eq_appendI append_eq_conv_conj + eq_Nil_appendI nth_drop') + +theorem prefix_length_le: "xs \ ys ==> length xs \ length ys" + by (auto simp add: prefix_def) + +lemma prefix_same_cases: + "(xs\<^isub>1::'a list) \ ys \ xs\<^isub>2 \ ys \ xs\<^isub>1 \ xs\<^isub>2 \ xs\<^isub>2 \ xs\<^isub>1" + unfolding prefix_def by (metis append_eq_append_conv2) + +lemma set_mono_prefix: "xs \ ys \ set xs \ set ys" + by (auto simp add: prefix_def) + +lemma take_is_prefix: "take n xs \ xs" + unfolding prefix_def by (metis append_take_drop_id) + +lemma map_prefixI: "xs \ ys \ map f xs \ map f ys" + by (auto simp: prefix_def) + +lemma prefix_length_less: "xs < ys \ length xs < length ys" + by (auto simp: strict_prefix_def prefix_def) + +lemma strict_prefix_simps [simp, code]: + "xs < [] \ False" + "[] < x # xs \ True" + "x # xs < y # ys \ x = y \ xs < ys" + by (simp_all add: strict_prefix_def cong: conj_cong) + +lemma take_strict_prefix: "xs < ys \ take n xs < ys" + apply (induct n arbitrary: xs ys) + apply (case_tac ys, simp_all)[1] + apply (metis order_less_trans strict_prefixI take_is_prefix) + done + +lemma not_prefix_cases: + assumes pfx: "\ ps \ ls" + obtains + (c1) "ps \ []" and "ls = []" + | (c2) a as x xs where "ps = a#as" and "ls = x#xs" and "x = a" and "\ as \ xs" + | (c3) a as x xs where "ps = a#as" and "ls = x#xs" and "x \ a" +proof (cases ps) + case Nil then show ?thesis using pfx by simp +next + case (Cons a as) + note c = `ps = a#as` + show ?thesis + proof (cases ls) + case Nil then show ?thesis by (metis append_Nil2 pfx c1 same_prefix_nil) + next + case (Cons x xs) + show ?thesis + proof (cases "x = a") + case True + have "\ as \ xs" using pfx c Cons True by simp + with c Cons True show ?thesis by (rule c2) + next + case False + with c Cons show ?thesis by (rule c3) + qed + qed +qed + +lemma not_prefix_induct [consumes 1, case_names Nil Neq Eq]: + assumes np: "\ ps \ ls" + and base: "\x xs. P (x#xs) []" + and r1: "\x xs y ys. x \ y \ P (x#xs) (y#ys)" + and r2: "\x xs y ys. \ x = y; \ xs \ ys; P xs ys \ \ P (x#xs) (y#ys)" + shows "P ps ls" using np +proof (induct ls arbitrary: ps) + case Nil then show ?case + by (auto simp: neq_Nil_conv elim!: not_prefix_cases intro!: base) +next + case (Cons y ys) + then have npfx: "\ ps \ (y # ys)" by simp + then obtain x xs where pv: "ps = x # xs" + by (rule not_prefix_cases) auto + show ?case by (metis Cons.hyps Cons_prefix_Cons npfx pv r1 r2) +qed + + +subsection {* Parallel lists *} + +definition + parallel :: "'a list => 'a list => bool" (infixl "\" 50) where + "(xs \ ys) = (\ xs \ ys \ \ ys \ xs)" + +lemma parallelI [intro]: "\ xs \ ys ==> \ ys \ xs ==> xs \ ys" + unfolding parallel_def by blast + +lemma parallelE [elim]: + assumes "xs \ ys" + obtains "\ xs \ ys \ \ ys \ xs" + using assms unfolding parallel_def by blast + +theorem prefix_cases: + obtains "xs \ ys" | "ys < xs" | "xs \ ys" + unfolding parallel_def strict_prefix_def by blast + +theorem parallel_decomp: + "xs \ ys ==> \as b bs c cs. b \ c \ xs = as @ b # bs \ ys = as @ c # cs" +proof (induct xs rule: rev_induct) + case Nil + then have False by auto + then show ?case .. +next + case (snoc x xs) + show ?case + proof (rule prefix_cases) + assume le: "xs \ ys" + then obtain ys' where ys: "ys = xs @ ys'" .. + show ?thesis + proof (cases ys') + assume "ys' = []" + then show ?thesis by (metis append_Nil2 parallelE prefixI snoc.prems ys) + next + fix c cs assume ys': "ys' = c # cs" + then show ?thesis + by (metis Cons_eq_appendI eq_Nil_appendI parallelE prefixI + same_prefix_prefix snoc.prems ys) + qed + next + assume "ys < xs" then have "ys \ xs @ [x]" by (simp add: strict_prefix_def) + with snoc have False by blast + then show ?thesis .. + next + assume "xs \ ys" + with snoc obtain as b bs c cs where neq: "(b::'a) \ c" + and xs: "xs = as @ b # bs" and ys: "ys = as @ c # cs" + by blast + from xs have "xs @ [x] = as @ b # (bs @ [x])" by simp + with neq ys show ?thesis by blast + qed +qed + +lemma parallel_append: "a \ b \ a @ c \ b @ d" + apply (rule parallelI) + apply (erule parallelE, erule conjE, + induct rule: not_prefix_induct, simp+)+ + done + +lemma parallel_appendI: "xs \ ys \ x = xs @ xs' \ y = ys @ ys' \ x \ y" + by (simp add: parallel_append) + +lemma parallel_commute: "a \ b \ b \ a" + unfolding parallel_def by auto + + +subsection {* Postfix order on lists *} + +definition + postfix :: "'a list => 'a list => bool" ("(_/ >>= _)" [51, 50] 50) where + "(xs >>= ys) = (\zs. xs = zs @ ys)" + +lemma postfixI [intro?]: "xs = zs @ ys ==> xs >>= ys" + unfolding postfix_def by blast + +lemma postfixE [elim?]: + assumes "xs >>= ys" + obtains zs where "xs = zs @ ys" + using assms unfolding postfix_def by blast + +lemma postfix_refl [iff]: "xs >>= xs" + by (auto simp add: postfix_def) +lemma postfix_trans: "\xs >>= ys; ys >>= zs\ \ xs >>= zs" + by (auto simp add: postfix_def) +lemma postfix_antisym: "\xs >>= ys; ys >>= xs\ \ xs = ys" + by (auto simp add: postfix_def) + +lemma Nil_postfix [iff]: "xs >>= []" + by (simp add: postfix_def) +lemma postfix_Nil [simp]: "([] >>= xs) = (xs = [])" + by (auto simp add: postfix_def) + +lemma postfix_ConsI: "xs >>= ys \ x#xs >>= ys" + by (auto simp add: postfix_def) +lemma postfix_ConsD: "xs >>= y#ys \ xs >>= ys" + by (auto simp add: postfix_def) + +lemma postfix_appendI: "xs >>= ys \ zs @ xs >>= ys" + by (auto simp add: postfix_def) +lemma postfix_appendD: "xs >>= zs @ ys \ xs >>= ys" + by (auto simp add: postfix_def) + +lemma postfix_is_subset: "xs >>= ys ==> set ys \ set xs" +proof - + assume "xs >>= ys" + then obtain zs where "xs = zs @ ys" .. + then show ?thesis by (induct zs) auto +qed + +lemma postfix_ConsD2: "x#xs >>= y#ys ==> xs >>= ys" +proof - + assume "x#xs >>= y#ys" + then obtain zs where "x#xs = zs @ y#ys" .. + then show ?thesis + by (induct zs) (auto intro!: postfix_appendI postfix_ConsI) +qed + +lemma postfix_to_prefix [code]: "xs >>= ys \ rev ys \ rev xs" +proof + assume "xs >>= ys" + then obtain zs where "xs = zs @ ys" .. + then have "rev xs = rev ys @ rev zs" by simp + then show "rev ys <= rev xs" .. +next + assume "rev ys <= rev xs" + then obtain zs where "rev xs = rev ys @ zs" .. + then have "rev (rev xs) = rev zs @ rev (rev ys)" by simp + then have "xs = rev zs @ ys" by simp + then show "xs >>= ys" .. +qed + +lemma distinct_postfix: "distinct xs \ xs >>= ys \ distinct ys" + by (clarsimp elim!: postfixE) + +lemma postfix_map: "xs >>= ys \ map f xs >>= map f ys" + by (auto elim!: postfixE intro: postfixI) + +lemma postfix_drop: "as >>= drop n as" + unfolding postfix_def + apply (rule exI [where x = "take n as"]) + apply simp + done + +lemma postfix_take: "xs >>= ys \ xs = take (length xs - length ys) xs @ ys" + by (clarsimp elim!: postfixE) + +lemma parallelD1: "x \ y \ \ x \ y" + by blast + +lemma parallelD2: "x \ y \ \ y \ x" + by blast + +lemma parallel_Nil1 [simp]: "\ x \ []" + unfolding parallel_def by simp + +lemma parallel_Nil2 [simp]: "\ [] \ x" + unfolding parallel_def by simp + +lemma Cons_parallelI1: "a \ b \ a # as \ b # bs" + by auto + +lemma Cons_parallelI2: "\ a = b; as \ bs \ \ a # as \ b # bs" + by (metis Cons_prefix_Cons parallelE parallelI) + +lemma not_equal_is_parallel: + assumes neq: "xs \ ys" + and len: "length xs = length ys" + shows "xs \ ys" + using len neq +proof (induct rule: list_induct2) + case Nil + then show ?case by simp +next + case (Cons a as b bs) + have ih: "as \ bs \ as \ bs" by fact + show ?case + proof (cases "a = b") + case True + then have "as \ bs" using Cons by simp + then show ?thesis by (rule Cons_parallelI2 [OF True ih]) + next + case False + then show ?thesis by (rule Cons_parallelI1) + qed +qed + +end diff -r 88fe93ae61cf -r 154f25a162e3 src/HOL/ROOT --- a/src/HOL/ROOT Mon Sep 03 11:30:29 2012 +0200 +++ b/src/HOL/ROOT Wed Aug 29 10:27:56 2012 +0900 @@ -38,7 +38,7 @@ description {* Classical Higher-order Logic -- batteries included *} theories Library - List_Prefix + Sublist List_lexord Sublist_Order Product_Lattice diff -r 88fe93ae61cf -r 154f25a162e3 src/HOL/Unix/Unix.thy --- a/src/HOL/Unix/Unix.thy Mon Sep 03 11:30:29 2012 +0200 +++ b/src/HOL/Unix/Unix.thy Wed Aug 29 10:27:56 2012 +0900 @@ -7,7 +7,7 @@ theory Unix imports Nested_Environment - "~~/src/HOL/Library/List_Prefix" + "~~/src/HOL/Library/Sublist" begin text {*