merged
authorpaulson
Thu, 26 Feb 2009 11:21:29 +0000
changeset 30100 e1c714d33c5c
parent 30098 896fed07349e (diff)
parent 30099 dde11464969c (current diff)
child 30101 5c6efec476ae
child 30104 b094999e1d33
merged
--- a/NEWS	Thu Feb 26 11:18:40 2009 +0000
+++ b/NEWS	Thu Feb 26 11:21:29 2009 +0000
@@ -367,6 +367,50 @@
     mult_div ~>             div_mult_self2_is_id
     mult_mod ~>             mod_mult_self2_is_0
 
+* HOL/IntDiv: removed most (all?) lemmas that are instances of class-based
+generalizations (from Divides and Ring_and_Field).
+INCOMPATIBILITY. Rename old lemmas as follows:
+
+dvd_diff               -> nat_dvd_diff
+dvd_zminus_iff         -> dvd_minus_iff
+nat_mod_add_left_eq    -> mod_add_left_eq
+nat_mod_add_right_eq   -> mod_add_right_eq
+nat_mod_div_trivial    -> mod_div_trivial
+nat_mod_mod_trivial    -> mod_mod_trivial
+zdiv_zadd_self1        -> div_add_self1
+zdiv_zadd_self2        -> div_add_self2
+zdiv_zmult_self2       -> div_mult_self1_is_id
+zdvd_triv_left         -> dvd_triv_left
+zdvd_triv_right        -> dvd_triv_right
+zdvd_zmult_cancel_disj -> dvd_mult_cancel_left
+zmod_eq0_zdvd_iff      -> dvd_eq_mod_eq_0[symmetric]
+zmod_zadd_left_eq      -> mod_add_left_eq
+zmod_zadd_right_eq     -> mod_add_right_eq
+zmod_zadd_self1        -> mod_add_self1
+zmod_zadd_self2        -> mod_add_self2
+zmod_zdiff1_eq         -> mod_diff_eq
+zmod_zdvd_zmod         -> mod_mod_cancel
+zmod_zmod_cancel       -> mod_mod_cancel
+zmod_zmult_self1       -> mod_mult_self2_is_0
+zmod_zmult_self2       -> mod_mult_self1_is_0
+zmod_1                 -> mod_by_1
+zdiv_1                 -> div_by_1
+zdvd_abs1              -> abs_dvd_iff
+zdvd_abs2              -> dvd_abs_iff
+zdvd_refl              -> dvd_refl
+zdvd_trans             -> dvd_trans
+zdvd_zadd              -> dvd_add
+zdvd_zdiff             -> dvd_diff
+zdvd_zminus_iff        -> dvd_minus_iff
+zdvd_zminus2_iff       -> minus_dvd_iff
+zdvd_zmultD            -> dvd_mult_right
+zdvd_zmultD2           -> dvd_mult_left
+zdvd_zmult_mono        -> mult_dvd_mono
+zdvd_0_right           -> dvd_0_right
+zdvd_0_left            -> dvd_0_left_iff
+zdvd_1_left            -> one_dvd
+zminus_dvd_iff         -> minus_dvd_iff
+
 * HOL/Library/GCD: Curried operations gcd, lcm (for nat) and zgcd,
 zlcm (for int); carried together from various gcd/lcm developements in
 the HOL Distribution.  zgcd and zlcm replace former igcd and ilcm;
--- a/src/HOL/Algebra/Exponent.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Algebra/Exponent.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -210,12 +210,12 @@
 
 lemma p_fac_forw: "[| (m::nat) > 0; k>0; k < p^a; (p^r) dvd (p^a)* m - k |]  
   ==> (p^r) dvd (p^a) - k"
-apply (frule_tac k1 = k and i = p in p_fac_forw_lemma [THEN le_imp_power_dvd], auto)
+apply (frule p_fac_forw_lemma [THEN le_imp_power_dvd, of _ k p], auto)
 apply (subgoal_tac "p^r dvd p^a*m")
  prefer 2 apply (blast intro: dvd_mult2)
 apply (drule dvd_diffD1)
   apply assumption
- prefer 2 apply (blast intro: dvd_diff)
+ prefer 2 apply (blast intro: nat_dvd_diff)
 apply (drule gr0_implies_Suc, auto)
 done
 
@@ -226,12 +226,12 @@
 
 lemma p_fac_backw: "[| m>0; k>0; (p::nat)\<noteq>0;  k < p^a;  (p^r) dvd p^a - k |]  
   ==> (p^r) dvd (p^a)*m - k"
-apply (frule_tac k1 = k and i = p in r_le_a_forw [THEN le_imp_power_dvd], auto)
+apply (frule_tac k1 = k and p1 = p in r_le_a_forw [THEN le_imp_power_dvd], auto)
 apply (subgoal_tac "p^r dvd p^a*m")
  prefer 2 apply (blast intro: dvd_mult2)
 apply (drule dvd_diffD1)
   apply assumption
- prefer 2 apply (blast intro: dvd_diff)
+ prefer 2 apply (blast intro: nat_dvd_diff)
 apply (drule less_imp_Suc_add, auto)
 done
 
--- a/src/HOL/Algebra/IntRing.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Algebra/IntRing.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -407,7 +407,7 @@
 
   hence "b mod m = (x * m + a) mod m" by simp
   also
-      have "\<dots> = ((x * m) mod m) + (a mod m)" by (simp add: zmod_zadd1_eq)
+      have "\<dots> = ((x * m) mod m) + (a mod m)" by (simp add: mod_add_eq)
   also
       have "\<dots> = a mod m" by simp
   finally
--- a/src/HOL/Algebra/poly/UnivPoly2.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Algebra/poly/UnivPoly2.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -1,6 +1,5 @@
 (*
   Title:     Univariate Polynomials
-  Id:        $Id$
   Author:    Clemens Ballarin, started 9 December 1996
   Copyright: Clemens Ballarin
 *)
@@ -388,7 +387,7 @@
   proof (cases k)
     case 0 then show ?thesis by simp ring
   next
-    case Suc then show ?thesis by (simp add: algebra_simps) ring
+    case Suc then show ?thesis by simp (ring, simp)
   qed
   then show "coeff (monom a 0 * p) k = coeff (a *s p) k" by ring
 qed
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Archimedean_Field.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -0,0 +1,400 @@
+(* Title:      Archimedean_Field.thy
+   Author:     Brian Huffman
+*)
+
+header {* Archimedean Fields, Floor and Ceiling Functions *}
+
+theory Archimedean_Field
+imports Main
+begin
+
+subsection {* Class of Archimedean fields *}
+
+text {* Archimedean fields have no infinite elements. *}
+
+class archimedean_field = ordered_field + number_ring +
+  assumes ex_le_of_int: "\<exists>z. x \<le> of_int z"
+
+lemma ex_less_of_int:
+  fixes x :: "'a::archimedean_field" shows "\<exists>z. x < of_int z"
+proof -
+  from ex_le_of_int obtain z where "x \<le> of_int z" ..
+  then have "x < of_int (z + 1)" by simp
+  then show ?thesis ..
+qed
+
+lemma ex_of_int_less:
+  fixes x :: "'a::archimedean_field" shows "\<exists>z. of_int z < x"
+proof -
+  from ex_less_of_int obtain z where "- x < of_int z" ..
+  then have "of_int (- z) < x" by simp
+  then show ?thesis ..
+qed
+
+lemma ex_less_of_nat:
+  fixes x :: "'a::archimedean_field" shows "\<exists>n. x < of_nat n"
+proof -
+  obtain z where "x < of_int z" using ex_less_of_int ..
+  also have "\<dots> \<le> of_int (int (nat z))" by simp
+  also have "\<dots> = of_nat (nat z)" by (simp only: of_int_of_nat_eq)
+  finally show ?thesis ..
+qed
+
+lemma ex_le_of_nat:
+  fixes x :: "'a::archimedean_field" shows "\<exists>n. x \<le> of_nat n"
+proof -
+  obtain n where "x < of_nat n" using ex_less_of_nat ..
+  then have "x \<le> of_nat n" by simp
+  then show ?thesis ..
+qed
+
+text {* Archimedean fields have no infinitesimal elements. *}
+
+lemma ex_inverse_of_nat_Suc_less:
+  fixes x :: "'a::archimedean_field"
+  assumes "0 < x" shows "\<exists>n. inverse (of_nat (Suc n)) < x"
+proof -
+  from `0 < x` have "0 < inverse x"
+    by (rule positive_imp_inverse_positive)
+  obtain n where "inverse x < of_nat n"
+    using ex_less_of_nat ..
+  then obtain m where "inverse x < of_nat (Suc m)"
+    using `0 < inverse x` by (cases n) (simp_all del: of_nat_Suc)
+  then have "inverse (of_nat (Suc m)) < inverse (inverse x)"
+    using `0 < inverse x` by (rule less_imp_inverse_less)
+  then have "inverse (of_nat (Suc m)) < x"
+    using `0 < x` by (simp add: nonzero_inverse_inverse_eq)
+  then show ?thesis ..
+qed
+
+lemma ex_inverse_of_nat_less:
+  fixes x :: "'a::archimedean_field"
+  assumes "0 < x" shows "\<exists>n>0. inverse (of_nat n) < x"
+  using ex_inverse_of_nat_Suc_less [OF `0 < x`] by auto
+
+lemma ex_less_of_nat_mult:
+  fixes x :: "'a::archimedean_field"
+  assumes "0 < x" shows "\<exists>n. y < of_nat n * x"
+proof -
+  obtain n where "y / x < of_nat n" using ex_less_of_nat ..
+  with `0 < x` have "y < of_nat n * x" by (simp add: pos_divide_less_eq)
+  then show ?thesis ..
+qed
+
+
+subsection {* Existence and uniqueness of floor function *}
+
+lemma exists_least_lemma:
+  assumes "\<not> P 0" and "\<exists>n. P n"
+  shows "\<exists>n. \<not> P n \<and> P (Suc n)"
+proof -
+  from `\<exists>n. P n` have "P (Least P)" by (rule LeastI_ex)
+  with `\<not> P 0` obtain n where "Least P = Suc n"
+    by (cases "Least P") auto
+  then have "n < Least P" by simp
+  then have "\<not> P n" by (rule not_less_Least)
+  then have "\<not> P n \<and> P (Suc n)"
+    using `P (Least P)` `Least P = Suc n` by simp
+  then show ?thesis ..
+qed
+
+lemma floor_exists:
+  fixes x :: "'a::archimedean_field"
+  shows "\<exists>z. of_int z \<le> x \<and> x < of_int (z + 1)"
+proof (cases)
+  assume "0 \<le> x"
+  then have "\<not> x < of_nat 0" by simp
+  then have "\<exists>n. \<not> x < of_nat n \<and> x < of_nat (Suc n)"
+    using ex_less_of_nat by (rule exists_least_lemma)
+  then obtain n where "\<not> x < of_nat n \<and> x < of_nat (Suc n)" ..
+  then have "of_int (int n) \<le> x \<and> x < of_int (int n + 1)" by simp
+  then show ?thesis ..
+next
+  assume "\<not> 0 \<le> x"
+  then have "\<not> - x \<le> of_nat 0" by simp
+  then have "\<exists>n. \<not> - x \<le> of_nat n \<and> - x \<le> of_nat (Suc n)"
+    using ex_le_of_nat by (rule exists_least_lemma)
+  then obtain n where "\<not> - x \<le> of_nat n \<and> - x \<le> of_nat (Suc n)" ..
+  then have "of_int (- int n - 1) \<le> x \<and> x < of_int (- int n - 1 + 1)" by simp
+  then show ?thesis ..
+qed
+
+lemma floor_exists1:
+  fixes x :: "'a::archimedean_field"
+  shows "\<exists>!z. of_int z \<le> x \<and> x < of_int (z + 1)"
+proof (rule ex_ex1I)
+  show "\<exists>z. of_int z \<le> x \<and> x < of_int (z + 1)"
+    by (rule floor_exists)
+next
+  fix y z assume
+    "of_int y \<le> x \<and> x < of_int (y + 1)"
+    "of_int z \<le> x \<and> x < of_int (z + 1)"
+  then have
+    "of_int y \<le> x" "x < of_int (y + 1)"
+    "of_int z \<le> x" "x < of_int (z + 1)"
+    by simp_all
+  from le_less_trans [OF `of_int y \<le> x` `x < of_int (z + 1)`]
+       le_less_trans [OF `of_int z \<le> x` `x < of_int (y + 1)`]
+  show "y = z" by (simp del: of_int_add)
+qed
+
+
+subsection {* Floor function *}
+
+definition
+  floor :: "'a::archimedean_field \<Rightarrow> int" where
+  [code del]: "floor x = (THE z. of_int z \<le> x \<and> x < of_int (z + 1))"
+
+notation (xsymbols)
+  floor  ("\<lfloor>_\<rfloor>")
+
+notation (HTML output)
+  floor  ("\<lfloor>_\<rfloor>")
+
+lemma floor_correct: "of_int (floor x) \<le> x \<and> x < of_int (floor x + 1)"
+  unfolding floor_def using floor_exists1 by (rule theI')
+
+lemma floor_unique: "\<lbrakk>of_int z \<le> x; x < of_int z + 1\<rbrakk> \<Longrightarrow> floor x = z"
+  using floor_correct [of x] floor_exists1 [of x] by auto
+
+lemma of_int_floor_le: "of_int (floor x) \<le> x"
+  using floor_correct ..
+
+lemma le_floor_iff: "z \<le> floor x \<longleftrightarrow> of_int z \<le> x"
+proof
+  assume "z \<le> floor x"
+  then have "(of_int z :: 'a) \<le> of_int (floor x)" by simp
+  also have "of_int (floor x) \<le> x" by (rule of_int_floor_le)
+  finally show "of_int z \<le> x" .
+next
+  assume "of_int z \<le> x"
+  also have "x < of_int (floor x + 1)" using floor_correct ..
+  finally show "z \<le> floor x" by (simp del: of_int_add)
+qed
+
+lemma floor_less_iff: "floor x < z \<longleftrightarrow> x < of_int z"
+  by (simp add: not_le [symmetric] le_floor_iff)
+
+lemma less_floor_iff: "z < floor x \<longleftrightarrow> of_int z + 1 \<le> x"
+  using le_floor_iff [of "z + 1" x] by auto
+
+lemma floor_le_iff: "floor x \<le> z \<longleftrightarrow> x < of_int z + 1"
+  by (simp add: not_less [symmetric] less_floor_iff)
+
+lemma floor_mono: assumes "x \<le> y" shows "floor x \<le> floor y"
+proof -
+  have "of_int (floor x) \<le> x" by (rule of_int_floor_le)
+  also note `x \<le> y`
+  finally show ?thesis by (simp add: le_floor_iff)
+qed
+
+lemma floor_less_cancel: "floor x < floor y \<Longrightarrow> x < y"
+  by (auto simp add: not_le [symmetric] floor_mono)
+
+lemma floor_of_int [simp]: "floor (of_int z) = z"
+  by (rule floor_unique) simp_all
+
+lemma floor_of_nat [simp]: "floor (of_nat n) = int n"
+  using floor_of_int [of "of_nat n"] by simp
+
+text {* Floor with numerals *}
+
+lemma floor_zero [simp]: "floor 0 = 0"
+  using floor_of_int [of 0] by simp
+
+lemma floor_one [simp]: "floor 1 = 1"
+  using floor_of_int [of 1] by simp
+
+lemma floor_number_of [simp]: "floor (number_of v) = number_of v"
+  using floor_of_int [of "number_of v"] by simp
+
+lemma zero_le_floor [simp]: "0 \<le> floor x \<longleftrightarrow> 0 \<le> x"
+  by (simp add: le_floor_iff)
+
+lemma one_le_floor [simp]: "1 \<le> floor x \<longleftrightarrow> 1 \<le> x"
+  by (simp add: le_floor_iff)
+
+lemma number_of_le_floor [simp]: "number_of v \<le> floor x \<longleftrightarrow> number_of v \<le> x"
+  by (simp add: le_floor_iff)
+
+lemma zero_less_floor [simp]: "0 < floor x \<longleftrightarrow> 1 \<le> x"
+  by (simp add: less_floor_iff)
+
+lemma one_less_floor [simp]: "1 < floor x \<longleftrightarrow> 2 \<le> x"
+  by (simp add: less_floor_iff)
+
+lemma number_of_less_floor [simp]:
+  "number_of v < floor x \<longleftrightarrow> number_of v + 1 \<le> x"
+  by (simp add: less_floor_iff)
+
+lemma floor_le_zero [simp]: "floor x \<le> 0 \<longleftrightarrow> x < 1"
+  by (simp add: floor_le_iff)
+
+lemma floor_le_one [simp]: "floor x \<le> 1 \<longleftrightarrow> x < 2"
+  by (simp add: floor_le_iff)
+
+lemma floor_le_number_of [simp]:
+  "floor x \<le> number_of v \<longleftrightarrow> x < number_of v + 1"
+  by (simp add: floor_le_iff)
+
+lemma floor_less_zero [simp]: "floor x < 0 \<longleftrightarrow> x < 0"
+  by (simp add: floor_less_iff)
+
+lemma floor_less_one [simp]: "floor x < 1 \<longleftrightarrow> x < 1"
+  by (simp add: floor_less_iff)
+
+lemma floor_less_number_of [simp]:
+  "floor x < number_of v \<longleftrightarrow> x < number_of v"
+  by (simp add: floor_less_iff)
+
+text {* Addition and subtraction of integers *}
+
+lemma floor_add_of_int [simp]: "floor (x + of_int z) = floor x + z"
+  using floor_correct [of x] by (simp add: floor_unique)
+
+lemma floor_add_number_of [simp]:
+    "floor (x + number_of v) = floor x + number_of v"
+  using floor_add_of_int [of x "number_of v"] by simp
+
+lemma floor_add_one [simp]: "floor (x + 1) = floor x + 1"
+  using floor_add_of_int [of x 1] by simp
+
+lemma floor_diff_of_int [simp]: "floor (x - of_int z) = floor x - z"
+  using floor_add_of_int [of x "- z"] by (simp add: algebra_simps)
+
+lemma floor_diff_number_of [simp]:
+  "floor (x - number_of v) = floor x - number_of v"
+  using floor_diff_of_int [of x "number_of v"] by simp
+
+lemma floor_diff_one [simp]: "floor (x - 1) = floor x - 1"
+  using floor_diff_of_int [of x 1] by simp
+
+
+subsection {* Ceiling function *}
+
+definition
+  ceiling :: "'a::archimedean_field \<Rightarrow> int" where
+  [code del]: "ceiling x = - floor (- x)"
+
+notation (xsymbols)
+  ceiling  ("\<lceil>_\<rceil>")
+
+notation (HTML output)
+  ceiling  ("\<lceil>_\<rceil>")
+
+lemma ceiling_correct: "of_int (ceiling x) - 1 < x \<and> x \<le> of_int (ceiling x)"
+  unfolding ceiling_def using floor_correct [of "- x"] by simp
+
+lemma ceiling_unique: "\<lbrakk>of_int z - 1 < x; x \<le> of_int z\<rbrakk> \<Longrightarrow> ceiling x = z"
+  unfolding ceiling_def using floor_unique [of "- z" "- x"] by simp
+
+lemma le_of_int_ceiling: "x \<le> of_int (ceiling x)"
+  using ceiling_correct ..
+
+lemma ceiling_le_iff: "ceiling x \<le> z \<longleftrightarrow> x \<le> of_int z"
+  unfolding ceiling_def using le_floor_iff [of "- z" "- x"] by auto
+
+lemma less_ceiling_iff: "z < ceiling x \<longleftrightarrow> of_int z < x"
+  by (simp add: not_le [symmetric] ceiling_le_iff)
+
+lemma ceiling_less_iff: "ceiling x < z \<longleftrightarrow> x \<le> of_int z - 1"
+  using ceiling_le_iff [of x "z - 1"] by simp
+
+lemma le_ceiling_iff: "z \<le> ceiling x \<longleftrightarrow> of_int z - 1 < x"
+  by (simp add: not_less [symmetric] ceiling_less_iff)
+
+lemma ceiling_mono: "x \<ge> y \<Longrightarrow> ceiling x \<ge> ceiling y"
+  unfolding ceiling_def by (simp add: floor_mono)
+
+lemma ceiling_less_cancel: "ceiling x < ceiling y \<Longrightarrow> x < y"
+  by (auto simp add: not_le [symmetric] ceiling_mono)
+
+lemma ceiling_of_int [simp]: "ceiling (of_int z) = z"
+  by (rule ceiling_unique) simp_all
+
+lemma ceiling_of_nat [simp]: "ceiling (of_nat n) = int n"
+  using ceiling_of_int [of "of_nat n"] by simp
+
+text {* Ceiling with numerals *}
+
+lemma ceiling_zero [simp]: "ceiling 0 = 0"
+  using ceiling_of_int [of 0] by simp
+
+lemma ceiling_one [simp]: "ceiling 1 = 1"
+  using ceiling_of_int [of 1] by simp
+
+lemma ceiling_number_of [simp]: "ceiling (number_of v) = number_of v"
+  using ceiling_of_int [of "number_of v"] by simp
+
+lemma ceiling_le_zero [simp]: "ceiling x \<le> 0 \<longleftrightarrow> x \<le> 0"
+  by (simp add: ceiling_le_iff)
+
+lemma ceiling_le_one [simp]: "ceiling x \<le> 1 \<longleftrightarrow> x \<le> 1"
+  by (simp add: ceiling_le_iff)
+
+lemma ceiling_le_number_of [simp]:
+  "ceiling x \<le> number_of v \<longleftrightarrow> x \<le> number_of v"
+  by (simp add: ceiling_le_iff)
+
+lemma ceiling_less_zero [simp]: "ceiling x < 0 \<longleftrightarrow> x \<le> -1"
+  by (simp add: ceiling_less_iff)
+
+lemma ceiling_less_one [simp]: "ceiling x < 1 \<longleftrightarrow> x \<le> 0"
+  by (simp add: ceiling_less_iff)
+
+lemma ceiling_less_number_of [simp]:
+  "ceiling x < number_of v \<longleftrightarrow> x \<le> number_of v - 1"
+  by (simp add: ceiling_less_iff)
+
+lemma zero_le_ceiling [simp]: "0 \<le> ceiling x \<longleftrightarrow> -1 < x"
+  by (simp add: le_ceiling_iff)
+
+lemma one_le_ceiling [simp]: "1 \<le> ceiling x \<longleftrightarrow> 0 < x"
+  by (simp add: le_ceiling_iff)
+
+lemma number_of_le_ceiling [simp]:
+  "number_of v \<le> ceiling x\<longleftrightarrow> number_of v - 1 < x"
+  by (simp add: le_ceiling_iff)
+
+lemma zero_less_ceiling [simp]: "0 < ceiling x \<longleftrightarrow> 0 < x"
+  by (simp add: less_ceiling_iff)
+
+lemma one_less_ceiling [simp]: "1 < ceiling x \<longleftrightarrow> 1 < x"
+  by (simp add: less_ceiling_iff)
+
+lemma number_of_less_ceiling [simp]:
+  "number_of v < ceiling x \<longleftrightarrow> number_of v < x"
+  by (simp add: less_ceiling_iff)
+
+text {* Addition and subtraction of integers *}
+
+lemma ceiling_add_of_int [simp]: "ceiling (x + of_int z) = ceiling x + z"
+  using ceiling_correct [of x] by (simp add: ceiling_unique)
+
+lemma ceiling_add_number_of [simp]:
+    "ceiling (x + number_of v) = ceiling x + number_of v"
+  using ceiling_add_of_int [of x "number_of v"] by simp
+
+lemma ceiling_add_one [simp]: "ceiling (x + 1) = ceiling x + 1"
+  using ceiling_add_of_int [of x 1] by simp
+
+lemma ceiling_diff_of_int [simp]: "ceiling (x - of_int z) = ceiling x - z"
+  using ceiling_add_of_int [of x "- z"] by (simp add: algebra_simps)
+
+lemma ceiling_diff_number_of [simp]:
+  "ceiling (x - number_of v) = ceiling x - number_of v"
+  using ceiling_diff_of_int [of x "number_of v"] by simp
+
+lemma ceiling_diff_one [simp]: "ceiling (x - 1) = ceiling x - 1"
+  using ceiling_diff_of_int [of x 1] by simp
+
+
+subsection {* Negation *}
+
+lemma floor_minus [simp]: "floor (- x) = - ceiling x"
+  unfolding ceiling_def by simp
+
+lemma ceiling_minus [simp]: "ceiling (- x) = - floor x"
+  unfolding ceiling_def by simp
+
+end
--- a/src/HOL/Arith_Tools.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Arith_Tools.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -68,8 +68,9 @@
 apply (subst add_eq_if)
 apply (simp split add: nat.split
             del: nat_numeral_1_eq_1
-            add: numeral_1_eq_Suc_0 [symmetric] Let_def
-                 neg_imp_number_of_eq_0 neg_number_of_pred_iff_0)
+            add: nat_numeral_1_eq_1 [symmetric]
+                 numeral_1_eq_Suc_0 [symmetric]
+                 neg_number_of_pred_iff_0)
 done
 
 lemma nat_rec_number_of [simp]:
@@ -89,7 +90,8 @@
 apply (subst add_eq_if)
 apply (simp split add: nat.split
             del: nat_numeral_1_eq_1
-            add: numeral_1_eq_Suc_0 [symmetric] Let_def neg_imp_number_of_eq_0
+            add: nat_numeral_1_eq_1 [symmetric]
+                 numeral_1_eq_Suc_0 [symmetric]
                  neg_number_of_pred_iff_0)
 done
 
--- a/src/HOL/Complex_Main.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Complex_Main.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -9,7 +9,6 @@
   Ln
   Taylor
   Integration
-  FrechetDeriv
 begin
 
 end
--- a/src/HOL/Decision_Procs/Cooper.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Decision_Procs/Cooper.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -620,7 +620,7 @@
   {assume "i=0" hence ?case using "12.hyps" by (simp add: dvd_def Let_def)}
   moreover 
   {assume i1: "abs i = 1"
-      from zdvd_1_left[where m = "Inum bs a"] uminus_dvd_conv[where d="1" and t="Inum bs a"]
+      from one_dvd[of "Inum bs a"] uminus_dvd_conv[where d="1" and t="Inum bs a"]
       have ?case using i1 apply (cases "i=0", simp_all add: Let_def) 
 	by (cases "i > 0", simp_all)}
   moreover   
@@ -640,7 +640,7 @@
   {assume "i=0" hence ?case using "13.hyps" by (simp add: dvd_def Let_def)}
   moreover 
   {assume i1: "abs i = 1"
-      from zdvd_1_left[where m = "Inum bs a"] uminus_dvd_conv[where d="1" and t="Inum bs a"]
+      from one_dvd[of "Inum bs a"] uminus_dvd_conv[where d="1" and t="Inum bs a"]
       have ?case using i1 apply (cases "i=0", simp_all add: Let_def)
       apply (cases "i > 0", simp_all) done}
   moreover   
@@ -990,7 +990,7 @@
   have "j=0 \<or> (j\<noteq>0 \<and> ?c = 0) \<or> (j\<noteq>0 \<and> ?c >0) \<or> (j\<noteq> 0 \<and> ?c<0)" by arith
   moreover
   {assume "j=0" hence z: "zlfm (Dvd j a) = (zlfm (Eq a))" by (simp add: Let_def) 
-    hence ?case using prems by (simp del: zlfm.simps add: zdvd_0_left)}
+    hence ?case using prems by (simp del: zlfm.simps)}
   moreover
   {assume "?c=0" and "j\<noteq>0" hence ?case 
       using zsplit0_I[OF spl, where x="i" and bs="bs"]
@@ -1005,7 +1005,7 @@
   moreover
   {assume cn: "?c < 0" and jnz: "j\<noteq>0" hence l: "?L (?l (Dvd j a))" 
       by (simp add: nb Let_def split_def)
-    hence ?case using Ia cn jnz zdvd_zminus_iff[where m="abs j" and n="?c*i + ?N ?r" ]
+    hence ?case using Ia cn jnz dvd_minus_iff[of "abs j" "?c*i + ?N ?r" ]
       by (simp add: Let_def split_def) }
   ultimately show ?case by blast
 next
@@ -1019,7 +1019,7 @@
   have "j=0 \<or> (j\<noteq>0 \<and> ?c = 0) \<or> (j\<noteq>0 \<and> ?c >0) \<or> (j\<noteq> 0 \<and> ?c<0)" by arith
   moreover
   {assume "j=0" hence z: "zlfm (NDvd j a) = (zlfm (NEq a))" by (simp add: Let_def) 
-    hence ?case using prems by (simp del: zlfm.simps add: zdvd_0_left)}
+    hence ?case using prems by (simp del: zlfm.simps)}
   moreover
   {assume "?c=0" and "j\<noteq>0" hence ?case 
       using zsplit0_I[OF spl, where x="i" and bs="bs"]
@@ -1034,7 +1034,7 @@
   moreover
   {assume cn: "?c < 0" and jnz: "j\<noteq>0" hence l: "?L (?l (Dvd j a))" 
       by (simp add: nb Let_def split_def)
-    hence ?case using Ia cn jnz zdvd_zminus_iff[where m="abs j" and n="?c*i + ?N ?r" ]
+    hence ?case using Ia cn jnz dvd_minus_iff[of "abs j" "?c*i + ?N ?r"]
       by (simp add: Let_def split_def)}
   ultimately show ?case by blast
 qed auto
@@ -1092,10 +1092,10 @@
   using lin ad d
 proof(induct p rule: iszlfm.induct)
   case (9 i c e)  thus ?case using d
-    by (simp add: zdvd_trans[where m="i" and n="d" and k="d'"])
+    by (simp add: dvd_trans[of "i" "d" "d'"])
 next
   case (10 i c e) thus ?case using d
-    by (simp add: zdvd_trans[where m="i" and n="d" and k="d'"])
+    by (simp add: dvd_trans[of "i" "d" "d'"])
 qed simp_all
 
 lemma \<delta> : assumes lin:"iszlfm p"
@@ -1354,7 +1354,7 @@
   case (9 j c e) hence nb: "numbound0 e" by simp
   have "Ifm bbs (x#bs) (mirror (Dvd j (CN 0 c e))) = (j dvd c*x - Inum (x#bs) e)" (is "_ = (j dvd c*x - ?e)") by simp
     also have "\<dots> = (j dvd (- (c*x - ?e)))"
-    by (simp only: zdvd_zminus_iff)
+    by (simp only: dvd_minus_iff)
   also have "\<dots> = (j dvd (c* (- x)) + ?e)"
     apply (simp only: minus_mult_right[symmetric] minus_mult_left[symmetric] diff_def zadd_ac zminus_zadd_distrib)
     by (simp add: algebra_simps)
@@ -1366,7 +1366,7 @@
     case (10 j c e) hence nb: "numbound0 e" by simp
   have "Ifm bbs (x#bs) (mirror (Dvd j (CN 0 c e))) = (j dvd c*x - Inum (x#bs) e)" (is "_ = (j dvd c*x - ?e)") by simp
     also have "\<dots> = (j dvd (- (c*x - ?e)))"
-    by (simp only: zdvd_zminus_iff)
+    by (simp only: dvd_minus_iff)
   also have "\<dots> = (j dvd (c* (- x)) + ?e)"
     apply (simp only: minus_mult_right[symmetric] minus_mult_left[symmetric] diff_def zadd_ac zminus_zadd_distrib)
     by (simp add: algebra_simps)
@@ -1392,7 +1392,7 @@
   and dr: "d\<beta> p l"
   and d: "l dvd l'"
   shows "d\<beta> p l'"
-using dr linp zdvd_trans[where n="l" and k="l'", simplified d]
+using dr linp dvd_trans[of _ "l" "l'", simplified d]
 by (induct p rule: iszlfm.induct) simp_all
 
 lemma \<alpha>_l: assumes lp: "iszlfm p"
@@ -1431,7 +1431,7 @@
       by (simp add: zdiv_mono1[OF clel cp])
     then have ldcp:"0 < l div c" 
       by (simp add: zdiv_self[OF cnz])
-    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
+    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
     hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
       by simp
     hence "(l*x + (l div c) * Inum (x # bs) e < 0) =
@@ -1449,7 +1449,7 @@
       by (simp add: zdiv_mono1[OF clel cp])
     then have ldcp:"0 < l div c" 
       by (simp add: zdiv_self[OF cnz])
-    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
+    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
     hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
       by simp
     hence "(l*x + (l div c) * Inum (x# bs) e \<le> 0) =
@@ -1467,7 +1467,7 @@
       by (simp add: zdiv_mono1[OF clel cp])
     then have ldcp:"0 < l div c" 
       by (simp add: zdiv_self[OF cnz])
-    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
+    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
     hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
       by simp
     hence "(l*x + (l div c)* Inum (x # bs) e > 0) =
@@ -1485,7 +1485,7 @@
       by (simp add: zdiv_mono1[OF clel cp])
     then have ldcp:"0 < l div c" 
       by (simp add: zdiv_self[OF cnz])
-    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
+    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
     hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
       by simp
     hence "(l*x + (l div c)* Inum (x # bs) e \<ge> 0) =
@@ -1505,7 +1505,7 @@
       by (simp add: zdiv_mono1[OF clel cp])
     then have ldcp:"0 < l div c" 
       by (simp add: zdiv_self[OF cnz])
-    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
+    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
     hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
       by simp
     hence "(l * x + (l div c) * Inum (x # bs) e = 0) =
@@ -1523,7 +1523,7 @@
       by (simp add: zdiv_mono1[OF clel cp])
     then have ldcp:"0 < l div c" 
       by (simp add: zdiv_self[OF cnz])
-    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
+    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
     hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
       by simp
     hence "(l * x + (l div c) * Inum (x # bs) e \<noteq> 0) =
@@ -1541,7 +1541,7 @@
       by (simp add: zdiv_mono1[OF clel cp])
     then have ldcp:"0 < l div c" 
       by (simp add: zdiv_self[OF cnz])
-    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
+    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
     hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
       by simp
     hence "(\<exists> (k::int). l * x + (l div c) * Inum (x # bs) e = ((l div c) * j) * k) = (\<exists> (k::int). (c * (l div c)) * x + (l div c) * Inum (x # bs) e = ((l div c) * j) * k)"  by simp
@@ -1558,7 +1558,7 @@
       by (simp add: zdiv_mono1[OF clel cp])
     then have ldcp:"0 < l div c" 
       by (simp add: zdiv_self[OF cnz])
-    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
+    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
     hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
       by simp
     hence "(\<exists> (k::int). l * x + (l div c) * Inum (x # bs) e = ((l div c) * j) * k) = (\<exists> (k::int). (c * (l div c)) * x + (l div c) * Inum (x # bs) e = ((l div c) * j) * k)"  by simp
--- a/src/HOL/Decision_Procs/Ferrack.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Decision_Procs/Ferrack.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -501,9 +501,9 @@
   assumes gdg: "g dvd g'" and dgt':"dvdnumcoeff t g'"
   shows "dvdnumcoeff t g"
   using dgt' gdg 
-  by (induct t rule: dvdnumcoeff.induct, simp_all add: gdg zdvd_trans[OF gdg])
+  by (induct t rule: dvdnumcoeff.induct, simp_all add: gdg dvd_trans[OF gdg])
 
-declare zdvd_trans [trans add]
+declare dvd_trans [trans add]
 
 lemma natabs0: "(nat (abs x) = 0) = (x = 0)"
 by arith
--- a/src/HOL/Decision_Procs/MIR.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Decision_Procs/MIR.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -83,7 +83,7 @@
   have "real (floor x) \<le> x" by simp 
   hence "real (floor x) < real (n + 1) " using ub by arith
   hence "floor x < n+1" by simp
-  moreover from lb have "n \<le> floor x" using floor_mono2[where x="real n" and y="x"] 
+  moreover from lb have "n \<le> floor x" using floor_mono[where x="real n" and y="x"] 
     by simp ultimately show "floor x = n" by simp
 qed
 
@@ -132,13 +132,13 @@
   assume d: "real d rdvd t"
   from d int_rdvd_real have d2: "d dvd (floor t)" and ti: "real (floor t) = t" by auto
 
-  from iffD2[OF zdvd_abs1] d2 have "(abs d) dvd (floor t)" by blast
+  from iffD2[OF abs_dvd_iff] d2 have "(abs d) dvd (floor t)" by blast
   with ti int_rdvd_real[symmetric] have "real (abs d) rdvd t" by blast 
   thus "abs (real d) rdvd t" by simp
 next
   assume "abs (real d) rdvd t" hence "real (abs d) rdvd t" by simp
   with int_rdvd_real[where i="abs d" and x="t"] have d2: "abs d dvd floor t" and ti: "real (floor t) =t" by auto
-  from iffD1[OF zdvd_abs1] d2 have "d dvd floor t" by blast
+  from iffD1[OF abs_dvd_iff] d2 have "d dvd floor t" by blast
   with ti int_rdvd_real[symmetric] show "real d rdvd t" by blast
 qed
 
@@ -675,9 +675,9 @@
   assumes gdg: "g dvd g'" and dgt':"dvdnumcoeff t g'"
   shows "dvdnumcoeff t g"
   using dgt' gdg 
-  by (induct t rule: dvdnumcoeff.induct, simp_all add: gdg zdvd_trans[OF gdg])
-
-declare zdvd_trans [trans add]
+  by (induct t rule: dvdnumcoeff.induct, simp_all add: gdg dvd_trans[OF gdg])
+
+declare dvd_trans [trans add]
 
 lemma natabs0: "(nat (abs x) = 0) = (x = 0)"
 by arith
@@ -1775,11 +1775,11 @@
   "(real (a::int) \<le> b) = (a \<le> floor b \<or> (a = floor b \<and> real (floor b) < b))"
 proof( auto)
   assume alb: "real a \<le> b" and agb: "\<not> a \<le> floor b"
-  from alb have "floor (real a) \<le> floor b " by (simp only: floor_mono2) 
+  from alb have "floor (real a) \<le> floor b " by (simp only: floor_mono) 
   hence "a \<le> floor b" by simp with agb show "False" by simp
 next
   assume alb: "a \<le> floor b"
-  hence "real a \<le> real (floor b)" by (simp only: floor_mono2)
+  hence "real a \<le> real (floor b)" by (simp only: floor_mono)
   also have "\<dots>\<le> b" by simp  finally show  "real a \<le> b" . 
 qed
 
@@ -2114,10 +2114,10 @@
   using lin ad d
 proof(induct p rule: iszlfm.induct)
   case (9 i c e)  thus ?case using d
-    by (simp add: zdvd_trans[where m="i" and n="d" and k="d'"])
+    by (simp add: dvd_trans[of "i" "d" "d'"])
 next
   case (10 i c e) thus ?case using d
-    by (simp add: zdvd_trans[where m="i" and n="d" and k="d'"])
+    by (simp add: dvd_trans[of "i" "d" "d'"])
 qed simp_all
 
 lemma \<delta> : assumes lin:"iszlfm p bs"
@@ -2496,7 +2496,7 @@
   and dr: "d\<beta> p l"
   and d: "l dvd l'"
   shows "d\<beta> p l'"
-using dr linp zdvd_trans[where n="l" and k="l'", simplified d]
+using dr linp dvd_trans[of _ "l" "l'", simplified d]
 by (induct p rule: iszlfm.induct) simp_all
 
 lemma \<alpha>_l: assumes lp: "iszlfm p (a#bs)"
@@ -2535,7 +2535,7 @@
       by (simp add: zdiv_mono1[OF clel cp])
     then have ldcp:"0 < l div c" 
       by (simp add: zdiv_self[OF cnz])
-    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
+    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
     hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
       by simp
     hence "(real l * real x + real (l div c) * Inum (real x # bs) e < (0\<Colon>real)) =
@@ -2553,7 +2553,7 @@
       by (simp add: zdiv_mono1[OF clel cp])
     then have ldcp:"0 < l div c" 
       by (simp add: zdiv_self[OF cnz])
-    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
+    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
     hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
       by simp
     hence "(real l * real x + real (l div c) * Inum (real x # bs) e \<le> (0\<Colon>real)) =
@@ -2571,7 +2571,7 @@
       by (simp add: zdiv_mono1[OF clel cp])
     then have ldcp:"0 < l div c" 
       by (simp add: zdiv_self[OF cnz])
-    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
+    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
     hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
       by simp
     hence "(real l * real x + real (l div c) * Inum (real x # bs) e > (0\<Colon>real)) =
@@ -2589,7 +2589,7 @@
       by (simp add: zdiv_mono1[OF clel cp])
     then have ldcp:"0 < l div c" 
       by (simp add: zdiv_self[OF cnz])
-    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
+    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
     hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
       by simp
     hence "(real l * real x + real (l div c) * Inum (real x # bs) e \<ge> (0\<Colon>real)) =
@@ -2607,7 +2607,7 @@
       by (simp add: zdiv_mono1[OF clel cp])
     then have ldcp:"0 < l div c" 
       by (simp add: zdiv_self[OF cnz])
-    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
+    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
     hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
       by simp
     hence "(real l * real x + real (l div c) * Inum (real x # bs) e = (0\<Colon>real)) =
@@ -2625,7 +2625,7 @@
       by (simp add: zdiv_mono1[OF clel cp])
     then have ldcp:"0 < l div c" 
       by (simp add: zdiv_self[OF cnz])
-    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
+    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
     hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
       by simp
     hence "(real l * real x + real (l div c) * Inum (real x # bs) e \<noteq> (0\<Colon>real)) =
@@ -2643,7 +2643,7 @@
       by (simp add: zdiv_mono1[OF clel cp])
     then have ldcp:"0 < l div c" 
       by (simp add: zdiv_self[OF cnz])
-    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
+    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
     hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
       by simp
     hence "(\<exists> (k::int). real l * real x + real (l div c) * Inum (real x # bs) e = (real (l div c) * real j) * real k) = (\<exists> (k::int). real (c * (l div c)) * real x + real (l div c) * Inum (real x # bs) e = (real (l div c) * real j) * real k)"  by simp
@@ -2660,7 +2660,7 @@
       by (simp add: zdiv_mono1[OF clel cp])
     then have ldcp:"0 < l div c" 
       by (simp add: zdiv_self[OF cnz])
-    have "c * (l div c) = c* (l div c) + l mod c" using d' zdvd_iff_zmod_eq_0[where m="c" and n="l"] by simp
+    have "c * (l div c) = c* (l div c) + l mod c" using d' dvd_eq_mod_eq_0[of "c" "l"] by simp
     hence cl:"c * (l div c) =l" using zmod_zdiv_equality[where a="l" and b="c", symmetric] 
       by simp
     hence "(\<exists> (k::int). real l * real x + real (l div c) * Inum (real x # bs) e = (real (l div c) * real j) * real k) = (\<exists> (k::int). real (c * (l div c)) * real x + real (l div c) * Inum (real x # bs) e = (real (l div c) * real j) * real k)"  by simp
@@ -3697,7 +3697,7 @@
   assumes xb: "real m \<le> x \<and> x < real ((n::int) + 1)"
   shows "\<exists> j\<in> {m.. n}. real j \<le> x \<and> x < real (j+1)" (is "\<exists> j\<in> ?N. ?P j")
 by (rule bexI[where P="?P" and x="floor x" and A="?N"]) 
-(auto simp add: floor_less_eq[where x="x" and a="n+1", simplified] xb[simplified] floor_mono2[where x="real m" and y="x", OF conjunct1[OF xb], simplified floor_real_of_int[where n="m"]])
+(auto simp add: floor_less_eq[where x="x" and a="n+1", simplified] xb[simplified] floor_mono[where x="real m" and y="x", OF conjunct1[OF xb], simplified floor_real_of_int[where n="m"]])
 
 lemma rsplit0_complete:
   assumes xp:"0 \<le> x" and x1:"x < 1"
--- a/src/HOL/Decision_Procs/cooper_tac.ML	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Decision_Procs/cooper_tac.ML	Thu Feb 26 11:21:29 2009 +0000
@@ -28,11 +28,9 @@
 val imp_le_cong = @{thm imp_le_cong};
 val conj_le_cong = @{thm conj_le_cong};
 val nat_mod_add_eq = @{thm mod_add1_eq} RS sym;
-val nat_mod_add_left_eq = @{thm mod_add_left_eq} RS sym;
-val nat_mod_add_right_eq = @{thm mod_add_right_eq} RS sym;
-val int_mod_add_eq = @{thm zmod_zadd1_eq} RS sym;
-val int_mod_add_left_eq = @{thm zmod_zadd_left_eq} RS sym;
-val int_mod_add_right_eq = @{thm zmod_zadd_right_eq} RS sym;
+val mod_add_left_eq = @{thm mod_add_left_eq} RS sym;
+val mod_add_right_eq = @{thm mod_add_right_eq} RS sym;
+val int_mod_add_eq = @{thm mod_add_eq} RS sym;
 val nat_div_add_eq = @{thm div_add1_eq} RS sym;
 val int_div_add_eq = @{thm zdiv_zadd1_eq} RS sym;
 
@@ -70,14 +68,13 @@
     val (t,np,nh) = prepare_for_linz q g
     (* Some simpsets for dealing with mod div abs and nat*)
     val mod_div_simpset = HOL_basic_ss 
-			addsimps [refl,nat_mod_add_eq, nat_mod_add_left_eq, 
-				  nat_mod_add_right_eq, int_mod_add_eq, 
-				  int_mod_add_right_eq, int_mod_add_left_eq,
+			addsimps [refl,nat_mod_add_eq, mod_add_left_eq, 
+				  mod_add_right_eq, int_mod_add_eq, 
 				  nat_div_add_eq, int_div_add_eq,
 				  @{thm mod_self}, @{thm "zmod_self"},
 				  @{thm mod_by_0}, @{thm div_by_0},
 				  @{thm "zdiv_zero"}, @{thm "zmod_zero"}, @{thm "div_0"}, @{thm "mod_0"},
-				  @{thm "zdiv_1"}, @{thm "zmod_1"}, @{thm "div_1"}, @{thm "mod_1"},
+				  @{thm "div_by_1"}, @{thm "mod_by_1"}, @{thm "div_1"}, @{thm "mod_1"},
 				  Suc_plus1]
 			addsimps @{thms add_ac}
 			addsimprocs [cancel_div_mod_proc]
--- a/src/HOL/Decision_Procs/ferrack_tac.ML	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Decision_Procs/ferrack_tac.ML	Thu Feb 26 11:21:29 2009 +0000
@@ -32,11 +32,9 @@
 val imp_le_cong = @{thm imp_le_cong};
 val conj_le_cong = @{thm conj_le_cong};
 val nat_mod_add_eq = @{thm mod_add1_eq} RS sym;
-val nat_mod_add_left_eq = @{thm mod_add_left_eq} RS sym;
-val nat_mod_add_right_eq = @{thm mod_add_right_eq} RS sym;
-val int_mod_add_eq = @{thm zmod_zadd1_eq} RS sym;
-val int_mod_add_left_eq = @{thm zmod_zadd_left_eq} RS sym;
-val int_mod_add_right_eq = @{thm zmod_zadd_right_eq} RS sym;
+val mod_add_left_eq = @{thm mod_add_left_eq} RS sym;
+val mod_add_right_eq = @{thm mod_add_right_eq} RS sym;
+val int_mod_add_eq = @{thm mod_add_eq} RS sym;
 val nat_div_add_eq = @{thm div_add1_eq} RS sym;
 val int_div_add_eq = @{thm zdiv_zadd1_eq} RS sym;
 val ZDIVISION_BY_ZERO_MOD = @{thm DIVISION_BY_ZERO} RS conjunct2;
--- a/src/HOL/Decision_Procs/mir_tac.ML	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Decision_Procs/mir_tac.ML	Thu Feb 26 11:21:29 2009 +0000
@@ -47,11 +47,9 @@
 val imp_le_cong = @{thm "imp_le_cong"};
 val conj_le_cong = @{thm "conj_le_cong"};
 val nat_mod_add_eq = @{thm "mod_add1_eq"} RS sym;
-val nat_mod_add_left_eq = @{thm "mod_add_left_eq"} RS sym;
-val nat_mod_add_right_eq = @{thm "mod_add_right_eq"} RS sym;
-val int_mod_add_eq = @{thm "zmod_zadd1_eq"} RS sym;
-val int_mod_add_left_eq = @{thm "zmod_zadd_left_eq"} RS sym;
-val int_mod_add_right_eq = @{thm "zmod_zadd_right_eq"} RS sym;
+val mod_add_left_eq = @{thm "mod_add_left_eq"} RS sym;
+val mod_add_right_eq = @{thm "mod_add_right_eq"} RS sym;
+val int_mod_add_eq = @{thm "mod_add_eq"} RS sym;
 val nat_div_add_eq = @{thm "div_add1_eq"} RS sym;
 val int_div_add_eq = @{thm "zdiv_zadd1_eq"} RS sym;
 val ZDIVISION_BY_ZERO_MOD = @{thm "DIVISION_BY_ZERO"} RS conjunct2;
@@ -99,7 +97,7 @@
                         addsimps [refl,nat_mod_add_eq, 
                                   @{thm "mod_self"}, @{thm "zmod_self"},
                                   @{thm "zdiv_zero"},@{thm "zmod_zero"},@{thm "div_0"}, @{thm "mod_0"},
-                                  @{thm "zdiv_1"}, @{thm "zmod_1"}, @{thm "div_1"}, @{thm "mod_1"},
+                                  @{thm "div_by_1"}, @{thm "mod_by_1"}, @{thm "div_1"}, @{thm "mod_1"},
                                   @{thm "Suc_plus1"}]
                         addsimps @{thms add_ac}
                         addsimprocs [cancel_div_mod_proc]
--- a/src/HOL/Deriv.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Deriv.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -9,7 +9,7 @@
 header{* Differentiation *}
 
 theory Deriv
-imports Lim Polynomial
+imports Lim
 begin
 
 text{*Standard Definitions*}
@@ -217,9 +217,7 @@
 by (cases "n", simp, simp add: DERIV_power_Suc f)
 
 
-(* ------------------------------------------------------------------------ *)
-(* Caratheodory formulation of derivative at a point: standard proof        *)
-(* ------------------------------------------------------------------------ *)
+text {* Caratheodory formulation of derivative at a point *}
 
 lemma CARAT_DERIV:
      "(DERIV f x :> l) =
@@ -307,6 +305,9 @@
        ==> DERIV (%y. f(y) / (g y)) x :> (d*g(x) - (e*f(x))) / (g(x) ^ Suc (Suc 0))"
 by (drule (2) DERIV_divide) (simp add: mult_commute power_Suc)
 
+lemma lemma_DERIV_subst: "[| DERIV f x :> D; D = E |] ==> DERIV f x :> E"
+by auto
+
 
 subsection {* Differentiability predicate *}
 
@@ -655,6 +656,9 @@
 apply (blast intro: IVT2)
 done
 
+
+subsection {* Boundedness of continuous functions *}
+
 text{*By bisection, function continuous on closed interval is bounded above*}
 
 lemma isCont_bounded:
@@ -773,6 +777,8 @@
 done
 
 
+subsection {* Local extrema *}
+
 text{*If @{term "0 < f'(x)"} then @{term x} is Locally Strictly Increasing At The Right*}
 
 lemma DERIV_left_inc:
@@ -877,6 +883,9 @@
   shows "[| DERIV f x :> l; 0 < d; \<forall>y. \<bar>x-y\<bar> < d --> f(x) = f(y) |] ==> l = 0"
 by (auto dest!: DERIV_local_max)
 
+
+subsection {* Rolle's Theorem *}
+
 text{*Lemma about introducing open ball in open interval*}
 lemma lemma_interval_lt:
      "[| a < x;  x < b |]
@@ -1163,6 +1172,8 @@
 qed
 
 
+subsection {* Continuous injective functions *}
+
 text{*Dull lemma: an continuous injection on an interval must have a
 strict maximum at an end point, not in the middle.*}
 
@@ -1356,6 +1367,9 @@
     using neq by (rule LIM_inverse)
 qed
 
+
+subsection {* Generalized Mean Value Theorem *}
+
 theorem GMVT:
   fixes a b :: real
   assumes alb: "a < b"
@@ -1442,245 +1456,6 @@
   with g'cdef f'cdef cint show ?thesis by auto
 qed
 
-lemma lemma_DERIV_subst: "[| DERIV f x :> D; D = E |] ==> DERIV f x :> E"
-by auto
-
-
-subsection {* Derivatives of univariate polynomials *}
-
-definition
-  pderiv :: "'a::real_normed_field poly \<Rightarrow> 'a poly" where
-  "pderiv = poly_rec 0 (\<lambda>a p p'. p + pCons 0 p')"
-
-lemma pderiv_0 [simp]: "pderiv 0 = 0"
-  unfolding pderiv_def by (simp add: poly_rec_0)
-
-lemma pderiv_pCons: "pderiv (pCons a p) = p + pCons 0 (pderiv p)"
-  unfolding pderiv_def by (simp add: poly_rec_pCons)
-
-lemma coeff_pderiv: "coeff (pderiv p) n = of_nat (Suc n) * coeff p (Suc n)"
-  apply (induct p arbitrary: n, simp)
-  apply (simp add: pderiv_pCons coeff_pCons algebra_simps split: nat.split)
-  done
-
-lemma pderiv_eq_0_iff: "pderiv p = 0 \<longleftrightarrow> degree p = 0"
-  apply (rule iffI)
-  apply (cases p, simp)
-  apply (simp add: expand_poly_eq coeff_pderiv del: of_nat_Suc)
-  apply (simp add: expand_poly_eq coeff_pderiv coeff_eq_0)
-  done
-
-lemma degree_pderiv: "degree (pderiv p) = degree p - 1"
-  apply (rule order_antisym [OF degree_le])
-  apply (simp add: coeff_pderiv coeff_eq_0)
-  apply (cases "degree p", simp)
-  apply (rule le_degree)
-  apply (simp add: coeff_pderiv del: of_nat_Suc)
-  apply (rule subst, assumption)
-  apply (rule leading_coeff_neq_0, clarsimp)
-  done
-
-lemma pderiv_singleton [simp]: "pderiv [:a:] = 0"
-by (simp add: pderiv_pCons)
-
-lemma pderiv_add: "pderiv (p + q) = pderiv p + pderiv q"
-by (rule poly_ext, simp add: coeff_pderiv algebra_simps)
-
-lemma pderiv_minus: "pderiv (- p) = - pderiv p"
-by (rule poly_ext, simp add: coeff_pderiv)
-
-lemma pderiv_diff: "pderiv (p - q) = pderiv p - pderiv q"
-by (rule poly_ext, simp add: coeff_pderiv algebra_simps)
-
-lemma pderiv_smult: "pderiv (smult a p) = smult a (pderiv p)"
-by (rule poly_ext, simp add: coeff_pderiv algebra_simps)
-
-lemma pderiv_mult: "pderiv (p * q) = p * pderiv q + q * pderiv p"
-apply (induct p)
-apply simp
-apply (simp add: pderiv_add pderiv_smult pderiv_pCons algebra_simps)
-done
-
-lemma pderiv_power_Suc:
-  "pderiv (p ^ Suc n) = smult (of_nat (Suc n)) (p ^ n) * pderiv p"
-apply (induct n)
-apply simp
-apply (subst power_Suc)
-apply (subst pderiv_mult)
-apply (erule ssubst)
-apply (simp add: smult_add_left algebra_simps)
-done
-
-lemma DERIV_cmult2: "DERIV f x :> D ==> DERIV (%x. (f x) * c :: real) x :> D * c"
-by (simp add: DERIV_cmult mult_commute [of _ c])
-
-lemma DERIV_pow2: "DERIV (%x. x ^ Suc n) x :> real (Suc n) * (x ^ n)"
-by (rule lemma_DERIV_subst, rule DERIV_pow, simp)
-declare DERIV_pow2 [simp] DERIV_pow [simp]
-
-lemma DERIV_add_const: "DERIV f x :> D ==>  DERIV (%x. a + f x :: 'a::real_normed_field) x :> D"
-by (rule lemma_DERIV_subst, rule DERIV_add, auto)
-
-lemma poly_DERIV[simp]: "DERIV (%x. poly p x) x :> poly (pderiv p) x"
-apply (induct p)
-apply simp
-apply (simp add: pderiv_pCons)
-apply (rule lemma_DERIV_subst)
-apply (rule DERIV_add DERIV_mult DERIV_const DERIV_ident | assumption)+
-apply simp
-done
-
-text{* Consequences of the derivative theorem above*}
-
-lemma poly_differentiable[simp]: "(%x. poly p x) differentiable (x::real)"
-apply (simp add: differentiable_def)
-apply (blast intro: poly_DERIV)
-done
-
-lemma poly_isCont[simp]: "isCont (%x. poly p x) (x::real)"
-by (rule poly_DERIV [THEN DERIV_isCont])
-
-lemma poly_IVT_pos: "[| a < b; poly p (a::real) < 0; 0 < poly p b |]
-      ==> \<exists>x. a < x & x < b & (poly p x = 0)"
-apply (cut_tac f = "%x. poly p x" and a = a and b = b and y = 0 in IVT_objl)
-apply (auto simp add: order_le_less)
-done
-
-lemma poly_IVT_neg: "[| (a::real) < b; 0 < poly p a; poly p b < 0 |]
-      ==> \<exists>x. a < x & x < b & (poly p x = 0)"
-by (insert poly_IVT_pos [where p = "- p" ]) simp
-
-lemma poly_MVT: "(a::real) < b ==>
-     \<exists>x. a < x & x < b & (poly p b - poly p a = (b - a) * poly (pderiv p) x)"
-apply (drule_tac f = "poly p" in MVT, auto)
-apply (rule_tac x = z in exI)
-apply (auto simp add: real_mult_left_cancel poly_DERIV [THEN DERIV_unique])
-done
-
-text{*Lemmas for Derivatives*}
-
-(* FIXME
-lemma lemma_order_pderiv [rule_format]:
-     "\<forall>p q a. 0 < n &
-       poly (pderiv p) \<noteq> poly [] &
-       poly p = poly ([- a, 1] %^ n *** q) & ~ [- a, 1] divides q
-       --> n = Suc (order a (pderiv p))"
-apply (induct "n", safe)
-apply (rule order_unique_lemma, rule conjI, assumption)
-apply (subgoal_tac "\<forall>r. r divides (pderiv p) = r divides (pderiv ([-a, 1] %^ Suc n *** q))")
-apply (drule_tac [2] poly_pderiv_welldef)
- prefer 2 apply (simp add: divides_def del: pmult_Cons pexp_Suc) 
-apply (simp del: pmult_Cons pexp_Suc) 
-apply (rule conjI)
-apply (simp add: divides_def fun_eq del: pmult_Cons pexp_Suc)
-apply (rule_tac x = "[-a, 1] *** (pderiv q) +++ real (Suc n) %* q" in exI)
-apply (simp add: poly_pderiv_mult poly_pderiv_exp_prime poly_add poly_mult poly_cmult right_distrib mult_ac del: pmult_Cons pexp_Suc)
-apply (simp add: poly_mult right_distrib left_distrib mult_ac del: pmult_Cons)
-apply (erule_tac V = "\<forall>r. r divides pderiv p = r divides pderiv ([- a, 1] %^ Suc n *** q)" in thin_rl)
-apply (unfold divides_def)
-apply (simp (no_asm) add: poly_pderiv_mult poly_pderiv_exp_prime fun_eq poly_add poly_mult del: pmult_Cons pexp_Suc)
-apply (rule contrapos_np, assumption)
-apply (rotate_tac 3, erule contrapos_np)
-apply (simp del: pmult_Cons pexp_Suc, safe)
-apply (rule_tac x = "inverse (real (Suc n)) %* (qa +++ -- (pderiv q))" in exI)
-apply (subgoal_tac "poly ([-a, 1] %^ n *** q) = poly ([-a, 1] %^ n *** ([-a, 1] *** (inverse (real (Suc n)) %* (qa +++ -- (pderiv q))))) ")
-apply (drule poly_mult_left_cancel [THEN iffD1], simp)
-apply (simp add: fun_eq poly_mult poly_add poly_cmult poly_minus del: pmult_Cons mult_cancel_left, safe)
-apply (rule_tac c1 = "real (Suc n)" in real_mult_left_cancel [THEN iffD1])
-apply (simp (no_asm))
-apply (subgoal_tac "real (Suc n) * (poly ([- a, 1] %^ n) xa * poly q xa) =
-          (poly qa xa + - poly (pderiv q) xa) *
-          (poly ([- a, 1] %^ n) xa *
-           ((- a + xa) * (inverse (real (Suc n)) * real (Suc n))))")
-apply (simp only: mult_ac)  
-apply (rotate_tac 2)
-apply (drule_tac x = xa in spec)
-apply (simp add: left_distrib mult_ac del: pmult_Cons)
-done
-
-lemma order_pderiv: "[| poly (pderiv p) \<noteq> poly []; order a p \<noteq> 0 |]
-      ==> (order a p = Suc (order a (pderiv p)))"
-apply (case_tac "poly p = poly []")
-apply (auto dest: pderiv_zero)
-apply (drule_tac a = a and p = p in order_decomp)
-using neq0_conv
-apply (blast intro: lemma_order_pderiv)
-done
-
-text{*Now justify the standard squarefree decomposition, i.e. f / gcd(f,f'). *}
-
-lemma poly_squarefree_decomp_order: "[| poly (pderiv p) \<noteq> poly [];
-         poly p = poly (q *** d);
-         poly (pderiv p) = poly (e *** d);
-         poly d = poly (r *** p +++ s *** pderiv p)
-      |] ==> order a q = (if order a p = 0 then 0 else 1)"
-apply (subgoal_tac "order a p = order a q + order a d")
-apply (rule_tac [2] s = "order a (q *** d)" in trans)
-prefer 2 apply (blast intro: order_poly)
-apply (rule_tac [2] order_mult)
- prefer 2 apply force
-apply (case_tac "order a p = 0", simp)
-apply (subgoal_tac "order a (pderiv p) = order a e + order a d")
-apply (rule_tac [2] s = "order a (e *** d)" in trans)
-prefer 2 apply (blast intro: order_poly)
-apply (rule_tac [2] order_mult)
- prefer 2 apply force
-apply (case_tac "poly p = poly []")
-apply (drule_tac p = p in pderiv_zero, simp)
-apply (drule order_pderiv, assumption)
-apply (subgoal_tac "order a (pderiv p) \<le> order a d")
-apply (subgoal_tac [2] " ([-a, 1] %^ (order a (pderiv p))) divides d")
- prefer 2 apply (simp add: poly_entire order_divides)
-apply (subgoal_tac [2] " ([-a, 1] %^ (order a (pderiv p))) divides p & ([-a, 1] %^ (order a (pderiv p))) divides (pderiv p) ")
- prefer 3 apply (simp add: order_divides)
- prefer 2 apply (simp add: divides_def del: pexp_Suc pmult_Cons, safe)
-apply (rule_tac x = "r *** qa +++ s *** qaa" in exI)
-apply (simp add: fun_eq poly_add poly_mult left_distrib right_distrib mult_ac del: pexp_Suc pmult_Cons, auto)
-done
-
-
-lemma poly_squarefree_decomp_order2: "[| poly (pderiv p) \<noteq> poly [];
-         poly p = poly (q *** d);
-         poly (pderiv p) = poly (e *** d);
-         poly d = poly (r *** p +++ s *** pderiv p)
-      |] ==> \<forall>a. order a q = (if order a p = 0 then 0 else 1)"
-apply (blast intro: poly_squarefree_decomp_order)
-done
-
-lemma order_pderiv2: "[| poly (pderiv p) \<noteq> poly []; order a p \<noteq> 0 |]
-      ==> (order a (pderiv p) = n) = (order a p = Suc n)"
-apply (auto dest: order_pderiv)
-done
-
-lemma rsquarefree_roots:
-  "rsquarefree p = (\<forall>a. ~(poly p a = 0 & poly (pderiv p) a = 0))"
-apply (simp add: rsquarefree_def)
-apply (case_tac "poly p = poly []", simp, simp)
-apply (case_tac "poly (pderiv p) = poly []")
-apply simp
-apply (drule pderiv_iszero, clarify)
-apply (subgoal_tac "\<forall>a. order a p = order a [h]")
-apply (simp add: fun_eq)
-apply (rule allI)
-apply (cut_tac p = "[h]" and a = a in order_root)
-apply (simp add: fun_eq)
-apply (blast intro: order_poly)
-apply (auto simp add: order_root order_pderiv2)
-apply (erule_tac x="a" in allE, simp)
-done
-
-lemma poly_squarefree_decomp: "[| poly (pderiv p) \<noteq> poly [];
-         poly p = poly (q *** d);
-         poly (pderiv p) = poly (e *** d);
-         poly d = poly (r *** p +++ s *** pderiv p)
-      |] ==> rsquarefree q & (\<forall>a. (poly q a = 0) = (poly p a = 0))"
-apply (frule poly_squarefree_decomp_order2, assumption+) 
-apply (case_tac "poly p = poly []")
-apply (blast dest: pderiv_zero)
-apply (simp (no_asm) add: rsquarefree_def order_root del: pmult_Cons)
-apply (simp add: poly_entire del: pmult_Cons)
-done
-*)
 
 subsection {* Theorems about Limits *}
 
--- a/src/HOL/Divides.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Divides.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -173,11 +173,17 @@
 qed
 
 lemma dvd_imp_mod_0: "a dvd b \<Longrightarrow> b mod a = 0"
-by (unfold dvd_def, auto)
+by (rule dvd_eq_mod_eq_0[THEN iffD1])
 
 lemma dvd_div_mult_self: "a dvd b \<Longrightarrow> (b div a) * a = b"
 by (subst (2) mod_div_equality [of b a, symmetric]) (simp add:dvd_imp_mod_0)
 
+lemma dvd_div_mult: "a dvd b \<Longrightarrow> (b div a) * c = b * c div a"
+apply (cases "a = 0")
+ apply simp
+apply (auto simp: dvd_def mult_assoc)
+done
+
 lemma div_dvd_div[simp]:
   "a dvd b \<Longrightarrow> a dvd c \<Longrightarrow> (b div a dvd c div a) = (b dvd c)"
 apply (cases "a = 0")
@@ -188,6 +194,12 @@
 apply(fastsimp simp add: mult_assoc)
 done
 
+lemma dvd_mod_imp_dvd: "[| k dvd m mod n;  k dvd n |] ==> k dvd m"
+  apply (subgoal_tac "k dvd (m div n) *n + m mod n")
+   apply (simp add: mod_div_equality)
+  apply (simp only: dvd_add dvd_mult)
+  done
+
 text {* Addition respects modular equivalence. *}
 
 lemma mod_add_left_eq: "(a + b) mod c = (a mod c + b) mod c"
@@ -478,9 +490,9 @@
   from divmod_rel have divmod_m_n: "divmod_rel m n (m div n) (m mod n)" .
   with assms have m_div_n: "m div n \<ge> 1"
     by (cases "m div n") (auto simp add: divmod_rel_def)
-  from assms divmod_m_n have "divmod_rel (m - n) n (m div n - 1) (m mod n)"
+  from assms divmod_m_n have "divmod_rel (m - n) n (m div n - Suc 0) (m mod n)"
     by (cases "m div n") (auto simp add: divmod_rel_def)
-  with divmod_eq have "divmod (m - n) n = (m div n - 1, m mod n)" by simp
+  with divmod_eq have "divmod (m - n) n = (m div n - Suc 0, m mod n)" by simp
   moreover from divmod_div_mod have "divmod (m - n) n = ((m - n) div n, (m - n) mod n)" .
   ultimately have "m div n = Suc ((m - n) div n)"
     and "m mod n = (m - n) mod n" using m_div_n by simp_all
@@ -795,12 +807,6 @@
 apply (auto simp add: Suc_diff_le le_mod_geq)
 done
 
-lemma nat_mod_div_trivial: "m mod n div n = (0 :: nat)"
-by simp
-
-lemma nat_mod_mod_trivial: "m mod n mod n = (m mod n :: nat)"
-by simp
-
 
 subsubsection {* The Divides Relation *}
 
@@ -810,6 +816,9 @@
 lemma dvd_1_iff_1 [simp]: "(m dvd Suc 0) = (m = Suc 0)"
 by (simp add: dvd_def)
 
+lemma nat_dvd_1_iff_1 [simp]: "m dvd (1::nat) \<longleftrightarrow> m = 1"
+by (simp add: dvd_def)
+
 lemma dvd_anti_sym: "[| m dvd n; n dvd m |] ==> m = (n::nat)"
   unfolding dvd_def
   by (force dest: mult_eq_self_implies_10 simp add: mult_assoc mult_eq_1_iff)
@@ -819,9 +828,9 @@
 interpretation dvd!: order "op dvd" "\<lambda>n m \<Colon> nat. n dvd m \<and> \<not> m dvd n"
   proof qed (auto intro: dvd_refl dvd_trans dvd_anti_sym)
 
-lemma dvd_diff: "[| k dvd m; k dvd n |] ==> k dvd (m-n :: nat)"
-  unfolding dvd_def
-  by (blast intro: diff_mult_distrib2 [symmetric])
+lemma nat_dvd_diff[simp]: "[| k dvd m; k dvd n |] ==> k dvd (m-n :: nat)"
+unfolding dvd_def
+by (blast intro: diff_mult_distrib2 [symmetric])
 
 lemma dvd_diffD: "[| k dvd m-n; k dvd n; n\<le>m |] ==> k dvd (m::nat)"
   apply (erule linorder_not_less [THEN iffD2, THEN add_diff_inverse, THEN subst])
@@ -829,7 +838,7 @@
   done
 
 lemma dvd_diffD1: "[| k dvd m-n; k dvd m; n\<le>m |] ==> k dvd (n::nat)"
-by (drule_tac m = m in dvd_diff, auto)
+by (drule_tac m = m in nat_dvd_diff, auto)
 
 lemma dvd_reduce: "(k dvd n + k) = (k dvd (n::nat))"
   apply (rule iffI)
@@ -838,7 +847,7 @@
   apply (subgoal_tac "n = (n+k) -k")
    prefer 2 apply simp
   apply (erule ssubst)
-  apply (erule dvd_diff)
+  apply (erule nat_dvd_diff)
   apply (rule dvd_refl)
   done
 
@@ -848,12 +857,6 @@
   apply (blast intro: mod_mult_distrib2 [symmetric])
   done
 
-lemma dvd_mod_imp_dvd: "[| (k::nat) dvd m mod n;  k dvd n |] ==> k dvd m"
-  apply (subgoal_tac "k dvd (m div n) *n + m mod n")
-   apply (simp add: mod_div_equality)
-  apply (simp only: dvd_add dvd_mult)
-  done
-
 lemma dvd_mod_iff: "k dvd n ==> ((k::nat) dvd m mod n) = (k dvd m)"
 by (blast intro: dvd_mod_imp_dvd dvd_mod)
 
@@ -889,21 +892,9 @@
   apply (simp only: dvd_eq_mod_eq_0)
   done
 
-lemma le_imp_power_dvd: "!!i::nat. m \<le> n ==> i^m dvd i^n"
-  apply (unfold dvd_def)
-  apply (erule linorder_not_less [THEN iffD2, THEN add_diff_inverse, THEN subst])
-  apply (simp add: power_add)
-  done
-
 lemma nat_zero_less_power_iff [simp]: "(x^n > 0) = (x > (0::nat) | n=0)"
   by (induct n) auto
 
-lemma power_le_dvd [rule_format]: "k^j dvd n --> i\<le>j --> k^i dvd (n::nat)"
-  apply (induct j)
-   apply (simp_all add: le_Suc_eq)
-  apply (blast dest!: dvd_mult_right)
-  done
-
 lemma power_dvd_imp_le: "[|i^m dvd i^n;  (1::nat) < i|] ==> m \<le> n"
   apply (rule power_le_imp_le_exp, assumption)
   apply (erule dvd_imp_le, simp)
--- a/src/HOL/Extraction/Euclid.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Extraction/Euclid.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -189,7 +189,7 @@
       assume pn: "p \<le> n"
       from `prime p` have "0 < p" by (rule prime_g_zero)
       then have "p dvd n!" using pn by (rule dvd_factorial)
-      with dvd have "p dvd ?k - n!" by (rule dvd_diff)
+      with dvd have "p dvd ?k - n!" by (rule nat_dvd_diff)
       then have "p dvd 1" by simp
       with prime show False using prime_nd_one by auto
     qed
--- a/src/HOL/Fact.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Fact.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -7,7 +7,7 @@
 header{*Factorial Function*}
 
 theory Fact
-imports Nat
+imports Main
 begin
 
 consts fact :: "nat => nat"
@@ -58,7 +58,7 @@
   "n < Suc m ==> fact (Suc m - n) = (Suc m - n) * fact (m - n)"
 apply (induct n arbitrary: m)
 apply auto
-apply (drule_tac x = "m - 1" in meta_spec, auto)
+apply (drule_tac x = "m - Suc 0" in meta_spec, auto)
 done
 
 lemma fact_num0: "fact 0 = 1"
--- a/src/HOL/Finite_Set.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Finite_Set.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -489,7 +489,7 @@
 subsection {* A fold functional for finite sets *}
 
 text {* The intended behaviour is
-@{text "fold f z {x1, ..., xn} = f x1 (\<dots> (f xn z)\<dots>)"}
+@{text "fold f z {x\<^isub>1, ..., x\<^isub>n} = f x\<^isub>1 (\<dots> (f x\<^isub>n z)\<dots>)"}
 if @{text f} is ``left-commutative'':
 *}
 
@@ -2486,16 +2486,16 @@
 begin
 
 definition
-  Inf_fin :: "'a set \<Rightarrow> 'a" ("\<Sqinter>fin_" [900] 900)
+  Inf_fin :: "'a set \<Rightarrow> 'a" ("\<Sqinter>\<^bsub>fin\<^esub>_" [900] 900)
 where
   "Inf_fin = fold1 inf"
 
 definition
-  Sup_fin :: "'a set \<Rightarrow> 'a" ("\<Squnion>fin_" [900] 900)
+  Sup_fin :: "'a set \<Rightarrow> 'a" ("\<Squnion>\<^bsub>fin\<^esub>_" [900] 900)
 where
   "Sup_fin = fold1 sup"
 
-lemma Inf_le_Sup [simp]: "\<lbrakk> finite A; A \<noteq> {} \<rbrakk> \<Longrightarrow> \<Sqinter>finA \<le> \<Squnion>finA"
+lemma Inf_le_Sup [simp]: "\<lbrakk> finite A; A \<noteq> {} \<rbrakk> \<Longrightarrow> \<Sqinter>\<^bsub>fin\<^esub>A \<le> \<Squnion>\<^bsub>fin\<^esub>A"
 apply(unfold Sup_fin_def Inf_fin_def)
 apply(subgoal_tac "EX a. a:A")
 prefer 2 apply blast
@@ -2506,13 +2506,13 @@
 done
 
 lemma sup_Inf_absorb [simp]:
-  "finite A \<Longrightarrow> a \<in> A \<Longrightarrow> sup a (\<Sqinter>finA) = a"
+  "finite A \<Longrightarrow> a \<in> A \<Longrightarrow> sup a (\<Sqinter>\<^bsub>fin\<^esub>A) = a"
 apply(subst sup_commute)
 apply(simp add: Inf_fin_def sup_absorb2 fold1_belowI)
 done
 
 lemma inf_Sup_absorb [simp]:
-  "finite A \<Longrightarrow> a \<in> A \<Longrightarrow> inf a (\<Squnion>finA) = a"
+  "finite A \<Longrightarrow> a \<in> A \<Longrightarrow> inf a (\<Squnion>\<^bsub>fin\<^esub>A) = a"
 by (simp add: Sup_fin_def inf_absorb1
   lower_semilattice.fold1_belowI [OF dual_lattice])
 
@@ -2524,7 +2524,7 @@
 lemma sup_Inf1_distrib:
   assumes "finite A"
     and "A \<noteq> {}"
-  shows "sup x (\<Sqinter>finA) = \<Sqinter>fin{sup x a|a. a \<in> A}"
+  shows "sup x (\<Sqinter>\<^bsub>fin\<^esub>A) = \<Sqinter>\<^bsub>fin\<^esub>{sup x a|a. a \<in> A}"
 proof -
   interpret ab_semigroup_idem_mult inf
     by (rule ab_semigroup_idem_mult_inf)
@@ -2536,7 +2536,7 @@
 
 lemma sup_Inf2_distrib:
   assumes A: "finite A" "A \<noteq> {}" and B: "finite B" "B \<noteq> {}"
-  shows "sup (\<Sqinter>finA) (\<Sqinter>finB) = \<Sqinter>fin{sup a b|a b. a \<in> A \<and> b \<in> B}"
+  shows "sup (\<Sqinter>\<^bsub>fin\<^esub>A) (\<Sqinter>\<^bsub>fin\<^esub>B) = \<Sqinter>\<^bsub>fin\<^esub>{sup a b|a b. a \<in> A \<and> b \<in> B}"
 using A proof (induct rule: finite_ne_induct)
   case singleton thus ?case
     by (simp add: sup_Inf1_distrib [OF B] fold1_singleton_def [OF Inf_fin_def])
@@ -2553,13 +2553,13 @@
     thus ?thesis by(simp add: insert(1) B(1))
   qed
   have ne: "{sup a b |a b. a \<in> A \<and> b \<in> B} \<noteq> {}" using insert B by blast
-  have "sup (\<Sqinter>fin(insert x A)) (\<Sqinter>finB) = sup (inf x (\<Sqinter>finA)) (\<Sqinter>finB)"
+  have "sup (\<Sqinter>\<^bsub>fin\<^esub>(insert x A)) (\<Sqinter>\<^bsub>fin\<^esub>B) = sup (inf x (\<Sqinter>\<^bsub>fin\<^esub>A)) (\<Sqinter>\<^bsub>fin\<^esub>B)"
     using insert by (simp add: fold1_insert_idem_def [OF Inf_fin_def])
-  also have "\<dots> = inf (sup x (\<Sqinter>finB)) (sup (\<Sqinter>finA) (\<Sqinter>finB))" by(rule sup_inf_distrib2)
-  also have "\<dots> = inf (\<Sqinter>fin{sup x b|b. b \<in> B}) (\<Sqinter>fin{sup a b|a b. a \<in> A \<and> b \<in> B})"
+  also have "\<dots> = inf (sup x (\<Sqinter>\<^bsub>fin\<^esub>B)) (sup (\<Sqinter>\<^bsub>fin\<^esub>A) (\<Sqinter>\<^bsub>fin\<^esub>B))" by(rule sup_inf_distrib2)
+  also have "\<dots> = inf (\<Sqinter>\<^bsub>fin\<^esub>{sup x b|b. b \<in> B}) (\<Sqinter>\<^bsub>fin\<^esub>{sup a b|a b. a \<in> A \<and> b \<in> B})"
     using insert by(simp add:sup_Inf1_distrib[OF B])
-  also have "\<dots> = \<Sqinter>fin({sup x b |b. b \<in> B} \<union> {sup a b |a b. a \<in> A \<and> b \<in> B})"
-    (is "_ = \<Sqinter>fin?M")
+  also have "\<dots> = \<Sqinter>\<^bsub>fin\<^esub>({sup x b |b. b \<in> B} \<union> {sup a b |a b. a \<in> A \<and> b \<in> B})"
+    (is "_ = \<Sqinter>\<^bsub>fin\<^esub>?M")
     using B insert
     by (simp add: Inf_fin_def fold1_Un2 [OF finB _ finAB ne])
   also have "?M = {sup a b |a b. a \<in> insert x A \<and> b \<in> B}"
@@ -2569,7 +2569,7 @@
 
 lemma inf_Sup1_distrib:
   assumes "finite A" and "A \<noteq> {}"
-  shows "inf x (\<Squnion>finA) = \<Squnion>fin{inf x a|a. a \<in> A}"
+  shows "inf x (\<Squnion>\<^bsub>fin\<^esub>A) = \<Squnion>\<^bsub>fin\<^esub>{inf x a|a. a \<in> A}"
 proof -
   interpret ab_semigroup_idem_mult sup
     by (rule ab_semigroup_idem_mult_sup)
@@ -2580,7 +2580,7 @@
 
 lemma inf_Sup2_distrib:
   assumes A: "finite A" "A \<noteq> {}" and B: "finite B" "B \<noteq> {}"
-  shows "inf (\<Squnion>finA) (\<Squnion>finB) = \<Squnion>fin{inf a b|a b. a \<in> A \<and> b \<in> B}"
+  shows "inf (\<Squnion>\<^bsub>fin\<^esub>A) (\<Squnion>\<^bsub>fin\<^esub>B) = \<Squnion>\<^bsub>fin\<^esub>{inf a b|a b. a \<in> A \<and> b \<in> B}"
 using A proof (induct rule: finite_ne_induct)
   case singleton thus ?case
     by(simp add: inf_Sup1_distrib [OF B] fold1_singleton_def [OF Sup_fin_def])
@@ -2597,13 +2597,13 @@
   have ne: "{inf a b |a b. a \<in> A \<and> b \<in> B} \<noteq> {}" using insert B by blast
   interpret ab_semigroup_idem_mult sup
     by (rule ab_semigroup_idem_mult_sup)
-  have "inf (\<Squnion>fin(insert x A)) (\<Squnion>finB) = inf (sup x (\<Squnion>finA)) (\<Squnion>finB)"
+  have "inf (\<Squnion>\<^bsub>fin\<^esub>(insert x A)) (\<Squnion>\<^bsub>fin\<^esub>B) = inf (sup x (\<Squnion>\<^bsub>fin\<^esub>A)) (\<Squnion>\<^bsub>fin\<^esub>B)"
     using insert by (simp add: fold1_insert_idem_def [OF Sup_fin_def])
-  also have "\<dots> = sup (inf x (\<Squnion>finB)) (inf (\<Squnion>finA) (\<Squnion>finB))" by(rule inf_sup_distrib2)
-  also have "\<dots> = sup (\<Squnion>fin{inf x b|b. b \<in> B}) (\<Squnion>fin{inf a b|a b. a \<in> A \<and> b \<in> B})"
+  also have "\<dots> = sup (inf x (\<Squnion>\<^bsub>fin\<^esub>B)) (inf (\<Squnion>\<^bsub>fin\<^esub>A) (\<Squnion>\<^bsub>fin\<^esub>B))" by(rule inf_sup_distrib2)
+  also have "\<dots> = sup (\<Squnion>\<^bsub>fin\<^esub>{inf x b|b. b \<in> B}) (\<Squnion>\<^bsub>fin\<^esub>{inf a b|a b. a \<in> A \<and> b \<in> B})"
     using insert by(simp add:inf_Sup1_distrib[OF B])
-  also have "\<dots> = \<Squnion>fin({inf x b |b. b \<in> B} \<union> {inf a b |a b. a \<in> A \<and> b \<in> B})"
-    (is "_ = \<Squnion>fin?M")
+  also have "\<dots> = \<Squnion>\<^bsub>fin\<^esub>({inf x b |b. b \<in> B} \<union> {inf a b |a b. a \<in> A \<and> b \<in> B})"
+    (is "_ = \<Squnion>\<^bsub>fin\<^esub>?M")
     using B insert
     by (simp add: Sup_fin_def fold1_Un2 [OF finB _ finAB ne])
   also have "?M = {inf a b |a b. a \<in> insert x A \<and> b \<in> B}"
@@ -2622,7 +2622,7 @@
 
 lemma Inf_fin_Inf:
   assumes "finite A" and "A \<noteq> {}"
-  shows "\<Sqinter>finA = Inf A"
+  shows "\<Sqinter>\<^bsub>fin\<^esub>A = Inf A"
 proof -
     interpret ab_semigroup_idem_mult inf
     by (rule ab_semigroup_idem_mult_inf)
@@ -2633,7 +2633,7 @@
 
 lemma Sup_fin_Sup:
   assumes "finite A" and "A \<noteq> {}"
-  shows "\<Squnion>finA = Sup A"
+  shows "\<Squnion>\<^bsub>fin\<^esub>A = Sup A"
 proof -
   interpret ab_semigroup_idem_mult sup
     by (rule ab_semigroup_idem_mult_sup)
--- a/src/HOL/FrechetDeriv.thy	Thu Feb 26 11:18:40 2009 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,503 +0,0 @@
-(*  Title       : FrechetDeriv.thy
-    ID          : $Id$
-    Author      : Brian Huffman
-*)
-
-header {* Frechet Derivative *}
-
-theory FrechetDeriv
-imports Lim
-begin
-
-definition
-  fderiv ::
-  "['a::real_normed_vector \<Rightarrow> 'b::real_normed_vector, 'a, 'a \<Rightarrow> 'b] \<Rightarrow> bool"
-    -- {* Frechet derivative: D is derivative of function f at x *}
-          ("(FDERIV (_)/ (_)/ :> (_))" [1000, 1000, 60] 60) where
-  "FDERIV f x :> D = (bounded_linear D \<and>
-    (\<lambda>h. norm (f (x + h) - f x - D h) / norm h) -- 0 --> 0)"
-
-lemma FDERIV_I:
-  "\<lbrakk>bounded_linear D; (\<lambda>h. norm (f (x + h) - f x - D h) / norm h) -- 0 --> 0\<rbrakk>
-   \<Longrightarrow> FDERIV f x :> D"
-by (simp add: fderiv_def)
-
-lemma FDERIV_D:
-  "FDERIV f x :> D \<Longrightarrow> (\<lambda>h. norm (f (x + h) - f x - D h) / norm h) -- 0 --> 0"
-by (simp add: fderiv_def)
-
-lemma FDERIV_bounded_linear: "FDERIV f x :> D \<Longrightarrow> bounded_linear D"
-by (simp add: fderiv_def)
-
-lemma bounded_linear_zero:
-  "bounded_linear (\<lambda>x::'a::real_normed_vector. 0::'b::real_normed_vector)"
-proof
-  show "(0::'b) = 0 + 0" by simp
-  fix r show "(0::'b) = scaleR r 0" by simp
-  have "\<forall>x::'a. norm (0::'b) \<le> norm x * 0" by simp
-  thus "\<exists>K. \<forall>x::'a. norm (0::'b) \<le> norm x * K" ..
-qed
-
-lemma FDERIV_const: "FDERIV (\<lambda>x. k) x :> (\<lambda>h. 0)"
-by (simp add: fderiv_def bounded_linear_zero)
-
-lemma bounded_linear_ident:
-  "bounded_linear (\<lambda>x::'a::real_normed_vector. x)"
-proof
-  fix x y :: 'a show "x + y = x + y" by simp
-  fix r and x :: 'a show "scaleR r x = scaleR r x" by simp
-  have "\<forall>x::'a. norm x \<le> norm x * 1" by simp
-  thus "\<exists>K. \<forall>x::'a. norm x \<le> norm x * K" ..
-qed
-
-lemma FDERIV_ident: "FDERIV (\<lambda>x. x) x :> (\<lambda>h. h)"
-by (simp add: fderiv_def bounded_linear_ident)
-
-subsection {* Addition *}
-
-lemma add_diff_add:
-  fixes a b c d :: "'a::ab_group_add"
-  shows "(a + c) - (b + d) = (a - b) + (c - d)"
-by simp
-
-lemma bounded_linear_add:
-  assumes "bounded_linear f"
-  assumes "bounded_linear g"
-  shows "bounded_linear (\<lambda>x. f x + g x)"
-proof -
-  interpret f: bounded_linear f by fact
-  interpret g: bounded_linear g by fact
-  show ?thesis apply (unfold_locales)
-    apply (simp only: f.add g.add add_ac)
-    apply (simp only: f.scaleR g.scaleR scaleR_right_distrib)
-    apply (rule f.pos_bounded [THEN exE], rename_tac Kf)
-    apply (rule g.pos_bounded [THEN exE], rename_tac Kg)
-    apply (rule_tac x="Kf + Kg" in exI, safe)
-    apply (subst right_distrib)
-    apply (rule order_trans [OF norm_triangle_ineq])
-    apply (rule add_mono, erule spec, erule spec)
-    done
-qed
-
-lemma norm_ratio_ineq:
-  fixes x y :: "'a::real_normed_vector"
-  fixes h :: "'b::real_normed_vector"
-  shows "norm (x + y) / norm h \<le> norm x / norm h + norm y / norm h"
-apply (rule ord_le_eq_trans)
-apply (rule divide_right_mono)
-apply (rule norm_triangle_ineq)
-apply (rule norm_ge_zero)
-apply (rule add_divide_distrib)
-done
-
-lemma FDERIV_add:
-  assumes f: "FDERIV f x :> F"
-  assumes g: "FDERIV g x :> G"
-  shows "FDERIV (\<lambda>x. f x + g x) x :> (\<lambda>h. F h + G h)"
-proof (rule FDERIV_I)
-  show "bounded_linear (\<lambda>h. F h + G h)"
-    apply (rule bounded_linear_add)
-    apply (rule FDERIV_bounded_linear [OF f])
-    apply (rule FDERIV_bounded_linear [OF g])
-    done
-next
-  have f': "(\<lambda>h. norm (f (x + h) - f x - F h) / norm h) -- 0 --> 0"
-    using f by (rule FDERIV_D)
-  have g': "(\<lambda>h. norm (g (x + h) - g x - G h) / norm h) -- 0 --> 0"
-    using g by (rule FDERIV_D)
-  from f' g'
-  have "(\<lambda>h. norm (f (x + h) - f x - F h) / norm h
-           + norm (g (x + h) - g x - G h) / norm h) -- 0 --> 0"
-    by (rule LIM_add_zero)
-  thus "(\<lambda>h. norm (f (x + h) + g (x + h) - (f x + g x) - (F h + G h))
-           / norm h) -- 0 --> 0"
-    apply (rule real_LIM_sandwich_zero)
-     apply (simp add: divide_nonneg_pos)
-    apply (simp only: add_diff_add)
-    apply (rule norm_ratio_ineq)
-    done
-qed
-
-subsection {* Subtraction *}
-
-lemma bounded_linear_minus:
-  assumes "bounded_linear f"
-  shows "bounded_linear (\<lambda>x. - f x)"
-proof -
-  interpret f: bounded_linear f by fact
-  show ?thesis apply (unfold_locales)
-    apply (simp add: f.add)
-    apply (simp add: f.scaleR)
-    apply (simp add: f.bounded)
-    done
-qed
-
-lemma FDERIV_minus:
-  "FDERIV f x :> F \<Longrightarrow> FDERIV (\<lambda>x. - f x) x :> (\<lambda>h. - F h)"
-apply (rule FDERIV_I)
-apply (rule bounded_linear_minus)
-apply (erule FDERIV_bounded_linear)
-apply (simp only: fderiv_def minus_diff_minus norm_minus_cancel)
-done
-
-lemma FDERIV_diff:
-  "\<lbrakk>FDERIV f x :> F; FDERIV g x :> G\<rbrakk>
-   \<Longrightarrow> FDERIV (\<lambda>x. f x - g x) x :> (\<lambda>h. F h - G h)"
-by (simp only: diff_minus FDERIV_add FDERIV_minus)
-
-subsection {* Continuity *}
-
-lemma FDERIV_isCont:
-  assumes f: "FDERIV f x :> F"
-  shows "isCont f x"
-proof -
-  from f interpret F: bounded_linear "F" by (rule FDERIV_bounded_linear)
-  have "(\<lambda>h. norm (f (x + h) - f x - F h) / norm h) -- 0 --> 0"
-    by (rule FDERIV_D [OF f])
-  hence "(\<lambda>h. norm (f (x + h) - f x - F h) / norm h * norm h) -- 0 --> 0"
-    by (intro LIM_mult_zero LIM_norm_zero LIM_ident)
-  hence "(\<lambda>h. norm (f (x + h) - f x - F h)) -- 0 --> 0"
-    by (simp cong: LIM_cong)
-  hence "(\<lambda>h. f (x + h) - f x - F h) -- 0 --> 0"
-    by (rule LIM_norm_zero_cancel)
-  hence "(\<lambda>h. f (x + h) - f x - F h + F h) -- 0 --> 0"
-    by (intro LIM_add_zero F.LIM_zero LIM_ident)
-  hence "(\<lambda>h. f (x + h) - f x) -- 0 --> 0"
-    by simp
-  thus "isCont f x"
-    unfolding isCont_iff by (rule LIM_zero_cancel)
-qed
-
-subsection {* Composition *}
-
-lemma real_divide_cancel_lemma:
-  fixes a b c :: real
-  shows "(b = 0 \<Longrightarrow> a = 0) \<Longrightarrow> (a / b) * (b / c) = a / c"
-by simp
-
-lemma bounded_linear_compose:
-  assumes "bounded_linear f"
-  assumes "bounded_linear g"
-  shows "bounded_linear (\<lambda>x. f (g x))"
-proof -
-  interpret f: bounded_linear f by fact
-  interpret g: bounded_linear g by fact
-  show ?thesis proof (unfold_locales)
-    fix x y show "f (g (x + y)) = f (g x) + f (g y)"
-      by (simp only: f.add g.add)
-  next
-    fix r x show "f (g (scaleR r x)) = scaleR r (f (g x))"
-      by (simp only: f.scaleR g.scaleR)
-  next
-    from f.pos_bounded
-    obtain Kf where f: "\<And>x. norm (f x) \<le> norm x * Kf" and Kf: "0 < Kf" by fast
-    from g.pos_bounded
-    obtain Kg where g: "\<And>x. norm (g x) \<le> norm x * Kg" by fast
-    show "\<exists>K. \<forall>x. norm (f (g x)) \<le> norm x * K"
-    proof (intro exI allI)
-      fix x
-      have "norm (f (g x)) \<le> norm (g x) * Kf"
-	using f .
-      also have "\<dots> \<le> (norm x * Kg) * Kf"
-	using g Kf [THEN order_less_imp_le] by (rule mult_right_mono)
-      also have "(norm x * Kg) * Kf = norm x * (Kg * Kf)"
-	by (rule mult_assoc)
-      finally show "norm (f (g x)) \<le> norm x * (Kg * Kf)" .
-    qed
-  qed
-qed
-
-lemma FDERIV_compose:
-  fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
-  fixes g :: "'b::real_normed_vector \<Rightarrow> 'c::real_normed_vector"
-  assumes f: "FDERIV f x :> F"
-  assumes g: "FDERIV g (f x) :> G"
-  shows "FDERIV (\<lambda>x. g (f x)) x :> (\<lambda>h. G (F h))"
-proof (rule FDERIV_I)
-  from FDERIV_bounded_linear [OF g] FDERIV_bounded_linear [OF f]
-  show "bounded_linear (\<lambda>h. G (F h))"
-    by (rule bounded_linear_compose)
-next
-  let ?Rf = "\<lambda>h. f (x + h) - f x - F h"
-  let ?Rg = "\<lambda>k. g (f x + k) - g (f x) - G k"
-  let ?k = "\<lambda>h. f (x + h) - f x"
-  let ?Nf = "\<lambda>h. norm (?Rf h) / norm h"
-  let ?Ng = "\<lambda>h. norm (?Rg (?k h)) / norm (?k h)"
-  from f interpret F!: bounded_linear "F" by (rule FDERIV_bounded_linear)
-  from g interpret G!: bounded_linear "G" by (rule FDERIV_bounded_linear)
-  from F.bounded obtain kF where kF: "\<And>x. norm (F x) \<le> norm x * kF" by fast
-  from G.bounded obtain kG where kG: "\<And>x. norm (G x) \<le> norm x * kG" by fast
-
-  let ?fun2 = "\<lambda>h. ?Nf h * kG + ?Ng h * (?Nf h + kF)"
-
-  show "(\<lambda>h. norm (g (f (x + h)) - g (f x) - G (F h)) / norm h) -- 0 --> 0"
-  proof (rule real_LIM_sandwich_zero)
-    have Nf: "?Nf -- 0 --> 0"
-      using FDERIV_D [OF f] .
-
-    have Ng1: "isCont (\<lambda>k. norm (?Rg k) / norm k) 0"
-      by (simp add: isCont_def FDERIV_D [OF g])
-    have Ng2: "?k -- 0 --> 0"
-      apply (rule LIM_zero)
-      apply (fold isCont_iff)
-      apply (rule FDERIV_isCont [OF f])
-      done
-    have Ng: "?Ng -- 0 --> 0"
-      using isCont_LIM_compose [OF Ng1 Ng2] by simp
-
-    have "(\<lambda>h. ?Nf h * kG + ?Ng h * (?Nf h + kF))
-           -- 0 --> 0 * kG + 0 * (0 + kF)"
-      by (intro LIM_add LIM_mult LIM_const Nf Ng)
-    thus "(\<lambda>h. ?Nf h * kG + ?Ng h * (?Nf h + kF)) -- 0 --> 0"
-      by simp
-  next
-    fix h::'a assume h: "h \<noteq> 0"
-    thus "0 \<le> norm (g (f (x + h)) - g (f x) - G (F h)) / norm h"
-      by (simp add: divide_nonneg_pos)
-  next
-    fix h::'a assume h: "h \<noteq> 0"
-    have "g (f (x + h)) - g (f x) - G (F h) = G (?Rf h) + ?Rg (?k h)"
-      by (simp add: G.diff)
-    hence "norm (g (f (x + h)) - g (f x) - G (F h)) / norm h
-           = norm (G (?Rf h) + ?Rg (?k h)) / norm h"
-      by (rule arg_cong)
-    also have "\<dots> \<le> norm (G (?Rf h)) / norm h + norm (?Rg (?k h)) / norm h"
-      by (rule norm_ratio_ineq)
-    also have "\<dots> \<le> ?Nf h * kG + ?Ng h * (?Nf h + kF)"
-    proof (rule add_mono)
-      show "norm (G (?Rf h)) / norm h \<le> ?Nf h * kG"
-        apply (rule ord_le_eq_trans)
-        apply (rule divide_right_mono [OF kG norm_ge_zero])
-        apply simp
-        done
-    next
-      have "norm (?Rg (?k h)) / norm h = ?Ng h * (norm (?k h) / norm h)"
-        apply (rule real_divide_cancel_lemma [symmetric])
-        apply (simp add: G.zero)
-        done
-      also have "\<dots> \<le> ?Ng h * (?Nf h + kF)"
-      proof (rule mult_left_mono)
-        have "norm (?k h) / norm h = norm (?Rf h + F h) / norm h"
-          by simp
-        also have "\<dots> \<le> ?Nf h + norm (F h) / norm h"
-          by (rule norm_ratio_ineq)
-        also have "\<dots> \<le> ?Nf h + kF"
-          apply (rule add_left_mono)
-          apply (subst pos_divide_le_eq, simp add: h)
-          apply (subst mult_commute)
-          apply (rule kF)
-          done
-        finally show "norm (?k h) / norm h \<le> ?Nf h + kF" .
-      next
-        show "0 \<le> ?Ng h"
-        apply (case_tac "f (x + h) - f x = 0", simp)
-        apply (rule divide_nonneg_pos [OF norm_ge_zero])
-        apply simp
-        done
-      qed
-      finally show "norm (?Rg (?k h)) / norm h \<le> ?Ng h * (?Nf h + kF)" .
-    qed
-    finally show "norm (g (f (x + h)) - g (f x) - G (F h)) / norm h
-        \<le> ?Nf h * kG + ?Ng h * (?Nf h + kF)" .
-  qed
-qed
-
-subsection {* Product Rule *}
-
-lemma (in bounded_bilinear) FDERIV_lemma:
-  "a' ** b' - a ** b - (a ** B + A ** b)
-   = a ** (b' - b - B) + (a' - a - A) ** b' + A ** (b' - b)"
-by (simp add: diff_left diff_right)
-
-lemma (in bounded_bilinear) FDERIV:
-  fixes x :: "'d::real_normed_vector"
-  assumes f: "FDERIV f x :> F"
-  assumes g: "FDERIV g x :> G"
-  shows "FDERIV (\<lambda>x. f x ** g x) x :> (\<lambda>h. f x ** G h + F h ** g x)"
-proof (rule FDERIV_I)
-  show "bounded_linear (\<lambda>h. f x ** G h + F h ** g x)"
-    apply (rule bounded_linear_add)
-    apply (rule bounded_linear_compose [OF bounded_linear_right])
-    apply (rule FDERIV_bounded_linear [OF g])
-    apply (rule bounded_linear_compose [OF bounded_linear_left])
-    apply (rule FDERIV_bounded_linear [OF f])
-    done
-next
-  from bounded_linear.bounded [OF FDERIV_bounded_linear [OF f]]
-  obtain KF where norm_F: "\<And>x. norm (F x) \<le> norm x * KF" by fast
-
-  from pos_bounded obtain K where K: "0 < K" and norm_prod:
-    "\<And>a b. norm (a ** b) \<le> norm a * norm b * K" by fast
-
-  let ?Rf = "\<lambda>h. f (x + h) - f x - F h"
-  let ?Rg = "\<lambda>h. g (x + h) - g x - G h"
-
-  let ?fun1 = "\<lambda>h.
-        norm (f x ** ?Rg h + ?Rf h ** g (x + h) + F h ** (g (x + h) - g x)) /
-        norm h"
-
-  let ?fun2 = "\<lambda>h.
-        norm (f x) * (norm (?Rg h) / norm h) * K +
-        norm (?Rf h) / norm h * norm (g (x + h)) * K +
-        KF * norm (g (x + h) - g x) * K"
-
-  have "?fun1 -- 0 --> 0"
-  proof (rule real_LIM_sandwich_zero)
-    from f g isCont_iff [THEN iffD1, OF FDERIV_isCont [OF g]]
-    have "?fun2 -- 0 -->
-          norm (f x) * 0 * K + 0 * norm (g x) * K + KF * norm (0::'b) * K"
-      by (intro LIM_add LIM_mult LIM_const LIM_norm LIM_zero FDERIV_D)
-    thus "?fun2 -- 0 --> 0"
-      by simp
-  next
-    fix h::'d assume "h \<noteq> 0"
-    thus "0 \<le> ?fun1 h"
-      by (simp add: divide_nonneg_pos)
-  next
-    fix h::'d assume "h \<noteq> 0"
-    have "?fun1 h \<le> (norm (f x) * norm (?Rg h) * K +
-         norm (?Rf h) * norm (g (x + h)) * K +
-         norm h * KF * norm (g (x + h) - g x) * K) / norm h"
-      by (intro
-        divide_right_mono mult_mono'
-        order_trans [OF norm_triangle_ineq add_mono]
-        order_trans [OF norm_prod mult_right_mono]
-        mult_nonneg_nonneg order_refl norm_ge_zero norm_F
-        K [THEN order_less_imp_le]
-      )
-    also have "\<dots> = ?fun2 h"
-      by (simp add: add_divide_distrib)
-    finally show "?fun1 h \<le> ?fun2 h" .
-  qed
-  thus "(\<lambda>h.
-    norm (f (x + h) ** g (x + h) - f x ** g x - (f x ** G h + F h ** g x))
-    / norm h) -- 0 --> 0"
-    by (simp only: FDERIV_lemma)
-qed
-
-lemmas FDERIV_mult = mult.FDERIV
-
-lemmas FDERIV_scaleR = scaleR.FDERIV
-
-
-subsection {* Powers *}
-
-lemma FDERIV_power_Suc:
-  fixes x :: "'a::{real_normed_algebra,recpower,comm_ring_1}"
-  shows "FDERIV (\<lambda>x. x ^ Suc n) x :> (\<lambda>h. (1 + of_nat n) * x ^ n * h)"
- apply (induct n)
-  apply (simp add: power_Suc FDERIV_ident)
- apply (drule FDERIV_mult [OF FDERIV_ident])
- apply (simp only: of_nat_Suc left_distrib mult_1_left)
- apply (simp only: power_Suc right_distrib add_ac mult_ac)
-done
-
-lemma FDERIV_power:
-  fixes x :: "'a::{real_normed_algebra,recpower,comm_ring_1}"
-  shows "FDERIV (\<lambda>x. x ^ n) x :> (\<lambda>h. of_nat n * x ^ (n - 1) * h)"
-  apply (cases n)
-   apply (simp add: FDERIV_const)
-  apply (simp add: FDERIV_power_Suc)
-  done
-
-
-subsection {* Inverse *}
-
-lemma inverse_diff_inverse:
-  "\<lbrakk>(a::'a::division_ring) \<noteq> 0; b \<noteq> 0\<rbrakk>
-   \<Longrightarrow> inverse a - inverse b = - (inverse a * (a - b) * inverse b)"
-by (simp add: right_diff_distrib left_diff_distrib mult_assoc)
-
-lemmas bounded_linear_mult_const =
-  mult.bounded_linear_left [THEN bounded_linear_compose]
-
-lemmas bounded_linear_const_mult =
-  mult.bounded_linear_right [THEN bounded_linear_compose]
-
-lemma FDERIV_inverse:
-  fixes x :: "'a::real_normed_div_algebra"
-  assumes x: "x \<noteq> 0"
-  shows "FDERIV inverse x :> (\<lambda>h. - (inverse x * h * inverse x))"
-        (is "FDERIV ?inv _ :> _")
-proof (rule FDERIV_I)
-  show "bounded_linear (\<lambda>h. - (?inv x * h * ?inv x))"
-    apply (rule bounded_linear_minus)
-    apply (rule bounded_linear_mult_const)
-    apply (rule bounded_linear_const_mult)
-    apply (rule bounded_linear_ident)
-    done
-next
-  show "(\<lambda>h. norm (?inv (x + h) - ?inv x - - (?inv x * h * ?inv x)) / norm h)
-        -- 0 --> 0"
-  proof (rule LIM_equal2)
-    show "0 < norm x" using x by simp
-  next
-    fix h::'a
-    assume 1: "h \<noteq> 0"
-    assume "norm (h - 0) < norm x"
-    hence "h \<noteq> -x" by clarsimp
-    hence 2: "x + h \<noteq> 0"
-      apply (rule contrapos_nn)
-      apply (rule sym)
-      apply (erule equals_zero_I)
-      done
-    show "norm (?inv (x + h) - ?inv x - - (?inv x * h * ?inv x)) / norm h
-          = norm ((?inv (x + h) - ?inv x) * h * ?inv x) / norm h"
-      apply (subst inverse_diff_inverse [OF 2 x])
-      apply (subst minus_diff_minus)
-      apply (subst norm_minus_cancel)
-      apply (simp add: left_diff_distrib)
-      done
-  next
-    show "(\<lambda>h. norm ((?inv (x + h) - ?inv x) * h * ?inv x) / norm h)
-          -- 0 --> 0"
-    proof (rule real_LIM_sandwich_zero)
-      show "(\<lambda>h. norm (?inv (x + h) - ?inv x) * norm (?inv x))
-            -- 0 --> 0"
-        apply (rule LIM_mult_left_zero)
-        apply (rule LIM_norm_zero)
-        apply (rule LIM_zero)
-        apply (rule LIM_offset_zero)
-        apply (rule LIM_inverse)
-        apply (rule LIM_ident)
-        apply (rule x)
-        done
-    next
-      fix h::'a assume h: "h \<noteq> 0"
-      show "0 \<le> norm ((?inv (x + h) - ?inv x) * h * ?inv x) / norm h"
-        apply (rule divide_nonneg_pos)
-        apply (rule norm_ge_zero)
-        apply (simp add: h)
-        done
-    next
-      fix h::'a assume h: "h \<noteq> 0"
-      have "norm ((?inv (x + h) - ?inv x) * h * ?inv x) / norm h
-            \<le> norm (?inv (x + h) - ?inv x) * norm h * norm (?inv x) / norm h"
-        apply (rule divide_right_mono [OF _ norm_ge_zero])
-        apply (rule order_trans [OF norm_mult_ineq])
-        apply (rule mult_right_mono [OF _ norm_ge_zero])
-        apply (rule norm_mult_ineq)
-        done
-      also have "\<dots> = norm (?inv (x + h) - ?inv x) * norm (?inv x)"
-        by simp
-      finally show "norm ((?inv (x + h) - ?inv x) * h * ?inv x) / norm h
-            \<le> norm (?inv (x + h) - ?inv x) * norm (?inv x)" .   
-    qed
-  qed
-qed
-
-subsection {* Alternate definition *}
-
-lemma field_fderiv_def:
-  fixes x :: "'a::real_normed_field" shows
-  "FDERIV f x :> (\<lambda>h. h * D) = (\<lambda>h. (f (x + h) - f x) / h) -- 0 --> D"
- apply (unfold fderiv_def)
- apply (simp add: mult.bounded_linear_left)
- apply (simp cong: LIM_cong add: nonzero_norm_divide [symmetric])
- apply (subst diff_divide_distrib)
- apply (subst times_divide_eq_left [symmetric])
- apply (simp cong: LIM_cong)
- apply (simp add: LIM_norm_zero_iff LIM_zero_iff)
-done
-
-end
--- a/src/HOL/GCD.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/GCD.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -60,9 +60,12 @@
 lemma gcd_non_0: "n > 0 \<Longrightarrow> gcd m n = gcd n (m mod n)"
   by simp
 
-lemma gcd_1 [simp, algebra]: "gcd m (Suc 0) = 1"
+lemma gcd_1 [simp, algebra]: "gcd m (Suc 0) = Suc 0"
   by simp
 
+lemma nat_gcd_1_right [simp, algebra]: "gcd m 1 = 1"
+  unfolding One_nat_def by (rule gcd_1)
+
 declare gcd.simps [simp del]
 
 text {*
@@ -116,9 +119,12 @@
   apply (blast intro: dvd_trans)
   done
 
-lemma gcd_1_left [simp, algebra]: "gcd (Suc 0) m = 1"
+lemma gcd_1_left [simp, algebra]: "gcd (Suc 0) m = Suc 0"
   by (simp add: gcd_commute)
 
+lemma nat_gcd_1_left [simp, algebra]: "gcd 1 m = 1"
+  unfolding One_nat_def by (rule gcd_1_left)
+
 text {*
   \medskip Multiplication laws
 *}
@@ -156,7 +162,6 @@
      apply (simp add: gcd_assoc)
      apply (simp add: gcd_commute)
     apply (simp_all add: mult_commute)
-  apply (blast intro: dvd_mult)
   done
 
 
@@ -404,7 +409,7 @@
   {fix x y assume H: "a * x - b * y = d \<or> b * x - a * y = d"
     have dv: "?g dvd a*x" "?g dvd b * y" "?g dvd b*x" "?g dvd a * y"
       using dvd_mult2[OF gcd_dvd1[of a b]] dvd_mult2[OF gcd_dvd2[of a b]] by simp_all
-    from dvd_diff[OF dv(1,2)] dvd_diff[OF dv(3,4)] H
+    from nat_dvd_diff[OF dv(1,2)] nat_dvd_diff[OF dv(3,4)] H
     have ?rhs by auto}
   ultimately show ?thesis by blast
 qed
@@ -597,8 +602,8 @@
   from h' have "int (nat \<bar>k\<bar>) = int (nat \<bar>i\<bar> * h')" by simp
   then have "\<bar>k\<bar> = \<bar>i\<bar> * int h'" by (simp add: int_mult)
   then show ?thesis
-    apply (subst zdvd_abs1 [symmetric])
-    apply (subst zdvd_abs2 [symmetric])
+    apply (subst abs_dvd_iff [symmetric])
+    apply (subst dvd_abs_iff [symmetric])
     apply (unfold dvd_def)
     apply (rule_tac x = "int h'" in exI, simp)
     done
@@ -614,11 +619,11 @@
   let ?m' = "nat \<bar>m\<bar>"
   let ?n' = "nat \<bar>n\<bar>"
   from `k dvd m` and `k dvd n` have dvd': "?k' dvd ?m'" "?k' dvd ?n'"
-    unfolding zdvd_int by (simp_all only: int_nat_abs zdvd_abs1 zdvd_abs2)
+    unfolding zdvd_int by (simp_all only: int_nat_abs abs_dvd_iff dvd_abs_iff)
   from gcd_greatest [OF dvd'] have "int (nat \<bar>k\<bar>) dvd zgcd m n"
     unfolding zgcd_def by (simp only: zdvd_int)
   then have "\<bar>k\<bar> dvd zgcd m n" by (simp only: int_nat_abs)
-  then show "k dvd zgcd m n" by (simp add: zdvd_abs1)
+  then show "k dvd zgcd m n" by simp
 qed
 
 lemma div_zgcd_relprime:
@@ -721,7 +726,7 @@
   assumes "k dvd i" shows "k dvd (zlcm i j)"
 proof -
   have "nat(abs k) dvd nat(abs i)" using `k dvd i`
-    by(simp add:int_dvd_iff[symmetric] dvd_int_iff[symmetric] zdvd_abs1)
+    by(simp add:int_dvd_iff[symmetric] dvd_int_iff[symmetric])
   thus ?thesis by(simp add:zlcm_def dvd_int_iff)(blast intro: dvd_trans)
 qed
 
@@ -729,7 +734,7 @@
   assumes "k dvd j" shows "k dvd (zlcm i j)"
 proof -
   have "nat(abs k) dvd nat(abs j)" using `k dvd j`
-    by(simp add:int_dvd_iff[symmetric] dvd_int_iff[symmetric] zdvd_abs1)
+    by(simp add:int_dvd_iff[symmetric] dvd_int_iff[symmetric])
   thus ?thesis by(simp add:zlcm_def dvd_int_iff)(blast intro: dvd_trans)
 qed
 
--- a/src/HOL/Groebner_Basis.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Groebner_Basis.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -147,7 +147,7 @@
 next show "pwr (mul x y) q = mul (pwr x q) (pwr y q)" by (rule pwr_mul)
 next show "pwr (pwr x p) q = pwr x (p * q)" by (rule pwr_pwr)
 next show "pwr x 0 = r1" using pwr_0 .
-next show "pwr x 1 = x" by (simp add: nat_number pwr_Suc pwr_0 mul_1 mul_c)
+next show "pwr x 1 = x" unfolding One_nat_def by (simp add: nat_number pwr_Suc pwr_0 mul_1 mul_c)
 next show "mul x (add y z) = add (mul x y) (mul x z)" using mul_d by simp
 next show "pwr x (Suc q) = mul x (pwr x q)" using pwr_Suc by simp
 next show "pwr x (2 * n) = mul (pwr x n) (pwr x n)" by (simp add: nat_number mul_pwr)
@@ -436,8 +436,8 @@
 *} "solve polynomial equations over (semi)rings and ideal membership problems using Groebner bases"
 declare dvd_def[algebra]
 declare dvd_eq_mod_eq_0[symmetric, algebra]
-declare nat_mod_div_trivial[algebra]
-declare nat_mod_mod_trivial[algebra]
+declare mod_div_trivial[algebra]
+declare mod_mod_trivial[algebra]
 declare conjunct1[OF DIVISION_BY_ZERO, algebra]
 declare conjunct2[OF DIVISION_BY_ZERO, algebra]
 declare zmod_zdiv_equality[symmetric,algebra]
@@ -448,16 +448,16 @@
 declare zmod_zminus2[algebra]
 declare zdiv_zero[algebra]
 declare zmod_zero[algebra]
-declare zmod_1[algebra]
-declare zdiv_1[algebra]
+declare mod_by_1[algebra]
+declare div_by_1[algebra]
 declare zmod_minus1_right[algebra]
 declare zdiv_minus1_right[algebra]
 declare mod_div_trivial[algebra]
 declare mod_mod_trivial[algebra]
-declare zmod_zmult_self1[algebra]
-declare zmod_zmult_self2[algebra]
+declare mod_mult_self2_is_0[algebra]
+declare mod_mult_self1_is_0[algebra]
 declare zmod_eq_0_iff[algebra]
-declare zdvd_0_left[algebra]
+declare dvd_0_left_iff[algebra]
 declare zdvd1_eq[algebra]
 declare zmod_eq_dvd_iff[algebra]
 declare nat_mod_eq_iff[algebra]
--- a/src/HOL/HOL.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/HOL.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -28,7 +28,8 @@
   ("~~/src/Tools/induct_tacs.ML")
   "~~/src/Tools/value.ML"
   "~~/src/Tools/code/code_name.ML"
-  "~~/src/Tools/code/code_funcgr.ML"
+  "~~/src/Tools/code/code_wellsorted.ML" (* formal dependency *)
+  (*"~~/src/Tools/code/code_funcgr.ML"*)
   "~~/src/Tools/code/code_thingol.ML"
   "~~/src/Tools/code/code_printer.ML"
   "~~/src/Tools/code/code_target.ML"
@@ -290,7 +291,7 @@
 typed_print_translation {*
 let
   fun tr' c = (c, fn show_sorts => fn T => fn ts =>
-    if T = dummyT orelse not (! show_types) andalso can Term.dest_Type T then raise Match
+    if (not o null) ts orelse T = dummyT orelse not (! show_types) andalso can Term.dest_Type T then raise Match
     else Syntax.const Syntax.constrainC $ Syntax.const c $ Syntax.term_of_typ show_sorts T);
 in map tr' [@{const_syntax HOL.one}, @{const_syntax HOL.zero}] end;
 *} -- {* show types that are presumably too general *}
--- a/src/HOL/Hoare/Arith2.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Hoare/Arith2.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -42,12 +42,12 @@
 
 lemma cd_diff_l: "n<=m ==> cd x m n = cd x (m-n) n"
   apply (unfold cd_def)
-  apply (blast intro: dvd_diff dest: dvd_diffD)
+  apply (fastsimp dest: dvd_diffD)
   done
 
 lemma cd_diff_r: "m<=n ==> cd x m n = cd x m (n-m)"
   apply (unfold cd_def)
-  apply (blast intro: dvd_diff dest: dvd_diffD)
+  apply (fastsimp dest: dvd_diffD)
   done
 
 
--- a/src/HOL/Induct/Common_Patterns.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Induct/Common_Patterns.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -1,5 +1,4 @@
 (*  Title:      HOL/Induct/Common_Patterns.thy
-    ID:         $Id$
     Author:     Makarius
 *)
 
--- a/src/HOL/Int.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Int.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -832,8 +832,8 @@
                              le_imp_0_less [THEN order_less_imp_le])  
 next
   case (neg n)
-  thus ?thesis by (simp del: of_nat_Suc of_nat_add
-    add: algebra_simps of_nat_1 [symmetric] of_nat_add [symmetric])
+  thus ?thesis by (simp del: of_nat_Suc of_nat_add of_nat_1
+    add: algebra_simps of_nat_1 [where 'a=int, symmetric] of_nat_add [symmetric])
 qed
 
 lemma bin_less_0_simps:
@@ -1165,8 +1165,8 @@
                              le_imp_0_less [THEN order_less_imp_le])  
 next
   case (neg n)
-  thus ?thesis by (simp del: of_nat_Suc of_nat_add
-    add: algebra_simps of_nat_1 [symmetric] of_nat_add [symmetric])
+  thus ?thesis by (simp del: of_nat_Suc of_nat_add of_nat_1
+    add: algebra_simps of_nat_1 [where 'a=int, symmetric] of_nat_add [symmetric])
 qed
 
 text {* Less-Than or Equals *}
@@ -1547,7 +1547,7 @@
      "abs(-1 ^ n) = (1::'a::{ordered_idom,number_ring,recpower})"
 by (simp add: power_abs)
 
-lemma of_int_number_of_eq:
+lemma of_int_number_of_eq [simp]:
      "of_int (number_of v) = (number_of v :: 'a :: number_ring)"
 by (simp add: number_of_eq) 
 
@@ -1627,7 +1627,7 @@
 context ring_1
 begin
 
-lemma of_int_of_nat:
+lemma of_int_of_nat [nitpick_const_simp]:
   "of_int k = (if k < 0 then - of_nat (nat (- k)) else of_nat (nat k))"
 proof (cases "k < 0")
   case True then have "0 \<le> - k" by simp
@@ -1785,11 +1785,12 @@
 lemma int_val_lemma:
      "(\<forall>i<n::nat. abs(f(i+1) - f i) \<le> 1) -->  
       f 0 \<le> k --> k \<le> f n --> (\<exists>i \<le> n. f i = (k::int))"
+unfolding One_nat_def
 apply (induct n, simp)
 apply (intro strip)
 apply (erule impE, simp)
 apply (erule_tac x = n in allE, simp)
-apply (case_tac "k = f (n+1) ")
+apply (case_tac "k = f (Suc n)")
 apply force
 apply (erule impE)
  apply (simp add: abs_if split add: split_if_asm)
@@ -1803,6 +1804,7 @@
          f m \<le> k; k \<le> f n |] ==> ? i. m \<le> i & i \<le> n & f i = (k::int)"
 apply (cut_tac n = "n-m" and f = "%i. f (i+m) " and k = k 
        in int_val_lemma)
+unfolding One_nat_def
 apply simp
 apply (erule exE)
 apply (rule_tac x = "i+m" in exI, arith)
--- a/src/HOL/IntDiv.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/IntDiv.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -377,6 +377,11 @@
 apply (blast intro: divmod_rel_div_mod [THEN zminus1_lemma, THEN divmod_rel_mod])
 done
 
+lemma zmod_zminus1_not_zero:
+  fixes k l :: int
+  shows "- k mod l \<noteq> 0 \<Longrightarrow> k mod l \<noteq> 0"
+  unfolding zmod_zminus1_eq_if by auto
+
 lemma zdiv_zminus2: "a div (-b) = (-a::int) div b"
 by (cut_tac a = "-a" in zdiv_zminus_zminus, auto)
 
@@ -393,6 +398,11 @@
      "a mod (-b::int) = (if a mod b = 0 then 0 else  (a mod b) - b)"
 by (simp add: zmod_zminus1_eq_if zmod_zminus2)
 
+lemma zmod_zminus2_not_zero:
+  fixes k l :: int
+  shows "k mod - l \<noteq> 0 \<Longrightarrow> k mod l \<noteq> 0"
+  unfolding zmod_zminus2_eq_if by auto 
+
 
 subsection{*Division of a Number by Itself*}
 
@@ -441,9 +451,6 @@
 lemma zmod_zero [simp]: "(0::int) mod b = 0"
 by (simp add: mod_def divmod_def)
 
-lemma zdiv_minus1: "(0::int) < b ==> -1 div b = -1"
-by (simp add: div_def divmod_def)
-
 lemma zmod_minus1: "(0::int) < b ==> -1 mod b = b - 1"
 by (simp add: mod_def divmod_def)
 
@@ -540,34 +547,6 @@
 simproc_setup binary_int_mod ("number_of m mod number_of n :: int") =
   {* K (divmod_proc (@{thm divmod_rel_mod_eq})) *}
 
-(* The following 8 lemmas are made unnecessary by the above simprocs: *)
-
-lemmas div_pos_pos_number_of =
-    div_pos_pos [of "number_of v" "number_of w", standard]
-
-lemmas div_neg_pos_number_of =
-    div_neg_pos [of "number_of v" "number_of w", standard]
-
-lemmas div_pos_neg_number_of =
-    div_pos_neg [of "number_of v" "number_of w", standard]
-
-lemmas div_neg_neg_number_of =
-    div_neg_neg [of "number_of v" "number_of w", standard]
-
-
-lemmas mod_pos_pos_number_of =
-    mod_pos_pos [of "number_of v" "number_of w", standard]
-
-lemmas mod_neg_pos_number_of =
-    mod_neg_pos [of "number_of v" "number_of w", standard]
-
-lemmas mod_pos_neg_number_of =
-    mod_pos_neg [of "number_of v" "number_of w", standard]
-
-lemmas mod_neg_neg_number_of =
-    mod_neg_neg [of "number_of v" "number_of w", standard]
-
-
 lemmas posDivAlg_eqn_number_of [simp] =
     posDivAlg_eqn [of "number_of v" "number_of w", standard]
 
@@ -577,15 +556,6 @@
 
 text{*Special-case simplification *}
 
-lemma zmod_1 [simp]: "a mod (1::int) = 0"
-apply (cut_tac a = a and b = 1 in pos_mod_sign)
-apply (cut_tac [2] a = a and b = 1 in pos_mod_bound)
-apply (auto simp del:pos_mod_bound pos_mod_sign)
-done
-
-lemma zdiv_1 [simp]: "a div (1::int) = a"
-by (cut_tac a = a and b = 1 in zmod_zdiv_equality, auto)
-
 lemma zmod_minus1_right [simp]: "a mod (-1::int) = 0"
 apply (cut_tac a = a and b = "-1" in neg_mod_sign)
 apply (cut_tac [2] a = a and b = "-1" in neg_mod_bound)
@@ -719,18 +689,6 @@
 apply (blast intro: divmod_rel_div_mod [THEN zmult1_lemma, THEN divmod_rel_mod])
 done
 
-lemma zmod_zmult1_eq': "(a*b) mod (c::int) = ((a mod c) * b) mod c"
-apply (rule trans)
-apply (rule_tac s = "b*a mod c" in trans)
-apply (rule_tac [2] zmod_zmult1_eq)
-apply (simp_all add: mult_commute)
-done
-
-lemma zmod_zmult_distrib: "(a*b) mod (c::int) = ((a mod c) * (b mod c)) mod c"
-apply (rule zmod_zmult1_eq' [THEN trans])
-apply (rule zmod_zmult1_eq)
-done
-
 lemma zdiv_zmult_self1 [simp]: "b \<noteq> (0::int) ==> (a*b) div b = a"
 by (simp add: zdiv_zmult1_eq)
 
@@ -739,11 +697,6 @@
 apply (auto simp add: linorder_neq_iff div_pos_pos_trivial div_neg_neg_trivial)
 done
 
-lemma zmod_zmod_trivial: "(a mod b) mod b = a mod (b::int)"
-apply (case_tac "b = 0", simp)
-apply (force simp add: linorder_neq_iff mod_pos_pos_trivial mod_neg_neg_trivial)
-done
-
 text{*proving (a+b) div c = a div c + b div c + ((a mod c + b mod c) div c) *}
 
 lemma zadd1_lemma:
@@ -758,11 +711,6 @@
 apply (blast intro: zadd1_lemma [OF divmod_rel_div_mod divmod_rel_div_mod] divmod_rel_div)
 done
 
-lemma zmod_zadd1_eq: "(a+b) mod (c::int) = (a mod c + b mod c) mod c"
-apply (case_tac "c = 0", simp)
-apply (blast intro: zadd1_lemma [OF divmod_rel_div_mod divmod_rel_div_mod] divmod_rel_mod)
-done
-
 instance int :: ring_div
 proof
   fix a b c :: int
@@ -799,41 +747,12 @@
   show ?thesis by simp
 qed
 
-lemma zdiv_zadd_self1: "a \<noteq> (0::int) ==> (a+b) div a = b div a + 1"
-by (rule div_add_self1) (* already declared [simp] *)
-
-lemma zdiv_zadd_self2: "a \<noteq> (0::int) ==> (b+a) div a = b div a + 1"
-by (rule div_add_self2) (* already declared [simp] *)
-
-lemma zdiv_zmult_self2: "b \<noteq> (0::int) ==> (b*a) div b = a"
-by (rule div_mult_self1_is_id) (* already declared [simp] *)
-
-lemma zmod_zmult_self1: "(a*b) mod b = (0::int)"
-by (rule mod_mult_self2_is_0) (* already declared [simp] *)
-
-lemma zmod_zmult_self2: "(b*a) mod b = (0::int)"
-by (rule mod_mult_self1_is_0) (* already declared [simp] *)
-
 lemma zmod_eq_0_iff: "(m mod d = 0) = (EX q::int. m = d*q)"
 by (simp add: dvd_eq_mod_eq_0 [symmetric] dvd_def)
 
 (* REVISIT: should this be generalized to all semiring_div types? *)
 lemmas zmod_eq_0D [dest!] = zmod_eq_0_iff [THEN iffD1]
 
-lemma zmod_zadd_left_eq: "(a+b) mod (c::int) = ((a mod c) + b) mod c"
-by (rule mod_add_left_eq)
-
-lemma zmod_zadd_right_eq: "(a+b) mod (c::int) = (a + (b mod c)) mod c"
-by (rule mod_add_right_eq)
-
-lemma zmod_zadd_self1: "(a+b) mod a = b mod (a::int)"
-by (rule mod_add_self1) (* already declared [simp] *)
-
-lemma zmod_zadd_self2: "(b+a) mod a = b mod (a::int)"
-by (rule mod_add_self2) (* already declared [simp] *)
-
-lemma zmod_zdiff1_eq: "(a - b) mod c = (a mod c - b mod c) mod (c::int)"
-by (rule mod_diff_eq)
 
 subsection{*Proving  @{term "a div (b*c) = (a div b) div c"} *}
 
@@ -917,13 +836,6 @@
   "(k*m) div (k*n) = (if k = (0::int) then 0 else m div n)"
 by (simp add:zdiv_zmult_zmult1)
 
-(*
-lemma zdiv_zmult_zmult2: "c \<noteq> (0::int) ==> (a*c) div (b*c) = a div b"
-apply (drule zdiv_zmult_zmult1)
-apply (auto simp add: mult_commute)
-done
-*)
-
 
 subsection{*Distribution of Factors over mod*}
 
@@ -948,9 +860,6 @@
 apply (auto simp add: mult_commute)
 done
 
-lemma zmod_zmod_cancel: "n dvd m \<Longrightarrow> (k::int) mod m mod n = k mod n"
-by (rule mod_mod_cancel)
-
 
 subsection {*Splitting Rules for div and mod*}
 
@@ -961,7 +870,7 @@
     P(n div k :: int)(n mod k) = (\<forall>i j. 0\<le>j & j<k & n = k*i + j --> P i j)"
 apply (rule iffI, clarify)
  apply (erule_tac P="P ?x ?y" in rev_mp)  
- apply (subst zmod_zadd1_eq) 
+ apply (subst mod_add_eq) 
  apply (subst zdiv_zadd1_eq) 
  apply (simp add: div_pos_pos_trivial mod_pos_pos_trivial)  
 txt{*converse direction*}
@@ -974,7 +883,7 @@
     P(n div k :: int)(n mod k) = (\<forall>i j. k<j & j\<le>0 & n = k*i + j --> P i j)"
 apply (rule iffI, clarify)
  apply (erule_tac P="P ?x ?y" in rev_mp)  
- apply (subst zmod_zadd1_eq) 
+ apply (subst mod_add_eq) 
  apply (subst zdiv_zadd1_eq) 
  apply (simp add: div_neg_neg_trivial mod_neg_neg_trivial)  
 txt{*converse direction*}
@@ -1047,11 +956,6 @@
        simp) 
 done
 
-(*Not clear why this must be proved separately; probably number_of causes
-  simplification problems*)
-lemma not_0_le_lemma: "~ 0 \<le> x ==> x \<le> (0::int)"
-by auto
-
 lemma zdiv_number_of_Bit0 [simp]:
      "number_of (Int.Bit0 v) div number_of (Int.Bit0 w) =  
           number_of v div (number_of w :: int)"
@@ -1078,7 +982,7 @@
  apply (rule_tac [2] mult_left_mono)
 apply (auto simp add: add_commute [of 1] mult_commute add1_zle_eq 
                       pos_mod_bound)
-apply (subst zmod_zadd1_eq)
+apply (subst mod_add_eq)
 apply (simp add: zmod_zmult_zmult2 mod_pos_pos_trivial)
 apply (rule mod_pos_pos_trivial)
 apply (auto simp add: mod_pos_pos_trivial ring_distribs)
@@ -1090,7 +994,7 @@
 apply (subgoal_tac "(1 + 2* (-b - 1)) mod (2* (-a)) = 
                     1 + 2* ((-b - 1) mod (-a))")
 apply (rule_tac [2] pos_zmod_mult_2)
-apply (auto simp add: minus_mult_right [symmetric] right_diff_distrib)
+apply (auto simp add: right_diff_distrib)
 apply (subgoal_tac " (-1 - (2 * b)) = - (1 + (2 * b))")
  prefer 2 apply simp 
 apply (simp only: zmod_zminus_zminus diff_minus minus_add_distrib [symmetric])
@@ -1101,7 +1005,7 @@
       (2::int) * (number_of v mod number_of w)"
 apply (simp only: number_of_eq numeral_simps) 
 apply (simp add: zmod_zmult_zmult1 pos_zmod_mult_2 
-                 not_0_le_lemma neg_zmod_mult_2 add_ac)
+                 neg_zmod_mult_2 add_ac)
 done
 
 lemma zmod_number_of_Bit1 [simp]:
@@ -1111,7 +1015,7 @@
                 else 2 * ((number_of v + (1::int)) mod number_of w) - 1)"
 apply (simp only: number_of_eq numeral_simps) 
 apply (simp add: zmod_zmult_zmult1 pos_zmod_mult_2 
-                 not_0_le_lemma neg_zmod_mult_2 add_ac)
+                 neg_zmod_mult_2 add_ac)
 done
 
 
@@ -1121,7 +1025,7 @@
 apply (subgoal_tac "a div b \<le> -1", force)
 apply (rule order_trans)
 apply (rule_tac a' = "-1" in zdiv_mono1)
-apply (auto simp add: zdiv_minus1)
+apply (auto simp add: div_eq_minus1)
 done
 
 lemma div_nonneg_neg_le0: "[| (0::int) \<le> a;  b < 0 |] ==> a div b \<le> 0"
@@ -1152,38 +1056,8 @@
 
 subsection {* The Divides Relation *}
 
-lemma zdvd_iff_zmod_eq_0: "(m dvd n) = (n mod m = (0::int))"
-  by (rule dvd_eq_mod_eq_0)
-
 lemmas zdvd_iff_zmod_eq_0_number_of [simp] =
-  zdvd_iff_zmod_eq_0 [of "number_of x" "number_of y", standard]
-
-lemma zdvd_0_right: "(m::int) dvd 0"
-  by (rule dvd_0_right) (* already declared [iff] *)
-
-lemma zdvd_0_left: "(0 dvd (m::int)) = (m = 0)"
-  by (rule dvd_0_left_iff) (* already declared [noatp,simp] *)
-
-lemma zdvd_1_left: "1 dvd (m::int)"
-  by (rule one_dvd) (* already declared [simp] *)
-
-lemma zdvd_refl [simp]: "m dvd (m::int)"
-  by (rule dvd_refl) (* TODO: declare generic dvd_refl [simp] *)
-
-lemma zdvd_trans: "m dvd n ==> n dvd k ==> m dvd (k::int)"
-  by (rule dvd_trans)
-
-lemma zdvd_zminus_iff[simp]: "m dvd -n \<longleftrightarrow> m dvd (n::int)"
-  by (rule dvd_minus_iff)
-
-lemma zdvd_zminus2_iff[simp]: "-m dvd n \<longleftrightarrow> m dvd (n::int)"
-  by (rule minus_dvd_iff)
-
-lemma zdvd_abs1[simp]: "( \<bar>i::int\<bar> dvd j) = (i dvd j)" 
-  by (cases "i > 0") (simp_all add: zdvd_zminus2_iff)
-
-lemma zdvd_abs2[simp]: "( (i::int) dvd \<bar>j\<bar>) = (i dvd j)" 
-  by (cases "j > 0") (simp_all add: zdvd_zminus_iff)
+  dvd_eq_mod_eq_0 [of "number_of x::int" "number_of y::int", standard]
 
 lemma zdvd_anti_sym:
     "0 < m ==> 0 < n ==> m dvd n ==> n dvd m ==> m = (n::int)"
@@ -1191,58 +1065,32 @@
   apply (simp add: mult_assoc zero_less_mult_iff zmult_eq_1_iff)
   done
 
-lemma zdvd_zadd: "k dvd m ==> k dvd n ==> k dvd (m + n :: int)"
-  by (rule dvd_add)
-
-lemma zdvd_dvd_eq: assumes anz:"a \<noteq> 0" and ab: "(a::int) dvd b" and ba:"b dvd a" 
+lemma zdvd_dvd_eq: assumes "a \<noteq> 0" and "(a::int) dvd b" and "b dvd a" 
   shows "\<bar>a\<bar> = \<bar>b\<bar>"
 proof-
-  from ab obtain k where k:"b = a*k" unfolding dvd_def by blast 
-  from ba obtain k' where k':"a = b*k'" unfolding dvd_def by blast 
+  from `a dvd b` obtain k where k:"b = a*k" unfolding dvd_def by blast 
+  from `b dvd a` obtain k' where k':"a = b*k'" unfolding dvd_def by blast 
   from k k' have "a = a*k*k'" by simp
   with mult_cancel_left1[where c="a" and b="k*k'"]
-  have kk':"k*k' = 1" using anz by (simp add: mult_assoc)
+  have kk':"k*k' = 1" using `a\<noteq>0` by (simp add: mult_assoc)
   hence "k = 1 \<and> k' = 1 \<or> k = -1 \<and> k' = -1" by (simp add: zmult_eq_1_iff)
   thus ?thesis using k k' by auto
 qed
 
-lemma zdvd_zdiff: "k dvd m ==> k dvd n ==> k dvd (m - n :: int)"
-  by (rule Ring_and_Field.dvd_diff)
-
 lemma zdvd_zdiffD: "k dvd m - n ==> k dvd n ==> k dvd (m::int)"
   apply (subgoal_tac "m = n + (m - n)")
    apply (erule ssubst)
-   apply (blast intro: zdvd_zadd, simp)
+   apply (blast intro: dvd_add, simp)
   done
 
-lemma zdvd_zmult: "k dvd (n::int) ==> k dvd m * n"
-  by (rule dvd_mult)
-
-lemma zdvd_zmult2: "k dvd (m::int) ==> k dvd m * n"
-  by (rule dvd_mult2)
-
-lemma zdvd_triv_right: "(k::int) dvd m * k"
-  by (rule dvd_triv_right) (* already declared [simp] *)
-
-lemma zdvd_triv_left: "(k::int) dvd k * m"
-  by (rule dvd_triv_left) (* already declared [simp] *)
-
-lemma zdvd_zmultD2: "j * k dvd n ==> j dvd (n::int)"
-  by (rule dvd_mult_left)
-
-lemma zdvd_zmultD: "j * k dvd n ==> k dvd (n::int)"
-  by (rule dvd_mult_right)
-
-lemma zdvd_zmult_mono: "i dvd m ==> j dvd (n::int) ==> i * j dvd m * n"
-  by (rule mult_dvd_mono)
-
 lemma zdvd_reduce: "(k dvd n + k * m) = (k dvd (n::int))"
-  apply (rule iffI)
-   apply (erule_tac [2] zdvd_zadd)
-   apply (subgoal_tac "n = (n + k * m) - k * m")
-    apply (erule ssubst)
-    apply (erule zdvd_zdiff, simp_all)
-  done
+apply (rule iffI)
+ apply (erule_tac [2] dvd_add)
+ apply (subgoal_tac "n = (n + k * m) - k * m")
+  apply (erule ssubst)
+  apply (erule dvd_diff)
+  apply(simp_all)
+done
 
 lemma zdvd_zmod: "f dvd m ==> f dvd (n::int) ==> f dvd m mod n"
   apply (simp add: dvd_def)
@@ -1252,7 +1100,7 @@
 lemma zdvd_zmod_imp_zdvd: "k dvd m mod n ==> k dvd n ==> k dvd (m::int)"
   apply (subgoal_tac "k dvd n * (m div n) + m mod n")
    apply (simp add: zmod_zdiv_equality [symmetric])
-  apply (simp only: zdvd_zadd zdvd_zmult2)
+  apply (simp only: dvd_add dvd_mult2)
   done
 
 lemma zdvd_not_zless: "0 < m ==> m < n ==> \<not> n dvd (m::int)"
@@ -1272,7 +1120,7 @@
 lemma zdvd_mult_div_cancel:"(n::int) dvd m \<Longrightarrow> n * (m div n) = m"
 apply (subgoal_tac "m mod n = 0")
  apply (simp add: zmult_div_cancel)
-apply (simp only: zdvd_iff_zmod_eq_0)
+apply (simp only: dvd_eq_mod_eq_0)
 done
 
 lemma zdvd_mult_cancel: assumes d:"k * m dvd k * n" and kz:"k \<noteq> (0::int)"
@@ -1285,10 +1133,6 @@
   thus ?thesis by simp
 qed
 
-lemma zdvd_zmult_cancel_disj[simp]:
-  "(k*m) dvd (k*n) = (k=0 | m dvd (n::int))"
-by (auto simp: zdvd_zmult_mono dest: zdvd_mult_cancel)
-
 
 theorem ex_nat: "(\<exists>x::nat. P x) = (\<exists>x::int. 0 <= x \<and> P (nat x))"
 apply (simp split add: split_nat)
@@ -1320,44 +1164,38 @@
       then show ?thesis by (simp only: negative_eq_positive) auto
     qed
   qed
-  then show ?thesis by (auto elim!: dvdE simp only: zdvd_triv_left int_mult)
+  then show ?thesis by (auto elim!: dvdE simp only: dvd_triv_left int_mult)
 qed
 
 lemma zdvd1_eq[simp]: "(x::int) dvd 1 = ( \<bar>x\<bar> = 1)"
 proof
-  assume d: "x dvd 1" hence "int (nat \<bar>x\<bar>) dvd int (nat 1)" by (simp add: zdvd_abs1)
+  assume d: "x dvd 1" hence "int (nat \<bar>x\<bar>) dvd int (nat 1)" by simp
   hence "nat \<bar>x\<bar> dvd 1" by (simp add: zdvd_int)
   hence "nat \<bar>x\<bar> = 1"  by simp
   thus "\<bar>x\<bar> = 1" by (cases "x < 0", auto)
 next
   assume "\<bar>x\<bar>=1" thus "x dvd 1" 
-    by(cases "x < 0",simp_all add: minus_equation_iff zdvd_iff_zmod_eq_0)
+    by(cases "x < 0",simp_all add: minus_equation_iff dvd_eq_mod_eq_0)
 qed
 lemma zdvd_mult_cancel1: 
   assumes mp:"m \<noteq>(0::int)" shows "(m * n dvd m) = (\<bar>n\<bar> = 1)"
 proof
   assume n1: "\<bar>n\<bar> = 1" thus "m * n dvd m" 
-    by (cases "n >0", auto simp add: zdvd_zminus2_iff minus_equation_iff)
+    by (cases "n >0", auto simp add: minus_dvd_iff minus_equation_iff)
 next
   assume H: "m * n dvd m" hence H2: "m * n dvd m * 1" by simp
   from zdvd_mult_cancel[OF H2 mp] show "\<bar>n\<bar> = 1" by (simp only: zdvd1_eq)
 qed
 
 lemma int_dvd_iff: "(int m dvd z) = (m dvd nat (abs z))"
-  unfolding zdvd_int by (cases "z \<ge> 0") (simp_all add: zdvd_zminus_iff)
+  unfolding zdvd_int by (cases "z \<ge> 0") simp_all
 
 lemma dvd_int_iff: "(z dvd int m) = (nat (abs z) dvd m)"
-  unfolding zdvd_int by (cases "z \<ge> 0") (simp_all add: zdvd_zminus2_iff)
+  unfolding zdvd_int by (cases "z \<ge> 0") simp_all
 
 lemma nat_dvd_iff: "(nat z dvd m) = (if 0 \<le> z then (z dvd int m) else m = 0)"
   by (auto simp add: dvd_int_iff)
 
-lemma zminus_dvd_iff [iff]: "(-z dvd w) = (z dvd (w::int))"
-  by (rule minus_dvd_iff)
-
-lemma dvd_zminus_iff [iff]: "(z dvd -w) = (z dvd (w::int))"
-  by (rule dvd_minus_iff)
-
 lemma zdvd_imp_le: "[| z dvd n; 0 < n |] ==> z \<le> (n::int)"
   apply (rule_tac z=n in int_cases)
   apply (auto simp add: dvd_int_iff)
@@ -1369,7 +1207,7 @@
 apply (induct "y", auto)
 apply (rule zmod_zmult1_eq [THEN trans])
 apply (simp (no_asm_simp))
-apply (rule zmod_zmult_distrib [symmetric])
+apply (rule mod_mult_eq [symmetric])
 done
 
 lemma zdiv_int: "int (a div b) = (int a) div (int b)"
@@ -1390,7 +1228,7 @@
 text{*Suggested by Matthias Daum*}
 lemma int_power_div_base:
      "\<lbrakk>0 < m; 0 < k\<rbrakk> \<Longrightarrow> k ^ m div k = (k::int) ^ (m - Suc 0)"
-apply (subgoal_tac "k ^ m = k ^ ((m - 1) + 1)")
+apply (subgoal_tac "k ^ m = k ^ ((m - Suc 0) + Suc 0)")
  apply (erule ssubst)
  apply (simp only: power_add)
  apply simp_all
@@ -1407,10 +1245,10 @@
 by (rule mod_diff_right_eq [symmetric])
 
 lemmas zmod_simps =
-  IntDiv.zmod_zadd_left_eq  [symmetric]
-  IntDiv.zmod_zadd_right_eq [symmetric]
+  mod_add_left_eq  [symmetric]
+  mod_add_right_eq [symmetric]
   IntDiv.zmod_zmult1_eq     [symmetric]
-  IntDiv.zmod_zmult1_eq'    [symmetric]
+  mod_mult_left_eq          [symmetric]
   IntDiv.zpower_zmod
   zminus_zmod zdiff_zmod_left zdiff_zmod_right
 
@@ -1483,14 +1321,14 @@
   assume H: "x mod n = y mod n"
   hence "x mod n - y mod n = 0" by simp
   hence "(x mod n - y mod n) mod n = 0" by simp 
-  hence "(x - y) mod n = 0" by (simp add: zmod_zdiff1_eq[symmetric])
-  thus "n dvd x - y" by (simp add: zdvd_iff_zmod_eq_0)
+  hence "(x - y) mod n = 0" by (simp add: mod_diff_eq[symmetric])
+  thus "n dvd x - y" by (simp add: dvd_eq_mod_eq_0)
 next
   assume H: "n dvd x - y"
   then obtain k where k: "x-y = n*k" unfolding dvd_def by blast
   hence "x = n*k + y" by simp
   hence "x mod n = (n*k + y) mod n" by simp
-  thus "x mod n = y mod n" by (simp add: zmod_zadd_left_eq)
+  thus "x mod n = y mod n" by (simp add: mod_add_left_eq)
 qed
 
 lemma nat_mod_eq_lemma: assumes xyn: "(x::nat) mod n = y  mod n" and xy:"y \<le> x"
@@ -1523,6 +1361,40 @@
   thus  ?lhs by simp
 qed
 
+
+subsection {* Code generation *}
+
+definition pdivmod :: "int \<Rightarrow> int \<Rightarrow> int \<times> int" where
+  "pdivmod k l = (\<bar>k\<bar> div \<bar>l\<bar>, \<bar>k\<bar> mod \<bar>l\<bar>)"
+
+lemma pdivmod_posDivAlg [code]:
+  "pdivmod k l = (if l = 0 then (0, \<bar>k\<bar>) else posDivAlg \<bar>k\<bar> \<bar>l\<bar>)"
+by (subst posDivAlg_div_mod) (simp_all add: pdivmod_def)
+
+lemma divmod_pdivmod: "divmod k l = (if k = 0 then (0, 0) else if l = 0 then (0, k) else
+  apsnd ((op *) (sgn l)) (if 0 < l \<and> 0 \<le> k \<or> l < 0 \<and> k < 0
+    then pdivmod k l
+    else (let (r, s) = pdivmod k l in
+      if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
+proof -
+  have aux: "\<And>q::int. - k = l * q \<longleftrightarrow> k = l * - q" by auto
+  show ?thesis
+    by (simp add: divmod_mod_div pdivmod_def)
+      (auto simp add: aux not_less not_le zdiv_zminus1_eq_if
+      zmod_zminus1_eq_if zdiv_zminus2_eq_if zmod_zminus2_eq_if)
+qed
+
+lemma divmod_code [code]: "divmod k l = (if k = 0 then (0, 0) else if l = 0 then (0, k) else
+  apsnd ((op *) (sgn l)) (if sgn k = sgn l
+    then pdivmod k l
+    else (let (r, s) = pdivmod k l in
+      if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
+proof -
+  have "k \<noteq> 0 \<Longrightarrow> l \<noteq> 0 \<Longrightarrow> 0 < l \<and> 0 \<le> k \<or> l < 0 \<and> k < 0 \<longleftrightarrow> sgn k = sgn l"
+    by (auto simp add: not_less sgn_if)
+  then show ?thesis by (simp add: divmod_pdivmod)
+qed
+
 code_modulename SML
   IntDiv Integer
 
--- a/src/HOL/Integration.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Integration.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -134,7 +134,7 @@
 apply (frule partition [THEN iffD1], safe)
 apply (drule_tac x = "psize D" and P="%n. psize D \<le> n --> ?P n" in spec, safe)
 apply (case_tac "psize D = 0")
-apply (drule_tac [2] n = "psize D - 1" in partition_lt, auto)
+apply (drule_tac [2] n = "psize D - Suc 0" in partition_lt, auto)
 done
 
 lemma partition_gt: "[|partition(a,b) D; n < (psize D)|] ==> D(n) < D(psize D)"
@@ -145,7 +145,7 @@
 apply (rotate_tac 2)
 apply (drule_tac x = "psize D" in spec)
 apply (rule ccontr)
-apply (drule_tac n = "psize D - 1" in partition_lt)
+apply (drule_tac n = "psize D - Suc 0" in partition_lt)
 apply auto
 done
 
--- a/src/HOL/IsaMakefile	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/IsaMakefile	Thu Feb 26 11:21:29 2009 +0000
@@ -86,7 +86,7 @@
   Tools/simpdata.ML \
   $(SRC)/Tools/atomize_elim.ML \
   $(SRC)/Tools/code/code_funcgr.ML \
-  $(SRC)/Tools/code/code_funcgr.ML \
+  $(SRC)/Tools/code/code_wellsorted.ML \
   $(SRC)/Tools/code/code_name.ML \
   $(SRC)/Tools/code/code_printer.ML \
   $(SRC)/Tools/code/code_target.ML \
@@ -267,11 +267,11 @@
 	@$(ISABELLE_TOOL) usedir -b -f main.ML -g true $(OUT)/Pure HOL-Main
 
 $(OUT)/HOL: ROOT.ML $(MAIN_DEPENDENCIES) \
+  Archimedean_Field.thy \
   Complex_Main.thy \
   Complex.thy \
   Deriv.thy \
   Fact.thy \
-  FrechetDeriv.thy \
   Integration.thy \
   Lim.thy \
   Ln.thy \
@@ -285,7 +285,6 @@
   GCD.thy \
   Parity.thy \
   Lubs.thy \
-  Polynomial.thy \
   PReal.thy \
   Rational.thy \
   RComplete.thy \
@@ -314,8 +313,11 @@
   Library/Euclidean_Space.thy Library/Glbs.thy Library/normarith.ML \
   Library/Executable_Set.thy Library/Infinite_Set.thy			\
   Library/FuncSet.thy Library/Permutations.thy Library/Determinants.thy\
+  Library/Bit.thy \
   Library/Finite_Cartesian_Product.thy \
+  Library/FrechetDeriv.thy \
   Library/Fundamental_Theorem_Algebra.thy \
+  Library/Inner_Product.thy \
   Library/Library.thy Library/List_Prefix.thy Library/State_Monad.thy	\
   Library/Nat_Int_Bij.thy Library/Multiset.thy Library/Permutation.thy	\
   Library/Primes.thy Library/Pocklington.thy Library/Quotient.thy	\
@@ -336,6 +338,10 @@
   Library/Boolean_Algebra.thy Library/Countable.thy	\
   Library/RBT.thy	Library/Univ_Poly.thy	\
   Library/Random.thy	Library/Quickcheck.thy	\
+  Library/Poly_Deriv.thy \
+  Library/Polynomial.thy \
+  Library/Product_plus.thy \
+  Library/Product_Vector.thy \
   Library/Enum.thy Library/Float.thy $(SRC)/Tools/float.ML $(SRC)/HOL/Tools/float_arith.ML \
   Library/reify_data.ML Library/reflection.ML
 	@cd Library; $(ISABELLE_TOOL) usedir $(OUT)/HOL Library
--- a/src/HOL/Library/Abstract_Rat.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Library/Abstract_Rat.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -247,7 +247,7 @@
     (of_int(n div d)::'a::{field, ring_char_0}) = of_int n / of_int d"
   apply (frule of_int_div_aux [of d n, where ?'a = 'a])
   apply simp
-  apply (simp add: zdvd_iff_zmod_eq_0)
+  apply (simp add: dvd_eq_mod_eq_0)
 done
 
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Library/Bit.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -0,0 +1,128 @@
+(* Title:      Bit.thy
+   Author:     Brian Huffman
+*)
+
+header {* The Field of Integers mod 2 *}
+
+theory Bit
+imports Main
+begin
+
+subsection {* Bits as a datatype *}
+
+typedef (open) bit = "UNIV :: bool set" ..
+
+instantiation bit :: "{zero, one}"
+begin
+
+definition zero_bit_def:
+  "0 = Abs_bit False"
+
+definition one_bit_def:
+  "1 = Abs_bit True"
+
+instance ..
+
+end
+
+rep_datatype (bit) "0::bit" "1::bit"
+proof -
+  fix P and x :: bit
+  assume "P (0::bit)" and "P (1::bit)"
+  then have "\<forall>b. P (Abs_bit b)"
+    unfolding zero_bit_def one_bit_def
+    by (simp add: all_bool_eq)
+  then show "P x"
+    by (induct x) simp
+next
+  show "(0::bit) \<noteq> (1::bit)"
+    unfolding zero_bit_def one_bit_def
+    by (simp add: Abs_bit_inject)
+qed
+
+lemma bit_not_0_iff [iff]: "(x::bit) \<noteq> 0 \<longleftrightarrow> x = 1"
+  by (induct x) simp_all
+
+lemma bit_not_1_iff [iff]: "(x::bit) \<noteq> 1 \<longleftrightarrow> x = 0"
+  by (induct x) simp_all
+
+
+subsection {* Type @{typ bit} forms a field *}
+
+instantiation bit :: "{field, division_by_zero}"
+begin
+
+definition plus_bit_def:
+  "x + y = (case x of 0 \<Rightarrow> y | 1 \<Rightarrow> (case y of 0 \<Rightarrow> 1 | 1 \<Rightarrow> 0))"
+
+definition times_bit_def:
+  "x * y = (case x of 0 \<Rightarrow> 0 | 1 \<Rightarrow> y)"
+
+definition uminus_bit_def [simp]:
+  "- x = (x :: bit)"
+
+definition minus_bit_def [simp]:
+  "x - y = (x + y :: bit)"
+
+definition inverse_bit_def [simp]:
+  "inverse x = (x :: bit)"
+
+definition divide_bit_def [simp]:
+  "x / y = (x * y :: bit)"
+
+lemmas field_bit_defs =
+  plus_bit_def times_bit_def minus_bit_def uminus_bit_def
+  divide_bit_def inverse_bit_def
+
+instance proof
+qed (unfold field_bit_defs, auto split: bit.split)
+
+end
+
+lemma bit_1_plus_1 [simp]: "1 + 1 = (0 :: bit)"
+  unfolding plus_bit_def by simp
+
+lemma bit_add_self [simp]: "x + x = (0 :: bit)"
+  by (cases x) simp_all
+
+lemma bit_add_self_left [simp]: "x + (x + y) = (y :: bit)"
+  by simp
+
+lemma bit_mult_eq_1_iff [simp]: "x * y = (1 :: bit) \<longleftrightarrow> x = 1 \<and> y = 1"
+  unfolding times_bit_def by (simp split: bit.split)
+
+text {* Not sure whether the next two should be simp rules. *}
+
+lemma bit_add_eq_0_iff: "x + y = (0 :: bit) \<longleftrightarrow> x = y"
+  unfolding plus_bit_def by (simp split: bit.split)
+
+lemma bit_add_eq_1_iff: "x + y = (1 :: bit) \<longleftrightarrow> x \<noteq> y"
+  unfolding plus_bit_def by (simp split: bit.split)
+
+
+subsection {* Numerals at type @{typ bit} *}
+
+instantiation bit :: number_ring
+begin
+
+definition number_of_bit_def:
+  "(number_of w :: bit) = of_int w"
+
+instance proof
+qed (rule number_of_bit_def)
+
+end
+
+text {* All numerals reduce to either 0 or 1. *}
+
+lemma bit_minus1 [simp]: "-1 = (1 :: bit)"
+  by (simp only: number_of_Min uminus_bit_def)
+
+lemma bit_number_of_even [simp]: "number_of (Int.Bit0 w) = (0 :: bit)"
+  by (simp only: number_of_Bit0 add_0_left bit_add_self)
+
+lemma bit_number_of_odd [simp]: "number_of (Int.Bit1 w) = (1 :: bit)"
+  by (simp only: number_of_Bit1 add_assoc bit_add_self
+                 monoid_add_class.add_0_right)
+
+end
--- a/src/HOL/Library/Boolean_Algebra.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Library/Boolean_Algebra.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -223,7 +223,7 @@
 lemma xor_left_self [simp]: "x \<oplus> (x \<oplus> y) = y"
 by (simp only: xor_assoc [symmetric] xor_self xor_zero_left)
 
-lemma xor_compl_left: "\<sim> x \<oplus> y = \<sim> (x \<oplus> y)"
+lemma xor_compl_left [simp]: "\<sim> x \<oplus> y = \<sim> (x \<oplus> y)"
 apply (simp only: xor_def de_Morgan_disj de_Morgan_conj double_compl)
 apply (simp only: conj_disj_distribs)
 apply (simp only: conj_cancel_right conj_cancel_left)
@@ -231,7 +231,7 @@
 apply (simp only: disj_ac conj_ac)
 done
 
-lemma xor_compl_right: "x \<oplus> \<sim> y = \<sim> (x \<oplus> y)"
+lemma xor_compl_right [simp]: "x \<oplus> \<sim> y = \<sim> (x \<oplus> y)"
 apply (simp only: xor_def de_Morgan_disj de_Morgan_conj double_compl)
 apply (simp only: conj_disj_distribs)
 apply (simp only: conj_cancel_right conj_cancel_left)
@@ -239,11 +239,11 @@
 apply (simp only: disj_ac conj_ac)
 done
 
-lemma xor_cancel_right [simp]: "x \<oplus> \<sim> x = \<one>"
+lemma xor_cancel_right: "x \<oplus> \<sim> x = \<one>"
 by (simp only: xor_compl_right xor_self compl_zero)
 
-lemma xor_cancel_left [simp]: "\<sim> x \<oplus> x = \<one>"
-by (subst xor_commute) (rule xor_cancel_right)
+lemma xor_cancel_left: "\<sim> x \<oplus> x = \<one>"
+by (simp only: xor_compl_left xor_self compl_zero)
 
 lemma conj_xor_distrib: "x \<sqinter> (y \<oplus> z) = (x \<sqinter> y) \<oplus> (x \<sqinter> z)"
 proof -
--- a/src/HOL/Library/Code_Char.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Library/Code_Char.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -1,5 +1,4 @@
 (*  Title:      HOL/Library/Code_Char.thy
-    ID:         $Id$
     Author:     Florian Haftmann
 *)
 
--- a/src/HOL/Library/Code_Integer.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Library/Code_Integer.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -1,5 +1,4 @@
 (*  Title:      HOL/Library/Code_Integer.thy
-    ID:         $Id$
     Author:     Florian Haftmann, TU Muenchen
 *)
 
@@ -72,6 +71,11 @@
   (OCaml "Big'_int.mult'_big'_int")
   (Haskell infixl 7 "*")
 
+code_const pdivmod
+  (SML "(fn k => fn l =>/ IntInf.divMod/ (IntInf.abs k,/ IntInf.abs l))")
+  (OCaml "(fun k -> fun l ->/ Big'_int.quomod'_big'_int/ (Big'_int.abs'_big'_int k)/ (Big'_int.abs'_big'_int l))")
+  (Haskell "(\\k l ->/ divMod/ (abs k)/ (abs l))")
+
 code_const "eq_class.eq \<Colon> int \<Rightarrow> int \<Rightarrow> bool"
   (SML "!((_ : IntInf.int) = _)")
   (OCaml "Big'_int.eq'_big'_int")
--- a/src/HOL/Library/Determinants.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Library/Determinants.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -1048,7 +1048,7 @@
   note th0 = this
   let ?g = "\<lambda>x. if x = 0 then 0 else norm x *s f (inverse (norm x) *s x)"
   {fix x:: "real ^'n" assume nx: "norm x = 1"
-    have "?g x = f x" using nx by (simp add: norm_eq_0[symmetric])}
+    have "?g x = f x" using nx by auto}
   hence thfg: "\<forall>x. norm x = 1 \<longrightarrow> ?g x = f x" by blast
   have g0: "?g 0 = 0" by simp
   {fix x y :: "real ^'n"
@@ -1057,15 +1057,15 @@
     moreover
     {assume "x = 0" "y \<noteq> 0"
       then have "dist (?g x) (?g y) = dist x y" 
-	apply (simp add: dist_def norm_neg norm_mul norm_eq_0)
+	apply (simp add: dist_def norm_mul)
 	apply (rule f1[rule_format])
-	by(simp add: norm_mul norm_eq_0 field_simps)}
+	by(simp add: norm_mul field_simps)}
     moreover
     {assume "x \<noteq> 0" "y = 0"
       then have "dist (?g x) (?g y) = dist x y" 
-	apply (simp add: dist_def norm_neg norm_mul norm_eq_0)
+	apply (simp add: dist_def norm_mul)
 	apply (rule f1[rule_format])
-	by(simp add: norm_mul norm_eq_0 field_simps)}
+	by(simp add: norm_mul field_simps)}
     moreover
     {assume z: "x \<noteq> 0" "y \<noteq> 0"
       have th00: "x = norm x *s inverse (norm x) *s x" "y = norm y *s inverse (norm y) *s y" "norm x *s f (inverse (norm x) *s x) = norm x *s f (inverse (norm x) *s x)"
@@ -1077,7 +1077,7 @@
 	"norm (f (inverse (norm x) *s x) - f (inverse (norm y) *s y)) =
 	norm (inverse (norm x) *s x - inverse (norm y) *s y)"
 	using z
-	by (auto simp add: norm_eq_0 vector_smult_assoc field_simps norm_mul intro: f1[rule_format] fd1[rule_format, unfolded dist_def])
+	by (auto simp add: vector_smult_assoc field_simps norm_mul intro: f1[rule_format] fd1[rule_format, unfolded dist_def])
       from z th0[OF th00] have "dist (?g x) (?g y) = dist x y" 
 	by (simp add: dist_def)}
     ultimately have "dist (?g x) (?g y) = dist x y" by blast}
@@ -1148,4 +1148,4 @@
   by (simp add: ring_simps)
 qed
 
-end
\ No newline at end of file
+end
--- a/src/HOL/Library/Efficient_Nat.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Library/Efficient_Nat.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -105,10 +105,16 @@
   This can be accomplished by applying the following transformation rules:
 *}
 
-lemma Suc_if_eq: "(\<And>n. f (Suc n) = h n) \<Longrightarrow> f 0 = g \<Longrightarrow>
+lemma Suc_if_eq': "(\<And>n. f (Suc n) = h n) \<Longrightarrow> f 0 = g \<Longrightarrow>
   f n = (if n = 0 then g else h (n - 1))"
   by (cases n) simp_all
 
+lemma Suc_if_eq: "(\<And>n. f (Suc n) \<equiv> h n) \<Longrightarrow> f 0 \<equiv> g \<Longrightarrow>
+  f n \<equiv> if n = 0 then g else h (n - 1)"
+  by (rule eq_reflection, rule Suc_if_eq')
+    (rule meta_eq_to_obj_eq, assumption,
+     rule meta_eq_to_obj_eq, assumption)
+
 lemma Suc_clause: "(\<And>n. P n (Suc n)) \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> P (n - 1) n"
   by (cases n) simp_all
 
@@ -123,14 +129,14 @@
 setup {*
 let
 
-fun remove_suc thy thms =
+fun gen_remove_suc Suc_if_eq dest_judgement thy thms =
   let
     val vname = Name.variant (map fst
-      (fold (Term.add_var_names o Thm.full_prop_of) thms [])) "x";
+      (fold (Term.add_var_names o Thm.full_prop_of) thms [])) "n";
     val cv = cterm_of thy (Var ((vname, 0), HOLogic.natT));
     fun lhs_of th = snd (Thm.dest_comb
-      (fst (Thm.dest_comb (snd (Thm.dest_comb (cprop_of th))))));
-    fun rhs_of th = snd (Thm.dest_comb (snd (Thm.dest_comb (cprop_of th))));
+      (fst (Thm.dest_comb (dest_judgement (cprop_of th)))));
+    fun rhs_of th = snd (Thm.dest_comb (dest_judgement (cprop_of th)));
     fun find_vars ct = (case term_of ct of
         (Const (@{const_name Suc}, _) $ Var _) => [(cv, snd (Thm.dest_comb ct))]
       | _ $ _ =>
@@ -150,7 +156,7 @@
              (Drule.instantiate'
                [SOME (ctyp_of_term ct)] [SOME (Thm.cabs cv ct),
                  SOME (Thm.cabs cv' (rhs_of th)), NONE, SOME cv']
-               @{thm Suc_if_eq})) (Thm.forall_intr cv' th)
+               Suc_if_eq)) (Thm.forall_intr cv' th)
       in
         case map_filter (fn th'' =>
             SOME (th'', singleton
@@ -161,20 +167,26 @@
               let val (ths1, ths2) = split_list thps
               in SOME (subtract Thm.eq_thm (th :: ths1) thms @ ths2) end
       end
-  in case get_first mk_thms eqs of
-      NONE => thms
-    | SOME x => remove_suc thy x
+  in get_first mk_thms eqs end;
+
+fun gen_eqn_suc_preproc Suc_if_eq dest_judgement dest_lhs thy thms =
+  let
+    val dest = dest_lhs o prop_of;
+    val contains_suc = exists_Const (fn (c, _) => c = @{const_name Suc});
+  in
+    if forall (can dest) thms andalso exists (contains_suc o dest) thms
+      then perhaps_loop (gen_remove_suc Suc_if_eq dest_judgement thy) thms
+       else NONE
   end;
 
-fun eqn_suc_preproc thy ths =
-  let
-    val dest = fst o HOLogic.dest_eq o HOLogic.dest_Trueprop o prop_of;
-    val contains_suc = exists_Const (fn (c, _) => c = @{const_name Suc});
-  in
-    if forall (can dest) ths andalso
-      exists (contains_suc o dest) ths
-    then remove_suc thy ths else ths
-  end;
+fun eqn_suc_preproc thy = map fst
+  #> gen_eqn_suc_preproc
+      @{thm Suc_if_eq} I (fst o Logic.dest_equals) thy
+  #> (Option.map o map) (Code_Unit.mk_eqn thy);
+
+fun eqn_suc_preproc' thy thms = gen_eqn_suc_preproc
+  @{thm Suc_if_eq'} (snd o Thm.dest_comb) (fst o HOLogic.dest_eq o HOLogic.dest_Trueprop) thy thms
+  |> the_default thms;
 
 fun remove_suc_clause thy thms =
   let
@@ -215,27 +227,11 @@
         (map_filter (try dest) (concl_of th :: prems_of th))) ths
     then remove_suc_clause thy ths else ths
   end;
-
-fun lift f thy eqns1 =
-  let
-    val eqns2 = burrow_fst Drule.zero_var_indexes_list eqns1;
-    val thms3 = try (map fst
-      #> map (fn thm => thm RS @{thm meta_eq_to_obj_eq})
-      #> f thy
-      #> map (fn thm => thm RS @{thm eq_reflection})
-      #> map (Conv.fconv_rule Drule.beta_eta_conversion)) eqns2;
-    val thms4 = Option.map Drule.zero_var_indexes_list thms3;
-  in case thms4
-   of NONE => NONE
-    | SOME thms4 => if Thm.eq_thms (map fst eqns2, thms4)
-        then NONE else SOME (map (apfst (AxClass.overload thy) o Code_Unit.mk_eqn thy) thms4)
-  end
-
 in
 
-  Codegen.add_preprocessor eqn_suc_preproc
+  Codegen.add_preprocessor eqn_suc_preproc'
   #> Codegen.add_preprocessor clause_suc_preproc
-  #> Code.add_functrans ("eqn_Suc", lift eqn_suc_preproc)
+  #> Code.add_functrans ("eqn_Suc", eqn_suc_preproc)
 
 end;
 *}
--- a/src/HOL/Library/Enum.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Library/Enum.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -1,5 +1,4 @@
 (*  Title:      HOL/Library/Enum.thy
-    ID:         $Id$
     Author:     Florian Haftmann, TU Muenchen
 *)
 
--- a/src/HOL/Library/Euclidean_Space.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Library/Euclidean_Space.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -8,6 +8,7 @@
 theory Euclidean_Space
   imports "~~/src/HOL/Decision_Procs/Dense_Linear_Order" Complex_Main 
   Finite_Cartesian_Product Glbs Infinite_Set Numeral_Type
+  Inner_Product
   uses ("normarith.ML")
 begin
 
@@ -84,7 +85,13 @@
 instance by (intro_classes)
 end
 
-text{* Also the scalar-vector multiplication. FIXME: We should unify this with the scalar multiplication in @{text real_vector} *}
+instantiation "^" :: (scaleR, type) scaleR
+begin
+definition vector_scaleR_def: "scaleR = (\<lambda> r x.  (\<chi> i. scaleR r (x$i)))" 
+instance ..
+end
+
+text{* Also the scalar-vector multiplication. *}
 
 definition vector_scalar_mult:: "'a::times \<Rightarrow> 'a ^'n \<Rightarrow> 'a ^ 'n" (infixr "*s" 75)
   where "c *s x = (\<chi> i. c * (x$i))"
@@ -118,6 +125,7 @@
              [@{thm vector_add_def}, @{thm vector_mult_def},  
               @{thm vector_minus_def}, @{thm vector_uminus_def}, 
               @{thm vector_one_def}, @{thm vector_zero_def}, @{thm vec_def}, 
+              @{thm vector_scaleR_def},
               @{thm Cart_lambda_beta'}, @{thm vector_scalar_mult_def}]
  fun vector_arith_tac ths = 
    simp_tac ss1
@@ -166,9 +174,18 @@
   shows "(- x)$i = - (x$i)"
   using i by vector
 
+lemma vector_scaleR_component:
+  fixes x :: "'a::scaleR ^ 'n"
+  assumes i: "i \<in> {1 .. dimindex(UNIV :: 'n set)}"
+  shows "(scaleR r x)$i = scaleR r (x$i)"
+  using i by vector
+
 lemma cond_component: "(if b then x else y)$i = (if b then x$i else y$i)" by vector
 
-lemmas vector_component = vec_component vector_add_component vector_mult_component vector_smult_component vector_minus_component vector_uminus_component cond_component 
+lemmas vector_component =
+  vec_component vector_add_component vector_mult_component
+  vector_smult_component vector_minus_component vector_uminus_component
+  vector_scaleR_component cond_component
 
 subsection {* Some frequently useful arithmetic lemmas over vectors. *}
 
@@ -199,6 +216,9 @@
   apply (intro_classes)
   by (vector Cart_eq)
 
+instance "^" :: (real_vector, type) real_vector
+  by default (vector scaleR_left_distrib scaleR_right_distrib)+
+
 instance "^" :: (semigroup_mult,type) semigroup_mult 
   apply (intro_classes) by (vector mult_assoc)
 
@@ -242,6 +262,18 @@
 instance "^" :: (ring,type) ring by (intro_classes) 
 instance "^" :: (semiring_1_cancel,type) semiring_1_cancel by (intro_classes) 
 instance "^" :: (comm_semiring_1,type) comm_semiring_1 by (intro_classes)
+
+instance "^" :: (ring_1,type) ring_1 ..
+
+instance "^" :: (real_algebra,type) real_algebra
+  apply intro_classes
+  apply (simp_all add: vector_scaleR_def ring_simps)
+  apply vector
+  apply vector
+  done
+
+instance "^" :: (real_algebra_1,type) real_algebra_1 ..
+
 lemma of_nat_index: 
   "i\<in>{1 .. dimindex (UNIV :: 'n set)} \<Longrightarrow> (of_nat n :: 'a::semiring_1 ^'n)$i = of_nat n"
   apply (induct n)
@@ -290,8 +322,7 @@
 qed
 
 instance "^" :: (comm_ring_1,type) comm_ring_1 by intro_classes
-  (* FIXME!!! Why does the axclass package complain here !!*)
-(* instance "^" :: (ring_char_0,type) ring_char_0 by intro_classes *)
+instance "^" :: (ring_char_0,type) ring_char_0 by intro_classes
 
 lemma vector_smult_assoc: "a *s (b *s x) = ((a::'a::semigroup_mult) * b) *s x"  
   by (vector mult_assoc)
@@ -314,6 +345,241 @@
   apply (auto simp add: vec_def Cart_eq vec_component Cart_lambda_beta )
   using dimindex_ge_1 apply auto done
 
+subsection {* Square root of sum of squares *}
+
+definition
+  "setL2 f A = sqrt (\<Sum>i\<in>A. (f i)\<twosuperior>)"
+
+lemma setL2_cong:
+  "\<lbrakk>A = B; \<And>x. x \<in> B \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> setL2 f A = setL2 g B"
+  unfolding setL2_def by simp
+
+lemma strong_setL2_cong:
+  "\<lbrakk>A = B; \<And>x. x \<in> B =simp=> f x = g x\<rbrakk> \<Longrightarrow> setL2 f A = setL2 g B"
+  unfolding setL2_def simp_implies_def by simp
+
+lemma setL2_infinite [simp]: "\<not> finite A \<Longrightarrow> setL2 f A = 0"
+  unfolding setL2_def by simp
+
+lemma setL2_empty [simp]: "setL2 f {} = 0"
+  unfolding setL2_def by simp
+
+lemma setL2_insert [simp]:
+  "\<lbrakk>finite F; a \<notin> F\<rbrakk> \<Longrightarrow>
+    setL2 f (insert a F) = sqrt ((f a)\<twosuperior> + (setL2 f F)\<twosuperior>)"
+  unfolding setL2_def by (simp add: setsum_nonneg)
+
+lemma setL2_nonneg [simp]: "0 \<le> setL2 f A"
+  unfolding setL2_def by (simp add: setsum_nonneg)
+
+lemma setL2_0': "\<forall>a\<in>A. f a = 0 \<Longrightarrow> setL2 f A = 0"
+  unfolding setL2_def by simp
+
+lemma setL2_mono:
+  assumes "\<And>i. i \<in> K \<Longrightarrow> f i \<le> g i"
+  assumes "\<And>i. i \<in> K \<Longrightarrow> 0 \<le> f i"
+  shows "setL2 f K \<le> setL2 g K"
+  unfolding setL2_def
+  by (simp add: setsum_nonneg setsum_mono power_mono prems)
+
+lemma setL2_right_distrib:
+  "0 \<le> r \<Longrightarrow> r * setL2 f A = setL2 (\<lambda>x. r * f x) A"
+  unfolding setL2_def
+  apply (simp add: power_mult_distrib)
+  apply (simp add: setsum_right_distrib [symmetric])
+  apply (simp add: real_sqrt_mult setsum_nonneg)
+  done
+
+lemma setL2_left_distrib:
+  "0 \<le> r \<Longrightarrow> setL2 f A * r = setL2 (\<lambda>x. f x * r) A"
+  unfolding setL2_def
+  apply (simp add: power_mult_distrib)
+  apply (simp add: setsum_left_distrib [symmetric])
+  apply (simp add: real_sqrt_mult setsum_nonneg)
+  done
+
+lemma setsum_nonneg_eq_0_iff:
+  fixes f :: "'a \<Rightarrow> 'b::pordered_ab_group_add"
+  shows "\<lbrakk>finite A; \<forall>x\<in>A. 0 \<le> f x\<rbrakk> \<Longrightarrow> setsum f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)"
+  apply (induct set: finite, simp)
+  apply (simp add: add_nonneg_eq_0_iff setsum_nonneg)
+  done
+
+lemma setL2_eq_0_iff: "finite A \<Longrightarrow> setL2 f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)"
+  unfolding setL2_def
+  by (simp add: setsum_nonneg setsum_nonneg_eq_0_iff)
+
+lemma setL2_triangle_ineq:
+  shows "setL2 (\<lambda>i. f i + g i) A \<le> setL2 f A + setL2 g A"
+proof (cases "finite A")
+  case False
+  thus ?thesis by simp
+next
+  case True
+  thus ?thesis
+  proof (induct set: finite)
+    case empty
+    show ?case by simp
+  next
+    case (insert x F)
+    hence "sqrt ((f x + g x)\<twosuperior> + (setL2 (\<lambda>i. f i + g i) F)\<twosuperior>) \<le>
+           sqrt ((f x + g x)\<twosuperior> + (setL2 f F + setL2 g F)\<twosuperior>)"
+      by (intro real_sqrt_le_mono add_left_mono power_mono insert
+                setL2_nonneg add_increasing zero_le_power2)
+    also have
+      "\<dots> \<le> sqrt ((f x)\<twosuperior> + (setL2 f F)\<twosuperior>) + sqrt ((g x)\<twosuperior> + (setL2 g F)\<twosuperior>)"
+      by (rule real_sqrt_sum_squares_triangle_ineq)
+    finally show ?case
+      using insert by simp
+  qed
+qed
+
+lemma sqrt_sum_squares_le_sum:
+  "\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> sqrt (x\<twosuperior> + y\<twosuperior>) \<le> x + y"
+  apply (rule power2_le_imp_le)
+  apply (simp add: power2_sum)
+  apply (simp add: mult_nonneg_nonneg)
+  apply (simp add: add_nonneg_nonneg)
+  done
+
+lemma setL2_le_setsum [rule_format]:
+  "(\<forall>i\<in>A. 0 \<le> f i) \<longrightarrow> setL2 f A \<le> setsum f A"
+  apply (cases "finite A")
+  apply (induct set: finite)
+  apply simp
+  apply clarsimp
+  apply (erule order_trans [OF sqrt_sum_squares_le_sum])
+  apply simp
+  apply simp
+  apply simp
+  done
+
+lemma sqrt_sum_squares_le_sum_abs: "sqrt (x\<twosuperior> + y\<twosuperior>) \<le> \<bar>x\<bar> + \<bar>y\<bar>"
+  apply (rule power2_le_imp_le)
+  apply (simp add: power2_sum)
+  apply (simp add: mult_nonneg_nonneg)
+  apply (simp add: add_nonneg_nonneg)
+  done
+
+lemma setL2_le_setsum_abs: "setL2 f A \<le> (\<Sum>i\<in>A. \<bar>f i\<bar>)"
+  apply (cases "finite A")
+  apply (induct set: finite)
+  apply simp
+  apply simp
+  apply (rule order_trans [OF sqrt_sum_squares_le_sum_abs])
+  apply simp
+  apply simp
+  done
+
+lemma setL2_mult_ineq_lemma:
+  fixes a b c d :: real
+  shows "2 * (a * c) * (b * d) \<le> a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior>"
+proof -
+  have "0 \<le> (a * d - b * c)\<twosuperior>" by simp
+  also have "\<dots> = a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior> - 2 * (a * d) * (b * c)"
+    by (simp only: power2_diff power_mult_distrib)
+  also have "\<dots> = a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior> - 2 * (a * c) * (b * d)"
+    by simp
+  finally show "2 * (a * c) * (b * d) \<le> a\<twosuperior> * d\<twosuperior> + b\<twosuperior> * c\<twosuperior>"
+    by simp
+qed
+
+lemma setL2_mult_ineq: "(\<Sum>i\<in>A. \<bar>f i\<bar> * \<bar>g i\<bar>) \<le> setL2 f A * setL2 g A"
+  apply (cases "finite A")
+  apply (induct set: finite)
+  apply simp
+  apply (rule power2_le_imp_le, simp)
+  apply (rule order_trans)
+  apply (rule power_mono)
+  apply (erule add_left_mono)
+  apply (simp add: add_nonneg_nonneg mult_nonneg_nonneg setsum_nonneg)
+  apply (simp add: power2_sum)
+  apply (simp add: power_mult_distrib)
+  apply (simp add: right_distrib left_distrib)
+  apply (rule ord_le_eq_trans)
+  apply (rule setL2_mult_ineq_lemma)
+  apply simp
+  apply (intro mult_nonneg_nonneg setL2_nonneg)
+  apply simp
+  done
+
+lemma member_le_setL2: "\<lbrakk>finite A; i \<in> A\<rbrakk> \<Longrightarrow> f i \<le> setL2 f A"
+  apply (rule_tac s="insert i (A - {i})" and t="A" in subst)
+  apply fast
+  apply (subst setL2_insert)
+  apply simp
+  apply simp
+  apply simp
+  done
+
+subsection {* Norms *}
+
+instantiation "^" :: (real_normed_vector, type) real_normed_vector
+begin
+
+definition vector_norm_def:
+  "norm (x::'a^'b) = setL2 (\<lambda>i. norm (x$i)) {1 .. dimindex (UNIV:: 'b set)}"
+
+definition vector_sgn_def:
+  "sgn (x::'a^'b) = scaleR (inverse (norm x)) x"
+
+instance proof
+  fix a :: real and x y :: "'a ^ 'b"
+  show "0 \<le> norm x"
+    unfolding vector_norm_def
+    by (rule setL2_nonneg)
+  show "norm x = 0 \<longleftrightarrow> x = 0"
+    unfolding vector_norm_def
+    by (simp add: setL2_eq_0_iff Cart_eq)
+  show "norm (x + y) \<le> norm x + norm y"
+    unfolding vector_norm_def
+    apply (rule order_trans [OF _ setL2_triangle_ineq])
+    apply (rule setL2_mono)
+    apply (simp add: vector_component norm_triangle_ineq)
+    apply simp
+    done
+  show "norm (scaleR a x) = \<bar>a\<bar> * norm x"
+    unfolding vector_norm_def
+    by (simp add: vector_component norm_scaleR setL2_right_distrib
+             cong: strong_setL2_cong)
+  show "sgn x = scaleR (inverse (norm x)) x"
+    by (rule vector_sgn_def)
+qed
+
+end
+
+subsection {* Inner products *}
+
+instantiation "^" :: (real_inner, type) real_inner
+begin
+
+definition vector_inner_def:
+  "inner x y = setsum (\<lambda>i. inner (x$i) (y$i)) {1 .. dimindex(UNIV::'b set)}"
+
+instance proof
+  fix r :: real and x y z :: "'a ^ 'b"
+  show "inner x y = inner y x"
+    unfolding vector_inner_def
+    by (simp add: inner_commute)
+  show "inner (x + y) z = inner x z + inner y z"
+    unfolding vector_inner_def
+    by (vector inner_left_distrib)
+  show "inner (scaleR r x) y = r * inner x y"
+    unfolding vector_inner_def
+    by (vector inner_scaleR_left)
+  show "0 \<le> inner x x"
+    unfolding vector_inner_def
+    by (simp add: setsum_nonneg)
+  show "inner x x = 0 \<longleftrightarrow> x = 0"
+    unfolding vector_inner_def
+    by (simp add: Cart_eq setsum_nonneg_eq_0_iff)
+  show "norm x = sqrt (inner x x)"
+    unfolding vector_inner_def vector_norm_def setL2_def
+    by (simp add: power2_norm_eq_inner)
+qed
+
+end
+
 subsection{* Properties of the dot product.  *}
 
 lemma dot_sym: "(x::'a:: {comm_monoid_add, ab_semigroup_mult} ^ 'n) \<bullet> y = y \<bullet> x" 
@@ -363,18 +629,7 @@
 lemma dot_pos_lt: "(0 < x \<bullet> x) \<longleftrightarrow> (x::'a::{ordered_ring_strict,ring_no_zero_divisors} ^ 'n) \<noteq> 0" using dot_eq_0[of x] dot_pos_le[of x] 
   by (auto simp add: le_less) 
 
-subsection {* Introduce norms, but defer many properties till we get square roots. *}
-text{* FIXME : This is ugly *}
-defs (overloaded) 
-  real_of_real_def [code inline, simp]: "real == id"
-
-instantiation "^" :: ("{times, comm_monoid_add}", type) norm begin
-definition  real_vector_norm_def: "norm \<equiv> (\<lambda>x. sqrt (real (x \<bullet> x)))" 
-instance ..
-end
-
-
-subsection{* The collapse of the general concepts to dimention one. *}
+subsection{* The collapse of the general concepts to dimension one. *}
 
 lemma vector_one: "(x::'a ^1) = (\<chi> i. (x$1))"
   by (vector dimindex_def)
@@ -385,11 +640,15 @@
   apply (simp only: vector_one[symmetric])
   done
 
+lemma norm_vector_1: "norm (x :: _^1) = norm (x$1)"
+  by (simp add: vector_norm_def dimindex_def)
+
 lemma norm_real: "norm(x::real ^ 1) = abs(x$1)" 
-  by (simp add: real_vector_norm_def)
+  by (simp add: norm_vector_1)
 
 text{* Metric *}
 
+text {* FIXME: generalize to arbitrary @{text real_normed_vector} types *}
 definition dist:: "real ^ 'n \<Rightarrow> real ^ 'n \<Rightarrow> real" where 
   "dist x y = norm (x - y)"
 
@@ -501,27 +760,18 @@
 text{* Hence derive more interesting properties of the norm. *}
 
 lemma norm_0: "norm (0::real ^ 'n) = 0"
-  by (simp add: real_vector_norm_def dot_eq_0)
-
-lemma norm_pos_le: "0 <= norm (x::real^'n)" 
-  by (simp add: real_vector_norm_def dot_pos_le)
-lemma norm_neg: " norm(-x) = norm (x:: real ^ 'n)" 
-  by (simp add: real_vector_norm_def dot_lneg dot_rneg)
-lemma norm_sub: "norm(x - y) = norm(y - (x::real ^ 'n))" 
-  by (metis norm_neg minus_diff_eq)
+  by (rule norm_zero)
+
 lemma norm_mul: "norm(a *s x) = abs(a) * norm x"
-  by (simp add: real_vector_norm_def dot_lmult dot_rmult mult_assoc[symmetric] real_sqrt_mult)
+  by (simp add: vector_norm_def vector_component setL2_right_distrib
+           abs_mult cong: strong_setL2_cong)
 lemma norm_eq_0_dot: "(norm x = 0) \<longleftrightarrow> (x \<bullet> x = (0::real))"
+  by (simp add: vector_norm_def dot_def setL2_def power2_eq_square)
+lemma real_vector_norm_def: "norm x = sqrt (x \<bullet> x)"
+  by (simp add: vector_norm_def setL2_def dot_def power2_eq_square)
+lemma norm_pow_2: "norm x ^ 2 = x \<bullet> x"
   by (simp add: real_vector_norm_def)
-lemma norm_eq_0: "norm x = 0 \<longleftrightarrow> x = (0::real ^ 'n)"
-  by (simp add: real_vector_norm_def dot_eq_0)
-lemma norm_pos_lt: "0 < norm x \<longleftrightarrow> x \<noteq> (0::real ^ 'n)"
-  by (metis less_le real_vector_norm_def norm_pos_le norm_eq_0)
-lemma norm_pow_2: "norm x ^ 2 = x \<bullet> x"
-  by (simp add: real_vector_norm_def dot_pos_le)
-lemma norm_eq_0_imp: "norm x = 0 ==> x = (0::real ^'n)" by (metis norm_eq_0)
-lemma norm_le_0: "norm x <= 0 \<longleftrightarrow> x = (0::real ^'n)"
-  by (metis norm_eq_0 norm_pos_le order_antisym) 
+lemma norm_eq_0_imp: "norm x = 0 ==> x = (0::real ^'n)" by (metis norm_eq_zero)
 lemma vector_mul_eq_0: "(a *s x = 0) \<longleftrightarrow> a = (0::'a::idom) \<or> x = 0"
   by vector
 lemma vector_mul_lcancel: "a *s x = a *s y \<longleftrightarrow> a = (0::real) \<or> x = y"
@@ -535,14 +785,14 @@
 lemma norm_cauchy_schwarz: "x \<bullet> y <= norm x * norm y"
 proof-
   {assume "norm x = 0"
-    hence ?thesis by (simp add: norm_eq_0 dot_lzero dot_rzero norm_0)}
+    hence ?thesis by (simp add: dot_lzero dot_rzero)}
   moreover
   {assume "norm y = 0" 
-    hence ?thesis by (simp add: norm_eq_0 dot_lzero dot_rzero norm_0)}
+    hence ?thesis by (simp add: dot_lzero dot_rzero)}
   moreover
   {assume h: "norm x \<noteq> 0" "norm y \<noteq> 0"
     let ?z = "norm y *s x - norm x *s y"
-    from h have p: "norm x * norm y > 0" by (metis norm_pos_le le_less zero_compare_simps)
+    from h have p: "norm x * norm y > 0" by (metis norm_ge_zero le_less zero_compare_simps)
     from dot_pos_le[of ?z]
     have "(norm x * norm y) * (x \<bullet> y) \<le> norm x ^2 * norm y ^2"
       apply (simp add: dot_rsub dot_lsub dot_lmult dot_rmult ring_simps)
@@ -553,26 +803,16 @@
   ultimately show ?thesis by metis
 qed
 
-lemma norm_abs[simp]: "abs (norm x) = norm (x::real ^'n)" 
-  using norm_pos_le[of x] by (simp add: real_abs_def linorder_linear)
-
 lemma norm_cauchy_schwarz_abs: "\<bar>x \<bullet> y\<bar> \<le> norm x * norm y"
   using norm_cauchy_schwarz[of x y] norm_cauchy_schwarz[of x "-y"]
-  by (simp add: real_abs_def dot_rneg norm_neg)
-lemma norm_triangle: "norm(x + y) <= norm x + norm (y::real ^'n)"
-  unfolding real_vector_norm_def
-  apply (rule real_le_lsqrt)
-  apply (auto simp add: dot_pos_le real_vector_norm_def[symmetric] norm_pos_le norm_pow_2[symmetric] intro: add_nonneg_nonneg)[1]
-  apply (auto simp add: dot_pos_le real_vector_norm_def[symmetric] norm_pos_le norm_pow_2[symmetric] intro: add_nonneg_nonneg)[1]
-  apply (simp add: dot_ladd dot_radd dot_sym )
-    by (simp add: norm_pow_2[symmetric] power2_eq_square ring_simps norm_cauchy_schwarz)
+  by (simp add: real_abs_def dot_rneg)
 
 lemma norm_triangle_sub: "norm (x::real ^'n) <= norm(y) + norm(x - y)"
-  using norm_triangle[of "y" "x - y"] by (simp add: ring_simps)
+  using norm_triangle_ineq[of "y" "x - y"] by (simp add: ring_simps)
 lemma norm_triangle_le: "norm(x::real ^'n) + norm y <= e ==> norm(x + y) <= e"
-  by (metis order_trans norm_triangle)
+  by (metis order_trans norm_triangle_ineq)
 lemma norm_triangle_lt: "norm(x::real ^'n) + norm(y) < e ==> norm(x + y) < e"
-  by (metis basic_trans_rules(21) norm_triangle)
+  by (metis basic_trans_rules(21) norm_triangle_ineq)
 
 lemma setsum_delta: 
   assumes fS: "finite S"
@@ -597,19 +837,10 @@
 qed
   
 lemma component_le_norm: "i \<in> {1 .. dimindex(UNIV :: 'n set)} ==> \<bar>x$i\<bar> <= norm (x::real ^ 'n)"
-proof(simp add: real_vector_norm_def, rule real_le_rsqrt, clarsimp)
-  assume i: "Suc 0 \<le> i" "i \<le> dimindex (UNIV :: 'n set)"
-  let ?S = "{1 .. dimindex(UNIV :: 'n set)}"
-  let ?f = "(\<lambda>k. if k = i then x$i ^2 else 0)"
-  have fS: "finite ?S" by simp
-  from i setsum_delta[OF fS, of i "\<lambda>k. x$i ^ 2"]
-  have th: "x$i^2 = setsum ?f ?S" by simp
-  let ?g = "\<lambda>k. x$k * x$k"
-  {fix x assume x: "x \<in> ?S" have "?f x \<le> ?g x" by (simp add: power2_eq_square)}
-  with setsum_mono[of ?S ?f ?g] 
-  have "setsum ?f ?S \<le> setsum ?g ?S" by blast 
-  then show "x$i ^2 \<le> x \<bullet> (x:: real ^ 'n)" unfolding dot_def th[symmetric] .
-qed    
+  apply (simp add: vector_norm_def)
+  apply (rule member_le_setL2, simp_all)
+  done
+
 lemma norm_bound_component_le: "norm(x::real ^ 'n) <= e
                 ==> \<forall>i \<in> {1 .. dimindex(UNIV:: 'n set)}. \<bar>x$i\<bar> <= e"
   by (metis component_le_norm order_trans)
@@ -619,24 +850,12 @@
   by (metis component_le_norm basic_trans_rules(21))
 
 lemma norm_le_l1: "norm (x:: real ^'n) <= setsum(\<lambda>i. \<bar>x$i\<bar>) {1..dimindex(UNIV::'n set)}"
-proof (simp add: real_vector_norm_def, rule real_le_lsqrt,simp add: dot_pos_le, simp add: setsum_mono, simp add: dot_def, induct "dimindex(UNIV::'n set)")
-  case 0 thus ?case by simp
-next
-  case (Suc n)
-  have th: "2 * (\<bar>x$(Suc n)\<bar> * (\<Sum>i = Suc 0..n. \<bar>x$i\<bar>)) \<ge> 0" 
-    apply simp
-    apply (rule mult_nonneg_nonneg)
-    by (simp_all add: setsum_abs_ge_zero)
-  
-  from Suc
-  show ?case using th by (simp add: power2_eq_square ring_simps)
-qed
+  by (simp add: vector_norm_def setL2_le_setsum)
 
 lemma real_abs_norm: "\<bar> norm x\<bar> = norm (x :: real ^'n)" 
-  by (simp add: norm_pos_le)
+  by (rule abs_norm_cancel)
 lemma real_abs_sub_norm: "\<bar>norm(x::real ^'n) - norm y\<bar> <= norm(x - y)"
-  apply (simp add: abs_le_iff ring_simps)
-  by (metis norm_triangle_sub norm_sub)
+  by (rule norm_triangle_ineq3)
 lemma norm_le: "norm(x::real ^ 'n) <= norm(y) \<longleftrightarrow> x \<bullet> x <= y \<bullet> y"
   by (simp add: real_vector_norm_def)
 lemma norm_lt: "norm(x::real ^'n) < norm(y) \<longleftrightarrow> x \<bullet> x < y \<bullet> y"
@@ -652,13 +871,7 @@
   by (simp add: real_vector_norm_def  dot_pos_le )
 
 lemma norm_eq_square: "norm(x) = a \<longleftrightarrow> 0 <= a \<and> x \<bullet> x = a^2"
-proof-
-  have th: "\<And>x y::real. x^2 = y^2 \<longleftrightarrow> x = y \<or> x = -y" by algebra
-  show ?thesis using norm_pos_le[of x]
-  apply (simp add: dot_square_norm th)
-  apply arith
-  done
-qed
+  by (auto simp add: real_vector_norm_def)
 
 lemma real_abs_le_square_iff: "\<bar>x\<bar> \<le> \<bar>y\<bar> \<longleftrightarrow> (x::real)^2 \<le> y^2"
 proof-
@@ -668,14 +881,14 @@
 qed
 
 lemma norm_le_square: "norm(x) <= a \<longleftrightarrow> 0 <= a \<and> x \<bullet> x <= a^2"
-  using norm_pos_le[of x]
   apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric])
+  using norm_ge_zero[of x]
   apply arith
   done
 
 lemma norm_ge_square: "norm(x) >= a \<longleftrightarrow> a <= 0 \<or> x \<bullet> x >= a ^ 2" 
-  using norm_pos_le[of x]
   apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric])
+  using norm_ge_zero[of x]
   apply arith
   done
 
@@ -746,14 +959,14 @@
 lemma pth_d: "x + (0::real ^'n) == x" by (atomize (full)) vector
 
 lemma norm_imp_pos_and_ge: "norm (x::real ^ 'n) == n \<Longrightarrow> norm x \<ge> 0 \<and> n \<ge> norm x"
-  by (atomize) (auto simp add: norm_pos_le)
+  by (atomize) (auto simp add: norm_ge_zero)
 
 lemma real_eq_0_iff_le_ge_0: "(x::real) = 0 == x \<ge> 0 \<and> -x \<ge> 0" by arith
 
 lemma norm_pths: 
   "(x::real ^'n) = y \<longleftrightarrow> norm (x - y) \<le> 0"
   "x \<noteq> y \<longleftrightarrow> \<not> (norm (x - y) \<le> 0)"
-  using norm_pos_le[of "x - y"] by (auto simp add: norm_0 norm_eq_0)
+  using norm_ge_zero[of "x - y"] by auto
 
 use "normarith.ML"
 
@@ -797,11 +1010,6 @@
 
 lemma dist_le_0: "dist x y <= 0 \<longleftrightarrow> x = y" by norm 
 
-instantiation "^" :: (monoid_add,type) monoid_add
-begin
-  instance by (intro_classes)
-end
-
 lemma setsum_eq: "setsum f S = (\<chi> i. setsum (\<lambda>x. (f x)$i ) S)"
   apply vector
   apply auto
@@ -873,7 +1081,7 @@
   assumes fS: "finite S"
   shows "norm (setsum f S) <= setsum (\<lambda>x. norm(f x)) S"
 proof(induct rule: finite_induct[OF fS])
-  case 1 thus ?case by (simp add: norm_zero)
+  case 1 thus ?case by simp
 next
   case (2 x S)
   from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" by (simp add: norm_triangle_ineq)
@@ -887,10 +1095,10 @@
   assumes fS: "finite S"
   shows "norm (setsum f S) <= setsum (\<lambda>x. norm(f x)) S"
 proof(induct rule: finite_induct[OF fS])
-  case 1 thus ?case by simp norm
+  case 1 thus ?case by simp
 next
   case (2 x S)
-  from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" apply (simp add: norm_triangle_ineq) by norm
+  from "2.hyps" have "norm (setsum f (insert x S)) \<le> norm (f x) + norm (setsum f S)" by (simp add: norm_triangle_ineq)
   also have "\<dots> \<le> norm (f x) + setsum (\<lambda>x. norm(f x)) S"
     using "2.hyps" by simp
   finally  show ?case  using "2.hyps" by simp
@@ -936,45 +1144,6 @@
   using real_setsum_norm_le[OF fS K] setsum_constant[symmetric]
   by simp
 
-instantiation "^" :: ("{scaleR, one, times}",type) scaleR
-begin
-
-definition vector_scaleR_def: "(scaleR :: real \<Rightarrow> 'a ^'b \<Rightarrow> 'a ^'b) \<equiv> (\<lambda> c x . (scaleR c 1) *s x)"
-instance ..
-end
-
-instantiation "^" :: ("ring_1",type) ring_1
-begin
-instance by intro_classes
-end
-
-instantiation "^" :: (real_algebra_1,type) real_vector
-begin
-
-instance
-  apply intro_classes
-  apply (simp_all  add: vector_scaleR_def)
-  apply (simp_all add: vector_sadd_rdistrib vector_add_ldistrib vector_smult_lid vector_smult_assoc scaleR_left_distrib mult_commute)
-  done
-end
-
-instantiation "^" :: (real_algebra_1,type) real_algebra
-begin
-
-instance
-  apply intro_classes
-  apply (simp_all add: vector_scaleR_def ring_simps)
-  apply vector
-  apply vector
-  done
-end
-
-instantiation "^" :: (real_algebra_1,type) real_algebra_1
-begin
-
-instance ..
-end
-
 lemma setsum_vmul:
   fixes f :: "'a \<Rightarrow> 'b::{real_normed_vector,semiring, mult_zero}"
   assumes fS: "finite S"
@@ -1211,7 +1380,7 @@
       by (auto simp add: setsum_component intro: abs_le_D1)
     have Pne: "setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pn \<le> e"
       using i component_le_norm[OF i, of "setsum (\<lambda>x. - f x) ?Pn"]  fPs[OF PnP]
-      by (auto simp add: setsum_negf norm_neg setsum_component vector_component intro: abs_le_D1)
+      by (auto simp add: setsum_negf setsum_component vector_component intro: abs_le_D1)
     have "setsum (\<lambda>x. \<bar>f x $ i\<bar>) P = setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pp + setsum (\<lambda>x. \<bar>f x $ i\<bar>) ?Pn" 
       apply (subst thp)
       apply (rule setsum_Un_nonzero) 
@@ -1535,7 +1704,7 @@
       unfolding norm_mul
       apply (simp only: mult_commute)
       apply (rule mult_mono)
-      by (auto simp add: ring_simps norm_pos_le) }
+      by (auto simp add: ring_simps norm_ge_zero) }
     then have th: "\<forall>i\<in> ?S. norm ((x$i) *s f (basis i :: real ^'m)) \<le> norm (f (basis i)) * norm x" by metis
     from real_setsum_norm_le[OF fS, of "\<lambda>i. (x$i) *s (f (basis i))", OF th]
     have "norm (f x) \<le> ?B * norm x" unfolding th0 setsum_left_distrib by metis}
@@ -1552,16 +1721,18 @@
   let ?K = "\<bar>B\<bar> + 1"
   have Kp: "?K > 0" by arith
     {assume C: "B < 0"
-      have "norm (1::real ^ 'n) > 0" by (simp add: norm_pos_lt)
+      have "norm (1::real ^ 'n) > 0" by (simp add: zero_less_norm_iff)
       with C have "B * norm (1:: real ^ 'n) < 0"
 	by (simp add: zero_compare_simps)
-      with B[rule_format, of 1] norm_pos_le[of "f 1"] have False by simp
+      with B[rule_format, of 1] norm_ge_zero[of "f 1"] have False by simp
     }
     then have Bp: "B \<ge> 0" by ferrack
     {fix x::"real ^ 'n"
       have "norm (f x) \<le> ?K *  norm x"
-      using B[rule_format, of x] norm_pos_le[of x] norm_pos_le[of "f x"] Bp
-      by (auto simp add: ring_simps split add: abs_split)
+      using B[rule_format, of x] norm_ge_zero[of x] norm_ge_zero[of "f x"] Bp
+      apply (auto simp add: ring_simps split add: abs_split)
+      apply (erule order_trans, simp)
+      done
   }
   then show ?thesis using Kp by blast
 qed
@@ -1641,9 +1812,9 @@
       apply simp
       apply (auto simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh] norm_mul ring_simps)
       apply (rule mult_mono)
-      apply (auto simp add: norm_pos_le zero_le_mult_iff component_le_norm)
+      apply (auto simp add: norm_ge_zero zero_le_mult_iff component_le_norm)
       apply (rule mult_mono)
-      apply (auto simp add: norm_pos_le zero_le_mult_iff component_le_norm)
+      apply (auto simp add: norm_ge_zero zero_le_mult_iff component_le_norm)
       done}
   then show ?thesis by metis
 qed
@@ -1663,7 +1834,7 @@
     have "B * norm x * norm y \<le> ?K * norm x * norm y"
       apply - 
       apply (rule mult_right_mono, rule mult_right_mono)
-      by (auto simp add: norm_pos_le)
+      by (auto simp add: norm_ge_zero)
     then have "norm (h x y) \<le> ?K * norm x * norm y"
       using B[rule_format, of x y] by simp} 
   with Kp show ?thesis by blast
@@ -2276,21 +2447,21 @@
   moreover
   {assume H: ?lhs
     from H[rule_format, of "basis 1"] 
-    have bp: "b \<ge> 0" using norm_pos_le[of "f (basis 1)"] dimindex_ge_1[of "UNIV:: 'n set"]
-      by (auto simp add: norm_basis) 
+    have bp: "b \<ge> 0" using norm_ge_zero[of "f (basis 1)"] dimindex_ge_1[of "UNIV:: 'n set"]
+      by (auto simp add: norm_basis elim: order_trans [OF norm_ge_zero])
     {fix x :: "real ^'n"
       {assume "x = 0"
-	then have "norm (f x) \<le> b * norm x" by (simp add: linear_0[OF lf] norm_0 bp)}
+	then have "norm (f x) \<le> b * norm x" by (simp add: linear_0[OF lf] bp)}
       moreover
       {assume x0: "x \<noteq> 0"
-	hence n0: "norm x \<noteq> 0" by (metis norm_eq_0)
+	hence n0: "norm x \<noteq> 0" by (metis norm_eq_zero)
 	let ?c = "1/ norm x"
-	have "norm (?c*s x) = 1" by (simp add: n0 norm_mul)
+	have "norm (?c*s x) = 1" using x0 by (simp add: n0 norm_mul)
 	with H have "norm (f(?c*s x)) \<le> b" by blast
 	hence "?c * norm (f x) \<le> b" 
 	  by (simp add: linear_cmul[OF lf] norm_mul)
 	hence "norm (f x) \<le> b * norm x" 
-	  using n0 norm_pos_le[of x] by (auto simp add: field_simps)}
+	  using n0 norm_ge_zero[of x] by (auto simp add: field_simps)}
       ultimately have "norm (f x) \<le> b * norm x" by blast}
     then have ?rhs by blast}
   ultimately show ?thesis by blast
@@ -2322,12 +2493,12 @@
 qed
 
 lemma onorm_pos_le: assumes lf: "linear (f::real ^'n \<Rightarrow> real ^'m)" shows "0 <= onorm f"
-  using order_trans[OF norm_pos_le onorm(1)[OF lf, of "basis 1"], unfolded norm_basis_1] by simp
+  using order_trans[OF norm_ge_zero onorm(1)[OF lf, of "basis 1"], unfolded norm_basis_1] by simp
 
 lemma onorm_eq_0: assumes lf: "linear (f::real ^'n \<Rightarrow> real ^'m)" 
   shows "onorm f = 0 \<longleftrightarrow> (\<forall>x. f x = 0)"
   using onorm[OF lf]
-  apply (auto simp add: norm_0 onorm_pos_le norm_le_0)
+  apply (auto simp add: onorm_pos_le)
   apply atomize
   apply (erule allE[where x="0::real"])
   using onorm_pos_le[OF lf]
@@ -2365,7 +2536,7 @@
 lemma onorm_neg_lemma: assumes lf: "linear (f::real ^'n \<Rightarrow> real^'m)"
   shows "onorm (\<lambda>x. - f x) \<le> onorm f"
   using onorm[OF linear_compose_neg[OF lf]] onorm[OF lf]
-  unfolding norm_neg by metis
+  unfolding norm_minus_cancel by metis
 
 lemma onorm_neg: assumes lf: "linear (f::real ^'n \<Rightarrow> real^'m)"
   shows "onorm (\<lambda>x. - f x) = onorm f"
@@ -2377,7 +2548,7 @@
   shows "onorm (\<lambda>x. f x + g x) <= onorm f + onorm g"
   apply(rule onorm(2)[OF linear_compose_add[OF lf lg], rule_format])
   apply (rule order_trans)
-  apply (rule norm_triangle)
+  apply (rule norm_triangle_ineq)
   apply (simp add: distrib)
   apply (rule add_mono)
   apply (rule onorm(1)[OF lf])
@@ -2594,7 +2765,7 @@
     by (simp add: dot_def setsum_add_split[OF th_0, of _ ?m] pastecart_def dimindex_finite_sum Cart_lambda_beta setsum_nonneg zero_le_square del: One_nat_def)
   then show ?thesis
     unfolding th0 
-    unfolding real_vector_norm_def real_sqrt_le_iff real_of_real_def id_def
+    unfolding real_vector_norm_def real_sqrt_le_iff id_def
     by (simp add: dot_def dimindex_finite_sum Cart_lambda_beta)
 qed
 
@@ -2626,7 +2797,7 @@
     by (simp add: dot_def setsum_add_split[OF th_0, of _ ?m] pastecart_def dimindex_finite_sum Cart_lambda_beta setsum_nonneg zero_le_square setsum_reindex[OF finj, unfolded fS] del: One_nat_def)    
   then show ?thesis
     unfolding th0 
-    unfolding real_vector_norm_def real_sqrt_le_iff real_of_real_def id_def
+    unfolding real_vector_norm_def real_sqrt_le_iff id_def
     by (simp add: dot_def dimindex_finite_sum Cart_lambda_beta)
 qed
 
@@ -2683,7 +2854,7 @@
 qed
 
 lemma norm_pastecart: "norm(pastecart x y) <= norm(x :: real ^ _) + norm(y)"
-  unfolding real_vector_norm_def dot_pastecart real_sqrt_le_iff real_of_real_def id_def
+  unfolding real_vector_norm_def dot_pastecart real_sqrt_le_iff id_def
   apply (rule power2_le_imp_le)
   apply (simp add: real_sqrt_pow2[OF add_nonneg_nonneg[OF dot_pos_le[of x] dot_pos_le[of y]]])
   apply (auto simp add: power2_eq_square ring_simps)
@@ -5007,7 +5178,7 @@
     apply blast
     by (rule abs_ge_zero)
   from real_le_lsqrt[OF dot_pos_le th th1]
-  show ?thesis unfolding real_vector_norm_def  real_of_real_def id_def . 
+  show ?thesis unfolding real_vector_norm_def id_def . 
 qed
 
 (* Equality in Cauchy-Schwarz and triangle inequalities.                     *)
@@ -5015,10 +5186,10 @@
 lemma norm_cauchy_schwarz_eq: "(x::real ^'n) \<bullet> y = norm x * norm y \<longleftrightarrow> norm x *s y = norm y *s x" (is "?lhs \<longleftrightarrow> ?rhs")
 proof-
   {assume h: "x = 0"
-    hence ?thesis by (simp add: norm_0)}
+    hence ?thesis by simp}
   moreover
   {assume h: "y = 0"
-    hence ?thesis by (simp add: norm_0)}
+    hence ?thesis by simp}
   moreover
   {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
     from dot_eq_0[of "norm y *s x - norm x *s y"]
@@ -5032,7 +5203,7 @@
     also have "\<dots> \<longleftrightarrow> (2 * norm x * norm y * (norm x * norm y - x \<bullet> y) = 0)" using x y
       by (simp add: ring_simps dot_sym)
     also have "\<dots> \<longleftrightarrow> ?lhs" using x y
-      apply (simp add: norm_eq_0)
+      apply simp
       by metis
     finally have ?thesis by blast}
   ultimately show ?thesis by blast
@@ -5043,14 +5214,14 @@
 proof-
   have th: "\<And>(x::real) a. a \<ge> 0 \<Longrightarrow> abs x = a \<longleftrightarrow> x = a \<or> x = - a" by arith
   have "?rhs \<longleftrightarrow> norm x *s y = norm y *s x \<or> norm (- x) *s y = norm y *s (- x)"
-    apply (simp add: norm_neg) by vector
+    apply simp by vector
   also have "\<dots> \<longleftrightarrow>(x \<bullet> y = norm x * norm y \<or>
      (-x) \<bullet> y = norm x * norm y)"
     unfolding norm_cauchy_schwarz_eq[symmetric]
-    unfolding norm_neg
+    unfolding norm_minus_cancel
       norm_mul by blast
   also have "\<dots> \<longleftrightarrow> ?lhs"
-    unfolding th[OF mult_nonneg_nonneg, OF norm_pos_le[of x] norm_pos_le[of y]] dot_lneg
+    unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] dot_lneg
     by arith
   finally show ?thesis ..
 qed
@@ -5058,17 +5229,17 @@
 lemma norm_triangle_eq: "norm(x + y) = norm x + norm y \<longleftrightarrow> norm x *s y = norm y *s x"
 proof-
   {assume x: "x =0 \<or> y =0"
-    hence ?thesis by (cases "x=0", simp_all add: norm_0)}
+    hence ?thesis by (cases "x=0", simp_all)}
   moreover
   {assume x: "x \<noteq> 0" and y: "y \<noteq> 0"
     hence "norm x \<noteq> 0" "norm y \<noteq> 0"
-      by (simp_all add: norm_eq_0)
+      by simp_all
     hence n: "norm x > 0" "norm y > 0" 
-      using norm_pos_le[of x] norm_pos_le[of y]
+      using norm_ge_zero[of x] norm_ge_zero[of y]
       by arith+
     have th: "\<And>(a::real) b c. a + b + c \<noteq> 0 ==> (a = b + c \<longleftrightarrow> a^2 = (b + c)^2)" by algebra
     have "norm(x + y) = norm x + norm y \<longleftrightarrow> norm(x + y)^ 2 = (norm x + norm y) ^2"
-      apply (rule th) using n norm_pos_le[of "x + y"]
+      apply (rule th) using n norm_ge_zero[of "x + y"]
       by arith
     also have "\<dots> \<longleftrightarrow> norm x *s y = norm y *s x"
       unfolding norm_cauchy_schwarz_eq[symmetric]
@@ -5138,8 +5309,8 @@
 
 lemma norm_cauchy_schwarz_equal: "abs(x \<bullet> y) = norm x * norm y \<longleftrightarrow> collinear {(0::real^'n),x,y}"
 unfolding norm_cauchy_schwarz_abs_eq
-apply (cases "x=0", simp_all add: collinear_2 norm_0)
-apply (cases "y=0", simp_all add: collinear_2 norm_0 insert_commute)
+apply (cases "x=0", simp_all add: collinear_2)
+apply (cases "y=0", simp_all add: collinear_2 insert_commute)
 unfolding collinear_lemma
 apply simp
 apply (subgoal_tac "norm x \<noteq> 0")
@@ -5164,8 +5335,8 @@
 apply (simp add: ring_simps)
 apply (case_tac "c <= 0", simp add: ring_simps)
 apply (simp add: ring_simps)
-apply (simp add: norm_eq_0)
-apply (simp add: norm_eq_0)
+apply simp
+apply simp
 done
 
-end
\ No newline at end of file
+end
--- a/src/HOL/Library/Float.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Library/Float.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -1,7 +1,10 @@
 (* Title:    HOL/Library/Float.thy
  * Author:   Steven Obua 2008
- *           Johannes Hölzl, TU Muenchen <hoelzl@in.tum.de> 2008 / 2009
+ *           Johannes H√\<paragraph>lzl, TU Muenchen <hoelzl@in.tum.de> 2008 / 2009
  *)
+
+header {* Floating-Point Numbers *}
+
 theory Float
 imports Complex_Main
 begin
@@ -792,7 +795,7 @@
     have "x \<noteq> y"
     proof (rule ccontr)
       assume "\<not> x \<noteq> y" hence "x = y" by auto
-      have "?X mod y = 0" unfolding `x = y` using zmod_zmult_self2 by auto
+      have "?X mod y = 0" unfolding `x = y` using mod_mult_self1_is_0 by auto
       thus False using False by auto
     qed
     hence "x < y" using `x \<le> y` by auto
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Library/FrechetDeriv.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -0,0 +1,503 @@
+(*  Title       : FrechetDeriv.thy
+    ID          : $Id$
+    Author      : Brian Huffman
+*)
+
+header {* Frechet Derivative *}
+
+theory FrechetDeriv
+imports Lim
+begin
+
+definition
+  fderiv ::
+  "['a::real_normed_vector \<Rightarrow> 'b::real_normed_vector, 'a, 'a \<Rightarrow> 'b] \<Rightarrow> bool"
+    -- {* Frechet derivative: D is derivative of function f at x *}
+          ("(FDERIV (_)/ (_)/ :> (_))" [1000, 1000, 60] 60) where
+  "FDERIV f x :> D = (bounded_linear D \<and>
+    (\<lambda>h. norm (f (x + h) - f x - D h) / norm h) -- 0 --> 0)"
+
+lemma FDERIV_I:
+  "\<lbrakk>bounded_linear D; (\<lambda>h. norm (f (x + h) - f x - D h) / norm h) -- 0 --> 0\<rbrakk>
+   \<Longrightarrow> FDERIV f x :> D"
+by (simp add: fderiv_def)
+
+lemma FDERIV_D:
+  "FDERIV f x :> D \<Longrightarrow> (\<lambda>h. norm (f (x + h) - f x - D h) / norm h) -- 0 --> 0"
+by (simp add: fderiv_def)
+
+lemma FDERIV_bounded_linear: "FDERIV f x :> D \<Longrightarrow> bounded_linear D"
+by (simp add: fderiv_def)
+
+lemma bounded_linear_zero:
+  "bounded_linear (\<lambda>x::'a::real_normed_vector. 0::'b::real_normed_vector)"
+proof
+  show "(0::'b) = 0 + 0" by simp
+  fix r show "(0::'b) = scaleR r 0" by simp
+  have "\<forall>x::'a. norm (0::'b) \<le> norm x * 0" by simp
+  thus "\<exists>K. \<forall>x::'a. norm (0::'b) \<le> norm x * K" ..
+qed
+
+lemma FDERIV_const: "FDERIV (\<lambda>x. k) x :> (\<lambda>h. 0)"
+by (simp add: fderiv_def bounded_linear_zero)
+
+lemma bounded_linear_ident:
+  "bounded_linear (\<lambda>x::'a::real_normed_vector. x)"
+proof
+  fix x y :: 'a show "x + y = x + y" by simp
+  fix r and x :: 'a show "scaleR r x = scaleR r x" by simp
+  have "\<forall>x::'a. norm x \<le> norm x * 1" by simp
+  thus "\<exists>K. \<forall>x::'a. norm x \<le> norm x * K" ..
+qed
+
+lemma FDERIV_ident: "FDERIV (\<lambda>x. x) x :> (\<lambda>h. h)"
+by (simp add: fderiv_def bounded_linear_ident)
+
+subsection {* Addition *}
+
+lemma add_diff_add:
+  fixes a b c d :: "'a::ab_group_add"
+  shows "(a + c) - (b + d) = (a - b) + (c - d)"
+by simp
+
+lemma bounded_linear_add:
+  assumes "bounded_linear f"
+  assumes "bounded_linear g"
+  shows "bounded_linear (\<lambda>x. f x + g x)"
+proof -
+  interpret f: bounded_linear f by fact
+  interpret g: bounded_linear g by fact
+  show ?thesis apply (unfold_locales)
+    apply (simp only: f.add g.add add_ac)
+    apply (simp only: f.scaleR g.scaleR scaleR_right_distrib)
+    apply (rule f.pos_bounded [THEN exE], rename_tac Kf)
+    apply (rule g.pos_bounded [THEN exE], rename_tac Kg)
+    apply (rule_tac x="Kf + Kg" in exI, safe)
+    apply (subst right_distrib)
+    apply (rule order_trans [OF norm_triangle_ineq])
+    apply (rule add_mono, erule spec, erule spec)
+    done
+qed
+
+lemma norm_ratio_ineq:
+  fixes x y :: "'a::real_normed_vector"
+  fixes h :: "'b::real_normed_vector"
+  shows "norm (x + y) / norm h \<le> norm x / norm h + norm y / norm h"
+apply (rule ord_le_eq_trans)
+apply (rule divide_right_mono)
+apply (rule norm_triangle_ineq)
+apply (rule norm_ge_zero)
+apply (rule add_divide_distrib)
+done
+
+lemma FDERIV_add:
+  assumes f: "FDERIV f x :> F"
+  assumes g: "FDERIV g x :> G"
+  shows "FDERIV (\<lambda>x. f x + g x) x :> (\<lambda>h. F h + G h)"
+proof (rule FDERIV_I)
+  show "bounded_linear (\<lambda>h. F h + G h)"
+    apply (rule bounded_linear_add)
+    apply (rule FDERIV_bounded_linear [OF f])
+    apply (rule FDERIV_bounded_linear [OF g])
+    done
+next
+  have f': "(\<lambda>h. norm (f (x + h) - f x - F h) / norm h) -- 0 --> 0"
+    using f by (rule FDERIV_D)
+  have g': "(\<lambda>h. norm (g (x + h) - g x - G h) / norm h) -- 0 --> 0"
+    using g by (rule FDERIV_D)
+  from f' g'
+  have "(\<lambda>h. norm (f (x + h) - f x - F h) / norm h
+           + norm (g (x + h) - g x - G h) / norm h) -- 0 --> 0"
+    by (rule LIM_add_zero)
+  thus "(\<lambda>h. norm (f (x + h) + g (x + h) - (f x + g x) - (F h + G h))
+           / norm h) -- 0 --> 0"
+    apply (rule real_LIM_sandwich_zero)
+     apply (simp add: divide_nonneg_pos)
+    apply (simp only: add_diff_add)
+    apply (rule norm_ratio_ineq)
+    done
+qed
+
+subsection {* Subtraction *}
+
+lemma bounded_linear_minus:
+  assumes "bounded_linear f"
+  shows "bounded_linear (\<lambda>x. - f x)"
+proof -
+  interpret f: bounded_linear f by fact
+  show ?thesis apply (unfold_locales)
+    apply (simp add: f.add)
+    apply (simp add: f.scaleR)
+    apply (simp add: f.bounded)
+    done
+qed
+
+lemma FDERIV_minus:
+  "FDERIV f x :> F \<Longrightarrow> FDERIV (\<lambda>x. - f x) x :> (\<lambda>h. - F h)"
+apply (rule FDERIV_I)
+apply (rule bounded_linear_minus)
+apply (erule FDERIV_bounded_linear)
+apply (simp only: fderiv_def minus_diff_minus norm_minus_cancel)
+done
+
+lemma FDERIV_diff:
+  "\<lbrakk>FDERIV f x :> F; FDERIV g x :> G\<rbrakk>
+   \<Longrightarrow> FDERIV (\<lambda>x. f x - g x) x :> (\<lambda>h. F h - G h)"
+by (simp only: diff_minus FDERIV_add FDERIV_minus)
+
+subsection {* Continuity *}
+
+lemma FDERIV_isCont:
+  assumes f: "FDERIV f x :> F"
+  shows "isCont f x"
+proof -
+  from f interpret F: bounded_linear "F" by (rule FDERIV_bounded_linear)
+  have "(\<lambda>h. norm (f (x + h) - f x - F h) / norm h) -- 0 --> 0"
+    by (rule FDERIV_D [OF f])
+  hence "(\<lambda>h. norm (f (x + h) - f x - F h) / norm h * norm h) -- 0 --> 0"
+    by (intro LIM_mult_zero LIM_norm_zero LIM_ident)
+  hence "(\<lambda>h. norm (f (x + h) - f x - F h)) -- 0 --> 0"
+    by (simp cong: LIM_cong)
+  hence "(\<lambda>h. f (x + h) - f x - F h) -- 0 --> 0"
+    by (rule LIM_norm_zero_cancel)
+  hence "(\<lambda>h. f (x + h) - f x - F h + F h) -- 0 --> 0"
+    by (intro LIM_add_zero F.LIM_zero LIM_ident)
+  hence "(\<lambda>h. f (x + h) - f x) -- 0 --> 0"
+    by simp
+  thus "isCont f x"
+    unfolding isCont_iff by (rule LIM_zero_cancel)
+qed
+
+subsection {* Composition *}
+
+lemma real_divide_cancel_lemma:
+  fixes a b c :: real
+  shows "(b = 0 \<Longrightarrow> a = 0) \<Longrightarrow> (a / b) * (b / c) = a / c"
+by simp
+
+lemma bounded_linear_compose:
+  assumes "bounded_linear f"
+  assumes "bounded_linear g"
+  shows "bounded_linear (\<lambda>x. f (g x))"
+proof -
+  interpret f: bounded_linear f by fact
+  interpret g: bounded_linear g by fact
+  show ?thesis proof (unfold_locales)
+    fix x y show "f (g (x + y)) = f (g x) + f (g y)"
+      by (simp only: f.add g.add)
+  next
+    fix r x show "f (g (scaleR r x)) = scaleR r (f (g x))"
+      by (simp only: f.scaleR g.scaleR)
+  next
+    from f.pos_bounded
+    obtain Kf where f: "\<And>x. norm (f x) \<le> norm x * Kf" and Kf: "0 < Kf" by fast
+    from g.pos_bounded
+    obtain Kg where g: "\<And>x. norm (g x) \<le> norm x * Kg" by fast
+    show "\<exists>K. \<forall>x. norm (f (g x)) \<le> norm x * K"
+    proof (intro exI allI)
+      fix x
+      have "norm (f (g x)) \<le> norm (g x) * Kf"
+	using f .
+      also have "\<dots> \<le> (norm x * Kg) * Kf"
+	using g Kf [THEN order_less_imp_le] by (rule mult_right_mono)
+      also have "(norm x * Kg) * Kf = norm x * (Kg * Kf)"
+	by (rule mult_assoc)
+      finally show "norm (f (g x)) \<le> norm x * (Kg * Kf)" .
+    qed
+  qed
+qed
+
+lemma FDERIV_compose:
+  fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
+  fixes g :: "'b::real_normed_vector \<Rightarrow> 'c::real_normed_vector"
+  assumes f: "FDERIV f x :> F"
+  assumes g: "FDERIV g (f x) :> G"
+  shows "FDERIV (\<lambda>x. g (f x)) x :> (\<lambda>h. G (F h))"
+proof (rule FDERIV_I)
+  from FDERIV_bounded_linear [OF g] FDERIV_bounded_linear [OF f]
+  show "bounded_linear (\<lambda>h. G (F h))"
+    by (rule bounded_linear_compose)
+next
+  let ?Rf = "\<lambda>h. f (x + h) - f x - F h"
+  let ?Rg = "\<lambda>k. g (f x + k) - g (f x) - G k"
+  let ?k = "\<lambda>h. f (x + h) - f x"
+  let ?Nf = "\<lambda>h. norm (?Rf h) / norm h"
+  let ?Ng = "\<lambda>h. norm (?Rg (?k h)) / norm (?k h)"
+  from f interpret F!: bounded_linear "F" by (rule FDERIV_bounded_linear)
+  from g interpret G!: bounded_linear "G" by (rule FDERIV_bounded_linear)
+  from F.bounded obtain kF where kF: "\<And>x. norm (F x) \<le> norm x * kF" by fast
+  from G.bounded obtain kG where kG: "\<And>x. norm (G x) \<le> norm x * kG" by fast
+
+  let ?fun2 = "\<lambda>h. ?Nf h * kG + ?Ng h * (?Nf h + kF)"
+
+  show "(\<lambda>h. norm (g (f (x + h)) - g (f x) - G (F h)) / norm h) -- 0 --> 0"
+  proof (rule real_LIM_sandwich_zero)
+    have Nf: "?Nf -- 0 --> 0"
+      using FDERIV_D [OF f] .
+
+    have Ng1: "isCont (\<lambda>k. norm (?Rg k) / norm k) 0"
+      by (simp add: isCont_def FDERIV_D [OF g])
+    have Ng2: "?k -- 0 --> 0"
+      apply (rule LIM_zero)
+      apply (fold isCont_iff)
+      apply (rule FDERIV_isCont [OF f])
+      done
+    have Ng: "?Ng -- 0 --> 0"
+      using isCont_LIM_compose [OF Ng1 Ng2] by simp
+
+    have "(\<lambda>h. ?Nf h * kG + ?Ng h * (?Nf h + kF))
+           -- 0 --> 0 * kG + 0 * (0 + kF)"
+      by (intro LIM_add LIM_mult LIM_const Nf Ng)
+    thus "(\<lambda>h. ?Nf h * kG + ?Ng h * (?Nf h + kF)) -- 0 --> 0"
+      by simp
+  next
+    fix h::'a assume h: "h \<noteq> 0"
+    thus "0 \<le> norm (g (f (x + h)) - g (f x) - G (F h)) / norm h"
+      by (simp add: divide_nonneg_pos)
+  next
+    fix h::'a assume h: "h \<noteq> 0"
+    have "g (f (x + h)) - g (f x) - G (F h) = G (?Rf h) + ?Rg (?k h)"
+      by (simp add: G.diff)
+    hence "norm (g (f (x + h)) - g (f x) - G (F h)) / norm h
+           = norm (G (?Rf h) + ?Rg (?k h)) / norm h"
+      by (rule arg_cong)
+    also have "\<dots> \<le> norm (G (?Rf h)) / norm h + norm (?Rg (?k h)) / norm h"
+      by (rule norm_ratio_ineq)
+    also have "\<dots> \<le> ?Nf h * kG + ?Ng h * (?Nf h + kF)"
+    proof (rule add_mono)
+      show "norm (G (?Rf h)) / norm h \<le> ?Nf h * kG"
+        apply (rule ord_le_eq_trans)
+        apply (rule divide_right_mono [OF kG norm_ge_zero])
+        apply simp
+        done
+    next
+      have "norm (?Rg (?k h)) / norm h = ?Ng h * (norm (?k h) / norm h)"
+        apply (rule real_divide_cancel_lemma [symmetric])
+        apply (simp add: G.zero)
+        done
+      also have "\<dots> \<le> ?Ng h * (?Nf h + kF)"
+      proof (rule mult_left_mono)
+        have "norm (?k h) / norm h = norm (?Rf h + F h) / norm h"
+          by simp
+        also have "\<dots> \<le> ?Nf h + norm (F h) / norm h"
+          by (rule norm_ratio_ineq)
+        also have "\<dots> \<le> ?Nf h + kF"
+          apply (rule add_left_mono)
+          apply (subst pos_divide_le_eq, simp add: h)
+          apply (subst mult_commute)
+          apply (rule kF)
+          done
+        finally show "norm (?k h) / norm h \<le> ?Nf h + kF" .
+      next
+        show "0 \<le> ?Ng h"
+        apply (case_tac "f (x + h) - f x = 0", simp)
+        apply (rule divide_nonneg_pos [OF norm_ge_zero])
+        apply simp
+        done
+      qed
+      finally show "norm (?Rg (?k h)) / norm h \<le> ?Ng h * (?Nf h + kF)" .
+    qed
+    finally show "norm (g (f (x + h)) - g (f x) - G (F h)) / norm h
+        \<le> ?Nf h * kG + ?Ng h * (?Nf h + kF)" .
+  qed
+qed
+
+subsection {* Product Rule *}
+
+lemma (in bounded_bilinear) FDERIV_lemma:
+  "a' ** b' - a ** b - (a ** B + A ** b)
+   = a ** (b' - b - B) + (a' - a - A) ** b' + A ** (b' - b)"
+by (simp add: diff_left diff_right)
+
+lemma (in bounded_bilinear) FDERIV:
+  fixes x :: "'d::real_normed_vector"
+  assumes f: "FDERIV f x :> F"
+  assumes g: "FDERIV g x :> G"
+  shows "FDERIV (\<lambda>x. f x ** g x) x :> (\<lambda>h. f x ** G h + F h ** g x)"
+proof (rule FDERIV_I)
+  show "bounded_linear (\<lambda>h. f x ** G h + F h ** g x)"
+    apply (rule bounded_linear_add)
+    apply (rule bounded_linear_compose [OF bounded_linear_right])
+    apply (rule FDERIV_bounded_linear [OF g])
+    apply (rule bounded_linear_compose [OF bounded_linear_left])
+    apply (rule FDERIV_bounded_linear [OF f])
+    done
+next
+  from bounded_linear.bounded [OF FDERIV_bounded_linear [OF f]]
+  obtain KF where norm_F: "\<And>x. norm (F x) \<le> norm x * KF" by fast
+
+  from pos_bounded obtain K where K: "0 < K" and norm_prod:
+    "\<And>a b. norm (a ** b) \<le> norm a * norm b * K" by fast
+
+  let ?Rf = "\<lambda>h. f (x + h) - f x - F h"
+  let ?Rg = "\<lambda>h. g (x + h) - g x - G h"
+
+  let ?fun1 = "\<lambda>h.
+        norm (f x ** ?Rg h + ?Rf h ** g (x + h) + F h ** (g (x + h) - g x)) /
+        norm h"
+
+  let ?fun2 = "\<lambda>h.
+        norm (f x) * (norm (?Rg h) / norm h) * K +
+        norm (?Rf h) / norm h * norm (g (x + h)) * K +
+        KF * norm (g (x + h) - g x) * K"
+
+  have "?fun1 -- 0 --> 0"
+  proof (rule real_LIM_sandwich_zero)
+    from f g isCont_iff [THEN iffD1, OF FDERIV_isCont [OF g]]
+    have "?fun2 -- 0 -->
+          norm (f x) * 0 * K + 0 * norm (g x) * K + KF * norm (0::'b) * K"
+      by (intro LIM_add LIM_mult LIM_const LIM_norm LIM_zero FDERIV_D)
+    thus "?fun2 -- 0 --> 0"
+      by simp
+  next
+    fix h::'d assume "h \<noteq> 0"
+    thus "0 \<le> ?fun1 h"
+      by (simp add: divide_nonneg_pos)
+  next
+    fix h::'d assume "h \<noteq> 0"
+    have "?fun1 h \<le> (norm (f x) * norm (?Rg h) * K +
+         norm (?Rf h) * norm (g (x + h)) * K +
+         norm h * KF * norm (g (x + h) - g x) * K) / norm h"
+      by (intro
+        divide_right_mono mult_mono'
+        order_trans [OF norm_triangle_ineq add_mono]
+        order_trans [OF norm_prod mult_right_mono]
+        mult_nonneg_nonneg order_refl norm_ge_zero norm_F
+        K [THEN order_less_imp_le]
+      )
+    also have "\<dots> = ?fun2 h"
+      by (simp add: add_divide_distrib)
+    finally show "?fun1 h \<le> ?fun2 h" .
+  qed
+  thus "(\<lambda>h.
+    norm (f (x + h) ** g (x + h) - f x ** g x - (f x ** G h + F h ** g x))
+    / norm h) -- 0 --> 0"
+    by (simp only: FDERIV_lemma)
+qed
+
+lemmas FDERIV_mult = mult.FDERIV
+
+lemmas FDERIV_scaleR = scaleR.FDERIV
+
+
+subsection {* Powers *}
+
+lemma FDERIV_power_Suc:
+  fixes x :: "'a::{real_normed_algebra,recpower,comm_ring_1}"
+  shows "FDERIV (\<lambda>x. x ^ Suc n) x :> (\<lambda>h. (1 + of_nat n) * x ^ n * h)"
+ apply (induct n)
+  apply (simp add: power_Suc FDERIV_ident)
+ apply (drule FDERIV_mult [OF FDERIV_ident])
+ apply (simp only: of_nat_Suc left_distrib mult_1_left)
+ apply (simp only: power_Suc right_distrib add_ac mult_ac)
+done
+
+lemma FDERIV_power:
+  fixes x :: "'a::{real_normed_algebra,recpower,comm_ring_1}"
+  shows "FDERIV (\<lambda>x. x ^ n) x :> (\<lambda>h. of_nat n * x ^ (n - 1) * h)"
+  apply (cases n)
+   apply (simp add: FDERIV_const)
+  apply (simp add: FDERIV_power_Suc)
+  done
+
+
+subsection {* Inverse *}
+
+lemma inverse_diff_inverse:
+  "\<lbrakk>(a::'a::division_ring) \<noteq> 0; b \<noteq> 0\<rbrakk>
+   \<Longrightarrow> inverse a - inverse b = - (inverse a * (a - b) * inverse b)"
+by (simp add: right_diff_distrib left_diff_distrib mult_assoc)
+
+lemmas bounded_linear_mult_const =
+  mult.bounded_linear_left [THEN bounded_linear_compose]
+
+lemmas bounded_linear_const_mult =
+  mult.bounded_linear_right [THEN bounded_linear_compose]
+
+lemma FDERIV_inverse:
+  fixes x :: "'a::real_normed_div_algebra"
+  assumes x: "x \<noteq> 0"
+  shows "FDERIV inverse x :> (\<lambda>h. - (inverse x * h * inverse x))"
+        (is "FDERIV ?inv _ :> _")
+proof (rule FDERIV_I)
+  show "bounded_linear (\<lambda>h. - (?inv x * h * ?inv x))"
+    apply (rule bounded_linear_minus)
+    apply (rule bounded_linear_mult_const)
+    apply (rule bounded_linear_const_mult)
+    apply (rule bounded_linear_ident)
+    done
+next
+  show "(\<lambda>h. norm (?inv (x + h) - ?inv x - - (?inv x * h * ?inv x)) / norm h)
+        -- 0 --> 0"
+  proof (rule LIM_equal2)
+    show "0 < norm x" using x by simp
+  next
+    fix h::'a
+    assume 1: "h \<noteq> 0"
+    assume "norm (h - 0) < norm x"
+    hence "h \<noteq> -x" by clarsimp
+    hence 2: "x + h \<noteq> 0"
+      apply (rule contrapos_nn)
+      apply (rule sym)
+      apply (erule equals_zero_I)
+      done
+    show "norm (?inv (x + h) - ?inv x - - (?inv x * h * ?inv x)) / norm h
+          = norm ((?inv (x + h) - ?inv x) * h * ?inv x) / norm h"
+      apply (subst inverse_diff_inverse [OF 2 x])
+      apply (subst minus_diff_minus)
+      apply (subst norm_minus_cancel)
+      apply (simp add: left_diff_distrib)
+      done
+  next
+    show "(\<lambda>h. norm ((?inv (x + h) - ?inv x) * h * ?inv x) / norm h)
+          -- 0 --> 0"
+    proof (rule real_LIM_sandwich_zero)
+      show "(\<lambda>h. norm (?inv (x + h) - ?inv x) * norm (?inv x))
+            -- 0 --> 0"
+        apply (rule LIM_mult_left_zero)
+        apply (rule LIM_norm_zero)
+        apply (rule LIM_zero)
+        apply (rule LIM_offset_zero)
+        apply (rule LIM_inverse)
+        apply (rule LIM_ident)
+        apply (rule x)
+        done
+    next
+      fix h::'a assume h: "h \<noteq> 0"
+      show "0 \<le> norm ((?inv (x + h) - ?inv x) * h * ?inv x) / norm h"
+        apply (rule divide_nonneg_pos)
+        apply (rule norm_ge_zero)
+        apply (simp add: h)
+        done
+    next
+      fix h::'a assume h: "h \<noteq> 0"
+      have "norm ((?inv (x + h) - ?inv x) * h * ?inv x) / norm h
+            \<le> norm (?inv (x + h) - ?inv x) * norm h * norm (?inv x) / norm h"
+        apply (rule divide_right_mono [OF _ norm_ge_zero])
+        apply (rule order_trans [OF norm_mult_ineq])
+        apply (rule mult_right_mono [OF _ norm_ge_zero])
+        apply (rule norm_mult_ineq)
+        done
+      also have "\<dots> = norm (?inv (x + h) - ?inv x) * norm (?inv x)"
+        by simp
+      finally show "norm ((?inv (x + h) - ?inv x) * h * ?inv x) / norm h
+            \<le> norm (?inv (x + h) - ?inv x) * norm (?inv x)" .   
+    qed
+  qed
+qed
+
+subsection {* Alternate definition *}
+
+lemma field_fderiv_def:
+  fixes x :: "'a::real_normed_field" shows
+  "FDERIV f x :> (\<lambda>h. h * D) = (\<lambda>h. (f (x + h) - f x) / h) -- 0 --> D"
+ apply (unfold fderiv_def)
+ apply (simp add: mult.bounded_linear_left)
+ apply (simp cong: LIM_cong add: nonzero_norm_divide [symmetric])
+ apply (subst diff_divide_distrib)
+ apply (subst times_divide_eq_left [symmetric])
+ apply (simp cong: LIM_cong)
+ apply (simp add: LIM_norm_zero_iff LIM_zero_iff)
+done
+
+end
--- a/src/HOL/Library/Fundamental_Theorem_Algebra.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Library/Fundamental_Theorem_Algebra.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -946,90 +946,6 @@
   ultimately show ?case by blast  
 qed simp
 
-subsection {* Order of polynomial roots *}
-
-definition
-  order :: "'a::{idom,recpower} \<Rightarrow> 'a poly \<Rightarrow> nat"
-where
-  [code del]:
-  "order a p = (LEAST n. \<not> [:-a, 1:] ^ Suc n dvd p)"
-
-lemma degree_power_le: "degree (p ^ n) \<le> degree p * n"
-by (induct n, simp, auto intro: order_trans degree_mult_le)
-
-lemma coeff_linear_power:
-  fixes a :: "'a::{comm_semiring_1,recpower}"
-  shows "coeff ([:a, 1:] ^ n) n = 1"
-apply (induct n, simp_all)
-apply (subst coeff_eq_0)
-apply (auto intro: le_less_trans degree_power_le)
-done
-
-lemma degree_linear_power:
-  fixes a :: "'a::{comm_semiring_1,recpower}"
-  shows "degree ([:a, 1:] ^ n) = n"
-apply (rule order_antisym)
-apply (rule ord_le_eq_trans [OF degree_power_le], simp)
-apply (rule le_degree, simp add: coeff_linear_power)
-done
-
-lemma order_1: "[:-a, 1:] ^ order a p dvd p"
-apply (cases "p = 0", simp)
-apply (cases "order a p", simp)
-apply (subgoal_tac "nat < (LEAST n. \<not> [:-a, 1:] ^ Suc n dvd p)")
-apply (drule not_less_Least, simp)
-apply (fold order_def, simp)
-done
-
-lemma order_2: "p \<noteq> 0 \<Longrightarrow> \<not> [:-a, 1:] ^ Suc (order a p) dvd p"
-unfolding order_def
-apply (rule LeastI_ex)
-apply (rule_tac x="degree p" in exI)
-apply (rule notI)
-apply (drule (1) dvd_imp_degree_le)
-apply (simp only: degree_linear_power)
-done
-
-lemma order:
-  "p \<noteq> 0 \<Longrightarrow> [:-a, 1:] ^ order a p dvd p \<and> \<not> [:-a, 1:] ^ Suc (order a p) dvd p"
-by (rule conjI [OF order_1 order_2])
-
-lemma order_degree:
-  assumes p: "p \<noteq> 0"
-  shows "order a p \<le> degree p"
-proof -
-  have "order a p = degree ([:-a, 1:] ^ order a p)"
-    by (simp only: degree_linear_power)
-  also have "\<dots> \<le> degree p"
-    using order_1 p by (rule dvd_imp_degree_le)
-  finally show ?thesis .
-qed
-
-lemma order_root: "poly p a = 0 \<longleftrightarrow> p = 0 \<or> order a p \<noteq> 0"
-apply (cases "p = 0", simp_all)
-apply (rule iffI)
-apply (rule ccontr, simp)
-apply (frule order_2 [where a=a], simp)
-apply (simp add: poly_eq_0_iff_dvd)
-apply (simp add: poly_eq_0_iff_dvd)
-apply (simp only: order_def)
-apply (drule not_less_Least, simp)
-done
-
-lemma poly_zero:
-  fixes p :: "'a::{idom,ring_char_0} poly"
-  shows "poly p = poly 0 \<longleftrightarrow> p = 0"
-apply (cases "p = 0", simp_all)
-apply (drule poly_roots_finite)
-apply (auto simp add: infinite_UNIV_char_0)
-done
-
-lemma poly_eq_iff:
-  fixes p q :: "'a::{idom,ring_char_0} poly"
-  shows "poly p = poly q \<longleftrightarrow> p = q"
-  using poly_zero [of "p - q"]
-  by (simp add: expand_fun_eq)
-
 
 subsection{* Nullstellenstatz, degrees and divisibility of polynomials *}
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Library/Inner_Product.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -0,0 +1,296 @@
+(* Title:      Inner_Product.thy
+   Author:     Brian Huffman
+*)
+
+header {* Inner Product Spaces and the Gradient Derivative *}
+
+theory Inner_Product
+imports Complex FrechetDeriv
+begin
+
+subsection {* Real inner product spaces *}
+
+class real_inner = real_vector + sgn_div_norm +
+  fixes inner :: "'a \<Rightarrow> 'a \<Rightarrow> real"
+  assumes inner_commute: "inner x y = inner y x"
+  and inner_left_distrib: "inner (x + y) z = inner x z + inner y z"
+  and inner_scaleR_left: "inner (scaleR r x) y = r * (inner x y)"
+  and inner_ge_zero [simp]: "0 \<le> inner x x"
+  and inner_eq_zero_iff [simp]: "inner x x = 0 \<longleftrightarrow> x = 0"
+  and norm_eq_sqrt_inner: "norm x = sqrt (inner x x)"
+begin
+
+lemma inner_zero_left [simp]: "inner 0 x = 0"
+  using inner_left_distrib [of 0 0 x] by simp
+
+lemma inner_minus_left [simp]: "inner (- x) y = - inner x y"
+  using inner_left_distrib [of x "- x" y] by simp
+
+lemma inner_diff_left: "inner (x - y) z = inner x z - inner y z"
+  by (simp add: diff_minus inner_left_distrib)
+
+text {* Transfer distributivity rules to right argument. *}
+
+lemma inner_right_distrib: "inner x (y + z) = inner x y + inner x z"
+  using inner_left_distrib [of y z x] by (simp only: inner_commute)
+
+lemma inner_scaleR_right: "inner x (scaleR r y) = r * (inner x y)"
+  using inner_scaleR_left [of r y x] by (simp only: inner_commute)
+
+lemma inner_zero_right [simp]: "inner x 0 = 0"
+  using inner_zero_left [of x] by (simp only: inner_commute)
+
+lemma inner_minus_right [simp]: "inner x (- y) = - inner x y"
+  using inner_minus_left [of y x] by (simp only: inner_commute)
+
+lemma inner_diff_right: "inner x (y - z) = inner x y - inner x z"
+  using inner_diff_left [of y z x] by (simp only: inner_commute)
+
+lemmas inner_distrib = inner_left_distrib inner_right_distrib
+lemmas inner_diff = inner_diff_left inner_diff_right
+lemmas inner_scaleR = inner_scaleR_left inner_scaleR_right
+
+lemma inner_gt_zero_iff [simp]: "0 < inner x x \<longleftrightarrow> x \<noteq> 0"
+  by (simp add: order_less_le)
+
+lemma power2_norm_eq_inner: "(norm x)\<twosuperior> = inner x x"
+  by (simp add: norm_eq_sqrt_inner)
+
+lemma Cauchy_Schwarz_ineq:
+  "(inner x y)\<twosuperior> \<le> inner x x * inner y y"
+proof (cases)
+  assume "y = 0"
+  thus ?thesis by simp
+next
+  assume y: "y \<noteq> 0"
+  let ?r = "inner x y / inner y y"
+  have "0 \<le> inner (x - scaleR ?r y) (x - scaleR ?r y)"
+    by (rule inner_ge_zero)
+  also have "\<dots> = inner x x - inner y x * ?r"
+    by (simp add: inner_diff inner_scaleR)
+  also have "\<dots> = inner x x - (inner x y)\<twosuperior> / inner y y"
+    by (simp add: power2_eq_square inner_commute)
+  finally have "0 \<le> inner x x - (inner x y)\<twosuperior> / inner y y" .
+  hence "(inner x y)\<twosuperior> / inner y y \<le> inner x x"
+    by (simp add: le_diff_eq)
+  thus "(inner x y)\<twosuperior> \<le> inner x x * inner y y"
+    by (simp add: pos_divide_le_eq y)
+qed
+
+lemma Cauchy_Schwarz_ineq2:
+  "\<bar>inner x y\<bar> \<le> norm x * norm y"
+proof (rule power2_le_imp_le)
+  have "(inner x y)\<twosuperior> \<le> inner x x * inner y y"
+    using Cauchy_Schwarz_ineq .
+  thus "\<bar>inner x y\<bar>\<twosuperior> \<le> (norm x * norm y)\<twosuperior>"
+    by (simp add: power_mult_distrib power2_norm_eq_inner)
+  show "0 \<le> norm x * norm y"
+    unfolding norm_eq_sqrt_inner
+    by (intro mult_nonneg_nonneg real_sqrt_ge_zero inner_ge_zero)
+qed
+
+subclass real_normed_vector
+proof
+  fix a :: real and x y :: 'a
+  show "0 \<le> norm x"
+    unfolding norm_eq_sqrt_inner by simp
+  show "norm x = 0 \<longleftrightarrow> x = 0"
+    unfolding norm_eq_sqrt_inner by simp
+  show "norm (x + y) \<le> norm x + norm y"
+    proof (rule power2_le_imp_le)
+      have "inner x y \<le> norm x * norm y"
+        by (rule order_trans [OF abs_ge_self Cauchy_Schwarz_ineq2])
+      thus "(norm (x + y))\<twosuperior> \<le> (norm x + norm y)\<twosuperior>"
+        unfolding power2_sum power2_norm_eq_inner
+        by (simp add: inner_distrib inner_commute)
+      show "0 \<le> norm x + norm y"
+        unfolding norm_eq_sqrt_inner
+        by (simp add: add_nonneg_nonneg)
+    qed
+  have "sqrt (a\<twosuperior> * inner x x) = \<bar>a\<bar> * sqrt (inner x x)"
+    by (simp add: real_sqrt_mult_distrib)
+  then show "norm (a *\<^sub>R x) = \<bar>a\<bar> * norm x"
+    unfolding norm_eq_sqrt_inner
+    by (simp add: inner_scaleR power2_eq_square mult_assoc)
+qed
+
+end
+
+interpretation inner!:
+  bounded_bilinear "inner::'a::real_inner \<Rightarrow> 'a \<Rightarrow> real"
+proof
+  fix x y z :: 'a and r :: real
+  show "inner (x + y) z = inner x z + inner y z"
+    by (rule inner_left_distrib)
+  show "inner x (y + z) = inner x y + inner x z"
+    by (rule inner_right_distrib)
+  show "inner (scaleR r x) y = scaleR r (inner x y)"
+    unfolding real_scaleR_def by (rule inner_scaleR_left)
+  show "inner x (scaleR r y) = scaleR r (inner x y)"
+    unfolding real_scaleR_def by (rule inner_scaleR_right)
+  show "\<exists>K. \<forall>x y::'a. norm (inner x y) \<le> norm x * norm y * K"
+  proof
+    show "\<forall>x y::'a. norm (inner x y) \<le> norm x * norm y * 1"
+      by (simp add: Cauchy_Schwarz_ineq2)
+  qed
+qed
+
+interpretation inner_left!:
+  bounded_linear "\<lambda>x::'a::real_inner. inner x y"
+  by (rule inner.bounded_linear_left)
+
+interpretation inner_right!:
+  bounded_linear "\<lambda>y::'a::real_inner. inner x y"
+  by (rule inner.bounded_linear_right)
+
+
+subsection {* Class instances *}
+
+instantiation real :: real_inner
+begin
+
+definition inner_real_def [simp]: "inner = op *"
+
+instance proof
+  fix x y z r :: real
+  show "inner x y = inner y x"
+    unfolding inner_real_def by (rule mult_commute)
+  show "inner (x + y) z = inner x z + inner y z"
+    unfolding inner_real_def by (rule left_distrib)
+  show "inner (scaleR r x) y = r * inner x y"
+    unfolding inner_real_def real_scaleR_def by (rule mult_assoc)
+  show "0 \<le> inner x x"
+    unfolding inner_real_def by simp
+  show "inner x x = 0 \<longleftrightarrow> x = 0"
+    unfolding inner_real_def by simp
+  show "norm x = sqrt (inner x x)"
+    unfolding inner_real_def by simp
+qed
+
+end
+
+instantiation complex :: real_inner
+begin
+
+definition inner_complex_def:
+  "inner x y = Re x * Re y + Im x * Im y"
+
+instance proof
+  fix x y z :: complex and r :: real
+  show "inner x y = inner y x"
+    unfolding inner_complex_def by (simp add: mult_commute)
+  show "inner (x + y) z = inner x z + inner y z"
+    unfolding inner_complex_def by (simp add: left_distrib)
+  show "inner (scaleR r x) y = r * inner x y"
+    unfolding inner_complex_def by (simp add: right_distrib)
+  show "0 \<le> inner x x"
+    unfolding inner_complex_def by (simp add: add_nonneg_nonneg)
+  show "inner x x = 0 \<longleftrightarrow> x = 0"
+    unfolding inner_complex_def
+    by (simp add: add_nonneg_eq_0_iff complex_Re_Im_cancel_iff)
+  show "norm x = sqrt (inner x x)"
+    unfolding inner_complex_def complex_norm_def
+    by (simp add: power2_eq_square)
+qed
+
+end
+
+
+subsection {* Gradient derivative *}
+
+definition
+  gderiv ::
+    "['a::real_inner \<Rightarrow> real, 'a, 'a] \<Rightarrow> bool"
+          ("(GDERIV (_)/ (_)/ :> (_))" [1000, 1000, 60] 60)
+where
+  "GDERIV f x :> D \<longleftrightarrow> FDERIV f x :> (\<lambda>h. inner h D)"
+
+lemma deriv_fderiv: "DERIV f x :> D \<longleftrightarrow> FDERIV f x :> (\<lambda>h. h * D)"
+  by (simp only: deriv_def field_fderiv_def)
+
+lemma gderiv_deriv [simp]: "GDERIV f x :> D \<longleftrightarrow> DERIV f x :> D"
+  by (simp only: gderiv_def deriv_fderiv inner_real_def)
+
+lemma GDERIV_DERIV_compose:
+    "\<lbrakk>GDERIV f x :> df; DERIV g (f x) :> dg\<rbrakk>
+     \<Longrightarrow> GDERIV (\<lambda>x. g (f x)) x :> scaleR dg df"
+  unfolding gderiv_def deriv_fderiv
+  apply (drule (1) FDERIV_compose)
+  apply (simp add: inner_scaleR_right mult_ac)
+  done
+
+lemma FDERIV_subst: "\<lbrakk>FDERIV f x :> df; df = d\<rbrakk> \<Longrightarrow> FDERIV f x :> d"
+  by simp
+
+lemma GDERIV_subst: "\<lbrakk>GDERIV f x :> df; df = d\<rbrakk> \<Longrightarrow> GDERIV f x :> d"
+  by simp
+
+lemma GDERIV_const: "GDERIV (\<lambda>x. k) x :> 0"
+  unfolding gderiv_def inner_right.zero by (rule FDERIV_const)
+
+lemma GDERIV_add:
+    "\<lbrakk>GDERIV f x :> df; GDERIV g x :> dg\<rbrakk>
+     \<Longrightarrow> GDERIV (\<lambda>x. f x + g x) x :> df + dg"
+  unfolding gderiv_def inner_right.add by (rule FDERIV_add)
+
+lemma GDERIV_minus:
+    "GDERIV f x :> df \<Longrightarrow> GDERIV (\<lambda>x. - f x) x :> - df"
+  unfolding gderiv_def inner_right.minus by (rule FDERIV_minus)
+
+lemma GDERIV_diff:
+    "\<lbrakk>GDERIV f x :> df; GDERIV g x :> dg\<rbrakk>
+     \<Longrightarrow> GDERIV (\<lambda>x. f x - g x) x :> df - dg"
+  unfolding gderiv_def inner_right.diff by (rule FDERIV_diff)
+
+lemma GDERIV_scaleR:
+    "\<lbrakk>DERIV f x :> df; GDERIV g x :> dg\<rbrakk>
+     \<Longrightarrow> GDERIV (\<lambda>x. scaleR (f x) (g x)) x
+      :> (scaleR (f x) dg + scaleR df (g x))"
+  unfolding gderiv_def deriv_fderiv inner_right.add inner_right.scaleR
+  apply (rule FDERIV_subst)
+  apply (erule (1) scaleR.FDERIV)
+  apply (simp add: mult_ac)
+  done
+
+lemma GDERIV_mult:
+    "\<lbrakk>GDERIV f x :> df; GDERIV g x :> dg\<rbrakk>
+     \<Longrightarrow> GDERIV (\<lambda>x. f x * g x) x :> scaleR (f x) dg + scaleR (g x) df"
+  unfolding gderiv_def
+  apply (rule FDERIV_subst)
+  apply (erule (1) FDERIV_mult)
+  apply (simp add: inner_distrib inner_scaleR mult_ac)
+  done
+
+lemma GDERIV_inverse:
+    "\<lbrakk>GDERIV f x :> df; f x \<noteq> 0\<rbrakk>
+     \<Longrightarrow> GDERIV (\<lambda>x. inverse (f x)) x :> - (inverse (f x))\<twosuperior> *\<^sub>R df"
+  apply (erule GDERIV_DERIV_compose)
+  apply (erule DERIV_inverse [folded numeral_2_eq_2])
+  done
+
+lemma GDERIV_norm:
+  assumes "x \<noteq> 0" shows "GDERIV (\<lambda>x. norm x) x :> sgn x"
+proof -
+  have 1: "FDERIV (\<lambda>x. inner x x) x :> (\<lambda>h. inner x h + inner h x)"
+    by (intro inner.FDERIV FDERIV_ident)
+  have 2: "(\<lambda>h. inner x h + inner h x) = (\<lambda>h. inner h (scaleR 2 x))"
+    by (simp add: expand_fun_eq inner_scaleR inner_commute)
+  have "0 < inner x x" using `x \<noteq> 0` by simp
+  then have 3: "DERIV sqrt (inner x x) :> (inverse (sqrt (inner x x)) / 2)"
+    by (rule DERIV_real_sqrt)
+  have 4: "(inverse (sqrt (inner x x)) / 2) *\<^sub>R 2 *\<^sub>R x = sgn x"
+    by (simp add: sgn_div_norm norm_eq_sqrt_inner)
+  show ?thesis
+    unfolding norm_eq_sqrt_inner
+    apply (rule GDERIV_subst [OF _ 4])
+    apply (rule GDERIV_DERIV_compose [where g=sqrt and df="scaleR 2 x"])
+    apply (subst gderiv_def)
+    apply (rule FDERIV_subst [OF _ 2])
+    apply (rule 1)
+    apply (rule 3)
+    done
+qed
+
+lemmas FDERIV_norm = GDERIV_norm [unfolded gderiv_def]
+
+end
--- a/src/HOL/Library/Library.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Library/Library.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -5,6 +5,7 @@
   AssocList
   BigO
   Binomial
+  Bit
   Boolean_Algebra
   Char_ord
   Code_Char_chr
@@ -22,9 +23,11 @@
   Executable_Set
   Float
   Formal_Power_Series
+  FrechetDeriv
   FuncSet
   Fundamental_Theorem_Algebra
   Infinite_Set
+  Inner_Product
   ListVector
   Mapping
   Multiset
@@ -35,7 +38,10 @@
   Option_ord
   Permutation
   Pocklington
+  Poly_Deriv
+  Polynomial
   Primes
+  Product_Vector
   Quickcheck
   Quicksort
   Quotient
--- a/src/HOL/Library/Numeral_Type.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Library/Numeral_Type.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -42,36 +42,87 @@
 end
 *}
 
-lemma card_unit: "CARD(unit) = 1"
+lemma card_unit [simp]: "CARD(unit) = 1"
   unfolding UNIV_unit by simp
 
-lemma card_bool: "CARD(bool) = 2"
+lemma card_bool [simp]: "CARD(bool) = 2"
   unfolding UNIV_bool by simp
 
-lemma card_prod: "CARD('a::finite \<times> 'b::finite) = CARD('a) * CARD('b)"
+lemma card_prod [simp]: "CARD('a \<times> 'b) = CARD('a::finite) * CARD('b::finite)"
   unfolding UNIV_Times_UNIV [symmetric] by (simp only: card_cartesian_product)
 
-lemma card_sum: "CARD('a::finite + 'b::finite) = CARD('a) + CARD('b)"
+lemma card_sum [simp]: "CARD('a + 'b) = CARD('a::finite) + CARD('b::finite)"
   unfolding UNIV_Plus_UNIV [symmetric] by (simp only: finite card_Plus)
 
-lemma card_option: "CARD('a::finite option) = Suc CARD('a)"
+lemma card_option [simp]: "CARD('a option) = Suc CARD('a::finite)"
   unfolding insert_None_conv_UNIV [symmetric]
   apply (subgoal_tac "(None::'a option) \<notin> range Some")
-  apply (simp add: finite card_image)
+  apply (simp add: card_image)
   apply fast
   done
 
-lemma card_set: "CARD('a::finite set) = 2 ^ CARD('a)"
+lemma card_set [simp]: "CARD('a set) = 2 ^ CARD('a::finite)"
   unfolding Pow_UNIV [symmetric]
   by (simp only: card_Pow finite numeral_2_eq_2)
 
+lemma card_nat [simp]: "CARD(nat) = 0"
+  by (simp add: infinite_UNIV_nat card_eq_0_iff)
+
+
+subsection {* Classes with at least 1 and 2  *}
+
+text {* Class finite already captures "at least 1" *}
+
+lemma zero_less_card_finite [simp]: "0 < CARD('a::finite)"
+  unfolding neq0_conv [symmetric] by simp
+
+lemma one_le_card_finite [simp]: "Suc 0 \<le> CARD('a::finite)"
+  by (simp add: less_Suc_eq_le [symmetric])
+
+text {* Class for cardinality "at least 2" *}
+
+class card2 = finite + 
+  assumes two_le_card: "2 \<le> CARD('a)"
+
+lemma one_less_card: "Suc 0 < CARD('a::card2)"
+  using two_le_card [where 'a='a] by simp
+
+lemma one_less_int_card: "1 < int CARD('a::card2)"
+  using one_less_card [where 'a='a] by simp
+
 
 subsection {* Numeral Types *}
 
 typedef (open) num0 = "UNIV :: nat set" ..
 typedef (open) num1 = "UNIV :: unit set" ..
-typedef (open) 'a bit0 = "UNIV :: (bool * 'a) set" ..
-typedef (open) 'a bit1 = "UNIV :: (bool * 'a) option set" ..
+
+typedef (open) 'a bit0 = "{0 ..< 2 * int CARD('a::finite)}"
+proof
+  show "0 \<in> {0 ..< 2 * int CARD('a)}"
+    by simp
+qed
+
+typedef (open) 'a bit1 = "{0 ..< 1 + 2 * int CARD('a::finite)}"
+proof
+  show "0 \<in> {0 ..< 1 + 2 * int CARD('a)}"
+    by simp
+qed
+
+lemma card_num0 [simp]: "CARD (num0) = 0"
+  unfolding type_definition.card [OF type_definition_num0]
+  by simp
+
+lemma card_num1 [simp]: "CARD(num1) = 1"
+  unfolding type_definition.card [OF type_definition_num1]
+  by (simp only: card_unit)
+
+lemma card_bit0 [simp]: "CARD('a bit0) = 2 * CARD('a::finite)"
+  unfolding type_definition.card [OF type_definition_bit0]
+  by simp
+
+lemma card_bit1 [simp]: "CARD('a bit1) = Suc (2 * CARD('a::finite))"
+  unfolding type_definition.card [OF type_definition_bit1]
+  by simp
 
 instance num1 :: finite
 proof
@@ -80,46 +131,263 @@
     using finite by (rule finite_imageI)
 qed
 
-instance bit0 :: (finite) finite
+instance bit0 :: (finite) card2
 proof
   show "finite (UNIV::'a bit0 set)"
     unfolding type_definition.univ [OF type_definition_bit0]
-    using finite by (rule finite_imageI)
+    by simp
+  show "2 \<le> CARD('a bit0)"
+    by simp
 qed
 
-instance bit1 :: (finite) finite
+instance bit1 :: (finite) card2
 proof
   show "finite (UNIV::'a bit1 set)"
     unfolding type_definition.univ [OF type_definition_bit1]
-    using finite by (rule finite_imageI)
+    by simp
+  show "2 \<le> CARD('a bit1)"
+    by simp
 qed
 
-lemma card_num1: "CARD(num1) = 1"
-  unfolding type_definition.card [OF type_definition_num1]
-  by (simp only: card_unit)
+
+subsection {* Locale for modular arithmetic subtypes *}
+
+locale mod_type =
+  fixes n :: int
+  and Rep :: "'a::{zero,one,plus,times,uminus,minus,power} \<Rightarrow> int"
+  and Abs :: "int \<Rightarrow> 'a::{zero,one,plus,times,uminus,minus,power}"
+  assumes type: "type_definition Rep Abs {0..<n}"
+  and size1: "1 < n"
+  and zero_def: "0 = Abs 0"
+  and one_def:  "1 = Abs 1"
+  and add_def:  "x + y = Abs ((Rep x + Rep y) mod n)"
+  and mult_def: "x * y = Abs ((Rep x * Rep y) mod n)"
+  and diff_def: "x - y = Abs ((Rep x - Rep y) mod n)"
+  and minus_def: "- x = Abs ((- Rep x) mod n)"
+  and power_def: "x ^ k = Abs (Rep x ^ k mod n)"
+begin
+
+lemma size0: "0 < n"
+by (cut_tac size1, simp)
+
+lemmas definitions =
+  zero_def one_def add_def mult_def minus_def diff_def power_def
+
+lemma Rep_less_n: "Rep x < n"
+by (rule type_definition.Rep [OF type, simplified, THEN conjunct2])
+
+lemma Rep_le_n: "Rep x \<le> n"
+by (rule Rep_less_n [THEN order_less_imp_le])
+
+lemma Rep_inject_sym: "x = y \<longleftrightarrow> Rep x = Rep y"
+by (rule type_definition.Rep_inject [OF type, symmetric])
+
+lemma Rep_inverse: "Abs (Rep x) = x"
+by (rule type_definition.Rep_inverse [OF type])
+
+lemma Abs_inverse: "m \<in> {0..<n} \<Longrightarrow> Rep (Abs m) = m"
+by (rule type_definition.Abs_inverse [OF type])
+
+lemma Rep_Abs_mod: "Rep (Abs (m mod n)) = m mod n"
+by (simp add: Abs_inverse IntDiv.pos_mod_conj [OF size0])
+
+lemma Rep_Abs_0: "Rep (Abs 0) = 0"
+by (simp add: Abs_inverse size0)
+
+lemma Rep_0: "Rep 0 = 0"
+by (simp add: zero_def Rep_Abs_0)
+
+lemma Rep_Abs_1: "Rep (Abs 1) = 1"
+by (simp add: Abs_inverse size1)
+
+lemma Rep_1: "Rep 1 = 1"
+by (simp add: one_def Rep_Abs_1)
 
-lemma card_bit0: "CARD('a::finite bit0) = 2 * CARD('a)"
-  unfolding type_definition.card [OF type_definition_bit0]
-  by (simp only: card_prod card_bool)
+lemma Rep_mod: "Rep x mod n = Rep x"
+apply (rule_tac x=x in type_definition.Abs_cases [OF type])
+apply (simp add: type_definition.Abs_inverse [OF type])
+apply (simp add: mod_pos_pos_trivial)
+done
+
+lemmas Rep_simps =
+  Rep_inject_sym Rep_inverse Rep_Abs_mod Rep_mod Rep_Abs_0 Rep_Abs_1
+
+lemma comm_ring_1: "OFCLASS('a, comm_ring_1_class)"
+apply (intro_classes, unfold definitions)
+apply (simp_all add: Rep_simps zmod_simps ring_simps)
+done
+
+lemma recpower: "OFCLASS('a, recpower_class)"
+apply (intro_classes, unfold definitions)
+apply (simp_all add: Rep_simps zmod_simps add_ac mult_assoc
+                     mod_pos_pos_trivial size1)
+done
+
+end
+
+locale mod_ring = mod_type +
+  constrains n :: int
+  and Rep :: "'a::{number_ring,power} \<Rightarrow> int"
+  and Abs :: "int \<Rightarrow> 'a::{number_ring,power}"
+begin
 
-lemma card_bit1: "CARD('a::finite bit1) = Suc (2 * CARD('a))"
-  unfolding type_definition.card [OF type_definition_bit1]
-  by (simp only: card_prod card_option card_bool)
+lemma of_nat_eq: "of_nat k = Abs (int k mod n)"
+apply (induct k)
+apply (simp add: zero_def)
+apply (simp add: Rep_simps add_def one_def zmod_simps add_ac)
+done
+
+lemma of_int_eq: "of_int z = Abs (z mod n)"
+apply (cases z rule: int_diff_cases)
+apply (simp add: Rep_simps of_nat_eq diff_def zmod_simps)
+done
+
+lemma Rep_number_of:
+  "Rep (number_of w) = number_of w mod n"
+by (simp add: number_of_eq of_int_eq Rep_Abs_mod)
+
+lemma iszero_number_of:
+  "iszero (number_of w::'a) \<longleftrightarrow> number_of w mod n = 0"
+by (simp add: Rep_simps number_of_eq of_int_eq iszero_def zero_def)
+
+lemma cases:
+  assumes 1: "\<And>z. \<lbrakk>(x::'a) = of_int z; 0 \<le> z; z < n\<rbrakk> \<Longrightarrow> P"
+  shows "P"
+apply (cases x rule: type_definition.Abs_cases [OF type])
+apply (rule_tac z="y" in 1)
+apply (simp_all add: of_int_eq mod_pos_pos_trivial)
+done
+
+lemma induct:
+  "(\<And>z. \<lbrakk>0 \<le> z; z < n\<rbrakk> \<Longrightarrow> P (of_int z)) \<Longrightarrow> P (x::'a)"
+by (cases x rule: cases) simp
+
+end
+
+
+subsection {* Number ring instances *}
 
-lemma card_num0: "CARD (num0) = 0"
-  by (simp add: infinite_UNIV_nat card_eq_0_iff type_definition.card [OF type_definition_num0])
+text {*
+  Unfortunately a number ring instance is not possible for
+  @{typ num1}, since 0 and 1 are not distinct.
+*}
+
+instantiation num1 :: "{comm_ring,comm_monoid_mult,number,recpower}"
+begin
+
+lemma num1_eq_iff: "(x::num1) = (y::num1) \<longleftrightarrow> True"
+  by (induct x, induct y) simp
+
+instance proof
+qed (simp_all add: num1_eq_iff)
+
+end
+
+instantiation
+  bit0 and bit1 :: (finite) "{zero,one,plus,times,uminus,minus,power}"
+begin
+
+definition Abs_bit0' :: "int \<Rightarrow> 'a bit0" where
+  "Abs_bit0' x = Abs_bit0 (x mod int CARD('a bit0))"
+
+definition Abs_bit1' :: "int \<Rightarrow> 'a bit1" where
+  "Abs_bit1' x = Abs_bit1 (x mod int CARD('a bit1))"
+
+definition "0 = Abs_bit0 0"
+definition "1 = Abs_bit0 1"
+definition "x + y = Abs_bit0' (Rep_bit0 x + Rep_bit0 y)"
+definition "x * y = Abs_bit0' (Rep_bit0 x * Rep_bit0 y)"
+definition "x - y = Abs_bit0' (Rep_bit0 x - Rep_bit0 y)"
+definition "- x = Abs_bit0' (- Rep_bit0 x)"
+definition "x ^ k = Abs_bit0' (Rep_bit0 x ^ k)"
+
+definition "0 = Abs_bit1 0"
+definition "1 = Abs_bit1 1"
+definition "x + y = Abs_bit1' (Rep_bit1 x + Rep_bit1 y)"
+definition "x * y = Abs_bit1' (Rep_bit1 x * Rep_bit1 y)"
+definition "x - y = Abs_bit1' (Rep_bit1 x - Rep_bit1 y)"
+definition "- x = Abs_bit1' (- Rep_bit1 x)"
+definition "x ^ k = Abs_bit1' (Rep_bit1 x ^ k)"
+
+instance ..
+
+end
 
-lemmas card_univ_simps [simp] =
-  card_unit
-  card_bool
-  card_prod
-  card_sum
-  card_option
-  card_set
-  card_num1
-  card_bit0
-  card_bit1
-  card_num0
+interpretation bit0!:
+  mod_type "int CARD('a::finite bit0)"
+           "Rep_bit0 :: 'a::finite bit0 \<Rightarrow> int"
+           "Abs_bit0 :: int \<Rightarrow> 'a::finite bit0"
+apply (rule mod_type.intro)
+apply (simp add: int_mult type_definition_bit0)
+apply (rule one_less_int_card)
+apply (rule zero_bit0_def)
+apply (rule one_bit0_def)
+apply (rule plus_bit0_def [unfolded Abs_bit0'_def])
+apply (rule times_bit0_def [unfolded Abs_bit0'_def])
+apply (rule minus_bit0_def [unfolded Abs_bit0'_def])
+apply (rule uminus_bit0_def [unfolded Abs_bit0'_def])
+apply (rule power_bit0_def [unfolded Abs_bit0'_def])
+done
+
+interpretation bit1!:
+  mod_type "int CARD('a::finite bit1)"
+           "Rep_bit1 :: 'a::finite bit1 \<Rightarrow> int"
+           "Abs_bit1 :: int \<Rightarrow> 'a::finite bit1"
+apply (rule mod_type.intro)
+apply (simp add: int_mult type_definition_bit1)
+apply (rule one_less_int_card)
+apply (rule zero_bit1_def)
+apply (rule one_bit1_def)
+apply (rule plus_bit1_def [unfolded Abs_bit1'_def])
+apply (rule times_bit1_def [unfolded Abs_bit1'_def])
+apply (rule minus_bit1_def [unfolded Abs_bit1'_def])
+apply (rule uminus_bit1_def [unfolded Abs_bit1'_def])
+apply (rule power_bit1_def [unfolded Abs_bit1'_def])
+done
+
+instance bit0 :: (finite) "{comm_ring_1,recpower}"
+  by (rule bit0.comm_ring_1 bit0.recpower)+
+
+instance bit1 :: (finite) "{comm_ring_1,recpower}"
+  by (rule bit1.comm_ring_1 bit1.recpower)+
+
+instantiation bit0 and bit1 :: (finite) number_ring
+begin
+
+definition "(number_of w :: _ bit0) = of_int w"
+
+definition "(number_of w :: _ bit1) = of_int w"
+
+instance proof
+qed (rule number_of_bit0_def number_of_bit1_def)+
+
+end
+
+interpretation bit0!:
+  mod_ring "int CARD('a::finite bit0)"
+           "Rep_bit0 :: 'a::finite bit0 \<Rightarrow> int"
+           "Abs_bit0 :: int \<Rightarrow> 'a::finite bit0"
+  ..
+
+interpretation bit1!:
+  mod_ring "int CARD('a::finite bit1)"
+           "Rep_bit1 :: 'a::finite bit1 \<Rightarrow> int"
+           "Abs_bit1 :: int \<Rightarrow> 'a::finite bit1"
+  ..
+
+text {* Set up cases, induction, and arithmetic *}
+
+lemmas bit0_cases [case_names of_int, cases type: bit0] = bit0.cases
+lemmas bit1_cases [case_names of_int, cases type: bit1] = bit1.cases
+
+lemmas bit0_induct [case_names of_int, induct type: bit0] = bit0.induct
+lemmas bit1_induct [case_names of_int, induct type: bit1] = bit1.induct
+
+lemmas bit0_iszero_number_of [simp] = bit0.iszero_number_of
+lemmas bit1_iszero_number_of [simp] = bit1.iszero_number_of
+
+declare power_Suc [where ?'a="'a::finite bit0", standard, simp]
+declare power_Suc [where ?'a="'a::finite bit1", standard, simp]
 
 
 subsection {* Syntax *}
@@ -184,42 +452,10 @@
 in [("bit0", bit_tr' 0), ("bit1", bit_tr' 1)] end;
 *}
 
-
-subsection {* Classes with at least 1 and 2  *}
-
-text {* Class finite already captures "at least 1" *}
-
-lemma zero_less_card_finite [simp]:
-  "0 < CARD('a::finite)"
-proof (cases "CARD('a::finite) = 0")
-  case False thus ?thesis by (simp del: card_0_eq)
-next
-  case True
-  thus ?thesis by (simp add: finite)
-qed
-
-lemma one_le_card_finite [simp]:
-  "Suc 0 <= CARD('a::finite)"
-  by (simp add: less_Suc_eq_le [symmetric] zero_less_card_finite)
-
-
-text {* Class for cardinality "at least 2" *}
-
-class card2 = finite + 
-  assumes two_le_card: "2 <= CARD('a)"
-
-lemma one_less_card: "Suc 0 < CARD('a::card2)"
-  using two_le_card [where 'a='a] by simp
-
-instance bit0 :: (finite) card2
-  by intro_classes (simp add: one_le_card_finite)
-
-instance bit1 :: (finite) card2
-  by intro_classes (simp add: one_le_card_finite)
-
 subsection {* Examples *}
 
 lemma "CARD(0) = 0" by simp
 lemma "CARD(17) = 17" by simp
+lemma "8 * 11 ^ 3 - 6 = (2::5)" by simp
 
 end
--- a/src/HOL/Library/Permutations.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Library/Permutations.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -6,7 +6,7 @@
 header {* Permutations, both general and specifically on finite sets.*}
 
 theory Permutations
-imports Main Finite_Cartesian_Product Parity 
+imports Main Finite_Cartesian_Product Parity Fact
 begin
 
   (* Why should I import Main just to solve the Typerep problem! *)
@@ -683,13 +683,13 @@
 (* ------------------------------------------------------------------------- *)
 
 lemma permutes_natset_le:
-  assumes p: "p permutes (S:: nat set)" and le: "\<forall>i \<in> S.  p i <= i" shows "p = id"
+  assumes p: "p permutes (S::'a::wellorder set)" and le: "\<forall>i \<in> S.  p i <= i" shows "p = id"
 proof-
   {fix n
     have "p n = n" 
       using p le
-    proof(induct n arbitrary: S rule: nat_less_induct)
-      fix n S assume H: "\<forall> m< n. \<forall>S. p permutes S \<longrightarrow> (\<forall>i\<in>S. p i \<le> i) \<longrightarrow> p m = m" 
+    proof(induct n arbitrary: S rule: less_induct)
+      fix n S assume H: "\<And>m S. \<lbrakk>m < n; p permutes S; \<forall>i\<in>S. p i \<le> i\<rbrakk> \<Longrightarrow> p m = m" 
 	"p permutes S" "\<forall>i \<in>S. p i \<le> i"
       {assume "n \<notin> S"
 	with H(2) have "p n = n" unfolding permutes_def by metis}
@@ -699,7 +699,7 @@
 	moreover{assume h: "p n < n"
 	  from H h have "p (p n) = p n" by metis
 	  with permutes_inj[OF H(2)] have "p n = n" unfolding inj_on_def by blast
-	  with h have False by arith}
+	  with h have False by simp}
 	ultimately have "p n = n" by blast }
       ultimately show "p n = n"  by blast
     qed}
@@ -707,7 +707,7 @@
 qed
 
 lemma permutes_natset_ge:
-  assumes p: "p permutes (S:: nat set)" and le: "\<forall>i \<in> S.  p i \<ge> i" shows "p = id"
+  assumes p: "p permutes (S::'a::wellorder set)" and le: "\<forall>i \<in> S.  p i \<ge> i" shows "p = id"
 proof-
   {fix i assume i: "i \<in> S"
     from i permutes_in_image[OF permutes_inv[OF p]] have "inv p i \<in> S" by simp
@@ -757,13 +757,13 @@
 done
 
 term setsum
-lemma setsum_permutations_inverse: "setsum f {p. p permutes {m..n}} = setsum (\<lambda>p. f(inv p)) {p. p permutes {m..n}}" (is "?lhs = ?rhs")
+lemma setsum_permutations_inverse: "setsum f {p. p permutes S} = setsum (\<lambda>p. f(inv p)) {p. p permutes S}" (is "?lhs = ?rhs")
 proof-
-  let ?S = "{p . p permutes {m .. n}}"
+  let ?S = "{p . p permutes S}"
 have th0: "inj_on inv ?S" 
 proof(auto simp add: inj_on_def)
   fix q r
-  assume q: "q permutes {m .. n}" and r: "r permutes {m .. n}" and qr: "inv q = inv r"
+  assume q: "q permutes S" and r: "r permutes S" and qr: "inv q = inv r"
   hence "inv (inv q) = inv (inv r)" by simp
   with permutes_inv_inv[OF q] permutes_inv_inv[OF r]
   show "q = r" by metis
@@ -774,17 +774,17 @@
 qed
 
 lemma setum_permutations_compose_left:
-  assumes q: "q permutes {m..n}"
-  shows "setsum f {p. p permutes {m..n}} =
-            setsum (\<lambda>p. f(q o p)) {p. p permutes {m..n}}" (is "?lhs = ?rhs")
+  assumes q: "q permutes S"
+  shows "setsum f {p. p permutes S} =
+            setsum (\<lambda>p. f(q o p)) {p. p permutes S}" (is "?lhs = ?rhs")
 proof-
-  let ?S = "{p. p permutes {m..n}}"
+  let ?S = "{p. p permutes S}"
   have th0: "?rhs = setsum (f o (op o q)) ?S" by (simp add: o_def)
   have th1: "inj_on (op o q) ?S"
     apply (auto simp add: inj_on_def)
   proof-
     fix p r
-    assume "p permutes {m..n}" and r:"r permutes {m..n}" and rp: "q \<circ> p = q \<circ> r"
+    assume "p permutes S" and r:"r permutes S" and rp: "q \<circ> p = q \<circ> r"
     hence "inv q o q o p = inv q o q o r" by (simp add: o_assoc[symmetric])
     with permutes_inj[OF q, unfolded inj_iff]
 
@@ -796,17 +796,17 @@
 qed
 
 lemma sum_permutations_compose_right:
-  assumes q: "q permutes {m..n}"
-  shows "setsum f {p. p permutes {m..n}} =
-            setsum (\<lambda>p. f(p o q)) {p. p permutes {m..n}}" (is "?lhs = ?rhs")
+  assumes q: "q permutes S"
+  shows "setsum f {p. p permutes S} =
+            setsum (\<lambda>p. f(p o q)) {p. p permutes S}" (is "?lhs = ?rhs")
 proof-
-  let ?S = "{p. p permutes {m..n}}"
+  let ?S = "{p. p permutes S}"
   have th0: "?rhs = setsum (f o (\<lambda>p. p o q)) ?S" by (simp add: o_def)
   have th1: "inj_on (\<lambda>p. p o q) ?S"
     apply (auto simp add: inj_on_def)
   proof-
     fix p r
-    assume "p permutes {m..n}" and r:"r permutes {m..n}" and rp: "p o q = r o q"
+    assume "p permutes S" and r:"r permutes S" and rp: "p o q = r o q"
     hence "p o (q o inv q)  = r o (q o inv q)" by (simp add: o_assoc)
     with permutes_surj[OF q, unfolded surj_iff]
 
--- a/src/HOL/Library/Pocklington.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Library/Pocklington.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -873,7 +873,7 @@
       from lh[unfolded nat_mod] 
       obtain q1 q2 where q12:"a ^ d + n * q1 = 1 + n * q2" by blast
       hence "a ^ d + n * q1 - n * q2 = 1" by simp
-      with dvd_diff [OF dvd_add [OF divides_rexp[OF p(2), of d'] dvd_mult2[OF p(1), of q1]] dvd_mult2[OF p(1), of q2]] d' have "p dvd 1" by simp 
+      with nat_dvd_diff [OF dvd_add [OF divides_rexp[OF p(2), of d'] dvd_mult2[OF p(1), of q1]] dvd_mult2[OF p(1), of q2]] d' have "p dvd 1" by simp
       with p(3) have False by simp
       hence ?rhs ..}
     ultimately have ?rhs by blast}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Library/Poly_Deriv.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -0,0 +1,316 @@
+(*  Title:      Poly_Deriv.thy
+    Author:     Amine Chaieb
+                Ported to new Polynomial library by Brian Huffman
+*)
+
+header{* Polynomials and Differentiation *}
+
+theory Poly_Deriv
+imports Deriv Polynomial
+begin
+
+subsection {* Derivatives of univariate polynomials *}
+
+definition
+  pderiv :: "'a::real_normed_field poly \<Rightarrow> 'a poly" where
+  "pderiv = poly_rec 0 (\<lambda>a p p'. p + pCons 0 p')"
+
+lemma pderiv_0 [simp]: "pderiv 0 = 0"
+  unfolding pderiv_def by (simp add: poly_rec_0)
+
+lemma pderiv_pCons: "pderiv (pCons a p) = p + pCons 0 (pderiv p)"
+  unfolding pderiv_def by (simp add: poly_rec_pCons)
+
+lemma coeff_pderiv: "coeff (pderiv p) n = of_nat (Suc n) * coeff p (Suc n)"
+  apply (induct p arbitrary: n, simp)
+  apply (simp add: pderiv_pCons coeff_pCons algebra_simps split: nat.split)
+  done
+
+lemma pderiv_eq_0_iff: "pderiv p = 0 \<longleftrightarrow> degree p = 0"
+  apply (rule iffI)
+  apply (cases p, simp)
+  apply (simp add: expand_poly_eq coeff_pderiv del: of_nat_Suc)
+  apply (simp add: expand_poly_eq coeff_pderiv coeff_eq_0)
+  done
+
+lemma degree_pderiv: "degree (pderiv p) = degree p - 1"
+  apply (rule order_antisym [OF degree_le])
+  apply (simp add: coeff_pderiv coeff_eq_0)
+  apply (cases "degree p", simp)
+  apply (rule le_degree)
+  apply (simp add: coeff_pderiv del: of_nat_Suc)
+  apply (rule subst, assumption)
+  apply (rule leading_coeff_neq_0, clarsimp)
+  done
+
+lemma pderiv_singleton [simp]: "pderiv [:a:] = 0"
+by (simp add: pderiv_pCons)
+
+lemma pderiv_add: "pderiv (p + q) = pderiv p + pderiv q"
+by (rule poly_ext, simp add: coeff_pderiv algebra_simps)
+
+lemma pderiv_minus: "pderiv (- p) = - pderiv p"
+by (rule poly_ext, simp add: coeff_pderiv)
+
+lemma pderiv_diff: "pderiv (p - q) = pderiv p - pderiv q"
+by (rule poly_ext, simp add: coeff_pderiv algebra_simps)
+
+lemma pderiv_smult: "pderiv (smult a p) = smult a (pderiv p)"
+by (rule poly_ext, simp add: coeff_pderiv algebra_simps)
+
+lemma pderiv_mult: "pderiv (p * q) = p * pderiv q + q * pderiv p"
+apply (induct p)
+apply simp
+apply (simp add: pderiv_add pderiv_smult pderiv_pCons algebra_simps)
+done
+
+lemma pderiv_power_Suc:
+  "pderiv (p ^ Suc n) = smult (of_nat (Suc n)) (p ^ n) * pderiv p"
+apply (induct n)
+apply simp
+apply (subst power_Suc)
+apply (subst pderiv_mult)
+apply (erule ssubst)
+apply (simp add: smult_add_left algebra_simps)
+done
+
+lemma DERIV_cmult2: "DERIV f x :> D ==> DERIV (%x. (f x) * c :: real) x :> D * c"
+by (simp add: DERIV_cmult mult_commute [of _ c])
+
+lemma DERIV_pow2: "DERIV (%x. x ^ Suc n) x :> real (Suc n) * (x ^ n)"
+by (rule lemma_DERIV_subst, rule DERIV_pow, simp)
+declare DERIV_pow2 [simp] DERIV_pow [simp]
+
+lemma DERIV_add_const: "DERIV f x :> D ==>  DERIV (%x. a + f x :: 'a::real_normed_field) x :> D"
+by (rule lemma_DERIV_subst, rule DERIV_add, auto)
+
+lemma poly_DERIV[simp]: "DERIV (%x. poly p x) x :> poly (pderiv p) x"
+apply (induct p)
+apply simp
+apply (simp add: pderiv_pCons)
+apply (rule lemma_DERIV_subst)
+apply (rule DERIV_add DERIV_mult DERIV_const DERIV_ident | assumption)+
+apply simp
+done
+
+text{* Consequences of the derivative theorem above*}
+
+lemma poly_differentiable[simp]: "(%x. poly p x) differentiable (x::real)"
+apply (simp add: differentiable_def)
+apply (blast intro: poly_DERIV)
+done
+
+lemma poly_isCont[simp]: "isCont (%x. poly p x) (x::real)"
+by (rule poly_DERIV [THEN DERIV_isCont])
+
+lemma poly_IVT_pos: "[| a < b; poly p (a::real) < 0; 0 < poly p b |]
+      ==> \<exists>x. a < x & x < b & (poly p x = 0)"
+apply (cut_tac f = "%x. poly p x" and a = a and b = b and y = 0 in IVT_objl)
+apply (auto simp add: order_le_less)
+done
+
+lemma poly_IVT_neg: "[| (a::real) < b; 0 < poly p a; poly p b < 0 |]
+      ==> \<exists>x. a < x & x < b & (poly p x = 0)"
+by (insert poly_IVT_pos [where p = "- p" ]) simp
+
+lemma poly_MVT: "(a::real) < b ==>
+     \<exists>x. a < x & x < b & (poly p b - poly p a = (b - a) * poly (pderiv p) x)"
+apply (drule_tac f = "poly p" in MVT, auto)
+apply (rule_tac x = z in exI)
+apply (auto simp add: real_mult_left_cancel poly_DERIV [THEN DERIV_unique])
+done
+
+text{*Lemmas for Derivatives*}
+
+lemma order_unique_lemma:
+  fixes p :: "'a::idom poly"
+  assumes "[:-a, 1:] ^ n dvd p \<and> \<not> [:-a, 1:] ^ Suc n dvd p"
+  shows "n = order a p"
+unfolding Polynomial.order_def
+apply (rule Least_equality [symmetric])
+apply (rule assms [THEN conjunct2])
+apply (erule contrapos_np)
+apply (rule power_le_dvd)
+apply (rule assms [THEN conjunct1])
+apply simp
+done
+
+lemma lemma_order_pderiv1:
+  "pderiv ([:- a, 1:] ^ Suc n * q) = [:- a, 1:] ^ Suc n * pderiv q +
+    smult (of_nat (Suc n)) (q * [:- a, 1:] ^ n)"
+apply (simp only: pderiv_mult pderiv_power_Suc)
+apply (simp del: power_poly_Suc of_nat_Suc add: pderiv_pCons)
+done
+
+lemma dvd_add_cancel1:
+  fixes a b c :: "'a::comm_ring_1"
+  shows "a dvd b + c \<Longrightarrow> a dvd b \<Longrightarrow> a dvd c"
+  by (drule (1) Ring_and_Field.dvd_diff, simp)
+
+lemma lemma_order_pderiv [rule_format]:
+     "\<forall>p q a. 0 < n &
+       pderiv p \<noteq> 0 &
+       p = [:- a, 1:] ^ n * q & ~ [:- a, 1:] dvd q
+       --> n = Suc (order a (pderiv p))"
+ apply (cases "n", safe, rename_tac n p q a)
+ apply (rule order_unique_lemma)
+ apply (rule conjI)
+  apply (subst lemma_order_pderiv1)
+  apply (rule dvd_add)
+   apply (rule dvd_mult2)
+   apply (rule le_imp_power_dvd, simp)
+  apply (rule dvd_smult)
+  apply (rule dvd_mult)
+  apply (rule dvd_refl)
+ apply (subst lemma_order_pderiv1)
+ apply (erule contrapos_nn) back
+ apply (subgoal_tac "[:- a, 1:] ^ Suc n dvd q * [:- a, 1:] ^ n")
+  apply (simp del: mult_pCons_left)
+ apply (drule dvd_add_cancel1)
+  apply (simp del: mult_pCons_left)
+ apply (drule dvd_smult_cancel, simp del: of_nat_Suc)
+ apply assumption
+done
+
+lemma order_decomp:
+     "p \<noteq> 0
+      ==> \<exists>q. p = [:-a, 1:] ^ (order a p) * q &
+                ~([:-a, 1:] dvd q)"
+apply (drule order [where a=a])
+apply (erule conjE)
+apply (erule dvdE)
+apply (rule exI)
+apply (rule conjI, assumption)
+apply (erule contrapos_nn)
+apply (erule ssubst) back
+apply (subst power_Suc2)
+apply (erule mult_dvd_mono [OF dvd_refl])
+done
+
+lemma order_pderiv: "[| pderiv p \<noteq> 0; order a p \<noteq> 0 |]
+      ==> (order a p = Suc (order a (pderiv p)))"
+apply (case_tac "p = 0", simp)
+apply (drule_tac a = a and p = p in order_decomp)
+using neq0_conv
+apply (blast intro: lemma_order_pderiv)
+done
+
+lemma order_mult: "p * q \<noteq> 0 \<Longrightarrow> order a (p * q) = order a p + order a q"
+proof -
+  def i \<equiv> "order a p"
+  def j \<equiv> "order a q"
+  def t \<equiv> "[:-a, 1:]"
+  have t_dvd_iff: "\<And>u. t dvd u \<longleftrightarrow> poly u a = 0"
+    unfolding t_def by (simp add: dvd_iff_poly_eq_0)
+  assume "p * q \<noteq> 0"
+  then show "order a (p * q) = i + j"
+    apply clarsimp
+    apply (drule order [where a=a and p=p, folded i_def t_def])
+    apply (drule order [where a=a and p=q, folded j_def t_def])
+    apply clarify
+    apply (rule order_unique_lemma [symmetric], fold t_def)
+    apply (erule dvdE)+
+    apply (simp add: power_add t_dvd_iff)
+    done
+qed
+
+text{*Now justify the standard squarefree decomposition, i.e. f / gcd(f,f'). *}
+
+lemma order_divides: "[:-a, 1:] ^ n dvd p \<longleftrightarrow> p = 0 \<or> n \<le> order a p"
+apply (cases "p = 0", auto)
+apply (drule order_2 [where a=a and p=p])
+apply (erule contrapos_np)
+apply (erule power_le_dvd)
+apply simp
+apply (erule power_le_dvd [OF order_1])
+done
+
+lemma poly_squarefree_decomp_order:
+  assumes "pderiv p \<noteq> 0"
+  and p: "p = q * d"
+  and p': "pderiv p = e * d"
+  and d: "d = r * p + s * pderiv p"
+  shows "order a q = (if order a p = 0 then 0 else 1)"
+proof (rule classical)
+  assume 1: "order a q \<noteq> (if order a p = 0 then 0 else 1)"
+  from `pderiv p \<noteq> 0` have "p \<noteq> 0" by auto
+  with p have "order a p = order a q + order a d"
+    by (simp add: order_mult)
+  with 1 have "order a p \<noteq> 0" by (auto split: if_splits)
+  have "order a (pderiv p) = order a e + order a d"
+    using `pderiv p \<noteq> 0` `pderiv p = e * d` by (simp add: order_mult)
+  have "order a p = Suc (order a (pderiv p))"
+    using `pderiv p \<noteq> 0` `order a p \<noteq> 0` by (rule order_pderiv)
+  have "d \<noteq> 0" using `p \<noteq> 0` `p = q * d` by simp
+  have "([:-a, 1:] ^ (order a (pderiv p))) dvd d"
+    apply (simp add: d)
+    apply (rule dvd_add)
+    apply (rule dvd_mult)
+    apply (simp add: order_divides `p \<noteq> 0`
+           `order a p = Suc (order a (pderiv p))`)
+    apply (rule dvd_mult)
+    apply (simp add: order_divides)
+    done
+  then have "order a (pderiv p) \<le> order a d"
+    using `d \<noteq> 0` by (simp add: order_divides)
+  show ?thesis
+    using `order a p = order a q + order a d`
+    using `order a (pderiv p) = order a e + order a d`
+    using `order a p = Suc (order a (pderiv p))`
+    using `order a (pderiv p) \<le> order a d`
+    by auto
+qed
+
+lemma poly_squarefree_decomp_order2: "[| pderiv p \<noteq> 0;
+         p = q * d;
+         pderiv p = e * d;
+         d = r * p + s * pderiv p
+      |] ==> \<forall>a. order a q = (if order a p = 0 then 0 else 1)"
+apply (blast intro: poly_squarefree_decomp_order)
+done
+
+lemma order_pderiv2: "[| pderiv p \<noteq> 0; order a p \<noteq> 0 |]
+      ==> (order a (pderiv p) = n) = (order a p = Suc n)"
+apply (auto dest: order_pderiv)
+done
+
+definition
+  rsquarefree :: "'a::idom poly => bool" where
+  "rsquarefree p = (p \<noteq> 0 & (\<forall>a. (order a p = 0) | (order a p = 1)))"
+
+lemma pderiv_iszero: "pderiv p = 0 \<Longrightarrow> \<exists>h. p = [:h:]"
+apply (simp add: pderiv_eq_0_iff)
+apply (case_tac p, auto split: if_splits)
+done
+
+lemma rsquarefree_roots:
+  "rsquarefree p = (\<forall>a. ~(poly p a = 0 & poly (pderiv p) a = 0))"
+apply (simp add: rsquarefree_def)
+apply (case_tac "p = 0", simp, simp)
+apply (case_tac "pderiv p = 0")
+apply simp
+apply (drule pderiv_iszero, clarify)
+apply simp
+apply (rule allI)
+apply (cut_tac p = "[:h:]" and a = a in order_root)
+apply simp
+apply (auto simp add: order_root order_pderiv2)
+apply (erule_tac x="a" in allE, simp)
+done
+
+lemma poly_squarefree_decomp:
+  assumes "pderiv p \<noteq> 0"
+    and "p = q * d"
+    and "pderiv p = e * d"
+    and "d = r * p + s * pderiv p"
+  shows "rsquarefree q & (\<forall>a. (poly q a = 0) = (poly p a = 0))"
+proof -
+  from `pderiv p \<noteq> 0` have "p \<noteq> 0" by auto
+  with `p = q * d` have "q \<noteq> 0" by simp
+  have "\<forall>a. order a q = (if order a p = 0 then 0 else 1)"
+    using assms by (rule poly_squarefree_decomp_order2)
+  with `p \<noteq> 0` `q \<noteq> 0` show ?thesis
+    by (simp add: rsquarefree_def order_root)
+qed
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Library/Polynomial.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -0,0 +1,1462 @@
+(*  Title:      HOL/Polynomial.thy
+    Author:     Brian Huffman
+                Based on an earlier development by Clemens Ballarin
+*)
+
+header {* Univariate Polynomials *}
+
+theory Polynomial
+imports Plain SetInterval Main
+begin
+
+subsection {* Definition of type @{text poly} *}
+
+typedef (Poly) 'a poly = "{f::nat \<Rightarrow> 'a::zero. \<exists>n. \<forall>i>n. f i = 0}"
+  morphisms coeff Abs_poly
+  by auto
+
+lemma expand_poly_eq: "p = q \<longleftrightarrow> (\<forall>n. coeff p n = coeff q n)"
+by (simp add: coeff_inject [symmetric] expand_fun_eq)
+
+lemma poly_ext: "(\<And>n. coeff p n = coeff q n) \<Longrightarrow> p = q"
+by (simp add: expand_poly_eq)
+
+
+subsection {* Degree of a polynomial *}
+
+definition
+  degree :: "'a::zero poly \<Rightarrow> nat" where
+  "degree p = (LEAST n. \<forall>i>n. coeff p i = 0)"
+
+lemma coeff_eq_0: "degree p < n \<Longrightarrow> coeff p n = 0"
+proof -
+  have "coeff p \<in> Poly"
+    by (rule coeff)
+  hence "\<exists>n. \<forall>i>n. coeff p i = 0"
+    unfolding Poly_def by simp
+  hence "\<forall>i>degree p. coeff p i = 0"
+    unfolding degree_def by (rule LeastI_ex)
+  moreover assume "degree p < n"
+  ultimately show ?thesis by simp
+qed
+
+lemma le_degree: "coeff p n \<noteq> 0 \<Longrightarrow> n \<le> degree p"
+  by (erule contrapos_np, rule coeff_eq_0, simp)
+
+lemma degree_le: "\<forall>i>n. coeff p i = 0 \<Longrightarrow> degree p \<le> n"
+  unfolding degree_def by (erule Least_le)
+
+lemma less_degree_imp: "n < degree p \<Longrightarrow> \<exists>i>n. coeff p i \<noteq> 0"
+  unfolding degree_def by (drule not_less_Least, simp)
+
+
+subsection {* The zero polynomial *}
+
+instantiation poly :: (zero) zero
+begin
+
+definition
+  zero_poly_def: "0 = Abs_poly (\<lambda>n. 0)"
+
+instance ..
+end
+
+lemma coeff_0 [simp]: "coeff 0 n = 0"
+  unfolding zero_poly_def
+  by (simp add: Abs_poly_inverse Poly_def)
+
+lemma degree_0 [simp]: "degree 0 = 0"
+  by (rule order_antisym [OF degree_le le0]) simp
+
+lemma leading_coeff_neq_0:
+  assumes "p \<noteq> 0" shows "coeff p (degree p) \<noteq> 0"
+proof (cases "degree p")
+  case 0
+  from `p \<noteq> 0` have "\<exists>n. coeff p n \<noteq> 0"
+    by (simp add: expand_poly_eq)
+  then obtain n where "coeff p n \<noteq> 0" ..
+  hence "n \<le> degree p" by (rule le_degree)
+  with `coeff p n \<noteq> 0` and `degree p = 0`
+  show "coeff p (degree p) \<noteq> 0" by simp
+next
+  case (Suc n)
+  from `degree p = Suc n` have "n < degree p" by simp
+  hence "\<exists>i>n. coeff p i \<noteq> 0" by (rule less_degree_imp)
+  then obtain i where "n < i" and "coeff p i \<noteq> 0" by fast
+  from `degree p = Suc n` and `n < i` have "degree p \<le> i" by simp
+  also from `coeff p i \<noteq> 0` have "i \<le> degree p" by (rule le_degree)
+  finally have "degree p = i" .
+  with `coeff p i \<noteq> 0` show "coeff p (degree p) \<noteq> 0" by simp
+qed
+
+lemma leading_coeff_0_iff [simp]: "coeff p (degree p) = 0 \<longleftrightarrow> p = 0"
+  by (cases "p = 0", simp, simp add: leading_coeff_neq_0)
+
+
+subsection {* List-style constructor for polynomials *}
+
+definition
+  pCons :: "'a::zero \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
+where
+  [code del]: "pCons a p = Abs_poly (nat_case a (coeff p))"
+
+syntax
+  "_poly" :: "args \<Rightarrow> 'a poly"  ("[:(_):]")
+
+translations
+  "[:x, xs:]" == "CONST pCons x [:xs:]"
+  "[:x:]" == "CONST pCons x 0"
+
+lemma Poly_nat_case: "f \<in> Poly \<Longrightarrow> nat_case a f \<in> Poly"
+  unfolding Poly_def by (auto split: nat.split)
+
+lemma coeff_pCons:
+  "coeff (pCons a p) = nat_case a (coeff p)"
+  unfolding pCons_def
+  by (simp add: Abs_poly_inverse Poly_nat_case coeff)
+
+lemma coeff_pCons_0 [simp]: "coeff (pCons a p) 0 = a"
+  by (simp add: coeff_pCons)
+
+lemma coeff_pCons_Suc [simp]: "coeff (pCons a p) (Suc n) = coeff p n"
+  by (simp add: coeff_pCons)
+
+lemma degree_pCons_le: "degree (pCons a p) \<le> Suc (degree p)"
+by (rule degree_le, simp add: coeff_eq_0 coeff_pCons split: nat.split)
+
+lemma degree_pCons_eq:
+  "p \<noteq> 0 \<Longrightarrow> degree (pCons a p) = Suc (degree p)"
+apply (rule order_antisym [OF degree_pCons_le])
+apply (rule le_degree, simp)
+done
+
+lemma degree_pCons_0: "degree (pCons a 0) = 0"
+apply (rule order_antisym [OF _ le0])
+apply (rule degree_le, simp add: coeff_pCons split: nat.split)
+done
+
+lemma degree_pCons_eq_if [simp]:
+  "degree (pCons a p) = (if p = 0 then 0 else Suc (degree p))"
+apply (cases "p = 0", simp_all)
+apply (rule order_antisym [OF _ le0])
+apply (rule degree_le, simp add: coeff_pCons split: nat.split)
+apply (rule order_antisym [OF degree_pCons_le])
+apply (rule le_degree, simp)
+done
+
+lemma pCons_0_0 [simp]: "pCons 0 0 = 0"
+by (rule poly_ext, simp add: coeff_pCons split: nat.split)
+
+lemma pCons_eq_iff [simp]:
+  "pCons a p = pCons b q \<longleftrightarrow> a = b \<and> p = q"
+proof (safe)
+  assume "pCons a p = pCons b q"
+  then have "coeff (pCons a p) 0 = coeff (pCons b q) 0" by simp
+  then show "a = b" by simp
+next
+  assume "pCons a p = pCons b q"
+  then have "\<forall>n. coeff (pCons a p) (Suc n) =
+                 coeff (pCons b q) (Suc n)" by simp
+  then show "p = q" by (simp add: expand_poly_eq)
+qed
+
+lemma pCons_eq_0_iff [simp]: "pCons a p = 0 \<longleftrightarrow> a = 0 \<and> p = 0"
+  using pCons_eq_iff [of a p 0 0] by simp
+
+lemma Poly_Suc: "f \<in> Poly \<Longrightarrow> (\<lambda>n. f (Suc n)) \<in> Poly"
+  unfolding Poly_def
+  by (clarify, rule_tac x=n in exI, simp)
+
+lemma pCons_cases [cases type: poly]:
+  obtains (pCons) a q where "p = pCons a q"
+proof
+  show "p = pCons (coeff p 0) (Abs_poly (\<lambda>n. coeff p (Suc n)))"
+    by (rule poly_ext)
+       (simp add: Abs_poly_inverse Poly_Suc coeff coeff_pCons
+             split: nat.split)
+qed
+
+lemma pCons_induct [case_names 0 pCons, induct type: poly]:
+  assumes zero: "P 0"
+  assumes pCons: "\<And>a p. P p \<Longrightarrow> P (pCons a p)"
+  shows "P p"
+proof (induct p rule: measure_induct_rule [where f=degree])
+  case (less p)
+  obtain a q where "p = pCons a q" by (rule pCons_cases)
+  have "P q"
+  proof (cases "q = 0")
+    case True
+    then show "P q" by (simp add: zero)
+  next
+    case False
+    then have "degree (pCons a q) = Suc (degree q)"
+      by (rule degree_pCons_eq)
+    then have "degree q < degree p"
+      using `p = pCons a q` by simp
+    then show "P q"
+      by (rule less.hyps)
+  qed
+  then have "P (pCons a q)"
+    by (rule pCons)
+  then show ?case
+    using `p = pCons a q` by simp
+qed
+
+
+subsection {* Recursion combinator for polynomials *}
+
+function
+  poly_rec :: "'b \<Rightarrow> ('a::zero \<Rightarrow> 'a poly \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a poly \<Rightarrow> 'b"
+where
+  poly_rec_pCons_eq_if [simp del, code del]:
+    "poly_rec z f (pCons a p) = f a p (if p = 0 then z else poly_rec z f p)"
+by (case_tac x, rename_tac q, case_tac q, auto)
+
+termination poly_rec
+by (relation "measure (degree \<circ> snd \<circ> snd)", simp)
+   (simp add: degree_pCons_eq)
+
+lemma poly_rec_0:
+  "f 0 0 z = z \<Longrightarrow> poly_rec z f 0 = z"
+  using poly_rec_pCons_eq_if [of z f 0 0] by simp
+
+lemma poly_rec_pCons:
+  "f 0 0 z = z \<Longrightarrow> poly_rec z f (pCons a p) = f a p (poly_rec z f p)"
+  by (simp add: poly_rec_pCons_eq_if poly_rec_0)
+
+
+subsection {* Monomials *}
+
+definition
+  monom :: "'a \<Rightarrow> nat \<Rightarrow> 'a::zero poly" where
+  "monom a m = Abs_poly (\<lambda>n. if m = n then a else 0)"
+
+lemma coeff_monom [simp]: "coeff (monom a m) n = (if m=n then a else 0)"
+  unfolding monom_def
+  by (subst Abs_poly_inverse, auto simp add: Poly_def)
+
+lemma monom_0: "monom a 0 = pCons a 0"
+  by (rule poly_ext, simp add: coeff_pCons split: nat.split)
+
+lemma monom_Suc: "monom a (Suc n) = pCons 0 (monom a n)"
+  by (rule poly_ext, simp add: coeff_pCons split: nat.split)
+
+lemma monom_eq_0 [simp]: "monom 0 n = 0"
+  by (rule poly_ext) simp
+
+lemma monom_eq_0_iff [simp]: "monom a n = 0 \<longleftrightarrow> a = 0"
+  by (simp add: expand_poly_eq)
+
+lemma monom_eq_iff [simp]: "monom a n = monom b n \<longleftrightarrow> a = b"
+  by (simp add: expand_poly_eq)
+
+lemma degree_monom_le: "degree (monom a n) \<le> n"
+  by (rule degree_le, simp)
+
+lemma degree_monom_eq: "a \<noteq> 0 \<Longrightarrow> degree (monom a n) = n"
+  apply (rule order_antisym [OF degree_monom_le])
+  apply (rule le_degree, simp)
+  done
+
+
+subsection {* Addition and subtraction *}
+
+instantiation poly :: (comm_monoid_add) comm_monoid_add
+begin
+
+definition
+  plus_poly_def [code del]:
+    "p + q = Abs_poly (\<lambda>n. coeff p n + coeff q n)"
+
+lemma Poly_add:
+  fixes f g :: "nat \<Rightarrow> 'a"
+  shows "\<lbrakk>f \<in> Poly; g \<in> Poly\<rbrakk> \<Longrightarrow> (\<lambda>n. f n + g n) \<in> Poly"
+  unfolding Poly_def
+  apply (clarify, rename_tac m n)
+  apply (rule_tac x="max m n" in exI, simp)
+  done
+
+lemma coeff_add [simp]:
+  "coeff (p + q) n = coeff p n + coeff q n"
+  unfolding plus_poly_def
+  by (simp add: Abs_poly_inverse coeff Poly_add)
+
+instance proof
+  fix p q r :: "'a poly"
+  show "(p + q) + r = p + (q + r)"
+    by (simp add: expand_poly_eq add_assoc)
+  show "p + q = q + p"
+    by (simp add: expand_poly_eq add_commute)
+  show "0 + p = p"
+    by (simp add: expand_poly_eq)
+qed
+
+end
+
+instance poly :: (cancel_comm_monoid_add) cancel_comm_monoid_add
+proof
+  fix p q r :: "'a poly"
+  assume "p + q = p + r" thus "q = r"
+    by (simp add: expand_poly_eq)
+qed
+
+instantiation poly :: (ab_group_add) ab_group_add
+begin
+
+definition
+  uminus_poly_def [code del]:
+    "- p = Abs_poly (\<lambda>n. - coeff p n)"
+
+definition
+  minus_poly_def [code del]:
+    "p - q = Abs_poly (\<lambda>n. coeff p n - coeff q n)"
+
+lemma Poly_minus:
+  fixes f :: "nat \<Rightarrow> 'a"
+  shows "f \<in> Poly \<Longrightarrow> (\<lambda>n. - f n) \<in> Poly"
+  unfolding Poly_def by simp
+
+lemma Poly_diff:
+  fixes f g :: "nat \<Rightarrow> 'a"
+  shows "\<lbrakk>f \<in> Poly; g \<in> Poly\<rbrakk> \<Longrightarrow> (\<lambda>n. f n - g n) \<in> Poly"
+  unfolding diff_minus by (simp add: Poly_add Poly_minus)
+
+lemma coeff_minus [simp]: "coeff (- p) n = - coeff p n"
+  unfolding uminus_poly_def
+  by (simp add: Abs_poly_inverse coeff Poly_minus)
+
+lemma coeff_diff [simp]:
+  "coeff (p - q) n = coeff p n - coeff q n"
+  unfolding minus_poly_def
+  by (simp add: Abs_poly_inverse coeff Poly_diff)
+
+instance proof
+  fix p q :: "'a poly"
+  show "- p + p = 0"
+    by (simp add: expand_poly_eq)
+  show "p - q = p + - q"
+    by (simp add: expand_poly_eq diff_minus)
+qed
+
+end
+
+lemma add_pCons [simp]:
+  "pCons a p + pCons b q = pCons (a + b) (p + q)"
+  by (rule poly_ext, simp add: coeff_pCons split: nat.split)
+
+lemma minus_pCons [simp]:
+  "- pCons a p = pCons (- a) (- p)"
+  by (rule poly_ext, simp add: coeff_pCons split: nat.split)
+
+lemma diff_pCons [simp]:
+  "pCons a p - pCons b q = pCons (a - b) (p - q)"
+  by (rule poly_ext, simp add: coeff_pCons split: nat.split)
+
+lemma degree_add_le_max: "degree (p + q) \<le> max (degree p) (degree q)"
+  by (rule degree_le, auto simp add: coeff_eq_0)
+
+lemma degree_add_le:
+  "\<lbrakk>degree p \<le> n; degree q \<le> n\<rbrakk> \<Longrightarrow> degree (p + q) \<le> n"
+  by (auto intro: order_trans degree_add_le_max)
+
+lemma degree_add_less:
+  "\<lbrakk>degree p < n; degree q < n\<rbrakk> \<Longrightarrow> degree (p + q) < n"
+  by (auto intro: le_less_trans degree_add_le_max)
+
+lemma degree_add_eq_right:
+  "degree p < degree q \<Longrightarrow> degree (p + q) = degree q"
+  apply (cases "q = 0", simp)
+  apply (rule order_antisym)
+  apply (simp add: degree_add_le)
+  apply (rule le_degree)
+  apply (simp add: coeff_eq_0)
+  done
+
+lemma degree_add_eq_left:
+  "degree q < degree p \<Longrightarrow> degree (p + q) = degree p"
+  using degree_add_eq_right [of q p]
+  by (simp add: add_commute)
+
+lemma degree_minus [simp]: "degree (- p) = degree p"
+  unfolding degree_def by simp
+
+lemma degree_diff_le_max: "degree (p - q) \<le> max (degree p) (degree q)"
+  using degree_add_le [where p=p and q="-q"]
+  by (simp add: diff_minus)
+
+lemma degree_diff_le:
+  "\<lbrakk>degree p \<le> n; degree q \<le> n\<rbrakk> \<Longrightarrow> degree (p - q) \<le> n"
+  by (simp add: diff_minus degree_add_le)
+
+lemma degree_diff_less:
+  "\<lbrakk>degree p < n; degree q < n\<rbrakk> \<Longrightarrow> degree (p - q) < n"
+  by (simp add: diff_minus degree_add_less)
+
+lemma add_monom: "monom a n + monom b n = monom (a + b) n"
+  by (rule poly_ext) simp
+
+lemma diff_monom: "monom a n - monom b n = monom (a - b) n"
+  by (rule poly_ext) simp
+
+lemma minus_monom: "- monom a n = monom (-a) n"
+  by (rule poly_ext) simp
+
+lemma coeff_setsum: "coeff (\<Sum>x\<in>A. p x) i = (\<Sum>x\<in>A. coeff (p x) i)"
+  by (cases "finite A", induct set: finite, simp_all)
+
+lemma monom_setsum: "monom (\<Sum>x\<in>A. a x) n = (\<Sum>x\<in>A. monom (a x) n)"
+  by (rule poly_ext) (simp add: coeff_setsum)
+
+
+subsection {* Multiplication by a constant *}
+
+definition
+  smult :: "'a::comm_semiring_0 \<Rightarrow> 'a poly \<Rightarrow> 'a poly" where
+  "smult a p = Abs_poly (\<lambda>n. a * coeff p n)"
+
+lemma Poly_smult:
+  fixes f :: "nat \<Rightarrow> 'a::comm_semiring_0"
+  shows "f \<in> Poly \<Longrightarrow> (\<lambda>n. a * f n) \<in> Poly"
+  unfolding Poly_def
+  by (clarify, rule_tac x=n in exI, simp)
+
+lemma coeff_smult [simp]: "coeff (smult a p) n = a * coeff p n"
+  unfolding smult_def
+  by (simp add: Abs_poly_inverse Poly_smult coeff)
+
+lemma degree_smult_le: "degree (smult a p) \<le> degree p"
+  by (rule degree_le, simp add: coeff_eq_0)
+
+lemma smult_smult [simp]: "smult a (smult b p) = smult (a * b) p"
+  by (rule poly_ext, simp add: mult_assoc)
+
+lemma smult_0_right [simp]: "smult a 0 = 0"
+  by (rule poly_ext, simp)
+
+lemma smult_0_left [simp]: "smult 0 p = 0"
+  by (rule poly_ext, simp)
+
+lemma smult_1_left [simp]: "smult (1::'a::comm_semiring_1) p = p"
+  by (rule poly_ext, simp)
+
+lemma smult_add_right:
+  "smult a (p + q) = smult a p + smult a q"
+  by (rule poly_ext, simp add: algebra_simps)
+
+lemma smult_add_left:
+  "smult (a + b) p = smult a p + smult b p"
+  by (rule poly_ext, simp add: algebra_simps)
+
+lemma smult_minus_right [simp]:
+  "smult (a::'a::comm_ring) (- p) = - smult a p"
+  by (rule poly_ext, simp)
+
+lemma smult_minus_left [simp]:
+  "smult (- a::'a::comm_ring) p = - smult a p"
+  by (rule poly_ext, simp)
+
+lemma smult_diff_right:
+  "smult (a::'a::comm_ring) (p - q) = smult a p - smult a q"
+  by (rule poly_ext, simp add: algebra_simps)
+
+lemma smult_diff_left:
+  "smult (a - b::'a::comm_ring) p = smult a p - smult b p"
+  by (rule poly_ext, simp add: algebra_simps)
+
+lemmas smult_distribs =
+  smult_add_left smult_add_right
+  smult_diff_left smult_diff_right
+
+lemma smult_pCons [simp]:
+  "smult a (pCons b p) = pCons (a * b) (smult a p)"
+  by (rule poly_ext, simp add: coeff_pCons split: nat.split)
+
+lemma smult_monom: "smult a (monom b n) = monom (a * b) n"
+  by (induct n, simp add: monom_0, simp add: monom_Suc)
+
+lemma degree_smult_eq [simp]:
+  fixes a :: "'a::idom"
+  shows "degree (smult a p) = (if a = 0 then 0 else degree p)"
+  by (cases "a = 0", simp, simp add: degree_def)
+
+lemma smult_eq_0_iff [simp]:
+  fixes a :: "'a::idom"
+  shows "smult a p = 0 \<longleftrightarrow> a = 0 \<or> p = 0"
+  by (simp add: expand_poly_eq)
+
+
+subsection {* Multiplication of polynomials *}
+
+text {* TODO: move to SetInterval.thy *}
+lemma setsum_atMost_Suc_shift:
+  fixes f :: "nat \<Rightarrow> 'a::comm_monoid_add"
+  shows "(\<Sum>i\<le>Suc n. f i) = f 0 + (\<Sum>i\<le>n. f (Suc i))"
+proof (induct n)
+  case 0 show ?case by simp
+next
+  case (Suc n) note IH = this
+  have "(\<Sum>i\<le>Suc (Suc n). f i) = (\<Sum>i\<le>Suc n. f i) + f (Suc (Suc n))"
+    by (rule setsum_atMost_Suc)
+  also have "(\<Sum>i\<le>Suc n. f i) = f 0 + (\<Sum>i\<le>n. f (Suc i))"
+    by (rule IH)
+  also have "f 0 + (\<Sum>i\<le>n. f (Suc i)) + f (Suc (Suc n)) =
+             f 0 + ((\<Sum>i\<le>n. f (Suc i)) + f (Suc (Suc n)))"
+    by (rule add_assoc)
+  also have "(\<Sum>i\<le>n. f (Suc i)) + f (Suc (Suc n)) = (\<Sum>i\<le>Suc n. f (Suc i))"
+    by (rule setsum_atMost_Suc [symmetric])
+  finally show ?case .
+qed
+
+instantiation poly :: (comm_semiring_0) comm_semiring_0
+begin
+
+definition
+  times_poly_def [code del]:
+    "p * q = poly_rec 0 (\<lambda>a p pq. smult a q + pCons 0 pq) p"
+
+lemma mult_poly_0_left: "(0::'a poly) * q = 0"
+  unfolding times_poly_def by (simp add: poly_rec_0)
+
+lemma mult_pCons_left [simp]:
+  "pCons a p * q = smult a q + pCons 0 (p * q)"
+  unfolding times_poly_def by (simp add: poly_rec_pCons)
+
+lemma mult_poly_0_right: "p * (0::'a poly) = 0"
+  by (induct p, simp add: mult_poly_0_left, simp)
+
+lemma mult_pCons_right [simp]:
+  "p * pCons a q = smult a p + pCons 0 (p * q)"
+  by (induct p, simp add: mult_poly_0_left, simp add: algebra_simps)
+
+lemmas mult_poly_0 = mult_poly_0_left mult_poly_0_right
+
+lemma mult_smult_left [simp]: "smult a p * q = smult a (p * q)"
+  by (induct p, simp add: mult_poly_0, simp add: smult_add_right)
+
+lemma mult_smult_right [simp]: "p * smult a q = smult a (p * q)"
+  by (induct q, simp add: mult_poly_0, simp add: smult_add_right)
+
+lemma mult_poly_add_left:
+  fixes p q r :: "'a poly"
+  shows "(p + q) * r = p * r + q * r"
+  by (induct r, simp add: mult_poly_0,
+                simp add: smult_distribs algebra_simps)
+
+instance proof
+  fix p q r :: "'a poly"
+  show 0: "0 * p = 0"
+    by (rule mult_poly_0_left)
+  show "p * 0 = 0"
+    by (rule mult_poly_0_right)
+  show "(p + q) * r = p * r + q * r"
+    by (rule mult_poly_add_left)
+  show "(p * q) * r = p * (q * r)"
+    by (induct p, simp add: mult_poly_0, simp add: mult_poly_add_left)
+  show "p * q = q * p"
+    by (induct p, simp add: mult_poly_0, simp)
+qed
+
+end
+
+instance poly :: (comm_semiring_0_cancel) comm_semiring_0_cancel ..
+
+lemma coeff_mult:
+  "coeff (p * q) n = (\<Sum>i\<le>n. coeff p i * coeff q (n-i))"
+proof (induct p arbitrary: n)
+  case 0 show ?case by simp
+next
+  case (pCons a p n) thus ?case
+    by (cases n, simp, simp add: setsum_atMost_Suc_shift
+                            del: setsum_atMost_Suc)
+qed
+
+lemma degree_mult_le: "degree (p * q) \<le> degree p + degree q"
+apply (rule degree_le)
+apply (induct p)
+apply simp
+apply (simp add: coeff_eq_0 coeff_pCons split: nat.split)
+done
+
+lemma mult_monom: "monom a m * monom b n = monom (a * b) (m + n)"
+  by (induct m, simp add: monom_0 smult_monom, simp add: monom_Suc)
+
+
+subsection {* The unit polynomial and exponentiation *}
+
+instantiation poly :: (comm_semiring_1) comm_semiring_1
+begin
+
+definition
+  one_poly_def:
+    "1 = pCons 1 0"
+
+instance proof
+  fix p :: "'a poly" show "1 * p = p"
+    unfolding one_poly_def
+    by simp
+next
+  show "0 \<noteq> (1::'a poly)"
+    unfolding one_poly_def by simp
+qed
+
+end
+
+instance poly :: (comm_semiring_1_cancel) comm_semiring_1_cancel ..
+
+lemma coeff_1 [simp]: "coeff 1 n = (if n = 0 then 1 else 0)"
+  unfolding one_poly_def
+  by (simp add: coeff_pCons split: nat.split)
+
+lemma degree_1 [simp]: "degree 1 = 0"
+  unfolding one_poly_def
+  by (rule degree_pCons_0)
+
+text {* Lemmas about divisibility *}
+
+lemma dvd_smult: "p dvd q \<Longrightarrow> p dvd smult a q"
+proof -
+  assume "p dvd q"
+  then obtain k where "q = p * k" ..
+  then have "smult a q = p * smult a k" by simp
+  then show "p dvd smult a q" ..
+qed
+
+lemma dvd_smult_cancel:
+  fixes a :: "'a::field"
+  shows "p dvd smult a q \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> p dvd q"
+  by (drule dvd_smult [where a="inverse a"]) simp
+
+lemma dvd_smult_iff:
+  fixes a :: "'a::field"
+  shows "a \<noteq> 0 \<Longrightarrow> p dvd smult a q \<longleftrightarrow> p dvd q"
+  by (safe elim!: dvd_smult dvd_smult_cancel)
+
+instantiation poly :: (comm_semiring_1) recpower
+begin
+
+primrec power_poly where
+  power_poly_0: "(p::'a poly) ^ 0 = 1"
+| power_poly_Suc: "(p::'a poly) ^ (Suc n) = p * p ^ n"
+
+instance
+  by default simp_all
+
+end
+
+lemma degree_power_le: "degree (p ^ n) \<le> degree p * n"
+by (induct n, simp, auto intro: order_trans degree_mult_le)
+
+instance poly :: (comm_ring) comm_ring ..
+
+instance poly :: (comm_ring_1) comm_ring_1 ..
+
+instantiation poly :: (comm_ring_1) number_ring
+begin
+
+definition
+  "number_of k = (of_int k :: 'a poly)"
+
+instance
+  by default (rule number_of_poly_def)
+
+end
+
+
+subsection {* Polynomials form an integral domain *}
+
+lemma coeff_mult_degree_sum:
+  "coeff (p * q) (degree p + degree q) =
+   coeff p (degree p) * coeff q (degree q)"
+  by (induct p, simp, simp add: coeff_eq_0)
+
+instance poly :: (idom) idom
+proof
+  fix p q :: "'a poly"
+  assume "p \<noteq> 0" and "q \<noteq> 0"
+  have "coeff (p * q) (degree p + degree q) =
+        coeff p (degree p) * coeff q (degree q)"
+    by (rule coeff_mult_degree_sum)
+  also have "coeff p (degree p) * coeff q (degree q) \<noteq> 0"
+    using `p \<noteq> 0` and `q \<noteq> 0` by simp
+  finally have "\<exists>n. coeff (p * q) n \<noteq> 0" ..
+  thus "p * q \<noteq> 0" by (simp add: expand_poly_eq)
+qed
+
+lemma degree_mult_eq:
+  fixes p q :: "'a::idom poly"
+  shows "\<lbrakk>p \<noteq> 0; q \<noteq> 0\<rbrakk> \<Longrightarrow> degree (p * q) = degree p + degree q"
+apply (rule order_antisym [OF degree_mult_le le_degree])
+apply (simp add: coeff_mult_degree_sum)
+done
+
+lemma dvd_imp_degree_le:
+  fixes p q :: "'a::idom poly"
+  shows "\<lbrakk>p dvd q; q \<noteq> 0\<rbrakk> \<Longrightarrow> degree p \<le> degree q"
+  by (erule dvdE, simp add: degree_mult_eq)
+
+
+subsection {* Polynomials form an ordered integral domain *}
+
+definition
+  pos_poly :: "'a::ordered_idom poly \<Rightarrow> bool"
+where
+  "pos_poly p \<longleftrightarrow> 0 < coeff p (degree p)"
+
+lemma pos_poly_pCons:
+  "pos_poly (pCons a p) \<longleftrightarrow> pos_poly p \<or> (p = 0 \<and> 0 < a)"
+  unfolding pos_poly_def by simp
+
+lemma not_pos_poly_0 [simp]: "\<not> pos_poly 0"
+  unfolding pos_poly_def by simp
+
+lemma pos_poly_add: "\<lbrakk>pos_poly p; pos_poly q\<rbrakk> \<Longrightarrow> pos_poly (p + q)"
+  apply (induct p arbitrary: q, simp)
+  apply (case_tac q, force simp add: pos_poly_pCons add_pos_pos)
+  done
+
+lemma pos_poly_mult: "\<lbrakk>pos_poly p; pos_poly q\<rbrakk> \<Longrightarrow> pos_poly (p * q)"
+  unfolding pos_poly_def
+  apply (subgoal_tac "p \<noteq> 0 \<and> q \<noteq> 0")
+  apply (simp add: degree_mult_eq coeff_mult_degree_sum mult_pos_pos)
+  apply auto
+  done
+
+lemma pos_poly_total: "p = 0 \<or> pos_poly p \<or> pos_poly (- p)"
+by (induct p) (auto simp add: pos_poly_pCons)
+
+instantiation poly :: (ordered_idom) ordered_idom
+begin
+
+definition
+  [code del]:
+    "x < y \<longleftrightarrow> pos_poly (y - x)"
+
+definition
+  [code del]:
+    "x \<le> y \<longleftrightarrow> x = y \<or> pos_poly (y - x)"
+
+definition
+  [code del]:
+    "abs (x::'a poly) = (if x < 0 then - x else x)"
+
+definition
+  [code del]:
+    "sgn (x::'a poly) = (if x = 0 then 0 else if 0 < x then 1 else - 1)"
+
+instance proof
+  fix x y :: "'a poly"
+  show "x < y \<longleftrightarrow> x \<le> y \<and> \<not> y \<le> x"
+    unfolding less_eq_poly_def less_poly_def
+    apply safe
+    apply simp
+    apply (drule (1) pos_poly_add)
+    apply simp
+    done
+next
+  fix x :: "'a poly" show "x \<le> x"
+    unfolding less_eq_poly_def by simp
+next
+  fix x y z :: "'a poly"
+  assume "x \<le> y" and "y \<le> z" thus "x \<le> z"
+    unfolding less_eq_poly_def
+    apply safe
+    apply (drule (1) pos_poly_add)
+    apply (simp add: algebra_simps)
+    done
+next
+  fix x y :: "'a poly"
+  assume "x \<le> y" and "y \<le> x" thus "x = y"
+    unfolding less_eq_poly_def
+    apply safe
+    apply (drule (1) pos_poly_add)
+    apply simp
+    done
+next
+  fix x y z :: "'a poly"
+  assume "x \<le> y" thus "z + x \<le> z + y"
+    unfolding less_eq_poly_def
+    apply safe
+    apply (simp add: algebra_simps)
+    done
+next
+  fix x y :: "'a poly"
+  show "x \<le> y \<or> y \<le> x"
+    unfolding less_eq_poly_def
+    using pos_poly_total [of "x - y"]
+    by auto
+next
+  fix x y z :: "'a poly"
+  assume "x < y" and "0 < z"
+  thus "z * x < z * y"
+    unfolding less_poly_def
+    by (simp add: right_diff_distrib [symmetric] pos_poly_mult)
+next
+  fix x :: "'a poly"
+  show "\<bar>x\<bar> = (if x < 0 then - x else x)"
+    by (rule abs_poly_def)
+next
+  fix x :: "'a poly"
+  show "sgn x = (if x = 0 then 0 else if 0 < x then 1 else - 1)"
+    by (rule sgn_poly_def)
+qed
+
+end
+
+text {* TODO: Simplification rules for comparisons *}
+
+
+subsection {* Long division of polynomials *}
+
+definition
+  pdivmod_rel :: "'a::field poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly \<Rightarrow> bool"
+where
+  [code del]:
+  "pdivmod_rel x y q r \<longleftrightarrow>
+    x = q * y + r \<and> (if y = 0 then q = 0 else r = 0 \<or> degree r < degree y)"
+
+lemma pdivmod_rel_0:
+  "pdivmod_rel 0 y 0 0"
+  unfolding pdivmod_rel_def by simp
+
+lemma pdivmod_rel_by_0:
+  "pdivmod_rel x 0 0 x"
+  unfolding pdivmod_rel_def by simp
+
+lemma eq_zero_or_degree_less:
+  assumes "degree p \<le> n" and "coeff p n = 0"
+  shows "p = 0 \<or> degree p < n"
+proof (cases n)
+  case 0
+  with `degree p \<le> n` and `coeff p n = 0`
+  have "coeff p (degree p) = 0" by simp
+  then have "p = 0" by simp
+  then show ?thesis ..
+next
+  case (Suc m)
+  have "\<forall>i>n. coeff p i = 0"
+    using `degree p \<le> n` by (simp add: coeff_eq_0)
+  then have "\<forall>i\<ge>n. coeff p i = 0"
+    using `coeff p n = 0` by (simp add: le_less)
+  then have "\<forall>i>m. coeff p i = 0"
+    using `n = Suc m` by (simp add: less_eq_Suc_le)
+  then have "degree p \<le> m"
+    by (rule degree_le)
+  then have "degree p < n"
+    using `n = Suc m` by (simp add: less_Suc_eq_le)
+  then show ?thesis ..
+qed
+
+lemma pdivmod_rel_pCons:
+  assumes rel: "pdivmod_rel x y q r"
+  assumes y: "y \<noteq> 0"
+  assumes b: "b = coeff (pCons a r) (degree y) / coeff y (degree y)"
+  shows "pdivmod_rel (pCons a x) y (pCons b q) (pCons a r - smult b y)"
+    (is "pdivmod_rel ?x y ?q ?r")
+proof -
+  have x: "x = q * y + r" and r: "r = 0 \<or> degree r < degree y"
+    using assms unfolding pdivmod_rel_def by simp_all
+
+  have 1: "?x = ?q * y + ?r"
+    using b x by simp
+
+  have 2: "?r = 0 \<or> degree ?r < degree y"
+  proof (rule eq_zero_or_degree_less)
+    show "degree ?r \<le> degree y"
+    proof (rule degree_diff_le)
+      show "degree (pCons a r) \<le> degree y"
+        using r by auto
+      show "degree (smult b y) \<le> degree y"
+        by (rule degree_smult_le)
+    qed
+  next
+    show "coeff ?r (degree y) = 0"
+      using `y \<noteq> 0` unfolding b by simp
+  qed
+
+  from 1 2 show ?thesis
+    unfolding pdivmod_rel_def
+    using `y \<noteq> 0` by simp
+qed
+
+lemma pdivmod_rel_exists: "\<exists>q r. pdivmod_rel x y q r"
+apply (cases "y = 0")
+apply (fast intro!: pdivmod_rel_by_0)
+apply (induct x)
+apply (fast intro!: pdivmod_rel_0)
+apply (fast intro!: pdivmod_rel_pCons)
+done
+
+lemma pdivmod_rel_unique:
+  assumes 1: "pdivmod_rel x y q1 r1"
+  assumes 2: "pdivmod_rel x y q2 r2"
+  shows "q1 = q2 \<and> r1 = r2"
+proof (cases "y = 0")
+  assume "y = 0" with assms show ?thesis
+    by (simp add: pdivmod_rel_def)
+next
+  assume [simp]: "y \<noteq> 0"
+  from 1 have q1: "x = q1 * y + r1" and r1: "r1 = 0 \<or> degree r1 < degree y"
+    unfolding pdivmod_rel_def by simp_all
+  from 2 have q2: "x = q2 * y + r2" and r2: "r2 = 0 \<or> degree r2 < degree y"
+    unfolding pdivmod_rel_def by simp_all
+  from q1 q2 have q3: "(q1 - q2) * y = r2 - r1"
+    by (simp add: algebra_simps)
+  from r1 r2 have r3: "(r2 - r1) = 0 \<or> degree (r2 - r1) < degree y"
+    by (auto intro: degree_diff_less)
+
+  show "q1 = q2 \<and> r1 = r2"
+  proof (rule ccontr)
+    assume "\<not> (q1 = q2 \<and> r1 = r2)"
+    with q3 have "q1 \<noteq> q2" and "r1 \<noteq> r2" by auto
+    with r3 have "degree (r2 - r1) < degree y" by simp
+    also have "degree y \<le> degree (q1 - q2) + degree y" by simp
+    also have "\<dots> = degree ((q1 - q2) * y)"
+      using `q1 \<noteq> q2` by (simp add: degree_mult_eq)
+    also have "\<dots> = degree (r2 - r1)"
+      using q3 by simp
+    finally have "degree (r2 - r1) < degree (r2 - r1)" .
+    then show "False" by simp
+  qed
+qed
+
+lemma pdivmod_rel_0_iff: "pdivmod_rel 0 y q r \<longleftrightarrow> q = 0 \<and> r = 0"
+by (auto dest: pdivmod_rel_unique intro: pdivmod_rel_0)
+
+lemma pdivmod_rel_by_0_iff: "pdivmod_rel x 0 q r \<longleftrightarrow> q = 0 \<and> r = x"
+by (auto dest: pdivmod_rel_unique intro: pdivmod_rel_by_0)
+
+lemmas pdivmod_rel_unique_div =
+  pdivmod_rel_unique [THEN conjunct1, standard]
+
+lemmas pdivmod_rel_unique_mod =
+  pdivmod_rel_unique [THEN conjunct2, standard]
+
+instantiation poly :: (field) ring_div
+begin
+
+definition div_poly where
+  [code del]: "x div y = (THE q. \<exists>r. pdivmod_rel x y q r)"
+
+definition mod_poly where
+  [code del]: "x mod y = (THE r. \<exists>q. pdivmod_rel x y q r)"
+
+lemma div_poly_eq:
+  "pdivmod_rel x y q r \<Longrightarrow> x div y = q"
+unfolding div_poly_def
+by (fast elim: pdivmod_rel_unique_div)
+
+lemma mod_poly_eq:
+  "pdivmod_rel x y q r \<Longrightarrow> x mod y = r"
+unfolding mod_poly_def
+by (fast elim: pdivmod_rel_unique_mod)
+
+lemma pdivmod_rel:
+  "pdivmod_rel x y (x div y) (x mod y)"
+proof -
+  from pdivmod_rel_exists
+    obtain q r where "pdivmod_rel x y q r" by fast
+  thus ?thesis
+    by (simp add: div_poly_eq mod_poly_eq)
+qed
+
+instance proof
+  fix x y :: "'a poly"
+  show "x div y * y + x mod y = x"
+    using pdivmod_rel [of x y]
+    by (simp add: pdivmod_rel_def)
+next
+  fix x :: "'a poly"
+  have "pdivmod_rel x 0 0 x"
+    by (rule pdivmod_rel_by_0)
+  thus "x div 0 = 0"
+    by (rule div_poly_eq)
+next
+  fix y :: "'a poly"
+  have "pdivmod_rel 0 y 0 0"
+    by (rule pdivmod_rel_0)
+  thus "0 div y = 0"
+    by (rule div_poly_eq)
+next
+  fix x y z :: "'a poly"
+  assume "y \<noteq> 0"
+  hence "pdivmod_rel (x + z * y) y (z + x div y) (x mod y)"
+    using pdivmod_rel [of x y]
+    by (simp add: pdivmod_rel_def left_distrib)
+  thus "(x + z * y) div y = z + x div y"
+    by (rule div_poly_eq)
+qed
+
+end
+
+lemma degree_mod_less:
+  "y \<noteq> 0 \<Longrightarrow> x mod y = 0 \<or> degree (x mod y) < degree y"
+  using pdivmod_rel [of x y]
+  unfolding pdivmod_rel_def by simp
+
+lemma div_poly_less: "degree x < degree y \<Longrightarrow> x div y = 0"
+proof -
+  assume "degree x < degree y"
+  hence "pdivmod_rel x y 0 x"
+    by (simp add: pdivmod_rel_def)
+  thus "x div y = 0" by (rule div_poly_eq)
+qed
+
+lemma mod_poly_less: "degree x < degree y \<Longrightarrow> x mod y = x"
+proof -
+  assume "degree x < degree y"
+  hence "pdivmod_rel x y 0 x"
+    by (simp add: pdivmod_rel_def)
+  thus "x mod y = x" by (rule mod_poly_eq)
+qed
+
+lemma pdivmod_rel_smult_left:
+  "pdivmod_rel x y q r
+    \<Longrightarrow> pdivmod_rel (smult a x) y (smult a q) (smult a r)"
+  unfolding pdivmod_rel_def by (simp add: smult_add_right)
+
+lemma div_smult_left: "(smult a x) div y = smult a (x div y)"
+  by (rule div_poly_eq, rule pdivmod_rel_smult_left, rule pdivmod_rel)
+
+lemma mod_smult_left: "(smult a x) mod y = smult a (x mod y)"
+  by (rule mod_poly_eq, rule pdivmod_rel_smult_left, rule pdivmod_rel)
+
+lemma poly_div_minus_left [simp]:
+  fixes x y :: "'a::field poly"
+  shows "(- x) div y = - (x div y)"
+  using div_smult_left [of "- 1::'a"] by simp
+
+lemma poly_mod_minus_left [simp]:
+  fixes x y :: "'a::field poly"
+  shows "(- x) mod y = - (x mod y)"
+  using mod_smult_left [of "- 1::'a"] by simp
+
+lemma pdivmod_rel_smult_right:
+  "\<lbrakk>a \<noteq> 0; pdivmod_rel x y q r\<rbrakk>
+    \<Longrightarrow> pdivmod_rel x (smult a y) (smult (inverse a) q) r"
+  unfolding pdivmod_rel_def by simp
+
+lemma div_smult_right:
+  "a \<noteq> 0 \<Longrightarrow> x div (smult a y) = smult (inverse a) (x div y)"
+  by (rule div_poly_eq, erule pdivmod_rel_smult_right, rule pdivmod_rel)
+
+lemma mod_smult_right: "a \<noteq> 0 \<Longrightarrow> x mod (smult a y) = x mod y"
+  by (rule mod_poly_eq, erule pdivmod_rel_smult_right, rule pdivmod_rel)
+
+lemma poly_div_minus_right [simp]:
+  fixes x y :: "'a::field poly"
+  shows "x div (- y) = - (x div y)"
+  using div_smult_right [of "- 1::'a"]
+  by (simp add: nonzero_inverse_minus_eq)
+
+lemma poly_mod_minus_right [simp]:
+  fixes x y :: "'a::field poly"
+  shows "x mod (- y) = x mod y"
+  using mod_smult_right [of "- 1::'a"] by simp
+
+lemma pdivmod_rel_mult:
+  "\<lbrakk>pdivmod_rel x y q r; pdivmod_rel q z q' r'\<rbrakk>
+    \<Longrightarrow> pdivmod_rel x (y * z) q' (y * r' + r)"
+apply (cases "z = 0", simp add: pdivmod_rel_def)
+apply (cases "y = 0", simp add: pdivmod_rel_by_0_iff pdivmod_rel_0_iff)
+apply (cases "r = 0")
+apply (cases "r' = 0")
+apply (simp add: pdivmod_rel_def)
+apply (simp add: pdivmod_rel_def ring_simps degree_mult_eq)
+apply (cases "r' = 0")
+apply (simp add: pdivmod_rel_def degree_mult_eq)
+apply (simp add: pdivmod_rel_def ring_simps)
+apply (simp add: degree_mult_eq degree_add_less)
+done
+
+lemma poly_div_mult_right:
+  fixes x y z :: "'a::field poly"
+  shows "x div (y * z) = (x div y) div z"
+  by (rule div_poly_eq, rule pdivmod_rel_mult, (rule pdivmod_rel)+)
+
+lemma poly_mod_mult_right:
+  fixes x y z :: "'a::field poly"
+  shows "x mod (y * z) = y * (x div y mod z) + x mod y"
+  by (rule mod_poly_eq, rule pdivmod_rel_mult, (rule pdivmod_rel)+)
+
+lemma mod_pCons:
+  fixes a and x
+  assumes y: "y \<noteq> 0"
+  defines b: "b \<equiv> coeff (pCons a (x mod y)) (degree y) / coeff y (degree y)"
+  shows "(pCons a x) mod y = (pCons a (x mod y) - smult b y)"
+unfolding b
+apply (rule mod_poly_eq)
+apply (rule pdivmod_rel_pCons [OF pdivmod_rel y refl])
+done
+
+
+subsection {* Evaluation of polynomials *}
+
+definition
+  poly :: "'a::comm_semiring_0 poly \<Rightarrow> 'a \<Rightarrow> 'a" where
+  "poly = poly_rec (\<lambda>x. 0) (\<lambda>a p f x. a + x * f x)"
+
+lemma poly_0 [simp]: "poly 0 x = 0"
+  unfolding poly_def by (simp add: poly_rec_0)
+
+lemma poly_pCons [simp]: "poly (pCons a p) x = a + x * poly p x"
+  unfolding poly_def by (simp add: poly_rec_pCons)
+
+lemma poly_1 [simp]: "poly 1 x = 1"
+  unfolding one_poly_def by simp
+
+lemma poly_monom:
+  fixes a x :: "'a::{comm_semiring_1,recpower}"
+  shows "poly (monom a n) x = a * x ^ n"
+  by (induct n, simp add: monom_0, simp add: monom_Suc power_Suc mult_ac)
+
+lemma poly_add [simp]: "poly (p + q) x = poly p x + poly q x"
+  apply (induct p arbitrary: q, simp)
+  apply (case_tac q, simp, simp add: algebra_simps)
+  done
+
+lemma poly_minus [simp]:
+  fixes x :: "'a::comm_ring"
+  shows "poly (- p) x = - poly p x"
+  by (induct p, simp_all)
+
+lemma poly_diff [simp]:
+  fixes x :: "'a::comm_ring"
+  shows "poly (p - q) x = poly p x - poly q x"
+  by (simp add: diff_minus)
+
+lemma poly_setsum: "poly (\<Sum>k\<in>A. p k) x = (\<Sum>k\<in>A. poly (p k) x)"
+  by (cases "finite A", induct set: finite, simp_all)
+
+lemma poly_smult [simp]: "poly (smult a p) x = a * poly p x"
+  by (induct p, simp, simp add: algebra_simps)
+
+lemma poly_mult [simp]: "poly (p * q) x = poly p x * poly q x"
+  by (induct p, simp_all, simp add: algebra_simps)
+
+lemma poly_power [simp]:
+  fixes p :: "'a::{comm_semiring_1,recpower} poly"
+  shows "poly (p ^ n) x = poly p x ^ n"
+  by (induct n, simp, simp add: power_Suc)
+
+
+subsection {* Synthetic division *}
+
+text {*
+  Synthetic division is simply division by the
+  linear polynomial @{term "x - c"}.
+*}
+
+definition
+  synthetic_divmod :: "'a::comm_semiring_0 poly \<Rightarrow> 'a \<Rightarrow> 'a poly \<times> 'a"
+where [code del]:
+  "synthetic_divmod p c =
+    poly_rec (0, 0) (\<lambda>a p (q, r). (pCons r q, a + c * r)) p"
+
+definition
+  synthetic_div :: "'a::comm_semiring_0 poly \<Rightarrow> 'a \<Rightarrow> 'a poly"
+where
+  "synthetic_div p c = fst (synthetic_divmod p c)"
+
+lemma synthetic_divmod_0 [simp]:
+  "synthetic_divmod 0 c = (0, 0)"
+  unfolding synthetic_divmod_def
+  by (simp add: poly_rec_0)
+
+lemma synthetic_divmod_pCons [simp]:
+  "synthetic_divmod (pCons a p) c =
+    (\<lambda>(q, r). (pCons r q, a + c * r)) (synthetic_divmod p c)"
+  unfolding synthetic_divmod_def
+  by (simp add: poly_rec_pCons)
+
+lemma snd_synthetic_divmod: "snd (synthetic_divmod p c) = poly p c"
+  by (induct p, simp, simp add: split_def)
+
+lemma synthetic_div_0 [simp]: "synthetic_div 0 c = 0"
+  unfolding synthetic_div_def by simp
+
+lemma synthetic_div_pCons [simp]:
+  "synthetic_div (pCons a p) c = pCons (poly p c) (synthetic_div p c)"
+  unfolding synthetic_div_def
+  by (simp add: split_def snd_synthetic_divmod)
+
+lemma synthetic_div_eq_0_iff:
+  "synthetic_div p c = 0 \<longleftrightarrow> degree p = 0"
+  by (induct p, simp, case_tac p, simp)
+
+lemma degree_synthetic_div:
+  "degree (synthetic_div p c) = degree p - 1"
+  by (induct p, simp, simp add: synthetic_div_eq_0_iff)
+
+lemma synthetic_div_correct:
+  "p + smult c (synthetic_div p c) = pCons (poly p c) (synthetic_div p c)"
+  by (induct p) simp_all
+
+lemma synthetic_div_unique_lemma: "smult c p = pCons a p \<Longrightarrow> p = 0"
+by (induct p arbitrary: a) simp_all
+
+lemma synthetic_div_unique:
+  "p + smult c q = pCons r q \<Longrightarrow> r = poly p c \<and> q = synthetic_div p c"
+apply (induct p arbitrary: q r)
+apply (simp, frule synthetic_div_unique_lemma, simp)
+apply (case_tac q, force)
+done
+
+lemma synthetic_div_correct':
+  fixes c :: "'a::comm_ring_1"
+  shows "[:-c, 1:] * synthetic_div p c + [:poly p c:] = p"
+  using synthetic_div_correct [of p c]
+  by (simp add: algebra_simps)
+
+lemma poly_eq_0_iff_dvd:
+  fixes c :: "'a::idom"
+  shows "poly p c = 0 \<longleftrightarrow> [:-c, 1:] dvd p"
+proof
+  assume "poly p c = 0"
+  with synthetic_div_correct' [of c p]
+  have "p = [:-c, 1:] * synthetic_div p c" by simp
+  then show "[:-c, 1:] dvd p" ..
+next
+  assume "[:-c, 1:] dvd p"
+  then obtain k where "p = [:-c, 1:] * k" by (rule dvdE)
+  then show "poly p c = 0" by simp
+qed
+
+lemma dvd_iff_poly_eq_0:
+  fixes c :: "'a::idom"
+  shows "[:c, 1:] dvd p \<longleftrightarrow> poly p (-c) = 0"
+  by (simp add: poly_eq_0_iff_dvd)
+
+lemma poly_roots_finite:
+  fixes p :: "'a::idom poly"
+  shows "p \<noteq> 0 \<Longrightarrow> finite {x. poly p x = 0}"
+proof (induct n \<equiv> "degree p" arbitrary: p)
+  case (0 p)
+  then obtain a where "a \<noteq> 0" and "p = [:a:]"
+    by (cases p, simp split: if_splits)
+  then show "finite {x. poly p x = 0}" by simp
+next
+  case (Suc n p)
+  show "finite {x. poly p x = 0}"
+  proof (cases "\<exists>x. poly p x = 0")
+    case False
+    then show "finite {x. poly p x = 0}" by simp
+  next
+    case True
+    then obtain a where "poly p a = 0" ..
+    then have "[:-a, 1:] dvd p" by (simp only: poly_eq_0_iff_dvd)
+    then obtain k where k: "p = [:-a, 1:] * k" ..
+    with `p \<noteq> 0` have "k \<noteq> 0" by auto
+    with k have "degree p = Suc (degree k)"
+      by (simp add: degree_mult_eq del: mult_pCons_left)
+    with `Suc n = degree p` have "n = degree k" by simp
+    with `k \<noteq> 0` have "finite {x. poly k x = 0}" by (rule Suc.hyps)
+    then have "finite (insert a {x. poly k x = 0})" by simp
+    then show "finite {x. poly p x = 0}"
+      by (simp add: k uminus_add_conv_diff Collect_disj_eq
+               del: mult_pCons_left)
+  qed
+qed
+
+lemma poly_zero:
+  fixes p :: "'a::{idom,ring_char_0} poly"
+  shows "poly p = poly 0 \<longleftrightarrow> p = 0"
+apply (cases "p = 0", simp_all)
+apply (drule poly_roots_finite)
+apply (auto simp add: infinite_UNIV_char_0)
+done
+
+lemma poly_eq_iff:
+  fixes p q :: "'a::{idom,ring_char_0} poly"
+  shows "poly p = poly q \<longleftrightarrow> p = q"
+  using poly_zero [of "p - q"]
+  by (simp add: expand_fun_eq)
+
+
+subsection {* Composition of polynomials *}
+
+definition
+  pcompose :: "'a::comm_semiring_0 poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
+where
+  "pcompose p q = poly_rec 0 (\<lambda>a _ c. [:a:] + q * c) p"
+
+lemma pcompose_0 [simp]: "pcompose 0 q = 0"
+  unfolding pcompose_def by (simp add: poly_rec_0)
+
+lemma pcompose_pCons:
+  "pcompose (pCons a p) q = [:a:] + q * pcompose p q"
+  unfolding pcompose_def by (simp add: poly_rec_pCons)
+
+lemma poly_pcompose: "poly (pcompose p q) x = poly p (poly q x)"
+  by (induct p) (simp_all add: pcompose_pCons)
+
+lemma degree_pcompose_le:
+  "degree (pcompose p q) \<le> degree p * degree q"
+apply (induct p, simp)
+apply (simp add: pcompose_pCons, clarify)
+apply (rule degree_add_le, simp)
+apply (rule order_trans [OF degree_mult_le], simp)
+done
+
+
+subsection {* Order of polynomial roots *}
+
+definition
+  order :: "'a::idom \<Rightarrow> 'a poly \<Rightarrow> nat"
+where
+  [code del]:
+  "order a p = (LEAST n. \<not> [:-a, 1:] ^ Suc n dvd p)"
+
+lemma coeff_linear_power:
+  fixes a :: "'a::comm_semiring_1"
+  shows "coeff ([:a, 1:] ^ n) n = 1"
+apply (induct n, simp_all)
+apply (subst coeff_eq_0)
+apply (auto intro: le_less_trans degree_power_le)
+done
+
+lemma degree_linear_power:
+  fixes a :: "'a::comm_semiring_1"
+  shows "degree ([:a, 1:] ^ n) = n"
+apply (rule order_antisym)
+apply (rule ord_le_eq_trans [OF degree_power_le], simp)
+apply (rule le_degree, simp add: coeff_linear_power)
+done
+
+lemma order_1: "[:-a, 1:] ^ order a p dvd p"
+apply (cases "p = 0", simp)
+apply (cases "order a p", simp)
+apply (subgoal_tac "nat < (LEAST n. \<not> [:-a, 1:] ^ Suc n dvd p)")
+apply (drule not_less_Least, simp)
+apply (fold order_def, simp)
+done
+
+lemma order_2: "p \<noteq> 0 \<Longrightarrow> \<not> [:-a, 1:] ^ Suc (order a p) dvd p"
+unfolding order_def
+apply (rule LeastI_ex)
+apply (rule_tac x="degree p" in exI)
+apply (rule notI)
+apply (drule (1) dvd_imp_degree_le)
+apply (simp only: degree_linear_power)
+done
+
+lemma order:
+  "p \<noteq> 0 \<Longrightarrow> [:-a, 1:] ^ order a p dvd p \<and> \<not> [:-a, 1:] ^ Suc (order a p) dvd p"
+by (rule conjI [OF order_1 order_2])
+
+lemma order_degree:
+  assumes p: "p \<noteq> 0"
+  shows "order a p \<le> degree p"
+proof -
+  have "order a p = degree ([:-a, 1:] ^ order a p)"
+    by (simp only: degree_linear_power)
+  also have "\<dots> \<le> degree p"
+    using order_1 p by (rule dvd_imp_degree_le)
+  finally show ?thesis .
+qed
+
+lemma order_root: "poly p a = 0 \<longleftrightarrow> p = 0 \<or> order a p \<noteq> 0"
+apply (cases "p = 0", simp_all)
+apply (rule iffI)
+apply (rule ccontr, simp)
+apply (frule order_2 [where a=a], simp)
+apply (simp add: poly_eq_0_iff_dvd)
+apply (simp add: poly_eq_0_iff_dvd)
+apply (simp only: order_def)
+apply (drule not_less_Least, simp)
+done
+
+
+subsection {* Configuration of the code generator *}
+
+code_datatype "0::'a::zero poly" pCons
+
+declare pCons_0_0 [code post]
+
+instantiation poly :: ("{zero,eq}") eq
+begin
+
+definition [code del]:
+  "eq_class.eq (p::'a poly) q \<longleftrightarrow> p = q"
+
+instance
+  by default (rule eq_poly_def)
+
+end
+
+lemma eq_poly_code [code]:
+  "eq_class.eq (0::_ poly) (0::_ poly) \<longleftrightarrow> True"
+  "eq_class.eq (0::_ poly) (pCons b q) \<longleftrightarrow> eq_class.eq 0 b \<and> eq_class.eq 0 q"
+  "eq_class.eq (pCons a p) (0::_ poly) \<longleftrightarrow> eq_class.eq a 0 \<and> eq_class.eq p 0"
+  "eq_class.eq (pCons a p) (pCons b q) \<longleftrightarrow> eq_class.eq a b \<and> eq_class.eq p q"
+unfolding eq by simp_all
+
+lemmas coeff_code [code] =
+  coeff_0 coeff_pCons_0 coeff_pCons_Suc
+
+lemmas degree_code [code] =
+  degree_0 degree_pCons_eq_if
+
+lemmas monom_poly_code [code] =
+  monom_0 monom_Suc
+
+lemma add_poly_code [code]:
+  "0 + q = (q :: _ poly)"
+  "p + 0 = (p :: _ poly)"
+  "pCons a p + pCons b q = pCons (a + b) (p + q)"
+by simp_all
+
+lemma minus_poly_code [code]:
+  "- 0 = (0 :: _ poly)"
+  "- pCons a p = pCons (- a) (- p)"
+by simp_all
+
+lemma diff_poly_code [code]:
+  "0 - q = (- q :: _ poly)"
+  "p - 0 = (p :: _ poly)"
+  "pCons a p - pCons b q = pCons (a - b) (p - q)"
+by simp_all
+
+lemmas smult_poly_code [code] =
+  smult_0_right smult_pCons
+
+lemma mult_poly_code [code]:
+  "0 * q = (0 :: _ poly)"
+  "pCons a p * q = smult a q + pCons 0 (p * q)"
+by simp_all
+
+lemmas poly_code [code] =
+  poly_0 poly_pCons
+
+lemmas synthetic_divmod_code [code] =
+  synthetic_divmod_0 synthetic_divmod_pCons
+
+text {* code generator setup for div and mod *}
+
+definition
+  pdivmod :: "'a::field poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly \<times> 'a poly"
+where
+  [code del]: "pdivmod x y = (x div y, x mod y)"
+
+lemma div_poly_code [code]: "x div y = fst (pdivmod x y)"
+  unfolding pdivmod_def by simp
+
+lemma mod_poly_code [code]: "x mod y = snd (pdivmod x y)"
+  unfolding pdivmod_def by simp
+
+lemma pdivmod_0 [code]: "pdivmod 0 y = (0, 0)"
+  unfolding pdivmod_def by simp
+
+lemma pdivmod_pCons [code]:
+  "pdivmod (pCons a x) y =
+    (if y = 0 then (0, pCons a x) else
+      (let (q, r) = pdivmod x y;
+           b = coeff (pCons a r) (degree y) / coeff y (degree y)
+        in (pCons b q, pCons a r - smult b y)))"
+apply (simp add: pdivmod_def Let_def, safe)
+apply (rule div_poly_eq)
+apply (erule pdivmod_rel_pCons [OF pdivmod_rel _ refl])
+apply (rule mod_poly_eq)
+apply (erule pdivmod_rel_pCons [OF pdivmod_rel _ refl])
+done
+
+end
--- a/src/HOL/Library/Primes.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Library/Primes.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -45,12 +45,14 @@
   by (rule prime_dvd_square) (simp_all add: power2_eq_square)
 
 
-lemma exp_eq_1:"(x::nat)^n = 1 \<longleftrightarrow> x = 1 \<or> n = 0" by (induct n, auto)
+lemma exp_eq_1:"(x::nat)^n = 1 \<longleftrightarrow> x = 1 \<or> n = 0"
+by (induct n, auto)
+
 lemma exp_mono_lt: "(x::nat) ^ (Suc n) < y ^ (Suc n) \<longleftrightarrow> x < y"
-  using power_less_imp_less_base[of x "Suc n" y] power_strict_mono[of x y "Suc n"]
-    by auto
+by(metis linorder_not_less not_less0 power_le_imp_le_base power_less_imp_less_base)
+
 lemma exp_mono_le: "(x::nat) ^ (Suc n) \<le> y ^ (Suc n) \<longleftrightarrow> x \<le> y"
-  by (simp only: linorder_not_less[symmetric] exp_mono_lt)
+by (simp only: linorder_not_less[symmetric] exp_mono_lt)
 
 lemma exp_mono_eq: "(x::nat) ^ Suc n = y ^ Suc n \<longleftrightarrow> x = y"
 using power_inject_base[of x n y] by auto
@@ -307,8 +309,8 @@
   {fix e assume H: "e dvd a^n" "e dvd b^n"
     from bezout_gcd_pow[of a n b] obtain x y 
       where xy: "a ^ n * x - b ^ n * y = ?gn \<or> b ^ n * x - a ^ n * y = ?gn" by blast
-    from dvd_diff [OF dvd_mult2[OF H(1), of x] dvd_mult2[OF H(2), of y]]
-      dvd_diff [OF dvd_mult2[OF H(2), of x] dvd_mult2[OF H(1), of y]] xy
+    from nat_dvd_diff [OF dvd_mult2[OF H(1), of x] dvd_mult2[OF H(2), of y]]
+      nat_dvd_diff [OF dvd_mult2[OF H(2), of x] dvd_mult2[OF H(1), of y]] xy
     have "e dvd ?gn" by (cases "a ^ n * x - b ^ n * y = gcd a b ^ n", simp_all)}
   hence th:  "\<forall>e. e dvd a^n \<and> e dvd b^n \<longrightarrow> e dvd ?gn" by blast
   from divides_exp[OF gcd_dvd1[of a b], of n] divides_exp[OF gcd_dvd2[of a b], of n] th
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Library/Product_Vector.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -0,0 +1,273 @@
+(*  Title:      HOL/Library/Product_Vector.thy
+    Author:     Brian Huffman
+*)
+
+header {* Cartesian Products as Vector Spaces *}
+
+theory Product_Vector
+imports Inner_Product Product_plus
+begin
+
+subsection {* Product is a real vector space *}
+
+instantiation "*" :: (real_vector, real_vector) real_vector
+begin
+
+definition scaleR_prod_def:
+  "scaleR r A = (scaleR r (fst A), scaleR r (snd A))"
+
+lemma fst_scaleR [simp]: "fst (scaleR r A) = scaleR r (fst A)"
+  unfolding scaleR_prod_def by simp
+
+lemma snd_scaleR [simp]: "snd (scaleR r A) = scaleR r (snd A)"
+  unfolding scaleR_prod_def by simp
+
+lemma scaleR_Pair [simp]: "scaleR r (a, b) = (scaleR r a, scaleR r b)"
+  unfolding scaleR_prod_def by simp
+
+instance proof
+  fix a b :: real and x y :: "'a \<times> 'b"
+  show "scaleR a (x + y) = scaleR a x + scaleR a y"
+    by (simp add: expand_prod_eq scaleR_right_distrib)
+  show "scaleR (a + b) x = scaleR a x + scaleR b x"
+    by (simp add: expand_prod_eq scaleR_left_distrib)
+  show "scaleR a (scaleR b x) = scaleR (a * b) x"
+    by (simp add: expand_prod_eq)
+  show "scaleR 1 x = x"
+    by (simp add: expand_prod_eq)
+qed
+
+end
+
+subsection {* Product is a normed vector space *}
+
+instantiation
+  "*" :: (real_normed_vector, real_normed_vector) real_normed_vector
+begin
+
+definition norm_prod_def:
+  "norm x = sqrt ((norm (fst x))\<twosuperior> + (norm (snd x))\<twosuperior>)"
+
+definition sgn_prod_def:
+  "sgn (x::'a \<times> 'b) = scaleR (inverse (norm x)) x"
+
+lemma norm_Pair: "norm (a, b) = sqrt ((norm a)\<twosuperior> + (norm b)\<twosuperior>)"
+  unfolding norm_prod_def by simp
+
+instance proof
+  fix r :: real and x y :: "'a \<times> 'b"
+  show "0 \<le> norm x"
+    unfolding norm_prod_def by simp
+  show "norm x = 0 \<longleftrightarrow> x = 0"
+    unfolding norm_prod_def
+    by (simp add: expand_prod_eq)
+  show "norm (x + y) \<le> norm x + norm y"
+    unfolding norm_prod_def
+    apply (rule order_trans [OF _ real_sqrt_sum_squares_triangle_ineq])
+    apply (simp add: add_mono power_mono norm_triangle_ineq)
+    done
+  show "norm (scaleR r x) = \<bar>r\<bar> * norm x"
+    unfolding norm_prod_def
+    apply (simp add: norm_scaleR power_mult_distrib)
+    apply (simp add: right_distrib [symmetric])
+    apply (simp add: real_sqrt_mult_distrib)
+    done
+  show "sgn x = scaleR (inverse (norm x)) x"
+    by (rule sgn_prod_def)
+qed
+
+end
+
+subsection {* Product is an inner product space *}
+
+instantiation "*" :: (real_inner, real_inner) real_inner
+begin
+
+definition inner_prod_def:
+  "inner x y = inner (fst x) (fst y) + inner (snd x) (snd y)"
+
+lemma inner_Pair [simp]: "inner (a, b) (c, d) = inner a c + inner b d"
+  unfolding inner_prod_def by simp
+
+instance proof
+  fix r :: real
+  fix x y z :: "'a::real_inner * 'b::real_inner"
+  show "inner x y = inner y x"
+    unfolding inner_prod_def
+    by (simp add: inner_commute)
+  show "inner (x + y) z = inner x z + inner y z"
+    unfolding inner_prod_def
+    by (simp add: inner_left_distrib)
+  show "inner (scaleR r x) y = r * inner x y"
+    unfolding inner_prod_def
+    by (simp add: inner_scaleR_left right_distrib)
+  show "0 \<le> inner x x"
+    unfolding inner_prod_def
+    by (intro add_nonneg_nonneg inner_ge_zero)
+  show "inner x x = 0 \<longleftrightarrow> x = 0"
+    unfolding inner_prod_def expand_prod_eq
+    by (simp add: add_nonneg_eq_0_iff)
+  show "norm x = sqrt (inner x x)"
+    unfolding norm_prod_def inner_prod_def
+    by (simp add: power2_norm_eq_inner)
+qed
+
+end
+
+subsection {* Pair operations are linear and continuous *}
+
+interpretation fst!: bounded_linear fst
+  apply (unfold_locales)
+  apply (rule fst_add)
+  apply (rule fst_scaleR)
+  apply (rule_tac x="1" in exI, simp add: norm_Pair)
+  done
+
+interpretation snd!: bounded_linear snd
+  apply (unfold_locales)
+  apply (rule snd_add)
+  apply (rule snd_scaleR)
+  apply (rule_tac x="1" in exI, simp add: norm_Pair)
+  done
+
+text {* TODO: move to NthRoot *}
+lemma sqrt_add_le_add_sqrt:
+  assumes x: "0 \<le> x" and y: "0 \<le> y"
+  shows "sqrt (x + y) \<le> sqrt x + sqrt y"
+apply (rule power2_le_imp_le)
+apply (simp add: real_sum_squared_expand add_nonneg_nonneg x y)
+apply (simp add: mult_nonneg_nonneg x y)
+apply (simp add: add_nonneg_nonneg x y)
+done
+
+lemma bounded_linear_Pair:
+  assumes f: "bounded_linear f"
+  assumes g: "bounded_linear g"
+  shows "bounded_linear (\<lambda>x. (f x, g x))"
+proof
+  interpret f: bounded_linear f by fact
+  interpret g: bounded_linear g by fact
+  fix x y and r :: real
+  show "(f (x + y), g (x + y)) = (f x, g x) + (f y, g y)"
+    by (simp add: f.add g.add)
+  show "(f (r *\<^sub>R x), g (r *\<^sub>R x)) = r *\<^sub>R (f x, g x)"
+    by (simp add: f.scaleR g.scaleR)
+  obtain Kf where "0 < Kf" and norm_f: "\<And>x. norm (f x) \<le> norm x * Kf"
+    using f.pos_bounded by fast
+  obtain Kg where "0 < Kg" and norm_g: "\<And>x. norm (g x) \<le> norm x * Kg"
+    using g.pos_bounded by fast
+  have "\<forall>x. norm (f x, g x) \<le> norm x * (Kf + Kg)"
+    apply (rule allI)
+    apply (simp add: norm_Pair)
+    apply (rule order_trans [OF sqrt_add_le_add_sqrt], simp, simp)
+    apply (simp add: right_distrib)
+    apply (rule add_mono [OF norm_f norm_g])
+    done
+  then show "\<exists>K. \<forall>x. norm (f x, g x) \<le> norm x * K" ..
+qed
+
+text {*
+  TODO: The next three proofs are nearly identical to each other.
+  Is there a good way to factor out the common parts?
+*}
+
+lemma LIMSEQ_Pair:
+  assumes "X ----> a" and "Y ----> b"
+  shows "(\<lambda>n. (X n, Y n)) ----> (a, b)"
+proof (rule LIMSEQ_I)
+  fix r :: real assume "0 < r"
+  then have "0 < r / sqrt 2" (is "0 < ?s")
+    by (simp add: divide_pos_pos)
+  obtain M where M: "\<forall>n\<ge>M. norm (X n - a) < ?s"
+    using LIMSEQ_D [OF `X ----> a` `0 < ?s`] ..
+  obtain N where N: "\<forall>n\<ge>N. norm (Y n - b) < ?s"
+    using LIMSEQ_D [OF `Y ----> b` `0 < ?s`] ..
+  have "\<forall>n\<ge>max M N. norm ((X n, Y n) - (a, b)) < r"
+    using M N by (simp add: real_sqrt_sum_squares_less norm_Pair)
+  then show "\<exists>n0. \<forall>n\<ge>n0. norm ((X n, Y n) - (a, b)) < r" ..
+qed
+
+lemma Cauchy_Pair:
+  assumes "Cauchy X" and "Cauchy Y"
+  shows "Cauchy (\<lambda>n. (X n, Y n))"
+proof (rule CauchyI)
+  fix r :: real assume "0 < r"
+  then have "0 < r / sqrt 2" (is "0 < ?s")
+    by (simp add: divide_pos_pos)
+  obtain M where M: "\<forall>m\<ge>M. \<forall>n\<ge>M. norm (X m - X n) < ?s"
+    using CauchyD [OF `Cauchy X` `0 < ?s`] ..
+  obtain N where N: "\<forall>m\<ge>N. \<forall>n\<ge>N. norm (Y m - Y n) < ?s"
+    using CauchyD [OF `Cauchy Y` `0 < ?s`] ..
+  have "\<forall>m\<ge>max M N. \<forall>n\<ge>max M N. norm ((X m, Y m) - (X n, Y n)) < r"
+    using M N by (simp add: real_sqrt_sum_squares_less norm_Pair)
+  then show "\<exists>n0. \<forall>m\<ge>n0. \<forall>n\<ge>n0. norm ((X m, Y m) - (X n, Y n)) < r" ..
+qed
+
+lemma LIM_Pair:
+  assumes "f -- x --> a" and "g -- x --> b"
+  shows "(\<lambda>x. (f x, g x)) -- x --> (a, b)"
+proof (rule LIM_I)
+  fix r :: real assume "0 < r"
+  then have "0 < r / sqrt 2" (is "0 < ?e")
+    by (simp add: divide_pos_pos)
+  obtain s where s: "0 < s"
+    "\<forall>z. z \<noteq> x \<and> norm (z - x) < s \<longrightarrow> norm (f z - a) < ?e"
+    using LIM_D [OF `f -- x --> a` `0 < ?e`] by fast
+  obtain t where t: "0 < t"
+    "\<forall>z. z \<noteq> x \<and> norm (z - x) < t \<longrightarrow> norm (g z - b) < ?e"
+    using LIM_D [OF `g -- x --> b` `0 < ?e`] by fast
+  have "0 < min s t \<and>
+    (\<forall>z. z \<noteq> x \<and> norm (z - x) < min s t \<longrightarrow> norm ((f z, g z) - (a, b)) < r)"
+    using s t by (simp add: real_sqrt_sum_squares_less norm_Pair)
+  then show
+    "\<exists>s>0. \<forall>z. z \<noteq> x \<and> norm (z - x) < s \<longrightarrow> norm ((f z, g z) - (a, b)) < r" ..
+qed
+
+lemma isCont_Pair [simp]:
+  "\<lbrakk>isCont f x; isCont g x\<rbrakk> \<Longrightarrow> isCont (\<lambda>x. (f x, g x)) x"
+  unfolding isCont_def by (rule LIM_Pair)
+
+
+subsection {* Product is a complete vector space *}
+
+instance "*" :: (banach, banach) banach
+proof
+  fix X :: "nat \<Rightarrow> 'a \<times> 'b" assume "Cauchy X"
+  have 1: "(\<lambda>n. fst (X n)) ----> lim (\<lambda>n. fst (X n))"
+    using fst.Cauchy [OF `Cauchy X`]
+    by (simp add: Cauchy_convergent_iff convergent_LIMSEQ_iff)
+  have 2: "(\<lambda>n. snd (X n)) ----> lim (\<lambda>n. snd (X n))"
+    using snd.Cauchy [OF `Cauchy X`]
+    by (simp add: Cauchy_convergent_iff convergent_LIMSEQ_iff)
+  have "X ----> (lim (\<lambda>n. fst (X n)), lim (\<lambda>n. snd (X n)))"
+    using LIMSEQ_Pair [OF 1 2] by simp
+  then show "convergent X"
+    by (rule convergentI)
+qed
+
+subsection {* Frechet derivatives involving pairs *}
+
+lemma FDERIV_Pair:
+  assumes f: "FDERIV f x :> f'" and g: "FDERIV g x :> g'"
+  shows "FDERIV (\<lambda>x. (f x, g x)) x :> (\<lambda>h. (f' h, g' h))"
+apply (rule FDERIV_I)
+apply (rule bounded_linear_Pair)
+apply (rule FDERIV_bounded_linear [OF f])
+apply (rule FDERIV_bounded_linear [OF g])
+apply (simp add: norm_Pair)
+apply (rule real_LIM_sandwich_zero)
+apply (rule LIM_add_zero)
+apply (rule FDERIV_D [OF f])
+apply (rule FDERIV_D [OF g])
+apply (rename_tac h)
+apply (simp add: divide_nonneg_pos)
+apply (rename_tac h)
+apply (subst add_divide_distrib [symmetric])
+apply (rule divide_right_mono [OF _ norm_ge_zero])
+apply (rule order_trans [OF sqrt_add_le_add_sqrt])
+apply simp
+apply simp
+apply simp
+done
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Library/Product_plus.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -0,0 +1,115 @@
+(*  Title:      HOL/Library/Product_plus.thy
+    Author:     Brian Huffman
+*)
+
+header {* Additive group operations on product types *}
+
+theory Product_plus
+imports Main
+begin
+
+subsection {* Operations *}
+
+instantiation "*" :: (zero, zero) zero
+begin
+
+definition zero_prod_def: "0 = (0, 0)"
+
+instance ..
+end
+
+instantiation "*" :: (plus, plus) plus
+begin
+
+definition plus_prod_def:
+  "x + y = (fst x + fst y, snd x + snd y)"
+
+instance ..
+end
+
+instantiation "*" :: (minus, minus) minus
+begin
+
+definition minus_prod_def:
+  "x - y = (fst x - fst y, snd x - snd y)"
+
+instance ..
+end
+
+instantiation "*" :: (uminus, uminus) uminus
+begin
+
+definition uminus_prod_def:
+  "- x = (- fst x, - snd x)"
+
+instance ..
+end
+
+lemma fst_zero [simp]: "fst 0 = 0"
+  unfolding zero_prod_def by simp
+
+lemma snd_zero [simp]: "snd 0 = 0"
+  unfolding zero_prod_def by simp
+
+lemma fst_add [simp]: "fst (x + y) = fst x + fst y"
+  unfolding plus_prod_def by simp
+
+lemma snd_add [simp]: "snd (x + y) = snd x + snd y"
+  unfolding plus_prod_def by simp
+
+lemma fst_diff [simp]: "fst (x - y) = fst x - fst y"
+  unfolding minus_prod_def by simp
+
+lemma snd_diff [simp]: "snd (x - y) = snd x - snd y"
+  unfolding minus_prod_def by simp
+
+lemma fst_uminus [simp]: "fst (- x) = - fst x"
+  unfolding uminus_prod_def by simp
+
+lemma snd_uminus [simp]: "snd (- x) = - snd x"
+  unfolding uminus_prod_def by simp
+
+lemma add_Pair [simp]: "(a, b) + (c, d) = (a + c, b + d)"
+  unfolding plus_prod_def by simp
+
+lemma diff_Pair [simp]: "(a, b) - (c, d) = (a - c, b - d)"
+  unfolding minus_prod_def by simp
+
+lemma uminus_Pair [simp, code]: "- (a, b) = (- a, - b)"
+  unfolding uminus_prod_def by simp
+
+lemmas expand_prod_eq = Pair_fst_snd_eq
+
+
+subsection {* Class instances *}
+
+instance "*" :: (semigroup_add, semigroup_add) semigroup_add
+  by default (simp add: expand_prod_eq add_assoc)
+
+instance "*" :: (ab_semigroup_add, ab_semigroup_add) ab_semigroup_add
+  by default (simp add: expand_prod_eq add_commute)
+
+instance "*" :: (monoid_add, monoid_add) monoid_add
+  by default (simp_all add: expand_prod_eq)
+
+instance "*" :: (comm_monoid_add, comm_monoid_add) comm_monoid_add
+  by default (simp add: expand_prod_eq)
+
+instance "*" ::
+  (cancel_semigroup_add, cancel_semigroup_add) cancel_semigroup_add
+    by default (simp_all add: expand_prod_eq)
+
+instance "*" ::
+  (cancel_ab_semigroup_add, cancel_ab_semigroup_add) cancel_ab_semigroup_add
+    by default (simp add: expand_prod_eq)
+
+instance "*" ::
+  (cancel_comm_monoid_add, cancel_comm_monoid_add) cancel_comm_monoid_add ..
+
+instance "*" :: (group_add, group_add) group_add
+  by default (simp_all add: expand_prod_eq diff_minus)
+
+instance "*" :: (ab_group_add, ab_group_add) ab_group_add
+  by default (simp_all add: expand_prod_eq)
+
+end
--- a/src/HOL/List.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/List.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -1438,10 +1438,10 @@
 apply (auto split:nat.split)
 done
 
-lemma last_conv_nth: "xs\<noteq>[] \<Longrightarrow> last xs = xs!(length xs - 1)"
+lemma last_conv_nth: "xs\<noteq>[] \<Longrightarrow> last xs = xs!(length xs - Suc 0)"
 by(induct xs)(auto simp:neq_Nil_conv)
 
-lemma butlast_conv_take: "butlast xs = take (length xs - 1) xs"
+lemma butlast_conv_take: "butlast xs = take (length xs - Suc 0) xs"
 by (induct xs, simp, case_tac xs, simp_all)
 
 
@@ -1588,7 +1588,7 @@
 done
 
 lemma butlast_take:
-  "n <= length xs ==> butlast (take n xs) = take (n - 1) xs"
+  "n <= length xs ==> butlast (take n xs) = take (n - Suc 0) xs"
 by (simp add: butlast_conv_take min_max.inf_absorb1 min_max.inf_absorb2)
 
 lemma butlast_drop: "butlast (drop n xs) = drop n (butlast xs)"
@@ -1639,7 +1639,7 @@
 done
 
 lemma take_hd_drop:
-  "n < length xs \<Longrightarrow> take n xs @ [hd (drop n xs)] = take (n+1) xs"
+  "n < length xs \<Longrightarrow> take n xs @ [hd (drop n xs)] = take (Suc n) xs"
 apply(induct xs arbitrary: n)
 apply simp
 apply(simp add:drop_Cons split:nat.split)
@@ -2458,7 +2458,7 @@
 done
 
 lemma length_remove1:
-  "length(remove1 x xs) = (if x : set xs then length xs - 1 else length xs)"
+  "length(remove1 x xs) = (if x : set xs then length xs - Suc 0 else length xs)"
 apply (induct xs)
  apply (auto dest!:length_pos_if_in_set)
 done
@@ -3564,52 +3564,51 @@
 
 open Basic_Code_Thingol;
 
-fun implode_list (nil', cons') t =
-  let
-    fun dest_cons (IConst (c, _) `$ t1 `$ t2) =
-          if c = cons'
-          then SOME (t1, t2)
-          else NONE
-      | dest_cons _ = NONE;
-    val (ts, t') = Code_Thingol.unfoldr dest_cons t;
-  in case t'
-   of IConst (c, _) => if c = nil' then SOME ts else NONE
+fun implode_list naming t = case pairself
+  (Code_Thingol.lookup_const naming) (@{const_name Nil}, @{const_name Cons})
+   of (SOME nil', SOME cons') => let
+          fun dest_cons (IConst (c, _) `$ t1 `$ t2) =
+                if c = cons'
+                then SOME (t1, t2)
+                else NONE
+            | dest_cons _ = NONE;
+          val (ts, t') = Code_Thingol.unfoldr dest_cons t;
+        in case t'
+         of IConst (c, _) => if c = nil' then SOME ts else NONE
+          | _ => NONE
+        end
     | _ => NONE
-  end;
-
-fun decode_char nibbles' (IConst (c1, _), IConst (c2, _)) =
-      let
-        fun idx c = find_index (curry (op =) c) nibbles';
-        fun decode ~1 _ = NONE
-          | decode _ ~1 = NONE
-          | decode n m = SOME (chr (n * 16 + m));
-      in decode (idx c1) (idx c2) end
-  | decode_char _ _ = NONE;
-
-fun implode_string (char', nibbles') mk_char mk_string ts =
-  let
-    fun implode_char (IConst (c, _) `$ t1 `$ t2) =
-          if c = char' then decode_char nibbles' (t1, t2) else NONE
-      | implode_char _ = NONE;
-    val ts' = map implode_char ts;
-  in if forall is_some ts'
-    then (SOME o Code_Printer.str o mk_string o implode o map_filter I) ts'
-    else NONE
-  end;
-
-fun list_names naming = pairself (the o Code_Thingol.lookup_const naming)
-  (@{const_name Nil}, @{const_name Cons});
-fun char_name naming = (the o Code_Thingol.lookup_const naming)
-  @{const_name Char}
-fun nibble_names naming = map (the o Code_Thingol.lookup_const naming)
-  [@{const_name Nibble0}, @{const_name Nibble1},
+
+fun decode_char naming (IConst (c1, _), IConst (c2, _)) = (case map_filter
+  (Code_Thingol.lookup_const naming)[@{const_name Nibble0}, @{const_name Nibble1},
    @{const_name Nibble2}, @{const_name Nibble3},
    @{const_name Nibble4}, @{const_name Nibble5},
    @{const_name Nibble6}, @{const_name Nibble7},
    @{const_name Nibble8}, @{const_name Nibble9},
    @{const_name NibbleA}, @{const_name NibbleB},
    @{const_name NibbleC}, @{const_name NibbleD},
-   @{const_name NibbleE}, @{const_name NibbleF}];
+   @{const_name NibbleE}, @{const_name NibbleF}]
+   of nibbles' as [_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _] => let
+          fun idx c = find_index (curry (op =) c) nibbles';
+          fun decode ~1 _ = NONE
+            | decode _ ~1 = NONE
+            | decode n m = SOME (chr (n * 16 + m));
+        in decode (idx c1) (idx c2) end
+    | _ => NONE)
+ | decode_char _ _ = NONE
+   
+fun implode_string naming mk_char mk_string ts = case
+  Code_Thingol.lookup_const naming @{const_name Char}
+   of SOME char' => let
+        fun implode_char (IConst (c, _) `$ t1 `$ t2) =
+              if c = char' then decode_char naming (t1, t2) else NONE
+          | implode_char _ = NONE;
+        val ts' = map implode_char ts;
+      in if forall is_some ts'
+        then (SOME o Code_Printer.str o mk_string o implode o map_filter I) ts'
+        else NONE
+      end
+    | _ => NONE;
 
 fun default_list (target_fxy, target_cons) pr fxy t1 t2 =
   Code_Printer.brackify_infix (target_fxy, Code_Printer.R) fxy [
@@ -3622,7 +3621,7 @@
   let
     val mk_list = Code_Printer.literal_list literals;
     fun pretty pr naming thm vars fxy [(t1, _), (t2, _)] =
-      case Option.map (cons t1) (implode_list (list_names naming) t2)
+      case Option.map (cons t1) (implode_list naming t2)
        of SOME ts => mk_list (map (pr vars Code_Printer.NOBR) ts)
         | NONE => default_list (Code_Printer.infix_cons literals) (pr vars) fxy t1 t2;
   in (2, pretty) end;
@@ -3633,8 +3632,8 @@
     val mk_char = Code_Printer.literal_char literals;
     val mk_string = Code_Printer.literal_string literals;
     fun pretty pr naming thm vars fxy [(t1, _), (t2, _)] =
-      case Option.map (cons t1) (implode_list (list_names naming) t2)
-       of SOME ts => (case implode_string (char_name naming, nibble_names naming) mk_char mk_string ts
+      case Option.map (cons t1) (implode_list naming t2)
+       of SOME ts => (case implode_string naming mk_char mk_string ts
            of SOME p => p
             | NONE => mk_list (map (pr vars Code_Printer.NOBR) ts))
         | NONE => default_list (Code_Printer.infix_cons literals) (pr vars) fxy t1 t2;
@@ -3644,7 +3643,7 @@
   let
     val mk_char = Code_Printer.literal_char literals;
     fun pretty _ naming thm _ _ [(t1, _), (t2, _)] =
-      case decode_char (nibble_names naming) (t1, t2)
+      case decode_char naming (t1, t2)
        of SOME c => (Code_Printer.str o mk_char) c
         | NONE => Code_Printer.nerror thm "Illegal character expression";
   in (2, pretty) end;
@@ -3654,8 +3653,8 @@
     val mk_char = Code_Printer.literal_char literals;
     val mk_string = Code_Printer.literal_string literals;
     fun pretty _ naming thm _ _ [(t, _)] =
-      case implode_list (list_names naming) t
-       of SOME ts => (case implode_string (char_name naming, nibble_names naming) mk_char mk_string ts
+      case implode_list naming t
+       of SOME ts => (case implode_string naming mk_char mk_string ts
            of SOME p => p
             | NONE => Code_Printer.nerror thm "Illegal message expression")
         | NONE => Code_Printer.nerror thm "Illegal message expression";
--- a/src/HOL/MacLaurin.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/MacLaurin.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -81,7 +81,7 @@
   prefer 2 apply simp
  apply (frule less_iff_Suc_add [THEN iffD1], clarify)
  apply (simp del: setsum_op_ivl_Suc)
- apply (insert sumr_offset4 [of 1])
+ apply (insert sumr_offset4 [of "Suc 0"])
  apply (simp del: setsum_op_ivl_Suc fact_Suc realpow_Suc)
  apply (rule lemma_DERIV_subst)
   apply (rule DERIV_add)
@@ -124,7 +124,7 @@
 
   have g2: "g 0 = 0 & g h = 0"
     apply (simp add: m f_h g_def del: setsum_op_ivl_Suc)
-    apply (cut_tac n = m and k = 1 in sumr_offset2)
+    apply (cut_tac n = m and k = "Suc 0" in sumr_offset2)
     apply (simp add: eq_diff_eq' diff_0 del: setsum_op_ivl_Suc)
     done
 
@@ -144,7 +144,7 @@
     apply (simp add: m difg_def)
     apply (frule less_iff_Suc_add [THEN iffD1], clarify)
     apply (simp del: setsum_op_ivl_Suc)
-    apply (insert sumr_offset4 [of 1])
+    apply (insert sumr_offset4 [of "Suc 0"])
     apply (simp del: setsum_op_ivl_Suc fact_Suc realpow_Suc)
     done
 
@@ -552,6 +552,10 @@
     "[|x = y; abs u \<le> (v::real) |] ==> \<bar>(x + u) - y\<bar> \<le> v"
 by auto
 
+text {* TODO: move to Parity.thy *}
+lemma nat_odd_1 [simp]: "odd (1::nat)"
+  unfolding even_nat_def by simp
+
 lemma Maclaurin_sin_bound:
   "abs(sin x - (\<Sum>m=0..<n. (if even m then 0 else (-1 ^ ((m - Suc 0) div 2)) / real (fact m)) *
   x ^ m))  \<le> inverse(real (fact n)) * \<bar>x\<bar> ^ n"
--- a/src/HOL/NSA/NSA.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/NSA/NSA.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -157,7 +157,7 @@
 by transfer (rule norm_divide)
 
 lemma hypreal_hnorm_def [simp]:
-  "\<And>r::hypreal. hnorm r \<equiv> \<bar>r\<bar>"
+  "\<And>r::hypreal. hnorm r = \<bar>r\<bar>"
 by transfer (rule real_norm_def)
 
 lemma hnorm_add_less:
--- a/src/HOL/Nat.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Nat.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -196,8 +196,8 @@
 
 instance proof
   fix n m q :: nat
-  show "0 \<noteq> (1::nat)" by simp
-  show "1 * n = n" by simp
+  show "0 \<noteq> (1::nat)" unfolding One_nat_def by simp
+  show "1 * n = n" unfolding One_nat_def by simp
   show "n * m = m * n" by (induct n) simp_all
   show "(n * m) * q = n * (m * q)" by (induct n) (simp_all add: add_mult_distrib)
   show "(n + m) * q = n * q + m * q" by (rule add_mult_distrib)
@@ -280,6 +280,9 @@
 lemma diff_add_0: "n - (n + m) = (0::nat)"
   by (induct n) simp_all
 
+lemma diff_Suc_1 [simp]: "Suc n - 1 = n"
+  unfolding One_nat_def by simp
+
 text {* Difference distributes over multiplication *}
 
 lemma diff_mult_distrib: "((m::nat) - n) * k = (m * k) - (n * k)"
@@ -307,18 +310,24 @@
 lemmas nat_distrib =
   add_mult_distrib add_mult_distrib2 diff_mult_distrib diff_mult_distrib2
 
-lemma mult_eq_1_iff [simp]: "(m * n = Suc 0) = (m = 1 & n = 1)"
+lemma mult_eq_1_iff [simp]: "(m * n = Suc 0) = (m = Suc 0 & n = Suc 0)"
   apply (induct m)
    apply simp
   apply (induct n)
    apply auto
   done
 
-lemma one_eq_mult_iff [simp,noatp]: "(Suc 0 = m * n) = (m = 1 & n = 1)"
+lemma one_eq_mult_iff [simp,noatp]: "(Suc 0 = m * n) = (m = Suc 0 & n = Suc 0)"
   apply (rule trans)
   apply (rule_tac [2] mult_eq_1_iff, fastsimp)
   done
 
+lemma nat_mult_eq_1_iff [simp]: "m * n = (1::nat) \<longleftrightarrow> m = 1 \<and> n = 1"
+  unfolding One_nat_def by (rule mult_eq_1_iff)
+
+lemma nat_1_eq_mult_iff [simp]: "(1::nat) = m * n \<longleftrightarrow> m = 1 \<and> n = 1"
+  unfolding One_nat_def by (rule one_eq_mult_iff)
+
 lemma mult_cancel1 [simp]: "(k * m = k * n) = (m = n | (k = (0::nat)))"
 proof -
   have "k \<noteq> 0 \<Longrightarrow> k * m = k * n \<Longrightarrow> m = n"
@@ -465,11 +474,11 @@
 lemma less_Suc_eq: "(m < Suc n) = (m < n | m = n)"
   unfolding less_Suc_eq_le le_less ..
 
-lemma less_one [iff, noatp]: "(n < (1::nat)) = (n = 0)"
+lemma less_Suc0 [iff]: "(n < Suc 0) = (n = 0)"
   by (simp add: less_Suc_eq)
 
-lemma less_Suc0 [iff]: "(n < Suc 0) = (n = 0)"
-  by (simp add: less_Suc_eq)
+lemma less_one [iff, noatp]: "(n < (1::nat)) = (n = 0)"
+  unfolding One_nat_def by (rule less_Suc0)
 
 lemma Suc_mono: "m < n ==> Suc m < Suc n"
   by simp
@@ -735,6 +744,11 @@
   show "i < j ==> 0 < k ==> k * i < k * j" by (simp add: mult_less_mono2)
 qed
 
+instance nat :: no_zero_divisors
+proof
+  fix a::nat and b::nat show "a ~= 0 \<Longrightarrow> b ~= 0 \<Longrightarrow> a * b ~= 0" by auto
+qed
+
 lemma nat_mult_1: "(1::nat) * n = n"
 by simp
 
@@ -795,6 +809,7 @@
   done
 
 lemma ex_least_nat_less: "\<not>P(0) \<Longrightarrow> P(n::nat) \<Longrightarrow> \<exists>k<n. (\<forall>i\<le>k. \<not>P i) & P(k+1)"
+  unfolding One_nat_def
   apply (cases n)
    apply blast
   apply (frule (1) ex_least_nat_le)
@@ -1084,7 +1099,7 @@
    apply simp_all
   done
 
-lemma one_le_mult_iff [simp]: "(Suc 0 \<le> m * n) = (1 \<le> m & 1 \<le> n)"
+lemma one_le_mult_iff [simp]: "(Suc 0 \<le> m * n) = (Suc 0 \<le> m & Suc 0 \<le> n)"
   apply (induct m)
    apply simp
   apply (case_tac n)
@@ -1120,7 +1135,7 @@
   by (cases m) (auto intro: le_add1)
 
 text {* Lemma for @{text gcd} *}
-lemma mult_eq_self_implies_10: "(m::nat) = m * n ==> n = 1 | m = 0"
+lemma mult_eq_self_implies_10: "(m::nat) = m * n ==> n = Suc 0 | m = 0"
   apply (drule sym)
   apply (rule disjCI)
   apply (rule nat_less_cases, erule_tac [2] _)
@@ -1159,7 +1174,7 @@
   | of_nat_Suc: "of_nat (Suc m) = 1 + of_nat m"
 
 lemma of_nat_1 [simp]: "of_nat 1 = 1"
-  by simp
+  unfolding One_nat_def by simp
 
 lemma of_nat_add [simp]: "of_nat (m + n) = of_nat m + of_nat n"
   by (induct m) (simp_all add: add_ac)
@@ -1271,7 +1286,7 @@
 end
 
 lemma of_nat_id [simp]: "of_nat n = n"
-  by (induct n) auto
+  by (induct n) (auto simp add: One_nat_def)
 
 lemma of_nat_eq_id [simp]: "of_nat = id"
   by (auto simp add: expand_fun_eq)
@@ -1376,7 +1391,7 @@
 apply(induct_tac k)
  apply simp
 apply(erule_tac x="m+n" in meta_allE)
-apply(erule_tac x="m+n+1" in meta_allE)
+apply(erule_tac x="Suc(m+n)" in meta_allE)
 apply simp
 done
 
--- a/src/HOL/NatBin.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/NatBin.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -159,6 +159,21 @@
   unfolding nat_number_of_def number_of_is_id numeral_simps
   by (simp add: nat_add_distrib)
 
+lemma nat_number_of_add_1 [simp]:
+  "number_of v + (1::nat) =
+    (if v < Int.Pls then 1 else number_of (Int.succ v))"
+  unfolding nat_number_of_def number_of_is_id numeral_simps
+  by (simp add: nat_add_distrib)
+
+lemma nat_1_add_number_of [simp]:
+  "(1::nat) + number_of v =
+    (if v < Int.Pls then 1 else number_of (Int.succ v))"
+  unfolding nat_number_of_def number_of_is_id numeral_simps
+  by (simp add: nat_add_distrib)
+
+lemma nat_1_add_1 [simp]: "1 + 1 = (2::nat)"
+  by (rule int_int_eq [THEN iffD1]) simp
+
 
 subsubsection{*Subtraction *}
 
@@ -178,6 +193,12 @@
   unfolding nat_number_of_def number_of_is_id numeral_simps neg_def
   by auto
 
+lemma nat_number_of_diff_1 [simp]:
+  "number_of v - (1::nat) =
+    (if v \<le> Int.Pls then 0 else number_of (Int.pred v))"
+  unfolding nat_number_of_def number_of_is_id numeral_simps
+  by auto
+
 
 subsubsection{*Multiplication *}
 
@@ -442,19 +463,13 @@
 (* These two can be useful when m = number_of... *)
 
 lemma add_eq_if: "(m::nat) + n = (if m=0 then n else Suc ((m - 1) + n))"
-apply (case_tac "m")
-apply (simp_all add: numerals)
-done
+  unfolding One_nat_def by (cases m) simp_all
 
 lemma mult_eq_if: "(m::nat) * n = (if m=0 then 0 else n + ((m - 1) * n))"
-apply (case_tac "m")
-apply (simp_all add: numerals)
-done
+  unfolding One_nat_def by (cases m) simp_all
 
 lemma power_eq_if: "(p ^ m :: nat) = (if m=0 then 1 else p * (p ^ (m - 1)))"
-apply (case_tac "m")
-apply (simp_all add: numerals)
-done
+  unfolding One_nat_def by (cases m) simp_all
 
 
 subsection{*Comparisons involving (0::nat) *}
--- a/src/HOL/Nominal/Examples/Fsub.thy	Thu Feb 26 11:18:40 2009 +0000
+++ b/src/HOL/Nominal/Examples/Fsub.thy	Thu Feb 26 11:21:29 2009 +0000
@@ -7,13 +7,18 @@
 text{* Authors: Christian Urban,
                 Benjamin Pierce,
                 Dimitrios Vytiniotis
-                Stephanie Weirich and
+                Stephanie Weirich
                 Steve Zdancewic
+                Julien Narboux
+                Stefan Berghofer
 
-       with great help from Stefan Berghofer and  Markus Wenzel. *}
+       with great help from Markus Wenzel. *}
 
 section {* Types for Names, Nominal Datatype Declaration for Types and Terms *}
 
+no_syntax
+  "_Map" :: "maplets => 'a ~=> 'b"  ("(1[_])")
+
 text {* The main point of this solution is to use names everywhere (be they bound, 
   binding or free). In System \FSUB{} there are two kinds of names corresponding to 
   type-variables and to term-variables. These two kinds of names are represented in 
@@ -31,30 +36,35 @@
 nominal_datatype ty = 
     Tvar   "tyvrs"
   | Top
-  | Arrow  "ty" "ty"          ("_ \<rightarrow> _" [100,100] 100)
+  | Arrow  "ty" "ty"         (infixr "\<rightarrow>" 200)
   | Forall "\<guillemotleft>tyvrs\<guillemotright>ty" "ty" 
 
 nominal_datatype trm = 
     Var   "vrs"
-  | Lam   "\<guillemotleft>vrs\<guillemotright>trm" "ty" 
-  | Tabs  "\<guillemotleft>tyvrs\<guillemotright>trm" "ty"
-  | App   "trm" "trm"
-  | Tapp  "trm" "ty"
+  | Abs   "\<guillemotleft>vrs\<guillemotright>trm" "ty" 
+  | TAbs  "\<guillemotleft>tyvrs\<guillemotright>trm" "ty"
+  | App   "trm" "trm" (infixl "\<cdot>" 200)
+  | TApp  "trm" "ty"  (infixl "\<cdot>\<^sub>\<tau>" 200)
 
 text {* To be polite to the eye, some more familiar notation is introduced. 
   Because of the change in the order of arguments, one needs to use 
   translation rules, instead of syntax annotations at the term-constructors
   as given above for @{term "Arrow"}. *}
 
-syntax
-  Forall_syn :: "tyvrs \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> ty" ("\<forall>[_<:_]._" [100,100,100] 100)
-  Lam_syn    :: "vrs \<Rightarrow> ty \<Rightarrow> trm \<Rightarrow> trm"   ("Lam [_:_]._" [100,100,100] 100)
-  Tabs_syn   :: "tyvrs \<Rightarrow> ty \<Rightarrow> trm \<Rightarrow> trm" ("Tabs [_<:_]._" [100,100,100] 100)
+abbreviation
+  Forall_syn :: "tyvrs \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> ty"  ("(3\<forall>_<:_./ _)" [0, 0, 10] 10) 
+where
+  "\<forall>X<:T\<^isub>1. T\<^isub>2 \<equiv> ty.Forall X T\<^isub>2 T\<^isub>1"
 
-translations 
-  "\<forall>[X<:T\<^isub>1].T\<^isub>2" \<rightleftharpoons> "ty.Forall X T\<^isub>2 T\<^isub>1"
-  "Lam [x:T].t" \<rightleftharpoons> "trm.Lam x t T"
-  "Tabs [X<:T].t" \<rightleftharpoons> "trm.Tabs X t T"
+abbreviation
+  Abs_syn    :: "vrs \<Rightarrow> ty \<Rightarrow> trm \<Rightarrow> trm"  ("(3\<lambda>_:_./ _)" [0, 0, 10] 10) 
+where
+  "\<lambda>x:T. t \<equiv> trm.Abs x t T"
+
+abbreviation
+  TAbs_syn   :: "tyvrs \<Rightarrow> ty \<Rightarrow> trm \<Rightarrow> trm" ("(3\<lambda>_<:_./ _)" [0, 0, 10] 10) 
+where
+  "\<lambda>X<:T. t \<equiv> trm.TAbs X t T"
 
 text {* Again there are numerous facts that are proved automatically for @{typ "ty"} 
   and @{typ "trm"}: for example that the set of free variables, i.e.~the @{text "support"}, 
@@ -64,13 +74,17 @@
   and @{typ "trm"}s are equal: *}
 
 lemma alpha_illustration:
-  shows "\<forall>[X<:T].(Tvar X) = \<forall>[Y<:T].(Tvar Y)" 
-  and "Lam [x:T].(Var x) = Lam [y:T].(Var y)"
+  shows "(\<forall>X<:T. Tvar X) = (\<forall>Y<:T. Tvar Y)"
+  and   "(\<lambda>x:T. Var x) = (\<lambda>y:T. Var y)"
   by (simp_all add: ty.inject trm.inject alpha calc_atm fresh_atm)
 
 section {* SubTyping Contexts *}
 
-types ty_context = "(tyvrs\<times>ty) list"
+nominal_datatype binding = 
+    VarB vrs ty 
+  | TVarB tyvrs ty
+
+types env = "binding list"
 
 text {* Typing contexts are represented as lists that ``grow" on the left; we
   thereby deviating from the convention in the POPLmark-paper. The lists contain
@@ -79,66 +93,139 @@
 text {* In order to state validity-conditions for typing-contexts, the notion of
   a @{text "domain"} of a typing-context is handy. *}
 
+nominal_primrec
+  "tyvrs_of" :: "binding \<Rightarrow> tyvrs set"
+where
+  "tyvrs_of (VarB  x y) = {}"
+| "tyvrs_of (TVarB x y) = {x}"
+by auto
+
+nominal_primrec
+  "vrs_of" :: "binding \<Rightarrow> vrs set"
+where
+  "vrs_of (VarB  x y) = {x}"
+| "vrs_of (TVarB x y) = {}"
+by auto
+
 consts
-  "domain" :: "ty_context \<Rightarrow> tyvrs set"
+  "ty_domain" :: "env \<Rightarrow> tyvrs set"
 primrec
-  "domain [] = {}"
-  "domain (X#\<Gamma>) = {fst X}\<union>(domain \<Gamma>)" 
+  "ty_domain [] = {}"
+  "ty_domain (X#\<Gamma>) = (tyvrs_of X)\<union>(ty_domain \<Gamma>)" 
+
+consts
+  "trm_domain" :: "env \<Rightarrow> vrs set"
+primrec
+  "trm_domain [] = {}"
+  "trm_domain (X#\<Gamma>) = (vrs_of X)\<union>(trm_domain \<Gamma>)" 
 
-lemma domain_eqvt[eqvt]:
+lemma vrs_of_eqvt[eqvt]:
+  fixes pi ::"tyvrs prm"
+  and   pi'::"vrs   prm"
+  shows "pi \<bullet>(tyvrs_of x) = tyvrs_of (pi\<bullet>x)"
+  and   "pi'\<bullet>(tyvrs_of x) = tyvrs_of (pi'\<bullet>x)"
+  and   "pi \<bullet>(vrs_of x)   = vrs_of   (pi\<bullet>x)"
+  and   "pi'\<bullet>(vrs_of x)   = vrs_of   (pi'\<bullet>x)"
+by (nominal_induct x rule: binding.strong_induct) (simp_all add: tyvrs_of.simps eqvts)
+
+lemma domains_eqvt[eqvt]:
   fixes pi::"tyvrs prm"
   and   pi'::"vrs prm"
-  shows "pi\<bullet>(domain \<Gamma>) = domain (pi\<bullet>\<Gamma>)"
-  and   "pi'\<bullet>(domain \<Gamma>) = domain (pi'\<bullet>\<Gamma>)"
-  by (induct \<Gamma>) (simp_all add: eqvts)
+  shows "pi \<bullet>(ty_domain \<Gamma>)  = ty_domain  (pi\<bullet>\<Gamma>)"
+  and   "pi'\<bullet>(ty_domain \<Gamma>)  = ty_domain  (pi'\<bullet>\<Gamma>)"
+  and   "pi \<bullet>(trm_domain \<Gamma>) = trm_domain (pi\<bullet>\<Gamma>)"
+  and   "pi'\<bullet>(trm_domain \<Gamma>) = trm_domain (pi'\<bullet>\<Gamma>)"
+by (induct \<Gamma>) (simp_all add: eqvts)
+
+lemma finite_vrs:
+  shows "finite (tyvrs_of x)"
+  and   "finite (vrs_of x)"
+by (nominal_induct rule:binding.strong_induct, auto)
+ 
+lemma finite_domains:
+  shows "finite (ty_domain \<Gamma>)"
+  and   "finite (trm_domain \<Gamma>)"
+by (induct \<Gamma>, auto simp add: finite_vrs)
+
+lemma ty_domain_supp:
+  shows "(supp (ty_domain  \<Gamma>)) = (ty_domain  \<Gamma>)"
+  and   "(supp (trm_domain \<Gamma>)) = (trm_domain \<Gamma>)"
+by (simp only: at_fin_set_supp at_tyvrs_inst at_vrs_inst finite_domains)+
 
-lemma finite_domain:
-  shows "finite (domain \<Gamma>)"
+lemma ty_domain_inclusion:
+  assumes a: "(TVarB X T)\<in>set \<Gamma>" 
+  shows "X\<in>(ty_domain \<Gamma>)"
+using a by (induct \<Gamma>, auto)
+
+lemma ty_binding_existence:
+  assumes "X \<in> (tyvrs_of a)"
+  shows "\<exists>T.(TVarB X T=a)"
+  using assms
+by (nominal_induct a rule: binding.strong_induct, auto)
+
+lemma ty_domain_existence:
+  assumes a: "X\<in>(ty_domain \<Gamma>)" 
+  shows "\<exists>T.(TVarB X T)\<in>set \<Gamma>"
+  using a 
+  apply (induct \<Gamma>, auto) 
+  apply (subgoal_tac "\<exists>T.(TVarB X T=a)")
+  apply (auto)
+  apply (auto simp add: ty_binding_existence)
+done
+
+lemma domains_append:
+  shows "ty_domain (\<Gamma>@\<Delta>) = ((ty_domain \<Gamma>) \<union> (ty_domain \<Delta>))"
+  and   "trm_domain (\<Gamma>@\<Delta>) = ((trm_domain \<Gamma>) \<union> (trm_domain \<Delta>))"
   by (induct \<Gamma>, auto)
 
-lemma domain_supp:
-  shows "(supp (domain \<Gamma>)) = (domain \<Gamma>)"
-  by (simp only: at_fin_set_supp at_tyvrs_inst finite_domain)
-
-lemma domain_inclusion:
-  assumes a: "(X,T)\<in>set \<Gamma>" 
-  shows "X\<in>(domain \<Gamma>)"
-  using a by (induct \<Gamma>, auto)
+lemma ty_vrs_prm_simp:
+  fixes pi::"vrs prm"
+  and   S::"ty"
+  shows "pi\<bullet>S = S"
+by (induct S rule: ty.induct) (auto simp add: calc_atm)
 
-lemma domain_existence:
-  assumes a: "X\<in>(domain \<Gamma>)" 
-  shows "\<exists>T.(X,T)\<in>set \<Gamma>"
-  using a by (induct \<Gamma>, auto)
+lemma fresh_ty_domain_cons:
+  fixes X::"tyvrs"
+  shows "X\<sharp>(ty_domain (Y#\<Gamma>)) = (X\<sharp>(tyvrs_of Y) \<and> X\<sharp>(ty_domain \<Gamma>))"
+  apply (nominal_induct rule:binding.strong_induct)
+  apply (auto)
+  apply (simp add: fresh_def supp_def eqvts)
+  apply (simp add: fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst] finite_domains)
+  apply (simp add: fresh_def supp_def eqvts)
+  apply (simp add: fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst] finite_domains)+
+  done
 
-lemma domain_append:
-  shows "domain (\<Gamma>@\<Delta>) = ((domain \<Gamma>) \<union> (domain \<Delta>))"
-  by (induct \<Gamma>, auto)
-
-lemma fresh_domain_cons:
-  fixes X::"tyvrs"
-  shows "X\<sharp>(domain (Y#\<Gamma>)) = (X\<sharp>(fst Y) \<and> X\<sharp>(domain \<Gamma>))"
-  by (simp add: fresh_fin_insert pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst finite_domain)
+lemma tyvrs_fresh:
+  fixes   X::"tyvrs"
+  assumes "X \<sharp> a" 
+  shows   "X \<sharp> tyvrs_of a"
+  and     "X \<sharp> vrs_of a"
+  using assms
+  apply (nominal_induct a rule:binding.strong_induct)
+  apply (auto)
+  apply (fresh_guess)+
+done
 
 lemma fresh_domain:
   fixes X::"tyvrs"
   assumes a: "X\<sharp>\<Gamma>" 
-  shows "X\<sharp>(domain \<Gamma>)"
+  shows "X\<sharp>(ty_domain \<Gamma>)"
 using a
 apply(induct \<Gamma>)
 apply(simp add: fresh_set_empty) 
-apply(simp only: fresh_domain_cons)
-apply(auto simp add: fresh_prod fresh_list_cons) 
+apply(simp only: fresh_ty_domain_cons)
+apply(auto simp add: fresh_prod fresh_list_cons tyvrs_fresh) 
 done
 
-text {* Not all lists of type @{typ "ty_context"} are well-formed. One condition
-  requires that in @{term "(X,S)#\<Gamma>"} all free variables of @{term "S"} must be 
-  in the @{term "domain"} of @{term "\<Gamma>"}, that is @{term "S"} must be @{text "closed"} 
+text {* Not all lists of type @{typ "env"} are well-formed. One condition
+  requires that in @{term "TVarB X S#\<Gamma>"} all free variables of @{term "S"} must be 
+  in the @{term "ty_domain"} of @{term "\<Gamma>"}, that is @{term "S"} must be @{text "closed"} 
   in @{term "\<Gamma>"}. The set of free variables of @{term "S"} is the 
   @{text "support"} of @{term "S"}. *}
 
 constdefs
-  "closed_in" :: "ty \<Rightarrow> ty_context \<Rightarrow> bool" ("_ closed'_in _" [100,100] 100)
-  "S closed_in \<Gamma> \<equiv> (supp S)\<subseteq>(domain \<Gamma>)"
+  "closed_in" :: "ty \<Rightarrow> env \<Rightarrow> bool" ("_ closed'_in _" [100,100] 100)
+  "S closed_in \<Gamma> \<equiv> (supp S)\<subseteq>(ty_domain \<Gamma>)"
 
 lemma closed_in_eqvt[eqvt]:
   fixes pi::"tyvrs prm"
@@ -150,80 +237,148 @@
   then show "(pi\<bullet>S) closed_in (pi\<bullet>\<Gamma>)" by (simp add: closed_in_def eqvts)
 qed
 
-lemma ty_vrs_prm_simp:
+lemma tyvrs_vrs_prm_simp:
   fixes pi::"vrs prm"
-  and   S::"ty"
-  shows "pi\<bullet>S = S"
-by (induct S rule: ty.induct) (auto simp add: calc_atm)
+  shows "tyvrs_of (pi\<bullet>a) = tyvrs_of a"
+  apply (nominal_induct rule:binding.strong_induct) 
+  apply (simp_all add: eqvts)
+  apply (simp add: dj_perm_forget[OF dj_tyvrs_vrs])
+  done
 
-lemma ty_context_vrs_prm_simp:
+lemma ty_vrs_fresh[fresh]:
+  fixes x::"vrs"
+  and   T::"ty"
+  shows "x \<sharp> T"
+by (simp add: fresh_def supp_def ty_vrs_prm_simp)
+
+lemma ty_domain_vrs_prm_simp:
   fixes pi::"vrs prm"
-  and   \<Gamma>::"ty_context"
-  shows "pi\<bullet>\<Gamma> = \<Gamma>"
-by (induct \<Gamma>) 
-   (auto simp add: calc_atm ty_vrs_prm_simp)
+  and   \<Gamma>::"env"
+  shows "(ty_domain (pi\<bullet>\<Gamma>)) = (ty_domain \<Gamma>)"
+  apply(induct \<Gamma>) 
+  apply (simp add: eqvts)
+  apply(simp add:  tyvrs_vrs_prm_simp)
+done
 
 lemma closed_in_eqvt'[eqvt]:
   fixes pi::"vrs prm"
   assumes a: "S closed_in \<Gamma>" 
   shows "(pi\<bullet>S) closed_in (pi\<bullet>\<Gamma>)"
 using a
-by (simp add: ty_vrs_prm_simp ty_context_vrs_prm_simp)
+by (simp add: closed_in_def ty_domain_vrs_prm_simp  ty_vrs_prm_simp)
+
+lemma fresh_vrs_of: 
+  fixes x::"vrs"
+  shows "x\<sharp>vrs_of b = x\<sharp>b"
+  by (nominal_induct b rule: binding.strong_induct)
+    (simp_all add: fresh_singleton [OF pt_vrs_inst at_vrs_inst] fresh_set_empty ty_vrs_fresh fresh_atm)
+
+lemma fresh_trm_domain: 
+  fixes x::"vrs"
+  shows "x\<sharp> trm_domain \<Gamma> = x\<sharp>\<Gamma>"
+  by (induct \<Gamma>)
+    (simp_all add: fresh_set_empty fresh_list_cons
+     fresh_fin_union [OF pt_vrs_inst at_vrs_inst fs_vrs_inst]
+     finite_domains finite_vrs fresh_vrs_of fresh_list_nil)
+
+lemma closed_in_fresh: "(X::tyvrs) \<sharp> ty_domain \<Gamma> \<Longrightarrow> T closed_in \<Gamma> \<Longrightarrow> X \<sharp> T"
+  by (auto simp add: closed_in_def fresh_def ty_domain_supp)
 
 text {* Now validity of a context is a straightforward inductive definition. *}
   
-inductive 
-  valid_rel :: "ty_context \<Rightarrow> bool" ("\<turnstile> _ ok" [100] 100)
+inductive
+  valid_rel :: "env \<Rightarrow> bool" ("\<turnstile> _ ok" [100] 100)
 where
-  valid_nil[simp]:  "\<turnstile> [] ok"
-| valid_cons[simp]: "\<lbrakk>\<turnstile> \<Gamma> ok; X\<sharp>(domain \<Gamma>); T closed_in \<Gamma>\<rbrakk>  \<Longrightarrow>  \<turnstile> ((X,T)#\<Gamma>) ok"
+  valid_nil[simp]:   "\<turnstile> [] ok"
+| valid_consT[simp]: "\<lbrakk>\<turnstile> \<Gamma> ok; X\<sharp>(ty_domain  \<Gamma>); T closed_in \<Gamma>\<rbrakk>  \<Longrightarrow>  \<turnstile> (TVarB X T#\<Gamma>) ok"
+| valid_cons [simp]: "\<lbrakk>\<turnstile> \<Gamma> ok; x\<sharp>(trm_domain \<Gamma>); T closed_in \<Gamma>\<rbrakk>  \<Longrightarrow>  \<turnstile> (VarB  x T#\<Gamma>) ok"
 
 equivariance valid_rel
 
-lemma validE:
-  assumes a: "\<turnstile> ((X,T)#\<Gamma>) ok"
-  shows "\<turnstile> \<Gamma> ok \<and> X\<sharp>(domain \<Gamma>) \<and> T closed_in \<Gamma>"
-using a by (cases, auto)
+declare binding.inject [simp add]
+declare trm.inject     [simp add]
+
+inductive_cases validE[elim]: "\<turnstile> (TVarB X T#\<Gamma>) ok" "\<turnstile> (VarB  x T#\<Gamma>) ok" "\<turnstile> (b#\<Gamma>) ok" 
+
+declare binding.inject [simp del]
+declare trm.inject     [simp del]
 
 lemma validE_append:
   assumes a: "\<turnstile> (\<Delta>@\<Gamma>) ok" 
   shows "\<turnstile> \<Gamma> ok"
-  using a by (induct \<Delta>, auto dest: validE)
+  using a 
+proof (induct \<Delta>)
+  case (Cons a \<Gamma>')
+  then show ?case 
+    by (nominal_induct a rule:binding.strong_induct)
+       (auto elim: validE)
+qed (auto)
 
 lemma replace_type:
-  assumes a: "\<turnstile> (\<Delta>@(X,T)#\<Gamma>) ok"
+  assumes a: "\<turnstile> (\<Delta>@(TVarB X T)#\<Gamma>) ok"
   and     b: "S closed_in \<Gamma>"
-  shows "\<turnstile> (\<Delta>@(X,S)#\<Gamma>) ok"
+  shows "\<turnstile> (\<Delta>@(TVarB X S)#\<Gamma>) ok"
 using a b
-apply(induct \<Delta>)
-apply(auto dest!: validE intro!: valid_cons simp add: domain_append closed_in_def)
-done
+proof(induct \<Delta>)
+  case Nil
+  then show ?case by (auto elim: validE intro: valid_cons simp add: domains_append closed_in_def)
+next
+  case (Cons a \<Gamma>')
+  then show ?case 
+    by (nominal_induct a rule:binding.strong_induct)
+       (auto elim: validE intro!: valid_cons simp add: domains_append closed_in_def)
+qed
 
 text {* Well-formed contexts have a unique type-binding for a type-variable. *} 
 
 lemma uniqueness_of_ctxt:
-  fixes \<Gamma>::"ty_context"
+  fixes \<Gamma>::"env"
   assumes a: "\<turnstile> \<Gamma> ok"
-  and     b: "(X,T)\<in>set \<Gamma>"
-  and     c: "(X,S)\<in>set \<Gamma>"
+  and     b: "(TVarB X T)\<in>set \<Gamma>"
+  and     c: "(TVarB X S)\<in>set \<Gamma>"
   shows "T=S"
 using a b c
 proof (induct)
-  case valid_nil thus "T=S" by simp
-next
-  case valid_cons
+  case (valid_consT \<Gamma> X' T')
   moreover
-  { fix \<Gamma>::"ty_context"
-    assume a: "X\<sharp>(domain \<Gamma>)" 
-    have "\<not>(\<exists>T.(X,T)\<in>(set \<Gamma>))" using a 
-    proof (induct \<Gamma>)
-      case (Cons Y \<Gamma>)
-      thus "\<not> (\<exists>T.(X,T)\<in>set(Y#\<Gamma>))" 
-	by (simp only: fresh_domain_cons, auto simp add: fresh_atm)
+  { fix \<Gamma>'::"env"
+    assume a: "X'\<sharp>(ty_domain \<Gamma>')" 
+    have "\<not>(\<exists>T.(TVarB X' T)\<in>(set \<Gamma>'))" using a 
+    proof (induct \<Gamma>')
+      case (Cons Y \<Gamma>')
+      thus "\<not> (\<exists>T.(TVarB X' T)\<in>set(Y#\<Gamma>'))"
+	by (simp add:  fresh_ty_domain_cons 
+                       fresh_fin_union[OF pt_tyvrs_inst  at_tyvrs_inst fs_tyvrs_inst]  
+                       finite_vrs finite_domains, 
+            auto simp add: fresh_atm fresh_singleton [OF pt_tyvrs_inst at_tyvrs_inst])
     qed (simp)
   }
-  ultimately show "T=S" by auto
-qed 
+  ultimately show "T=S" by (auto simp add: binding.inject)
+qed (auto)
+
+lemma uniqueness_of_ctxt':
+  fixes \<Gamma>::"env"
+  assumes a: "\<turnstile> \<Gamma> ok"
+  and     b: "(VarB x T)\<in>set \<Gamma>"
+  and     c: "(VarB x S)\<in>set \<Gamma>"
+  shows "T=S"
+using a b c
+proof (induct)
+  case (valid_cons \<Gamma> x' T')
+  moreover
+  { fix \<Gamma>'::"env"
+    assume a: "x'\<sharp>(trm_domain \<Gamma>')" 
+    have "\<not>(\<exists>T.(VarB x' T)\<in>(set \<Gamma>'))" using a 
+    proof (induct \<Gamma>')
+      case (Cons y \<Gamma>')
+      thus "\<not> (\<exists>T.(VarB x' T)\<in>set(y#\<Gamma>'))" 
+	by (simp add:  fresh_fin_union[OF pt_vrs_inst  at_vrs_inst fs_vrs_inst]  
+                       finite_vrs finite_domains, 
+            auto simp add: fresh_atm fresh_singleton [OF pt_vrs_inst at_vrs_inst])
+    qed (simp)
+  }
+  ultimately show "T=S" by (auto simp add: binding.inject)
+qed (auto)
 
 section {* Size and Capture-Avoiding Substitution for Types *}
 
@@ -233,7 +388,7 @@
   "size_ty (Tvar X) = 1"
 | "size_ty (Top) = 1"
 | "size_ty (T1 \<rightarrow> T2) = (size_ty T1) + (size_ty T2) + 1"
-| "X\<sharp>T1 \<Longrightarrow> size_ty (\<forall>[X<:T1].T2) = (size_ty T1) + (size_ty T2) + 1"
+| "X \<sharp> T1 \<Longrightarrow> size_ty (\<forall>X<:T1. T2) = (size_ty T1) + (size_ty T2) + 1"
   apply (finite_guess)+
   apply (rule TrueI)+
   apply (simp add: fresh_nat)
@@ -241,24 +396,195 @@
   done
 
 nominal_primrec
-  subst_ty :: "ty \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> ty" ("_[_:=_]\<^isub>t\<^isub>y" [100,100,100] 100)
+  subst_ty :: "ty \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> ty" ("_[_ \<mapsto> _]\<^sub>\<tau>" [300, 0, 0] 300)
 where
-  "(Tvar X)[Y:=T]\<^isub>t\<^isub>y= (if X=Y then T else (Tvar X))"
-| "(Top)[Y:=T]\<^isub>t\<^isub>y = Top"
-| "(T\<^isub>1 \<rightarrow> T\<^isub>2)[Y:=T]\<^isub>t\<^isub>y = (T\<^isub>1[Y:=T]\<^isub>t\<^isub>y) \<rightarrow> (T\<^isub>2[Y:=T]\<^isub>t\<^isub>y)"
-| "\<lbrakk>X\<sharp>(Y,T); X\<sharp>T\<^isub>1\<rbrakk> \<Longrightarrow> (\<forall>[X<:T\<^isub>1].T\<^isub>2)[Y:=T]\<^isub>t\<^isub>y = (\<forall>[X<:(T\<^isub>1[Y:=T]\<^isub>t\<^isub>y)].(T\<^isub>2[Y:=T]\<^isub>t\<^isub>y))"
+  "(Tvar X)[Y \<mapsto> T]\<^sub>\<tau> = (if X=Y then T else Tvar X)"
+| "(Top)[Y \<mapsto> T]\<^sub>\<tau> = Top"
+| "(T\<^isub>1 \<rightarrow> T\<^isub>2)[Y \<mapsto> T]\<^sub>\<tau> = T\<^isub>1[Y \<mapsto> T]\<^sub>\<tau> \<rightarrow> T\<^isub>2[Y \<mapsto> T]\<^sub>\<tau>"
+| "\<lbrakk>X\<sharp>(Y,T); X\<sharp>T\<^isub>1\<rbrakk> \<Longrightarrow> (\<forall>X<:T\<^isub>1. T\<^isub>2)[Y \<mapsto> T]\<^sub>\<tau> = (\<forall>X<:T\<^isub>1[Y \<mapsto> T]\<^sub>\<tau>. T\<^isub>2[Y \<mapsto> T]\<^sub>\<tau>)"
   apply (finite_guess)+
   apply (rule TrueI)+
   apply (simp add: abs_fresh)
   apply (fresh_guess)+
   done
 
+lemma subst_eqvt[eqvt]:
+  fixes pi::"tyvrs prm" 
+  and   T::"ty"
+  shows "pi\<bullet>(T[X \<mapsto> T']\<^sub>\<tau>) = (pi\<bullet>T)[(pi\<bullet>X) \<mapsto> (pi\<bullet>T')]\<^sub>\<tau>"
+  by (nominal_induct T avoiding: X T' rule: ty.strong_induct)
+     (perm_simp add: fresh_bij)+
+
+lemma subst_eqvt'[eqvt]:
+  fixes pi::"vrs prm" 
+  and   T::"ty"
+  shows "pi\<bullet>(T[X \<mapsto> T']\<^sub>\<tau>) = (pi\<bullet>T)[(pi\<bullet>X) \<mapsto> (pi\<bullet>T')]\<^sub>\<tau>"
+  by (nominal_induct T avoiding: X T' rule: ty.strong_induct)
+     (perm_simp add: fresh_left)+
+
+lemma type_subst_fresh[fresh]:
+  fixes X::"tyvrs"
+  assumes "X \<sharp> T" and "X \<sharp> P"
+  shows   "X \<sharp> T[Y \<mapsto> P]\<^sub>\<tau>"
+using assms
+by (nominal_induct T avoiding: X Y P rule:ty.strong_induct)
+   (auto simp add: abs_fresh)
+
+lemma fresh_type_subst_fresh[fresh]:
+    assumes "X\<sharp>T'"
+    shows "X\<sharp>T[X \<mapsto> T']\<^sub>\<tau>"
+using assms 
+by (nominal_induct T avoiding: X T' rule: ty.strong_induct)
+   (auto simp add: fresh_atm abs_fresh fresh_nat) 
+
+lemma type_subst_identity: "X \<sharp> T \<Longrightarrow> T[X \<mapsto> U]\<^sub>\<tau> = T"
+  by (nominal_induct T avoiding: X U rule: ty.strong_induct)
+    (simp_all add: fresh_atm abs_fresh)
+
+lemma type_substitution_lemma:  
+  "X \<noteq> Y \<Longrightarrow> X \<sharp> L \<Longrightarrow> M[X \<mapsto> N]\<^sub>\<tau>[Y \<mapsto> L]\<^sub>\<tau> = M[Y \<mapsto> L]\<^sub>\<tau>[X \<mapsto> N[Y \<mapsto> L]\<^sub>\<tau>]\<^sub>\<tau>"
+  by (nominal_induct M avoiding: X Y N L rule: ty.strong_induct)
+    (auto simp add: type_subst_fresh type_subst_identity)
+
+lemma type_subst_rename:
+  "Y \<sharp> T \<Longrightarrow> ([(Y, X)] \<bullet> T)[Y \<mapsto> U]\<^sub>\<tau> = T[X \<mapsto> U]\<^sub>\<tau>"
+  by (nominal_induct T avoiding: X Y U rule: ty.strong_induct)
+    (simp_all add: fresh_atm calc_atm abs_fresh fresh_aux)
+
+nominal_primrec
+  subst_tyb :: "binding \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> binding" ("_[_ \<mapsto> _]\<^sub>b" [100,100,100] 100)
+where
+  "(TVarB X U)[Y \<mapsto> T]\<^sub>b = TVarB X (U[Y \<mapsto> T]\<^sub>\<tau>)"
+| "(VarB  X U)[Y \<mapsto> T]\<^sub>b =  VarB X (U[Y \<mapsto> T]\<^sub>\<tau>)"
+by auto
+
+lemma binding_subst_fresh[fresh]:
+  fixes X::"tyvrs"
+  assumes "X \<sharp> a"
+  and     "X \<sharp> P"
+  shows "X \<sharp> a[Y \<mapsto> P]\<^sub>b"
+using assms
+by (nominal_induct a rule:binding.strong_induct)
+   (auto simp add: freshs)
+
+lemma binding_subst_identity: "X \<sharp> B \<Longrightarrow> B[X \<mapsto> U]\<^sub>b = B"
+  by (induct B rule: binding.induct)
+    (simp_all add: fresh_atm type_subst_identity)
+
 consts 
-  subst_tyc :: "ty_context \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> ty_context" ("_[_:=_]\<^isub>t\<^isub>y\<^isub>c" [100,100,100] 100)
+  subst_tyc :: "env \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> env" ("_[_ \<mapsto> _]\<^sub>e" [100,100,100] 100)
+
 primrec
-"([])[Y:=T]\<^isub>t\<^isub>y\<^isub>c= []"
-"(XT#\<Gamma>)[Y:=T]\<^isub>t\<^isub>y\<^isub>c = (fst XT,(snd XT)[Y:=T]\<^isub>t\<^isub>y)#(\<Gamma>[Y:=T]\<^isub>t\<^isub>y\<^isub>c)"
- 
+"([])[Y \<mapsto> T]\<^sub>e= []"
+"(B#\<Gamma>)[Y \<mapsto> T]\<^sub>e = (B[Y \<mapsto> T]\<^sub>b)#(\<Gamma>[Y \<mapsto> T]\<^sub>e)"
+
+lemma ctxt_subst_fresh'[fresh]:
+  fixes X::"tyvrs"
+  assumes "X \<sharp> \<Gamma>"
+  and     "X \<sharp> P"
+  shows   "X \<sharp> \<Gamma>[Y \<mapsto> P]\<^sub>e"
+using assms
+by (induct \<Gamma>)
+   (auto simp add: fresh_list_cons freshs)
+
+lemma ctxt_subst_mem_TVarB: "TVarB X T \<in> set \<Gamma> \<Longrightarrow> TVarB X (T[Y \<mapsto> U]\<^sub>\<tau>) \<in> set (\<Gamma>[Y \<mapsto> U]\<^sub>e)"
+  by (induct \<Gamma>) auto
+
+lemma ctxt_subst_mem_VarB: "VarB x T \<in> set \<Gamma> \<Longrightarrow> VarB x (T[Y \<mapsto> U]\<^sub>\<tau>) \<in> set (\<Gamma>[Y \<mapsto> U]\<^sub>e)"
+  by (induct \<Gamma>) auto
+
+lemma ctxt_subst_identity: "X \<sharp> \<Gamma> \<Longrightarrow> \<Gamma>[X \<mapsto> U]\<^sub>e = \<Gamma>"
+  by (induct \<Gamma>) (simp_all add: fresh_list_cons binding_subst_identity)
+
+lemma ctxt_subst_append: "(\<Delta> @ \<Gamma>)[X \<mapsto> T]\<^sub>e = \<Delta>[X \<mapsto> T]\<^sub>e @ \<Gamma>[X \<mapsto> T]\<^sub>e"
+  by (induct \<Delta>) simp_all
+
+nominal_primrec
+   subst_trm :: "trm \<Rightarrow> vrs \<Rightarrow> trm \<Rightarrow> trm"  ("_[_ \<mapsto> _]" [300, 0, 0] 300)
+where
+  "(Var x)[y \<mapsto> t'] = (if x=y then t' else (Var x))"
+| "(t1 \<cdot> t2)[y \<mapsto> t'] = t1[y \<mapsto> t'] \<cdot> t2[y \<mapsto> t']"
+| "(t \<cdot>\<^sub>\<tau> T)[y \<mapsto> t'] = t[y \<mapsto> t'] \<cdot>\<^sub>\<tau> T"
+| "X\<sharp>(T,t') \<Longrightarrow> (\<lambda>X<:T. t)[y \<mapsto> t'] = (\<lambda>X<:T. t[y \<mapsto> t'])" 
+| "x\<sharp>(y,t') \<Longrightarrow> (\<lambda>x:T. t)[y \<mapsto> t'] = (\<lambda>x:T. t[y \<mapsto> t'])"
+apply(finite_guess)+
+apply(rule TrueI)+
+apply(simp add: abs_fresh)+
+apply(fresh_guess add: ty_vrs_fresh abs_fresh)+
+done
+
+lemma subst_trm_fresh_tyvar:
+  "(X::tyvrs) \<sharp> t \<Longrightarrow> X \<sharp> u \<Longrightarrow> X \<sharp> t[x \<mapsto> u]"
+  by (nominal_induct t avoiding: x u rule: trm.strong_induct)
+    (auto simp add: trm.fresh abs_fresh)
+
+lemma subst_trm_fresh_var: "x \<sharp> u \<Longrightarrow> x \<sharp> t[x \<mapsto> u]"
+  by (nominal_induct t avoiding: x u rule: trm.strong_induct)
+    (simp_all add: abs_fresh fresh_atm ty_vrs_fresh)
+
+lemma subst_trm_eqvt[eqvt]:
+  fixes pi::"tyvrs prm" 
+  and   t::"trm"
+  shows "pi\<bullet>(t[x \<mapsto> u]) = (pi\<bullet>t)[(pi\<bullet>x) \<mapsto> (pi\<bullet>u)]"
+  by (nominal_induct t avoiding: x u rule: trm.strong_induct)
+     (perm_simp add: fresh_left)+
+
+lemma subst_trm_eqvt'[eqvt]:
+  fixes pi::"vrs prm" 
+  and   t::"trm"
+  shows "pi\<bullet>(t[x \<mapsto> u]) = (pi\<bullet>t)[(pi\<bullet>x) \<mapsto> (pi\<bullet>u)]"
+  by (nominal_induct t avoiding: x u rule: trm.strong_induct)
+     (perm_simp add: fresh_left)+
+
+lemma subst_trm_rename:
+  "y \<sharp> t \<Longrightarrow> ([(y, x)] \<bullet> t)[y \<mapsto> u] = t[x \<mapsto> u]"
+  by (nominal_induct t avoiding: x y u rule: trm.strong_induct)
+    (simp_all add: fresh_atm calc_atm abs_fresh fresh_aux ty_vrs_fresh perm_fresh_fresh)
+
+nominal_primrec (freshness_context: "T2::ty")
+  subst_trm_ty :: "trm \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> trm"  ("_[_ \<mapsto>\<^sub>\<tau> _]" [300, 0, 0] 300)
+where
+  "(Var x)[Y \<mapsto>\<^sub>\<tau> T2] = Var x"
+| "(t1 \<cdot> t2)[Y \<mapsto>\<^sub>\<tau> T2] = t1[Y \<mapsto>\<^sub>\<tau> T2] \<cdot> t2[Y \<mapsto>\<^sub>\<tau> T2]"
+| "(t1 \<cdot>\<^sub>\<tau> T)[Y \<mapsto>\<^sub>\<tau> T2] = t1[Y \<mapsto>\<^sub>\<tau> T2] \<cdot>\<^sub>\<tau> T[Y \<mapsto> T2]\<^sub>\<tau>"
+| "X\<sharp>(Y,T,T2) \<Longrightarrow> (\<lambda>X<:T. t)[Y \<mapsto>\<^sub>\<tau> T2] = (\<lambda>X<:T[Y \<mapsto> T2]\<^sub>\<tau>. t[Y \<mapsto>\<^sub>\<tau> T2])" 
+| "(\<lambda>x:T. t)[Y \<mapsto>\<^sub>\<tau> T2] = (\<lambda>x:T[Y \<mapsto> T2]\<^sub>\<tau>. t[Y \<mapsto>\<^sub>\<tau> T2])"
+apply(finite_guess)+
+apply(rule TrueI)+
+apply(simp add: abs_fresh ty_vrs_fresh)+
+apply(simp add: type_subst_fresh)
+apply(fresh_guess add: ty_vrs_fresh abs_fresh)+
+done
+
+lemma subst_trm_ty_fresh:
+  "(X::tyvrs) \<sharp> t \<Longrightarrow> X \<sharp> T \<Longrightarrow> X \<sharp> t[Y \<mapsto>\<^sub>\<tau> T]"
+  by (nominal_induct t avoiding: Y T rule: trm.strong_induct)
+    (auto simp add: abs_fresh type_subst_fresh)
+
+lemma subst_trm_ty_fresh':
+  "X \<sharp> T \<Longrightarrow> X \<sharp> t[X \<mapsto>\<^sub>\<tau> T]"
+  by (nominal_induct t avoiding: X T rule: trm.strong_induct)
+    (simp_all add: abs_fresh fresh_type_subst_fresh fresh_atm)
+
+lemma subst_trm_ty_eqvt[eqvt]:
+  fixes pi::"tyvrs prm" 
+  and   t::"trm"
+  shows "pi\<bullet>(t[X \<mapsto>\<^sub>\<tau> T]) = (pi\<bullet>t)[(pi\<bullet>X) \<mapsto>\<^sub>\<tau> (pi\<bullet>T)]"
+  by (nominal_induct t avoiding: X T rule: trm.strong_induct)
+     (perm_simp add: fresh_bij subst_eqvt)+
+
+lemma subst_trm_ty_eqvt'[eqvt]:
+  fixes pi::"vrs prm" 
+  and   t::"trm"
+  shows "pi\<bullet>(t[X \<mapsto>\<^sub>\<tau> T]) = (pi\<bullet>t)[(pi\<bullet>X) \<mapsto>\<^sub>\<tau> (pi\<bullet>T)]"
+  by (nominal_induct t avoiding: X T rule: trm.strong_induct)
+     (perm_simp add: fresh_left subst_eqvt')+
+
+lemma subst_trm_ty_rename:
+  "Y \<sharp> t \<Longrightarrow> ([(Y, X)] \<bullet> t)[Y \<mapsto>\<^sub>\<tau> U] = t[X \<mapsto>\<^sub>\<tau> U]"
+  by (nominal_induct t avoiding: X Y U rule: trm.strong_induct)
+    (simp_all add: fresh_atm calc_atm abs_fresh fresh_aux type_subst_rename)
+
 section {* Subtyping-Relation *}
 
 text {* The definition for the subtyping-relation follows quite closely what is written 
@@ -269,13 +595,13 @@
   $\alpha$-equivalence classes.) *}
 
 inductive 
-  subtype_of :: "ty_context \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool"   ("_\<turnstile>_<:_" [100,100,100] 100)
+  subtype_of :: "env \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool"   ("_\<turnstile>_<:_" [100,100,100] 100)
 where
-  S_Top[intro]:    "\<lbrakk>\<turnstile> \<Gamma> ok; S closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> S <: Top"
-| S_Var[intro]:    "\<lbrakk>(X,S) \<in> set \<Gamma>; \<Gamma> \<turnstile> S <: T\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (Tvar X) <: T"
-| S_Refl[intro]:   "\<lbrakk>\<turnstile> \<Gamma> ok; X \<in> domain \<Gamma>\<rbrakk>\<Longrightarrow> \<Gamma> \<turnstile> Tvar X <: Tvar X"
-| S_Arrow[intro]:  "\<lbrakk>\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1; \<Gamma> \<turnstile> S\<^isub>2 <: T\<^isub>2\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (S\<^isub>1 \<rightarrow> S\<^isub>2) <: (T\<^isub>1 \<rightarrow> T\<^isub>2)" 
-| S_Forall[intro]: "\<lbrakk>\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1; X\<sharp>\<Gamma>; ((X,T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: \<forall>[X<:T\<^isub>1].T\<^isub>2"
+  SA_Top[intro]:    "\<lbrakk>\<turnstile> \<Gamma> ok; S closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> S <: Top"
+| SA_refl_TVar[intro]:   "\<lbrakk>\<turnstile> \<Gamma> ok; X \<in> ty_domain \<Gamma>\<rbrakk>\<Longrightarrow> \<Gamma> \<turnstile> Tvar X <: Tvar X"
+| SA_trans_TVar[intro]:    "\<lbrakk>(TVarB X S) \<in> set \<Gamma>; \<Gamma> \<turnstile> S <: T\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (Tvar X) <: T"
+| SA_arrow[intro]:  "\<lbrakk>\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1; \<Gamma> \<turnstile> S\<^isub>2 <: T\<^isub>2\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (S\<^isub>1 \<rightarrow> S\<^isub>2) <: (T\<^isub>1 \<rightarrow> T\<^isub>2)" 
+| SA_all[intro]: "\<lbrakk>\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1; ((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: (\<forall>X<:T\<^isub>1. T\<^isub>2)"
 
 lemma subtype_implies_ok:
   fixes X::"tyvrs"
@@ -288,15 +614,15 @@
   shows "S closed_in \<Gamma> \<and> T closed_in \<Gamma>"
 using a
 proof (induct)
-  case (S_Top \<Gamma> S)
+  case (SA_Top \<Gamma> S)
   have "Top closed_in \<Gamma>" by (simp add: closed_in_def ty.supp)
   moreover
   have "S closed_in \<Gamma>" by fact
   ultimately show "S closed_in \<Gamma> \<and> Top closed_in \<Gamma>" by simp
 next
-  case (S_Var X S \<Gamma> T)
-  have "(X,S)\<in>set \<Gamma>" by fact
-  hence "X \<in> domain \<Gamma>" by (rule domain_inclusion)
+  case (SA_trans_TVar X S \<Gamma> T)
+  have "(TVarB X S)\<in>set \<Gamma>" by fact
+  hence "X \<in> ty_domain \<Gamma>" by (rule ty_domain_inclusion)
   hence "(Tvar X) closed_in \<Gamma>" by (simp add: closed_in_def ty.supp supp_atm)
   moreover
   have "S closed_in \<Gamma> \<and> T closed_in \<Gamma>" by fact
@@ -311,20 +637,33 @@
   shows "X\<sharp>S \<and> X\<sharp>T"  
 proof -
   from a1 have "\<turnstile> \<Gamma> ok" by (rule subtype_implies_ok)
-  with a2 have "X\<sharp>domain(\<Gamma>)" by (simp add: fresh_domain)
+  with a2 have "X\<sharp>ty_domain(\<Gamma>)" by (simp add: fresh_domain)
   moreover
   from a1 have "S closed_in \<Gamma> \<and> T closed_in \<Gamma>" by (rule subtype_implies_closed)
-  hence "supp S \<subseteq> ((supp (domain \<Gamma>))::tyvrs set)" 
-    and "supp T \<subseteq> ((supp (domain \<Gamma>))::tyvrs set)" by (simp_all add: domain_supp closed_in_def)
+  hence "supp S \<subseteq> ((supp (ty_domain \<Gamma>))::tyvrs set)" 
+    and "supp T \<subseteq> ((supp (ty_domain \<Gamma>))::tyvrs set)" by (simp_all add: ty_domain_supp closed_in_def)
   ultimately show "X\<sharp>S \<and> X\<sharp>T" by (force simp add: supp_prod fresh_def)
 qed
 
+lemma valid_ty_domain_fresh:
+  fixes X::"tyvrs"
+  assumes valid: "\<turnstile> \<Gamma> ok"
+  shows "X\<sharp>(ty_domain \<Gamma>) = X\<sharp>\<Gamma>" 
+  using valid
+  apply induct
+  apply (simp add: fresh_list_nil fresh_set_empty)
+  apply (simp_all add: binding.fresh fresh_list_cons
+     fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst] finite_domains fresh_atm)
+  apply (auto simp add: closed_in_fresh)
+  done
+
 equivariance subtype_of
 
-nominal_inductive subtype_of  
-  by (simp_all add: abs_fresh subtype_implies_fresh)
-
-thm subtype_of.strong_induct
+nominal_inductive subtype_of
+  apply (simp_all add: abs_fresh)
+  apply (fastsimp simp add: valid_ty_domain_fresh dest: subtype_implies_ok)
+  apply (force simp add: closed_in_fresh dest: subtype_implies_closed subtype_implies_ok)+
+  done
 
 section {* Reflexivity of Subtyping *}
 
@@ -338,17 +677,17 @@
   have ih_T\<^isub>1: "\<And>\<Gamma>. \<lbrakk>\<turnstile> \<Gamma> ok; T\<^isub>1 closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> T\<^isub>1 <: T\<^isub>1" by fact 
   have ih_T\<^isub>2: "\<And>\<Gamma>. \<lbrakk>\<turnstile> \<Gamma> ok; T\<^isub>2 closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> T\<^isub>2 <: T\<^isub>2" by fact
   have fresh_cond: "X\<sharp>\<Gamma>" by fact
-  hence fresh_domain: "X\<sharp>(domain \<Gamma>)" by (simp add: fresh_domain)
-  have "(\<forall>[X<:T\<^isub>2].T\<^isub>1) closed_in \<Gamma>" by fact
-  hence closed\<^isub>T\<^isub>2: "T\<^isub>2 closed_in \<Gamma>" and closed\<^isub>T\<^isub>1: "T\<^isub>1 closed_in ((X,T\<^isub>2)#\<Gamma>)" 
+  hence fresh_ty_domain: "X\<sharp>(ty_domain \<Gamma>)" by (simp add: fresh_domain)
+  have "(\<forall>X<:T\<^isub>2. T\<^isub>1) closed_in \<Gamma>" by fact
+  hence closed\<^isub>T\<^isub>2: "T\<^isub>2 closed_in \<Gamma>" and closed\<^isub>T\<^isub>1: "T\<^isub>1 closed_in ((TVarB  X T\<^isub>2)#\<Gamma>)" 
     by (auto simp add: closed_in_def ty.supp abs_supp)
   have ok: "\<turnstile> \<Gamma> ok" by fact  
-  hence ok': "\<turnstile> ((X,T\<^isub>2)#\<Gamma>) ok" using closed\<^isub>T\<^isub>2 fresh_domain by simp
+  hence ok': "\<turnstile> ((TVarB X T\<^isub>2)#\<Gamma>) ok" using closed\<^isub>T\<^isub>2 fresh_ty_domain by simp
   have "\<Gamma> \<turnstile> T\<^isub>2 <: T\<^isub>2" using ih_T\<^isub>2 closed\<^isub>T\<^isub>2 ok by simp
   moreover
-  have "((X,T\<^isub>2)#\<Gamma>) \<turnstile> T\<^isub>1 <: T\<^isub>1" using ih_T\<^isub>1 closed\<^isub>T\<^isub>1 ok' by simp
-  ultimately show "\<Gamma> \<turnstile> \<forall>[X<:T\<^isub>2].T\<^isub>1 <: \<forall>[X<:T\<^isub>2].T\<^isub>1" using fresh_cond 
-    by (simp add: subtype_of.S_Forall)
+  have "((TVarB X T\<^isub>2)#\<Gamma>) \<turnstile> T\<^isub>1 <: T\<^isub>1" using ih_T\<^isub>1 closed\<^isub>T\<^isub>1 ok' by simp
+  ultimately show "\<Gamma> \<turnstile> (\<forall>X<:T\<^isub>2. T\<^isub>1) <: (\<forall>X<:T\<^isub>2. T\<^isub>1)" using fresh_cond 
+    by (simp add: subtype_of.SA_all)
 qed (auto simp add: closed_in_def ty.supp supp_atm)
 
 lemma subtype_reflexivity_semiautomated:
@@ -361,11 +700,10 @@
   --{* Too bad that this instantiation cannot be found automatically by
   \isakeyword{auto}; \isakeyword{blast} would find it if we had not used 
   an explicit definition for @{text "closed_in_def"}. *}
-apply(drule_tac x="(tyvrs, ty2)#\<Gamma>" in meta_spec)
+apply(drule_tac x="(TVarB tyvrs ty2)#\<Gamma>" in meta_spec)
 apply(force dest: fresh_domain simp add: closed_in_def)
 done
 
-
 section {* Weakening *}
 
 text {* In order to prove weakening we introduce the notion of a type-context extending 
@@ -373,16 +711,16 @@
   smoother than if we had strictly adhered to the version in the POPLmark-paper. *}
 
 constdefs 
-  extends :: "ty_context \<Rightarrow> ty_context \<Rightarrow> bool" ("_ extends _" [100,100] 100)
-  "\<Delta> extends \<Gamma> \<equiv> \<forall>X Q. (X,Q)\<in>set \<Gamma> \<longrightarrow> (X,Q)\<in>set \<Delta>"
+  extends :: "env \<Rightarrow> env \<Rightarrow> bool" ("_ extends _" [100,100] 100)
+  "\<Delta> extends \<Gamma> \<equiv> \<forall>X Q. (TVarB X Q)\<in>set \<Gamma> \<longrightarrow> (TVarB X Q)\<in>set \<Delta>"
 
-lemma extends_domain:
+lemma extends_ty_domain:
   assumes a: "\<Delta> extends \<Gamma>"
-  shows "domain \<Gamma> \<subseteq> domain \<Delta>"
+  shows "ty_domain \<Gamma> \<subseteq> ty_domain \<Delta>"
   using a 
   apply (auto simp add: extends_def)
-  apply (drule domain_existence)
-  apply (force simp add: domain_inclusion)
+  apply (drule ty_domain_existence)
+  apply (force simp add: ty_domain_inclusion)
   done
 
 lemma extends_closed:
@@ -390,12 +728,12 @@
   and     a2: "\<Delta> extends \<Gamma>"
   shows "T closed_in \<Delta>"
   using a1 a2
-  by (auto dest: extends_domain simp add: closed_in_def)
+  by (auto dest: extends_ty_domain simp add: closed_in_def)
 
 lemma extends_memb:
   assumes a: "\<Delta> extends \<Gamma>"
-  and b: "(X,T) \<in> set \<Gamma>"
-  shows "(X,T) \<in> set \<Delta>"
+  and b: "(TVarB X T) \<in> set \<Gamma>"
+  shows "(TVarB X T) \<in> set \<Delta>"
   using a b by (simp add: extends_def)
 
 lemma weakening:
@@ -405,7 +743,7 @@
   shows "\<Delta> \<turnstile> S <: T"
   using a b c 
 proof (nominal_induct \<Gamma> S T avoiding: \<Delta> rule: subtype_of.strong_induct)
-  case (S_Top \<Gamma> S) 
+  case (SA_Top \<Gamma> S) 
   have lh_drv_prem: "S closed_in \<Gamma>" by fact
   have "\<turnstile> \<Delta> ok" by fact
   moreover
@@ -413,43 +751,43 @@
   hence "S closed_in \<Delta>" using lh_drv_prem by (simp only: extends_closed)
   ultimately show "\<Delta> \<turnstile> S <: Top" by force
 next 
-  case (S_Var X S \<Gamma> T)
-  have lh_drv_prem: "(X,S) \<in> set \<Gamma>" by fact
+  case (SA_trans_TVar X S \<Gamma> T)
+  have lh_drv_prem: "(TVarB X S) \<in> set \<Gamma>" by fact
   have ih: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends \<Gamma> \<Longrightarrow> \<Delta> \<turnstile> S <: T" by fact
   have ok: "\<turnstile> \<Delta> ok" by fact
   have extends: "\<Delta> extends \<Gamma>" by fact
-  have "(X,S) \<in> set \<Delta>" using lh_drv_prem extends by (simp only: extends_memb)
+  have "(TVarB X S) \<in> set \<Delta>" using lh_drv_prem extends by (simp only: extends_memb)
   moreover
   have "\<Delta> \<turnstile> S <: T" using ok extends ih by simp
   ultimately show "\<Delta> \<turnstile> Tvar X <: T" using ok by force
 next
-  case (S_Refl \<Gamma> X)
-  have lh_drv_prem: "X \<in> domain \<Gamma>" by fact
+  case (SA_refl_TVar \<Gamma> X)
+  have lh_drv_prem: "X \<in> ty_domain \<Gamma>" by fact
   have "\<turnstile> \<Delta> ok" by fact
   moreover
   have "\<Delta> extends \<Gamma>" by fact
-  hence "X \<in> domain \<Delta>" using lh_drv_prem by (force dest: extends_domain)
+  hence "X \<in> ty_domain \<Delta>" using lh_drv_prem by (force dest: extends_ty_domain)
   ultimately show "\<Delta> \<turnstile> Tvar X <: Tvar X" by force
 next 
-  case (S_Arrow \<Gamma> T\<^isub>1 S\<^isub>1 S\<^isub>2 T\<^isub>2) thus "\<Delta> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T\<^isub>1 \<rightarrow> T\<^isub>2" by blast
+  case (SA_arrow \<Gamma> T\<^isub>1 S\<^isub>1 S\<^isub>2 T\<^isub>2) thus "\<Delta> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T\<^isub>1 \<rightarrow> T\<^isub>2" by blast
 next
-  case (S_Forall \<Gamma> T\<^isub>1 S\<^isub>1 X S\<^isub>2 T\<^isub>2)
+  case (SA_all \<Gamma> T\<^isub>1 S\<^isub>1 X S\<^isub>2 T\<^isub>2)
   have fresh_cond: "X\<sharp>\<Delta>" by fact
-  hence fresh_domain: "X\<sharp>(domain \<Delta>)" by (simp add: fresh_domain)
+  hence fresh_domain: "X\<sharp>(ty_domain \<Delta>)" by (simp add: fresh_domain)
   have ih\<^isub>1: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends \<Gamma> \<Longrightarrow> \<Delta> \<turnstile> T\<^isub>1 <: S\<^isub>1" by fact
-  have ih\<^isub>2: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends ((X,T\<^isub>1)#\<Gamma>) \<Longrightarrow> \<Delta> \<turnstile> S\<^isub>2 <: T\<^isub>2" by fact
+  have ih\<^isub>2: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends ((TVarB X T\<^isub>1)#\<Gamma>) \<Longrightarrow> \<Delta> \<turnstile> S\<^isub>2 <: T\<^isub>2" by fact
   have lh_drv_prem: "\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1" by fact
   hence closed\<^isub>T\<^isub>1: "T\<^isub>1 closed_in \<Gamma>" by (simp add: subtype_implies_closed) 
   have ok: "\<turnstile> \<Delta> ok" by fact
   have ext: "\<Delta> extends \<Gamma>" by fact
   have "T\<^isub>1 closed_in \<Delta>" using ext closed\<^isub>T\<^isub>1 by (simp only: extends_closed)
-  hence "\<turnstile> ((X,T\<^isub>1)#\<Delta>) ok" using fresh_domain ok by force   
+  hence "\<turnstile> ((TVarB X T\<^isub>1)#\<Delta>) ok" using fresh_domain ok by force   
   moreover 
-  have "((X,T\<^isub>1)#\<Delta>) extends ((X,T\<^isub>1)#\<Gamma>)" using ext by (force simp add: extends_def)
-  ultimately have "((X,T\<^isub>1)#\<Delta>) \<turnstile> S\<^isub>2 <: T\<^isub>2" using ih\<^isub>2 by simp
+  have "((TVarB X T\<^isub>1)#\<Delta>) extends ((TVarB X T\<^isub>1)#\<Gamma>)" using ext by (force simp add: extends_def)
+  ultimately have "((TVarB X T\<^isub>1)#\<Delta>) \<turnstile> S\<^isub>2 <: T\<^isub>2" using ih\<^isub>2 by simp
   moreover
   have "\<Delta> \<turnstile> T\<^isub>1 <: S\<^isub>1" using ok ext ih\<^isub>1 by simp 
-  ultimately show "\<Delta> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: \<forall>[X<:T\<^isub>1].T\<^isub>2" using ok by (force intro: S_Forall)
+  ultimately show "\<Delta> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: (\<forall>X<:T\<^isub>1. T\<^isub>2)" using ok by (force intro: SA_all)
 qed
 
 text {* In fact all ``non-binding" cases can be solved automatically: *}
@@ -461,44 +799,41 @@
   shows "\<Delta> \<turnstile> S <: T"
   using a b c 
 proof (nominal_induct \<Gamma> S T avoiding: \<Delta> rule: subtype_of.strong_induct)
-  case (S_Forall \<Gamma> T\<^isub>1 S\<^isub>1 X S\<^isub>2 T\<^isub>2)
+  case (SA_all \<Gamma> T\<^isub>1 S\<^isub>1 X S\<^isub>2 T\<^isub>2)
   have fresh_cond: "X\<sharp>\<Delta>" by fact
-  hence fresh_domain: "X\<sharp>(domain \<Delta>)" by (simp add: fresh_domain)
+  hence fresh_domain: "X\<sharp>(ty_domain \<Delta>)" by (simp add: fresh_domain)
   have ih\<^isub>1: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends \<Gamma> \<Longrightarrow> \<Delta> \<turnstile> T\<^isub>1 <: S\<^isub>1" by fact
-  have ih\<^isub>2: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends ((X,T\<^isub>1)#\<Gamma>) \<Longrightarrow> \<Delta> \<turnstile> S\<^isub>2 <: T\<^isub>2" by fact
+  have ih\<^isub>2: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends ((TVarB X T\<^isub>1)#\<Gamma>) \<Longrightarrow> \<Delta> \<turnstile> S\<^isub>2 <: T\<^isub>2" by fact
   have lh_drv_prem: "\<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1" by fact
   hence closed\<^isub>T\<^isub>1: "T\<^isub>1 closed_in \<Gamma>" by (simp add: subtype_implies_closed) 
   have ok: "\<turnstile> \<Delta> ok" by fact
   have ext: "\<Delta> extends \<Gamma>" by fact
   have "T\<^isub>1 closed_in \<Delta>" using ext closed\<^isub>T\<^isub>1 by (simp only: extends_closed)
-  hence "\<turnstile> ((X,T\<^isub>1)#\<Delta>) ok" using fresh_domain ok by force   
+  hence "\<turnstile> ((TVarB X T\<^isub>1)#\<Delta>) ok" using fresh_domain ok by force   
   moreover
-  have "((X,T\<^isub>1)#\<Delta>) extends ((X,T\<^isub>1)#\<Gamma>)" using ext by (force simp add: extends_def)
-  ultimately have "((X,T\<^isub>1)#\<Delta>) \<turnstile> S\<^isub>2 <: T\<^isub>2" using ih\<^isub>2 by simp
+  have "((TVarB X T\<^isub>1)#\<Delta>) extends ((TVarB X T\<^isub>1)#\<Gamma>)" using ext by (force simp add: extends_def)
+  ultimately have "((TVarB X T\<^isub>1)#\<Delta>) \<turnstile> S\<^isub>2 <: T\<^isub>2" using ih\<^isub>2 by simp
   moreover
   have "\<Delta> \<turnstile> T\<^isub>1 <: S\<^isub>1" using ok ext ih\<^isub>1 by simp 
-  ultimately show "\<Delta> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: \<forall>[X<:T\<^isub>1].T\<^isub>2" using ok by (force intro: S_Forall)
-qed (blast intro: extends_closed extends_memb dest: extends_domain)+
+  ultimately show "\<Delta> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: (\<forall>X<:T\<^isub>1. T\<^isub>2)" using ok by (force intro: SA_all)
+qed (blast intro: extends_closed extends_memb dest: extends_ty_domain)+
 
 section {* Transitivity and Narrowing *}
 
 text {* Some inversion lemmas that are needed in the transitivity and narrowing proof.*}
 
-lemma S_TopE:
-  assumes a: "\<Gamma> \<turnstile> Top <: T"
-  shows "T = Top"
-using a by (cases, auto) 
+declare ty.inject [simp add]
 
-lemma S_ArrowE_left:
-  assumes a: "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T" 
-  shows "T = Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T = T\<^isub>1 \<rightarrow> T\<^isub>2 \<and> \<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1 \<and> \<Gamma> \<turnstile> S\<^isub>2 <: T\<^isub>2)"
-using a by (cases, auto simp add: ty.inject)
+inductive_cases S_TopE: "\<Gamma> \<turnstile> Top <: T"
+inductive_cases S_ArrowE_left: "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T" 
+
+declare ty.inject [simp del]
 
 lemma S_ForallE_left:
-  shows "\<lbrakk>\<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: T; X\<sharp>\<Gamma>; X\<sharp>S\<^isub>1\<rbrakk>
-         \<Longrightarrow> T = Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T = \<forall>[X<:T\<^isub>1].T\<^isub>2 \<and> \<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1 \<and> ((X,T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2)"
+  shows "\<lbrakk>\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: T; X\<sharp>\<Gamma>; X\<sharp>S\<^isub>1\<rbrakk>
+         \<Longrightarrow> T = Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T = (\<forall>X<:T\<^isub>1. T\<^isub>2) \<and> \<Gamma> \<turnstile> T\<^isub>1 <: S\<^isub>1 \<and> ((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2)"
   apply(frule subtype_implies_ok)
-  apply(ind_cases "\<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: T")
+  apply(ind_cases "\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: T")
   apply(auto simp add: ty.inject alpha)
   apply(rule_tac x="[(X,Xa)]\<bullet>T\<^isub>2" in exI)
   apply(rule conjI)
@@ -509,18 +844,20 @@
   apply(rule at_ds5[OF at_tyvrs_inst])
   apply(rule conjI)
   apply(simp add: pt_fresh_left[OF pt_tyvrs_inst, OF at_tyvrs_inst] calc_atm)
-  apply(drule_tac \<Gamma>="((Xa,T\<^isub>1)#\<Gamma>)" in  subtype_implies_closed)+
+  apply(drule_tac \<Gamma>="((TVarB Xa T\<^isub>1)#\<Gamma>)" in  subtype_implies_closed)+
   apply(simp add: closed_in_def)
   apply(drule fresh_domain)+
   apply(simp add: fresh_def)
-  apply(subgoal_tac "X \<notin> (insert Xa (domain \<Gamma>))")(*A*)
+  apply(subgoal_tac "X \<notin> (insert Xa (ty_domain \<Gamma>))")(*A*)
   apply(force)
-  (*A*)apply(simp add: at_fin_set_supp[OF at_tyvrs_inst, OF finite_domain])
+  (*A*)apply(simp add: at_fin_set_supp[OF at_tyvrs_inst, OF finite_domains(1)])
   (* 2nd conjunct *)apply(frule_tac X="X" in subtype_implies_fresh)
   apply(assumption)
+  apply (frule_tac \<Gamma>="TVarB Xa T\<^isub>1 # \<Gamma>" in subtype_implies_ok)
+  apply (erule validE)
+  apply (simp add: valid_ty_domain_fresh)
   apply(drule_tac X="Xa" in subtype_implies_fresh)
   apply(assumption)
-  apply(simp add: fresh_prod)
   apply(drule_tac pi="[(X,Xa)]" in subtype_of.eqvt(2))
   apply(simp add: calc_atm)
   apply(simp add: pt_fresh_fresh[OF pt_tyvrs_inst, OF at_tyvrs_inst])
@@ -556,8 +893,8 @@
 that of @{term x} the property @{term "P y"} holds. *}
 
 lemma 
-  shows trans: "\<Gamma>\<turnstile>S<:Q \<Longrightarrow> \<Gamma>\<turnstile>Q<:T \<Longrightarrow> \<Gamma>\<turnstile>S<:T" 
-  and narrow: "(\<Delta>@[(X,Q)]@\<Gamma>)\<turnstile>M<:N \<Longrightarrow> \<Gamma>\<turnstile>P<:Q \<Longrightarrow> (\<Delta>@[(X,P)]@\<Gamma>)\<turnstile>M<:N"
+  shows subtype_transitivity: "\<Gamma>\<turnstile>S<:Q \<Longrightarrow> \<Gamma>\<turnstile>Q<:T \<Longrightarrow> \<Gamma>\<turnstile>S<:T" 
+  and subtype_narrow: "(\<Delta>@[(TVarB X Q)]@\<Gamma>)\<turnstile>M<:N \<Longrightarrow> \<Gamma>\<turnstile>P<:Q \<Longrightarrow> (\<Delta>@[(TVarB X P)]@\<Gamma>)\<turnstile>M<:N"
 proof (induct Q arbitrary: \<Gamma> S T \<Delta> X P M N taking: "size_ty" rule: measure_induct_rule)
   case (less Q)
     --{* \begin{minipage}[t]{0.9\textwidth}
@@ -566,8 +903,8 @@
   have IH_trans:  
     "\<And>Q' \<Gamma> S T. \<lbrakk>size_ty Q' < size_ty Q; \<Gamma>\<turnstile>S<:Q'; \<Gamma>\<turnstile>Q'<:T\<rbrakk> \<Longrightarrow> \<Gamma>\<turnstile>S<:T" by fact
   have IH_narrow:
-    "\<And>Q' \<Delta> \<Gamma> X M N P. \<lbrakk>size_ty Q' < size_ty Q; (\<Delta>@[(X,Q')]@\<Gamma>)\<turnstile>M<:N; \<Gamma>\<turnstile>P<:Q'\<rbrakk> 
-    \<Longrightarrow> (\<Delta>@[(X,P)]@\<Gamma>)\<turnstile>M<:N" by fact
+    "\<And>Q' \<Delta> \<Gamma> X M N P. \<lbrakk>size_ty Q' < size_ty Q; (\<Delta>@[(TVarB X Q')]@\<Gamma>)\<turnstile>M<:N; \<Gamma>\<turnstile>P<:Q'\<rbrakk> 
+    \<Longrightarrow> (\<Delta>@[(TVarB X P)]@\<Gamma>)\<turnstile>M<:N" by fact
     --{* \begin{minipage}[t]{0.9\textwidth}
     We proceed with the transitivity proof as an auxiliary lemma, because it needs 
     to be referenced in the narrowing proof.\end{minipage}*}
@@ -579,37 +916,36 @@
       and  "\<Gamma>' \<turnstile> Q <: T"  --{* right-hand derivation *}
     thus "\<Gamma>' \<turnstile> S' <: T"
     proof (nominal_induct \<Gamma>' S' Q\<equiv>Q rule: subtype_of.strong_induct) 
-      case (S_Top \<Gamma> S) 
+      case (SA_Top \<Gamma> S) 
 	--{* \begin{minipage}[t]{0.9\textwidth}
 	In this case the left-hand derivation is @{term "\<Gamma> \<turnstile> S <: Top"}, giving
 	us @{term "\<turnstile> \<Gamma> ok"} and @{term "S closed_in \<Gamma>"}. This case is straightforward, 
 	because the right-hand derivation must be of the form @{term "\<Gamma> \<turnstile> Top <: Top"} 
 	giving us the equation @{term "T = Top"}.\end{minipage}*}
       hence rh_drv: "\<Gamma> \<turnstile> Top <: T" by simp
-      hence T_inst: "T = Top" by (simp add: S_TopE)
-      have "\<turnstile> \<Gamma> ok" 
-	and "S closed_in \<Gamma>" by fact+
-      hence "\<Gamma> \<turnstile> S <: Top" by (simp add: subtype_of.S_Top)
+      hence T_inst: "T = Top" by (auto elim: S_TopE)
+      from `\<turnstile> \<Gamma> ok` and `S closed_in \<Gamma>`
+      have "\<Gamma> \<turnstile> S <: Top" by (simp add: subtype_of.SA_Top)
       thus "\<Gamma> \<turnstile> S <: T" using T_inst by simp
     next
-      case (S_Var Y U \<Gamma>) 
+      case (SA_trans_TVar Y U \<Gamma>) 
 	-- {* \begin{minipage}[t]{0.9\textwidth}
 	In this case the left-hand derivation is @{term "\<Gamma> \<turnstile> Tvar Y <: Q"} 
 	with @{term "S = Tvar Y"}. We have therefore @{term "(Y,U)"} 
 	is in @{term "\<Gamma>"} and by inner induction hypothesis that @{term "\<Gamma> \<turnstile> U <: T"}. 
 	By @{text "S_Var"} follows @{term "\<Gamma> \<turnstile> Tvar Y <: T"}.\end{minipage}*}
       hence IH_inner: "\<Gamma> \<turnstile> U <: T" by simp
-      have "(Y,U) \<in> set \<Gamma>" by fact
-      with IH_inner show "\<Gamma> \<turnstile> Tvar Y <: T" by (simp add: subtype_of.S_Var)
+      have "(TVarB Y U) \<in> set \<Gamma>" by fact
+      with IH_inner show "\<Gamma> \<turnstile> Tvar Y <: T" by (simp add: subtype_of.SA_trans_TVar)
     next
-      case (S_Refl \<Gamma> X) 
+      case (SA_refl_TVar \<Gamma> X) 
 	--{* \begin{minipage}[t]{0.9\textwidth}
         In this case the left-hand derivation is @{term "\<Gamma>\<turnstile>(Tvar X) <: (Tvar X)"} with
         @{term "Q=Tvar X"}. The goal then follows immediately from the right-hand 
 	derivation.\end{minipage}*}
       thus "\<Gamma> \<turnstile> Tvar X <: T" by simp
     next
-      case (S_Arrow \<Gamma> Q\<^isub>1 S\<^isub>1 S\<^isub>2 Q\<^isub>2) 
+      case (SA_arrow \<Gamma> Q\<^isub>1 S\<^isub>1 S\<^isub>2 Q\<^isub>2) 
 	--{* \begin{minipage}[t]{0.9\textwidth}
 	In this case the left-hand derivation is @{term "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: Q\<^isub>1 \<rightarrow> Q\<^isub>2"} with
         @{term "S\<^isub>1\<rightarrow>S\<^isub>2=S"} and @{term "Q\<^isub>1\<rightarrow>Q\<^isub>2=Q"}. We know that the @{text "size_ty"} of 
@@ -629,7 +965,7 @@
       have lh_drv_prm\<^isub>1: "\<Gamma> \<turnstile> Q\<^isub>1 <: S\<^isub>1" by fact
       have lh_drv_prm\<^isub>2: "\<Gamma> \<turnstile> S\<^isub>2 <: Q\<^isub>2" by fact      
       from rh_drv have "T=Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T=T\<^isub>1\<rightarrow>T\<^isub>2 \<and> \<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1 \<and> \<Gamma>\<turnstile>Q\<^isub>2<:T\<^isub>2)" 
-	by (simp add: S_ArrowE_left)  
+	by (auto elim: S_ArrowE_left)  
       moreover
       have "S\<^isub>1 closed_in \<Gamma>" and "S\<^isub>2 closed_in \<Gamma>" 
 	using lh_drv_prm\<^isub>1 lh_drv_prm\<^isub>2 by (simp_all add: subtype_implies_closed)
@@ -647,176 +983,1020 @@
 	moreover
 	from IH_trans[of "Q\<^isub>2"] 
 	have "\<Gamma> \<turnstile> S\<^isub>2 <: T\<^isub>2" using Q\<^isub>1\<^isub>2_less rh_drv_prm\<^isub>2 lh_drv_prm\<^isub>2 by simp
-	ultimately have "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T\<^isub>1 \<rightarrow> T\<^isub>2" by (simp add: subtype_of.S_Arrow)
+	ultimately have "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T\<^isub>1 \<rightarrow> T\<^isub>2" by (simp add: subtype_of.SA_arrow)
 	hence "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T" using T_inst by simp
       }
       ultimately show "\<Gamma> \<turnstile> S\<^isub>1 \<rightarrow> S\<^isub>2 <: T" by blast
     next
-      case (S_Forall \<Gamma> Q\<^isub>1 S\<^isub>1 X S\<^isub>2 Q\<^isub>2) 
+      case (SA_all \<Gamma> Q\<^isub>1 S\<^isub>1 X S\<^isub>2 Q\<^isub>2) 
 	--{* \begin{minipage}[t]{0.9\textwidth}
-	In this case the left-hand derivation is @{text "\<Gamma>\<turnstile>\<forall>[X<:S\<^isub>1].S\<^isub>2 <: \<forall>[X<:Q\<^isub>1].Q\<^isub>2"} with 
-	@{text "\<forall>[X<:S\<^isub>1].S\<^isub>2=S"} and @{text "\<forall>[X<:Q\<^isub>1].Q\<^isub>2=Q"}. We therefore have the sub-derivations  
-	@{term "\<Gamma>\<turnstile>Q\<^isub>1<:S\<^isub>1"} and @{term "((X,Q\<^isub>1)#\<Gamma>)\<turnstile>S\<^isub>2<:Q\<^isub>2"}. Since @{term "X"} is a binder, we
+	In this case the left-hand derivation is @{term "\<Gamma>\<turnstile>(\<forall>X<:S\<^isub>1. S\<^isub>2) <: (\<forall>X<:Q\<^isub>1. Q\<^isub>2)"} with 
+	@{term "(\<forall>X<:S\<^isub>1. S\<^isub>2)=S"} and @{term "(\<forall>X<:Q\<^isub>1. Q\<^isub>2)=Q"}. We therefore have the sub-derivations  
+	@{term "\<Gamma>\<turnstile>Q\<^isub>1<:S\<^isub>1"} and @{term "((TVarB X Q\<^isub>1)#\<Gamma>)\<turnstile>S\<^isub>2<:Q\<^isub>2"}. Since @{term "X"} is a binder, we
 	assume that it is sufficiently fresh; in particular we have the freshness conditions
 	@{term "X\<sharp>\<Gamma>"} and @{term "X\<sharp>Q\<^isub>1"} (these assumptions are provided by the strong 
 	induction-rule @{text "subtype_of_induct"}). We know that the @{text "size_ty"} of 
 	@{term Q\<^isub>1} and @{term Q\<^isub>2} is smaller than that of @{term Q};
 	so we can apply the outer induction hypotheses for @{term Q\<^isub>1} and @{term Q\<^isub>2}. 
-	The right-hand derivation is @{text "\<Gamma> \<turnstile> \<forall>[X<:Q\<^isub>1].Q\<^isub>2 <: T"}. Since @{term "X\<sharp>\<Gamma>"} 
+	The right-hand derivation is @{term "\<Gamma> \<turnstile> (\<forall>X<:Q\<^isub>1. Q\<^isub>2) <: T"}. Since @{term "X\<sharp>\<Gamma>"} 
 	and @{term "X\<sharp>Q\<^isub>1"} there exists types @{text "T\<^isub>1,T\<^isub>2"} such that 
-	@{text "T=Top \<or> T=\<forall>[X<:T\<^isub>1].T\<^isub>2"}. The @{term "Top"}-case is straightforward once we know 
-	@{text "(\<forall>[X<:S\<^isub>1].S\<^isub>2) closed_in \<Gamma>"} and @{term "\<turnstile> \<Gamma> ok"}. In the other case we have 
-	the sub-derivations @{term "\<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1"} and @{term "((X,T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2"}. Using the outer 
+	@{term "T=Top \<or> T=(\<forall>X<:T\<^isub>1. T\<^isub>2)"}. The @{term "Top"}-case is straightforward once we know 
+	@{term "(\<forall>X<:S\<^isub>1. S\<^isub>2) closed_in \<Gamma>"} and @{term "\<turnstile> \<Gamma> ok"}. In the other case we have 
+	the sub-derivations @{term "\<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1"} and @{term "((TVarB X T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2"}. Using the outer 
 	induction hypothesis for transitivity we can derive @{term "\<Gamma>\<turnstile>T\<^isub>1<:S\<^isub>1"}. From the outer 
-	induction for narrowing we get @{term "((X,T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: Q\<^isub>2"} and then using again 
-	induction for transitivity we obtain @{term "((X,T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2"}. By rule 
+	induction for narrowing we get @{term "((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: Q\<^isub>2"} and then using again 
+	induction for transitivity we obtain @{term "((TVarB X T\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: T\<^isub>2"}. By rule 
 	@{text "S_Forall"} and the freshness condition @{term "X\<sharp>\<Gamma>"} follows 
-	@{text "\<Gamma> \<turnstile> \<forall>[X<:S\<^isub>1].S\<^isub>2 <: \<forall>[X<:T\<^isub>1].T\<^isub>2"}, which is @{text "\<Gamma> \<turnstile>  \<forall>[X<:S\<^isub>1].S\<^isub>2 <: T\<^isub>"}.
+	@{term "\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: (\<forall>X<:T\<^isub>1. T\<^isub>2)"}, which is @{term "\<Gamma> \<turnstile> (\<forall>X<:S\<^isub>1. S\<^isub>2) <: T\<^isub>"}.
 	\end{minipage}*}
-      hence rh_drv: "\<Gamma> \<turnstile> \<forall>[X<:Q\<^isub>1].Q\<^isub>2 <: T" by simp
+      hence rh_drv: "\<Gamma> \<turnstile> (\<forall>X<:Q\<^isub>1. Q\<^isub>2) <: T" by simp
       have lh_drv_prm\<^isub>1: "\<Gamma> \<turnstile> Q\<^isub>1 <: S\<^isub>1" by fact
-      have lh_drv_prm\<^isub>2: "((X,Q\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: Q\<^isub>2" by fact
-      have "X\<sharp>\<Gamma>" by fact
+      have lh_drv_prm\<^isub>2: "((TVarB X Q\<^isub>1)#\<Gamma>) \<turnstile> S\<^isub>2 <: Q\<^isub>2" by fact
+      then have "X\<sharp>\<Gamma>" by (force dest: subtype_implies_ok simp add: valid_ty_domain_fresh)
       then have fresh_cond: "X\<sharp>\<Gamma>" "X\<sharp>Q\<^isub>1" using lh_drv_prm\<^isub>1 by (simp_all add: subtype_implies_fresh)
-      from `\<forall>[X<:Q\<^isub>1].Q\<^isub>2 = Q` 
+      from `(\<forall>X<:Q\<^isub>1. Q\<^isub>2) = Q` 
       have Q\<^isub>1\<^isub>2_less: "size_ty Q\<^isub>1 < size_ty Q" "size_ty Q\<^isub>2 < size_ty Q " using fresh_cond by auto
       from rh_drv 
-      have "T=Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T=\<forall>[X<:T\<^isub>1].T\<^isub>2 \<and> \<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1 \<and> ((X,T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2)" 
+      have "T=Top \<or> (\<exists>T\<^isub>1 T\<^isub>2. T=(\<forall>X<:T\<^isub>1. T\<^isub>2) \<and> \<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1 \<and> ((TVarB X T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2)" 
 	using fresh_cond by (simp add: S_ForallE_left)
       moreover
-      have "S\<^isub>1 closed_in \<Gamma>" and "S\<^isub>2 closed_in ((X,Q\<^isub>1)#\<Gamma>)" 
+      have "S\<^isub>1 closed_in \<Gamma>" and "S\<^isub>2 closed_in ((TVarB X Q\<^isub>1)#\<Gamma>)" 
 	using lh_drv_prm\<^isub>1 lh_drv_prm\<^isub>2 by (simp_all add: subtype_implies_closed)
-      hence "(\<forall>[X<:S\<^isub>1].S\<^isub>2) closed_in \<Gamma>" by (force simp add: closed_in_def ty.supp abs_supp)
+      hence "(\<forall>X<:S\<^isub>1. S\<^isub>2) closed_in \<Gamma>" by (force simp add: closed_in_def ty.supp abs_supp)
       moreover
       have "\<turnstile> \<Gamma> ok" using rh_drv by (rule subtype_implies_ok)
       moreover
-      { assume "\<exists>T\<^isub>1 T\<^isub>2. T=\<forall>[X<:T\<^isub>1].T\<^isub>2 \<and> \<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1 \<and> ((X,T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2"
+      { assume "\<exists>T\<^isub>1 T\<^isub>2. T=(\<forall>X<:T\<^isub>1. T\<^isub>2) \<and> \<Gamma>\<turnstile>T\<^isub>1<:Q\<^isub>1 \<and> ((TVarB X T\<^isub>1)#\<Gamma>)\<turnstile>Q\<^isub>2<:T\<^isub>2"
 	then obtain T\<^isub>1 T\<^isub>2