# HG changeset patch # User haftmann # Date 1275665550 -7200 # Node ID 381b391351b5470b94b9514f67fe03bfdff4859b # Parent 5164c4ec787b228586866a78e38b4b6c0286396e avoid flowerish abbreviation diff -r 5164c4ec787b -r 381b391351b5 src/HOL/Extraction/Euclid.thy --- a/src/HOL/Extraction/Euclid.thy Fri Jun 04 16:42:26 2010 +0200 +++ b/src/HOL/Extraction/Euclid.thy Fri Jun 04 17:32:30 2010 +0200 @@ -123,18 +123,25 @@ lemma dvd_prod [iff]: "n dvd (PROD m\nat:#multiset_of (n # ns). m)" by (simp add: msetprod_Un msetprod_singleton) -abbreviation (input) "primel ps \ (\(p::nat)\set ps. prime p)" +definition all_prime :: "nat list \ bool" where + "all_prime ps \ (\p\set ps. prime p)" + +lemma all_prime_simps: + "all_prime []" + "all_prime (p # ps) \ prime p \ all_prime ps" + by (simp_all add: all_prime_def) -lemma prime_primel: "prime n \ primel [n]" - by simp +lemma all_prime_append: + "all_prime (ps @ qs) \ all_prime ps \ all_prime qs" + by (simp add: all_prime_def ball_Un) -lemma split_primel: - assumes "primel ms" and "primel ns" - shows "\qs. primel qs \ (PROD m\nat:#multiset_of qs. m) = +lemma split_all_prime: + assumes "all_prime ms" and "all_prime ns" + shows "\qs. all_prime qs \ (PROD m\nat:#multiset_of qs. m) = (PROD m\nat:#multiset_of ms. m) * (PROD m\nat:#multiset_of ns. m)" (is "\qs. ?P qs \ ?Q qs") proof - - from assms have "primel (ms @ ns)" - unfolding set_append ball_Un by iprover + from assms have "all_prime (ms @ ns)" + by (simp add: all_prime_append) moreover from assms have "(PROD m\nat:#multiset_of (ms @ ns). m) = (PROD m\nat:#multiset_of ms. m) * (PROD m\nat:#multiset_of ns. m)" by (simp add: msetprod_Un) @@ -142,13 +149,13 @@ then show ?thesis .. qed -lemma primel_nempty_g_one: - assumes "primel ps" and "ps \ []" +lemma all_prime_nempty_g_one: + assumes "all_prime ps" and "ps \ []" shows "Suc 0 < (PROD m\nat:#multiset_of ps. m)" - using `ps \ []` `primel ps` unfolding One_nat_def [symmetric] by (induct ps rule: list_nonempty_induct) - (simp_all add: msetprod_singleton msetprod_Un prime_gt_1_nat less_1_mult del: One_nat_def) + using `ps \ []` `all_prime ps` unfolding One_nat_def [symmetric] by (induct ps rule: list_nonempty_induct) + (simp_all add: all_prime_simps msetprod_singleton msetprod_Un prime_gt_1_nat less_1_mult del: One_nat_def) -lemma factor_exists: "Suc 0 < n \ (\l. primel l \ (PROD m\nat:#multiset_of l. m) = n)" +lemma factor_exists: "Suc 0 < n \ (\ps. all_prime ps \ (PROD m\nat:#multiset_of ps. m) = n)" proof (induct n rule: nat_wf_ind) case (1 n) from `Suc 0 < n` @@ -159,21 +166,21 @@ assume "\m k. Suc 0 < m \ Suc 0 < k \ m < n \ k < n \ n = m * k" then obtain m k where m: "Suc 0 < m" and k: "Suc 0 < k" and mn: "m < n" and kn: "k < n" and nmk: "n = m * k" by iprover - from mn and m have "\l. primel l \ (PROD m\nat:#multiset_of l. m) = m" by (rule 1) - then obtain l1 where primel_l1: "primel l1" and prod_l1_m: "(PROD m\nat:#multiset_of l1. m) = m" + from mn and m have "\ps. all_prime ps \ (PROD m\nat:#multiset_of ps. m) = m" by (rule 1) + then obtain ps1 where "all_prime ps1" and prod_ps1_m: "(PROD m\nat:#multiset_of ps1. m) = m" by iprover - from kn and k have "\l. primel l \ (PROD m\nat:#multiset_of l. m) = k" by (rule 1) - then obtain l2 where primel_l2: "primel l2" and prod_l2_k: "(PROD m\nat:#multiset_of l2. m) = k" + from kn and k have "\ps. all_prime ps \ (PROD m\nat:#multiset_of ps. m) = k" by (rule 1) + then obtain ps2 where "all_prime ps2" and prod_ps2_k: "(PROD m\nat:#multiset_of ps2. m) = k" by iprover - from primel_l1 primel_l2 - have "\l. primel l \ (PROD m\nat:#multiset_of l. m) = - (PROD m\nat:#multiset_of l1. m) * (PROD m\nat:#multiset_of l2. m)" - by (rule split_primel) - with prod_l1_m prod_l2_k nmk show ?thesis by simp + from `all_prime ps1` `all_prime ps2` + have "\ps. all_prime ps \ (PROD m\nat:#multiset_of ps. m) = + (PROD m\nat:#multiset_of ps1. m) * (PROD m\nat:#multiset_of ps2. m)" + by (rule split_all_prime) + with prod_ps1_m prod_ps2_k nmk show ?thesis by simp next - assume "prime n" then have "primel [n]" by (rule prime_primel) + assume "prime n" then have "all_prime [n]" by (simp add: all_prime_simps) moreover have "(PROD m\nat:#multiset_of [n]. m) = n" by (simp add: msetprod_singleton) - ultimately have "primel [n] \ (PROD m\nat:#multiset_of [n]. m) = n" .. + ultimately have "all_prime [n] \ (PROD m\nat:#multiset_of [n]. m) = n" .. then show ?thesis .. qed qed @@ -182,17 +189,15 @@ assumes N: "(1::nat) < n" shows "\p. prime p \ p dvd n" proof - - from N obtain l where primel_l: "primel l" - and prod_l: "n = (PROD m\nat:#multiset_of l. m)" using factor_exists + from N obtain ps where "all_prime ps" + and prod_ps: "n = (PROD m\nat:#multiset_of ps. m)" using factor_exists by simp iprover - with N have "l \ []" - by (auto simp add: primel_nempty_g_one msetprod_empty) - then obtain x xs where l: "l = x # xs" - by (cases l) simp - then have "x \ set l" by (simp only: insert_def set.simps) (iprover intro: UnI1 CollectI) - with primel_l have "prime x" .. - moreover from primel_l l prod_l - have "x dvd n" by (simp only: dvd_prod) + with N have "ps \ []" + by (auto simp add: all_prime_nempty_g_one msetprod_empty) + then obtain p qs where ps: "ps = p # qs" by (cases ps) simp + with `all_prime ps` have "prime p" by (simp add: all_prime_simps) + moreover from `all_prime ps` ps prod_ps + have "p dvd n" by (simp only: dvd_prod) ultimately show ?thesis by iprover qed